;; ffi/gettext-po.ffi			-*- scheme -*-

;; Copyright (C) 2018 Matthew R. Wette
;;
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
;; License as published by the Free Software Foundation; either
;; version 3 of the License, or (at your option) any later version.
;;
;; This library is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; Lesser General Public License for more details.
;;
;; You should have received a copy of the GNU Lesser General Public License
;; along with this library; if not, see <http://www.gnu.org/licenses/>

;; initiated by Florian Pelz

(define-ffi-module (ffi gettext-po)
  #:include '("gettext-po.h")
  #:library '("libgettextpo"))

(define-public std-po-error-handler
  (let* ((error
	  (lambda (status errnum format)
	    (simple-format #t "~A\n" (ffi:pointer->string format))))
	 (error-p
	  (ffi:procedure->pointer ffi:void error (list ffi:int ffi:int '*)))
	 ;;
	 (error_at_line
	  (lambda (status errnum filename lineno format)
	    (simple-format #t "~A\n" (ffi:pointer->string format))))
	 (error_at_line-p
	  (ffi:procedure->pointer ffi:void error_at_line
				  (list ffi:int ffi:int '* ffi:int '*)))
	 ;;
	 (multiline_warning
	  (lambda (prefix message)
	    (simple-format #t "~A ~A\n"
			   (ffi:pointer->string prefix)
			   (ffi:pointer->string message))))
	 (multiline_warning-p
	  (ffi:procedure->pointer ffi:void multiline_warning (list '* '*)))
	 ;;
	 (multiline_error
	  (lambda (prefix message)
	    (simple-format #t "~A ~A\n" prefix message)))
	 (multiline_error-p
	  (ffi:procedure->pointer ffi:void multiline_error (list '* '*)))
	 ;;
	 (eh-struct (make-struct-po_error_handler)))
    
    (fh-object-set! eh-struct 'error error-p)
    (fh-object-set! eh-struct 'error_at_line error_at_line-p)
    (fh-object-set! eh-struct 'multiline_warning multiline_warning-p)
    (fh-object-set! eh-struct 'multiline_error multiline_error-p)
    ;;
    ;; The ffi helper needs help to make this easier:
    (make-po_error_handler_t
     (ffi:pointer-address
      ((fht-unwrap struct-po_error_handler*)
       (pointer-to eh-struct))))))

(define-public std-po-xerror-handler
  (let* (
	 (xerror
	  (lambda (severity message filename lineno column multiline_p
			    message_text)
	    (simple-format #t "~A\n" (ffi:pointer->string message_text))))
	 (xerror-p
	  (ffi:procedure->pointer
	   ffi:void xerror
	   (list ffi:int '* '* ffi:size_t ffi:size_t ffi:int '*)))
	 (xerror2
	  (lambda (severity
		   message1 filename1 lineno1 column1 multiline_p1 message_text1
		   message2 filename2 lineno2 column2 multiline_p2 message_text2
		   )
	    (simple-format #t "~A\n" (ffi:pointer->string message_text1))))
	 (xerror2-p
	  (ffi:procedure->pointer
	   ffi:void xerror2
	   (list ffi:int '* '* ffi:size_t ffi:size_t ffi:int '*
		 ffi:int '* '* ffi:size_t ffi:size_t ffi:int '*)))
	 ;;
	 (eh-struct (make-struct-po_xerror_handler)))
    
    (fh-object-set! eh-struct 'xerror (ffi:pointer-address xerror-p))
    (fh-object-set! eh-struct 'xerror2 (ffi:pointer-address xerror2-p))
    ;;
    ;; The ffi helper needs help to make this easier:
    (make-po_xerror_handler_t
     (ffi:pointer-address
      ((fht-unwrap struct-po_xerror_handler*)
       (pointer-to eh-struct))))))

;; --- last line ---
