;;; Guile bindings for Mutt
;;; Copyright (C) 2003  Ludovic Courtès

;;; This program is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License
;;; as published by the Free Software Foundation; either version 2
;;; of the License, or (at your option) any later version.
;;; 
;;; This program 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 General Public License for more details.
;;; 
;;; You should have received a copy of the GNU General Public License
;;; along with this program; if not, write to the Free Software
;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.  */

(mutt-module (mutt helpers misc)
	     #:documentation
"Miscellaneous helper functions.")



(define-public (inbox? mailbox)
  "Returns true if @var{mailbox} is in the inbox ($spoolfile)."
  (let ((spoolfile (builtin-query-option "spoolfile"))
	(path      (mailbox-path mailbox)))
    (or
      (string=? path spoolfile)
      (string=? path (expand-path spoolfile))
      (string=? (expand-path path) (expand-path spoolfile))
      (string=? (expand-path path)  ; IMAP
		(string-append spoolfile "INBOX")))))

(define-public (loop-until-true proc lst)
  "Traverse list @var{lst} calling procedure @var{proc} until @var{proc}
returns true and return the remaining list entries."
  (while (and (not (null? lst))
	      (not (proc (car lst))))
	 (set! lst (cdr lst)))
  (ui-debug (format #f "loop-until-true: ~a" lst))
  lst)

(define-public (pretty-address address)
  "Return a string representing @var{address}, an address object."
  (let ((mailbox (address-mailbox address))
        (personal (address-personal address)))
    (if personal
	personal
	(if mailbox
	    (string-append "<" mailbox ">")
	    "<no-address>"))))

(define-public (full-address address)
  "Return a string fully representing @var{address}, an address object."
  (let ((mailbox (address-mailbox address))
        (personal (address-personal address)))
    (string-append
     (if personal
	 (string-append personal " "))
     "<" (if mailbox mailbox "<no-address>") ">")))

(define-public (quote-string string)
  "Quote simple quotes from @var{string}."
  (regexp-substitute/global #f "\"" string 'pre "\\\"" 'post))

(define (find-header header-list header-type)
  "Find in @var{header-list} a header of type @var{header-type}."
  (if (null? header-list)
      #f
      (let ((this-header (car header-list))
	    (header-len  (string-length header-type)))
	(if (string=? (substring this-header 0 header-len)
		      header-type)
	    (substring this-header (+ header-len 1))
	    (find-header (cdr header-list) header-type)))))

(define-public (get-message-header message header-type)
  "Return the value (a string) for @var{message}'s user header
@var{header-type} (e.g. @code{\"X-Mailer\"}).  NOTE: Inbox messages
@code{envelope-user-headers} is always en empty list!"
  (let ((user-headers (envelope-user-headers (message-envelope
					      message))))
    (if (= 0 (length user-headers))
	(and (ui-message "No user-headers!")
	     (sleep 1)
	     #f)
	(find-header user-headers header-type))))

(define-public (pipe-file-through-command filename command)
  "Pipe file @var{filename} through shell command @var{command} and
return a @code{waitpid} status for @var{command}."
  (let* ((command-pipe (open-output-pipe command)))
    (if command-pipe
	(let* ((file (open-input-file filename))
	       (line ""))
	  (if file
	      (begin
		(while (not (eof-object? line))
		       (begin
; 			 (catch 'system-error
; 				(lambda ()
; 				  (set! status (waitpid WAIT_ANY WNOHANG)))
; 				(lambda (key . args)
; 				  (set! status #f)))
			 (display line command-pipe)
			 (newline command-pipe)
			 (set! line (read-line file))))

		(close-port file)

		; Check whether the task is already over
		(let ((status (close-pipe command-pipe)))
		  ;(format #t "status: ~a~%" status)
		  status))

	      (and (ui-error (string-append "Failed to open "
					    filename)) #f)))
	(and (ui-error "Failed to create pipe") #f))))

(define-public (command-output command)
  "Return the output string of shell command @var{command}."
  (let ((command-pipe (open-input-pipe command))
	(output-string ""))
    (if (not command-pipe)
	#f
	(let ((line ""))
	  (while
	   (or (catch 'system-error
		      (lambda ()
			(= 0 (car (waitpid WAIT_ANY WNOHANG))))
		      (lambda (key . args) #f))
	       (not (eof-object? line)))
	   (begin
	     (set! line (read-line command-pipe))
	     (if (not (eof-object? line))
		 (set! output-string
		       (string-append output-string line "\n")))))
	  (false-if-exception (close-pipe command-pipe))
	  output-string))))

(define-public (strip-non-printable-chars string)
  "Replace newline and tab chars from @var{string} by spaces."
  (list->string (map (lambda (char)
		       (cond
			((char=? char #\newline) #\space)
			((char=? char #\tab)     #\space)
			(#t                      char)))
		     (string->list string))))