;;;  This file is part of the BBDB Filters Package. BBDB Filters Package is a
;;;  collection of input and output filters for BBDB.
;;; 
;;;  Copyright (C) 1995 Neda Communications, Inc.
;;; 	Prepared by Mohsen Banan (mohsen@neda.com)
;;; 
;;;  This library 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.
;;; 
;;; This is bbdb-ph.el
;;;
;;;
;;; RCS: bbdb-ph.el,v 1.1.1.1 1995/08/07 08:43:08 mohsen Exp
;;;
;;; a copy-and-edit job on bbdb-print.el


;;; To use this, add the following to your .emacs
;;; and strip ";;;XXX"
;;;

;;;XXX;; BBDB PH Filter
;;;XXX(load "bbdb-ph")

;;;XXX(setq bbdb-ph-filename
;;;XXX      (concat "/dos/u/" (user-login-name) "/bb-phone.cdf"))
;;;XXX;;; - to output the *BBDB* buffer in PH tab-delimited-file (.CDF)
;;;XXX;;; format, invoke M-x bbdb-ph-output
;;;XXX;;;
;;;XXX;;; - you may also want to modify default values of the following (use
;;;XXX;;;   M-x describe-variable for details):
;;;XXX;;;     bbdb-ph-output-elide
;;;XXX;;;     bbdb-ph-output-requires
;;;XXX;;;     bbdb-ph-output-no-bare-names


(require 'bbdb-print)
(require 'basic-ext)


(defvar bbdb-ph-filename "~/data.out"
  "*Default file name for bbdb-output-ph printouts of BBDB database.")


(defvar bbdb-ph-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-ph-output-requires.")


(defvar bbdb-ph-output-requires '(and name net)
  "*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-ph-output-elide.
")


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


(defun bbdb-ph-output (to-file)
  "Print the selected BBDB entries"
  (interactive (list (read-file-name "Print To File: " bbdb-ph-filename)))
  (setq bbdb-ph-filename (expand-file-name to-file))
  (let ((current-letter t)
	(records (progn (set-buffer bbdb-buffer-name)
			bbdb-records)))
    (find-file bbdb-ph-filename)
    (delete-region (point-min) (point-max))
    (while records
      (setq current-letter
	    (boph-maybe-format-record (car (car records)) current-letter))
      (setq records (cdr records)))
    (goto-char (point-min))
    (message "PH tag and tab-delimited file %s generated." bbdb-ph-filename)))


(defun boph-maybe-format-record (record &optional current-letter brief)
  "Insert the bbdb RECORD in Ph 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.
Someday, optional third arg BRIEF will produce one-line format."
  (bbdb-debug (if (bbdb-record-deleted-p record)
		  (error "plus ungood: formatting deleted record")))

  (let* ((bbdb-elided-display bbdb-ph-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))))
	 (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)
	 ph-name ph-email ph-office-phone ph-skypager ph-portable
	 ph-title-notes-part
	 saved-case-fold)


    ;; Section header, if neccessary.

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


    (if (eval bbdb-ph-output-requires)
	(progn

	  ;; =============================================================
	  ;; grovel through BBDB record collecting ph-relevant information
	  ;; =============================================================

	  ;; grovel through name
	  ;;
	  (setq ph-name name)

	  ;; grovel through phone numbers
	  ;;
	  (progn
	    (setq saved-case-fold case-fold-search
		  case-fold-search t)
	    (while phones
	      (let ((place (aref (car phones) 0))
		    (number (bbdb-phone-string (car phones))))
		(cond ((or (string-match place "office")
			   (string-match place "work"))
		       (if (null ph-office-phone)
			   (setq ph-office-phone number)))
		      ((or (string-match place "mobile")
			   (string-match place "cellular"))
		       (if (null ph-portable)
			   (setq ph-portable number)))
		      (t nil)))
	      (setq phones (cdr phones)))


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

	  ;; grovel through BBDB email-addresses
	  ;;
	  (if net
	      (setq ph-email (car net)))

	  ;; grovel through BBDB Notes
	  ;;
	  (progn 

	    (if (stringp notes)
		(setq notes (list (cons 'notes notes))))

	    (while notes
	      (let ((curr-note (car notes)))
		(if (bbdb-field-shown-p (car curr-note))
		    (cond ((member (car curr-note) '(skypage pager))
			   (setq ph-skypager (boph-mangle-if-multi-line (cdr curr-note))))
			  ((equal (car curr-note) 'mobile)
			   (setq ph-portable (boph-mangle-if-multi-line (cdr curr-note))))
			  ((equal (car curr-note) 'notes)
			   (setq ph-title-notes-part (boph-mangle-if-multi-line (cdr curr-note))))
			  (t nil))
		  ))
	      (setq notes (cdr notes)))
	    )

	  ;; grovel through comp
	  ;;
	  (setq ph-title-coname-part comp)
	  (setq ph-title (concat (or ph-title-coname-part "")
				 (if (and ph-title-coname-part ph-title-notes-part) " " "")
				 (if ph-title-notes-part (concat "[" ph-title-notes-part "]") "")))

	  ;; ====================
	  ;; now output PH record
	  ;; ====================

	  ;; PH 'name' field (maxlen 256)
	  ;;
	  (insert (format "3:%s\t" (boph-maybe-truncate (or name "") 256)))

	  ;; PH 'email' field (maxlen 25) (should be 128?)  ** NOT YET **
	  (if ph-email (setq bare nil))
	  (insert (format "2:%s\t" (boph-maybe-truncate (or ph-email "") 25)))

	  ;; PH 'office_phone' field (max len 60)
	  ;;
	  (if ph-office-phone (setq bare nil))
	  (insert (format "32:%s\t" (boph-maybe-truncate (or ph-office-phone "") 60)))

	  ;; PH 'title' field (maxlen 120) 
	  (insert (format "98:%s\t" (boph-maybe-truncate ph-title 120)))

	  ;; PH 'portable' field (maxlen 60)
	  (if ph-portable (setq bare nil))
	  (insert (format "97:%s\t" (boph-maybe-truncate (or ph-portable "") 60)))

	  ;; PH 'skypager' field (maxlen 64)
	  (if ph-skypager (setq bare nil))
	  (insert (format "27:%s\t" (boph-maybe-truncate (or ph-skypager "") 64)))

	  ;; ==========
	  ;; bare check
	  ;; ==========

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

    ;; return current letter
    current-letter))


(defun boph-maybe-truncate (string maxlen)
  "If STRING is longer than MAXLEN, returns a truncated version."
  (if (> (length string) maxlen)
      (substring string 0 maxlen)
    string))


(defun boph-mangle-if-multi-line (string)
  "If STRING is has multiple lines, mangle it for output to PH"
  (if (string-match "\n" string)
      (string-replace-regexp string "\n" "\t") ; tabs are used to denote new lines in the .cdf file
  string))