1 files changed, 253 insertions, 0 deletions
diff --git a/bits/bbdb-filters/bbdb-ph.el b/bits/bbdb-filters/bbdb-ph.el
new file mode 100644
index 0000000..fc21502
--- /dev/null
+++ b/bits/bbdb-filters/bbdb-ph.el
@@ -0,0 +1,253 @@
+;;;  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))