;;;  bbdb-pilot.el -- convert bbdb records to pilot databases
;;;
;;;  Author: Tom Fawcett <fawcett@basit.com>
;;;  Copyright (C) 1998 Tom Fawcett
;;; 
;;;  This file is free software; you can redistribute it and/or modify
;;;  it under the terms of the GNU Library General Public License as
;;;  published by the Free Software Foundation; either version 2 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 Library General Public
;;;  License for more details.  You should have received a copy of the GNU
;;;  Library General Public License along with this library; if not, write
;;;  to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139,
;;;  USA.
;;; 
;;;
;;; Commentary:
;;;
;;; This is bbdb-pilot.el, a copy-and-edit job on bbdb-hp200lx.el
;;; To use this, add the following to your .emacs
;;; and strip ";;;XXX"
;;;
;; BBDB PILOT Filter
;;(load "bbdb-pilot")
;;
;;; - to output the *BBDB* buffer in PILOT comma-delimited-file
;;; format, invoke M-x bbdb-pilot-output
;;;
;;; - you may also want to modify default values of the following (use
;;;   M-x describe-variable for details):
;;;     bbdb-pilot-output-elide
;;;     bbdb-pilot-output-requires
;;;     bbdb-pilot-output-no-bare-names
;;;     bbdb-pilot-customX (with X={1,..,4})

;;; To use this utility, you'll have to get the pilot-link package, a
;;; collection of Unix utilities for communicating with the Pilot.
;;; Specifically, you'll need the pilot-addresses script.
;;; Pilot-link is available from either of these URLs:
;;; 	ftp://ryeham.ee.ryerson.ca/pub/PalmOS/
;;; 	ftp://ns1.pfnet.com/pub/PalmOS/
;;;
;;; Compile the package, or at least the pilot-addresses program.
;;;
;;; To download a bbdb database to your Pilot:
;;; (1) Run bbdb to create a *BBDB* buffer with the set of addresses
;;;     you want to download.  To download your entire database, simply
;;;     hit Return when prompted for a regexp.
;;; (2) Run M-X bbdb-pilot-output and give it a file name, say,
;;;     bbdb-addresses.pilot.
;;; (3) After it finishes, save the buffer out.  You should probably
;;;     check it over by eye before the next step.
;;; (3) Run the Unix script pilot-addresses to download the address file
;;;     to the pilot.  For example:
;;;            pilot-addresses -p /dev/cua0 -r bbdb-addresses.pilot
;;; (4) Press the HotSync button on the Pilot cradle.  The addresses
;;;     will end up in the Unfiled category of the Pilot AddressBook.
;;;
;;; Known bugs/limitations:
;;; - This script could do a better job of address phone label
;;;   recognition.  It gets you about 98% of the way.
;;; - I suspect the script will fail if you have strange characters in your
;;;   bbdb records, eg embedded double quotes.
;;; - I'm not sure what the script will do if you "name" from the
;;;   required field list.
;;; - I have left in no checks for field length limits.  I believe the
;;;   pilot-addresses script trims fields itself, so this is probably
;;;   unnecessary.
;;;
;;; 
;;; Further changes done by Michael Steiner <steiner@acm.org>
;;; - added support for custom fields
;;; - as pilot only knows of one address just the first is taken 
;;;   as pilot-address.  I added now the remaining addresses as notes fields
;;;   limitations:
;;; - should there be support for pilot categories ?

(require 'bbdb-print)
(require 'cl)				; Use common lisp extensions

(defconst empty-string "\"\"")

(defvar bbdb-pilot-filename "~/files/addresses.pilot"
  "*Default file name for bbdb-output-pilot printouts of BBDB database.")


(defvar bbdb-pilot-output-elide '(creation-date timestamp mail-alias)
  "*List of symbols denoting BBDB fields NOT to be output.
Valid symbols are: name comp net phones addrs.  You can also use the
tags for notes (e.g., creation-date).
  e.g.: '(net creation-date)
See also variable bbdb-pilot-output-requires.")


(defvar bbdb-pilot-output-requires '(or name comp)
  "*A boolean expression of 'and' and 'or' to be evaluated to determine if
the current record should be output.  Valid symbols for use
in the boolean expression are: name comp net phones addrs notes.
  e.g.: (and name (or comp addrs))
See also variable bbdb-pilot-output-elide.
")


(defvar bbdb-pilot-output-no-bare-names t
  "*A bare name is one with no information other than
that in bbdb-pilot-output-requires.  To avoid printing
these set this variable to t")

(defvar bbdb-pilot-custom1 'maiden
  "the notes-field name of the custom field 1.
Should be a symbol, not a string !
Note that if you change this field once this file is 
loaded you would have to change also bbdb-pilot-custom-regexp ! ") 

(defvar bbdb-pilot-custom2 'family
  "the notes-field name of the custom field 2
Should be a symbol, not a string !
Note that if you change this field once this file is 
loaded you would have to change also bbdb-pilot-custom-regexp ! ")

(defvar bbdb-pilot-custom3 'birthday
  "the notes-field name of the custom field 3.
Should be a symbol, not a string !
Note that if you change this field once this file is 
loaded you would have to change also bbdb-pilot-custom-regexp ! ")

(defvar bbdb-pilot-custom4 'anniversary
  "the notes-field name of the custom field 4.
Should be a symbol, not a string !
Note that if you change this field once this file is 
loaded you would have to change also bbdb-pilot-custom-regexp ! ")

(defconst bbdb-pilot-custom-regexp
  (concat "^\\("
	  (symbol-name bbdb-pilot-custom1) "\\|"
	  (symbol-name bbdb-pilot-custom2) "\\|"
	  (symbol-name bbdb-pilot-custom3) "\\|"
	  (symbol-name bbdb-pilot-custom4) "\\|"
	  "title\\|attribution"
	  "\\)$"))

(defun bbdb-pilot-output (to-file)
  "Print the selected BBDB entries"
  (interactive (list (read-file-name (concat "Print To File [" bbdb-pilot-filename "]: ")
				     nil
				     (expand-file-name bbdb-pilot-filename))))
  (setq bbdb-pilot-filename (expand-file-name to-file))
  (let ((current-letter t)
	(records (progn (set-buffer bbdb-buffer-name)
			bbdb-records)))
    (find-file bbdb-pilot-filename)
    (delete-region (point-min) (point-max))
    (while records
      (setq current-letter
	    (boh-maybe-format-record (car (car records)) current-letter))
      (setq records (cdr records)))
    (goto-char (point-min))
    (message "Pilot address file %s generated." bbdb-pilot-filename)))


(defun boh-maybe-format-record (record &optional current-letter)
  "Insert the bbdb RECORD in Pilot format.
Optional CURRENT-LETTER is the section we're in -- if this is non-nil and
the first letter of the sortkey of the record differs from it, a new section
heading will be output \(an arg of t will always produce a heading).
The new current-letter is the return value of this function. "
  ;;;  Note that this function binds bare, which is set freely by
  ;;;  other low-level functions.
  (bbdb-debug (if (bbdb-record-deleted-p record)
		  (error "plus ungood: formatting deleted record")))

  (let* ((bbdb-elided-display bbdb-pilot-output-elide)
	 (first-letter
	  (substring (concat (bbdb-record-sortkey record) "?") 0 1))
	 (name   (and (bbdb-field-shown-p 'name)
		      (or (bbdb-record-getprop record 'tex-name)
			  (bbdb-record-name record))))
	 (lastname (and (bbdb-field-shown-p 'lastname)
			(bbdb-record-lastname record)))
	 (firstname (and (bbdb-field-shown-p 'firstname)
			 (bbdb-record-firstname record)))
	 (comp   (and (bbdb-field-shown-p 'company)
		      (bbdb-record-company record)))
	 (net    (and (bbdb-field-shown-p 'net)
		      (bbdb-record-net record)))
	 (phones (and (bbdb-field-shown-p 'phone)
		      (bbdb-record-phones record)))
	 (addrs  (and (bbdb-field-shown-p 'address)
		      (bbdb-record-addresses record)))
	 (notes  (bbdb-record-raw-notes record))
	 (begin (point))
	 (bare t))


    ;; Section header, if neccessary.

    (if (and current-letter (not (string-equal first-letter current-letter)))
	(message "Now processing \"%s\" entries..." (upcase first-letter)))

    (when (eval bbdb-pilot-output-requires)

      ;; Pilot last name field -- from BBDB name
      (insert-string-or-null lastname)

      ;; First name field
      (insert-string-or-null firstname)

      ;; Title -- not provided by bbdb
      (bbdb-insert-title notes)

      ;; Company field  -- used for BBDB company
      (insert-string-or-null comp)

      ;; Phone numbers
      (process-phone-numbers phones)

      ;; Net (= e-mail) address
      (insert-string-or-null (first net))
      (if net (pop net))

      ;; handle addresses
      (let ((addr (car addrs)))
	; as the pilot only has one address field take here just take the first
	; bbdb address 
	(cond (addr
	       (insert-lines (concat "[" (bbdb-address-location addr) "]")
		             (bbdb-address-street1 addr)
			     (bbdb-address-street2 addr)
			     (bbdb-address-street3 addr))

	       (insert-string-or-null (bbdb-address-city addr))
	       (insert-string-or-null (bbdb-address-state addr))
	       (insert-string-or-null (bbdb-address-zip-string addr))
	       (insert-string-or-null )	;leave country empty
	       (setq bare nil)
	       )
	      (t;; No address
	       (insert-string-or-null)
	       (insert-string-or-null)
	       (insert-string-or-null)
	       (insert-string-or-null)
	       (insert-string-or-null)
	       )))
      ;; the remaining addresses are handled below
      (setq addrs (cdr addrs))

      ;;  4 custom fields
      (bbdb-pilot-insert-custom bbdb-pilot-custom1 notes)
      (bbdb-pilot-insert-custom bbdb-pilot-custom2 notes)
      (bbdb-pilot-insert-custom bbdb-pilot-custom3 notes)
      (bbdb-pilot-insert-custom bbdb-pilot-custom4 notes)
	    
      ;; BBDB Notes
      (if (and (null notes) (null addrs))
	  (insert-string-or-null)	; no notes and no remaining addresses to cover
	;; we do have either addresses or notes ...
	(insert "\"")			; start record ..
	; .. so handle first remaining addresses
	(while addrs
	  (let*
	      ((addr     (car addrs))
	       (location (bbdb-address-location addr))
	       (street1  (bbdb-address-street1 addr))
	       (street2  (bbdb-address-street2 addr))
	       (street3  (bbdb-address-street3 addr))
	       (city     (bbdb-address-city addr))
	       (state    (bbdb-address-state addr))
	       (zip      (bbdb-address-zip-string addr)))
	    (insert
	     (format "[%s]\n" location)
	     (if (not (equal "" street1))  (format "  %s\n" street1) "")
	     (if (not (equal "" street2))  (format "  %s\n" street2) "")
	     (if (not (equal "" street3))  (format "  %s\n" street3) "")
		 (if (equal "" state)
			 (if (equal "" city) 
				 "" 
			   (format "  %s\n" city))
		   (if (equal "" city)
			   (format "  %s\n" state)
			 (format "  %s, %s\n" city state)))
	     (if (not (equal "" zip    ))  (format "    %s\n" zip)     "")))
	  (setq addrs (cdr addrs)))
	;; and then the notes 
	(if notes
	    (progn
	      (if (stringp notes)
		  (setq notes (list (cons 'notes notes))))
	      (while notes
			(let* ((thisnote       (car notes))
				   (thisnote-name  (car thisnote))
				   (thisnote-value (cdr thisnote))
				   )
			  (cond ((and		; if  ..
										; ..not elided ..
					  (bbdb-field-shown-p thisnote-name) 
										; ...and not special custom field
					  (not (string-match bbdb-pilot-custom-regexp
					       (symbol-name thisnote-name))) 
			  )
			 (setq bare nil)
			 (insert 
										; .. insert the notes entry ...
			  (if (eq 'notes thisnote-name) 
				     (format "%s\n" 
					     (bbdb-string-trim 
					      (sanitize thisnote-value)))
				(format "Note [%s]: %s\n"
						(bbdb-string-trim 
						 (symbol-name thisnote-name))
						(bbdb-string-trim 
						 (sanitize thisnote-value))))
			  ))))
		(setq notes (cdr notes)))))
	; .. and finally close notes record
	(insert "\",")
	) ; end else-part of (if (not notes addrs)

        ;;; End of record.
	;; If record is bare, delete anything we may have inserted.
	;; otherwise, mark the end of this record.
	(if (and bare bbdb-pilot-output-no-bare-names)
	    (delete-region begin (point))
	  (insert "\"0\"\n"))		; end of record
	)
    )	; end initial (let* ...

  ;; return current letter
  current-letter)


(defun process-phone-numbers (phones)
  ;;
  (let (business-phone home-phone fax-phone more-phones
		       saved-case-fold)
    (setq saved-case-fold  case-fold-search
	  case-fold-search t)

    (mapc #'(lambda (phone)
	      (let* ((place (aref phone 0))
		     (number (bbdb-phone-string phone))
		     (place+number (list place number)))
	      
		(cond ((or (string-match place "office")
			   (string-match place "Work phone"))
		       (if (null business-phone)
			   (setq business-phone (list place number))
			 (push place+number more-phones)))
		      ((string-match place "Home phone")
		       (if (null home-phone)
			   (setq home-phone (list place number))
			 (push place+number more-phones)))
		      ((or (string-match place "Fax")
			   (string-match place "FAX")
			   (string-match place "Work FAX")
			   (string-match place "Home FAX"))
		       (if (null fax-phone)
			   (setq fax-phone (list place number))
			 (push place+number more-phones)))
		      (t
		       (push place+number more-phones)))))
	  phones)

    (setq case-fold-search saved-case-fold)

    ;; WORK phone 
    (insert-string-or-null (second business-phone))

    ;; HOME phone
    (insert-string-or-null (second home-phone))

    ;; FAX phone
    (insert-string-or-null (second fax-phone))

    ;; OTHER phone numbers
    ;; This basically gets everything else we didn't recognize
    ;; Let the Pilot user figure out what to do with them
    (cond (more-phones
	   (insert "\"")
	   (loop for phone-pair in more-phones do
		 (insert (format "[%s]\n%s\n" 
				 (first phone-pair) 
				 (second phone-pair))))
	   (insert "\",")
	   (setq bare nil))
	  (t (insert empty-string ",")))
    )
  )




;;; These two functions set bare if they do anything nontrivial.
;;; bare is bound in boh-maybe-format-record.
(defun insert-lines (&rest lines) 
  (cond (lines
	 (insert "\"")
	 (let ((l lines)
	       x)
	   (while l
	     (setq x (car l))
	     (if x (insert (sanitize x)) (return))
	     (setq bare nil)
	     (setq l (cdr l))
	     (if (and (car l)
		      (not (string-equal (car l) "")))
		 (insert "\n"))
	     )
	   )
	 (insert "\"")
	 )
	(t (insert empty-string)))
  (insert ","))

(defun insert-string-or-null (&optional string)
  (cond (string
	 (insert "\"" (sanitize string) "\"")
	 (setq bare nil))
	(t (insert empty-string)))
  (insert ","))


(defun sanitize (x)
  ;;  Do whatever sanitization needs to be done.
  ;;  For the moment, just convert embedded double quotes
  ;;  to "".
  (let ((start 0)
	next)
    (while (setq next (string-match "\"" x start))
      (setq x (replace-match "\"\"" nil nil x)
	    start (+ next 2))))
  x)

(defun bbdb-insert-title (notes-field)
  ;; check if there is a `title' custom field, and if so print it.
  ;; check if custom-field is contained in notes-field. if so print it
  (insert-string-or-null 
   (if (and  'title notes)	; only if both fields are non-null
       (let ((field (assoc 'title notes-field)))
	 (if field			; field exists
	    (let ((field-value (cdr field)))
	      (format "%s"
		      (bbdb-string-trim field-value))))))) ;note sanitize is done in insert-string-or-null !
)

(defun bbdb-pilot-insert-custom (field-name notes-field)
  ;; check if custom-field is contained in notes-field. if so print it
  (insert-string-or-null 
   (if (and field-name notes)	; only if both fields are non-null
       (let ((field (assoc field-name notes-field)))
	 (if field			; field exists
	    (let ((field-value (cdr field)))
	      (format "%s\n"
		      (bbdb-string-trim field-value))))))) ;note sanitize is done in insert-string-or-null !
)

(provide 'bbdb-pilot)