diff options
Diffstat (limited to 'bits/bbdb-filters/bbdb-hp200lx.el')
-rw-r--r-- | bits/bbdb-filters/bbdb-hp200lx.el | 348 |
1 files changed, 348 insertions, 0 deletions
diff --git a/bits/bbdb-filters/bbdb-hp200lx.el b/bits/bbdb-filters/bbdb-hp200lx.el new file mode 100644 index 0000000..fe3f00a --- /dev/null +++ b/bits/bbdb-filters/bbdb-hp200lx.el @@ -0,0 +1,348 @@ +;;; 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-hp200lx.el +;;; +;;; +;;; RCS: bbdb-hp200lx.el,v 1.1.1.1 1995/08/07 08:43:09 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 HP200LX Filter +;;;XXX(load "bbdb-hp200lx") + +;;;XXX(setq bbdb-hp200lx-filename +;;;XXX (concat "/dos/u/" (user-login-name) "/bb-phone.cdf")) +;;;XXX;;; - to output the *BBDB* buffer in HP200LX comma-delimited-file (.CDF) +;;;XXX;;; format, invoke M-x bbdb-hp200lx-output +;;;XXX;;; +;;;XXX;;; - you may also want to modify default values of the following (use +;;;XXX;;; M-x describe-variable for details): +;;;XXX;;; bbdb-hp200lx-output-elide +;;;XXX;;; bbdb-hp200lx-output-requires +;;;XXX;;; bbdb-hp200lx-output-no-bare-names + + +(require 'bbdb-print) +(require 'basic-ext) + + +(defvar bbdb-hp200lx-filename "~/bb-phone.cdf" + "*Default file name for bbdb-output-hp200lx printouts of BBDB database.") + + +(defvar bbdb-hp200lx-output-elide '(net 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-hp200lx-output-requires.") + + +(defvar bbdb-hp200lx-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-hp200lx-output-elide. +") + + +(defvar bbdb-hp200lx-output-no-bare-names t + "*A bare name is one with no information other than +that in bbdb-hp200lx-output-requires. To avoid printing +these set this variable to t") + + +(defun bbdb-hp200lx-output (to-file) + "Print the selected BBDB entries" + (interactive (list (read-file-name "Print To File: " bbdb-hp200lx-filename))) + (setq bbdb-hp200lx-filename (expand-file-name to-file)) + (let ((current-letter t) + (records (progn (set-buffer bbdb-buffer-name) + bbdb-records))) + (find-file bbdb-hp200lx-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 "HP 200LX comma-delimited phonebook file %s generated." bbdb-hp200lx-filename))) + + +(defun boh-maybe-format-record (record &optional current-letter brief) + "Insert the bbdb RECORD in Hp200lx 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-hp200lx-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)) + + + ;; 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-hp200lx-output-requires) + (let (more-phones) + + + ;; HP 200LX last name field (maxlen 86 ??) -- used for BBDB name + ;; + (insert (format "\"%s\"," (boh-maybe-truncate name 86))) + + + ;; HP 200LX first name field (maxlen ??) -- unused + (insert ",") + + + ;; HP 200LX middle name field (maxlen ??) -- unused + ;; + (insert ",") + + + ;; Phone numbers + ;; + (let (business-phone home-phone fax-phone saved-case-fold) + (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 business-phone) + (setq business-phone (list place number)) + (setq more-phones (cons (list place number) more-phones)))) + ((string-match place "home") + (if (null home-phone) + (setq home-phone (list place number)) + (setq more-phones (cons (list place number) more-phones)))) + ((or (string-match place "fax") + (string-match place "facsimile")) + (if (null fax-phone) + (setq fax-phone (list place number)) + (setq more-phones (cons (list place number) more-phones)))) + (t + (setq more-phones (cons (list place number) more-phones))))) + (setq phones (cdr phones))) + + + (setq case-fold-search saved-case-fold) + + + ;; HP 200LX business phone field (maxlen 29) + (if business-phone + (progn + (insert (format "\"%s\"," (boh-maybe-truncate + (format "%s" (car (cdr business-phone))) + 29))) + (setq bare nil)) + (insert ",")) + + + ;; HP 200LX home phone field (maxlen 29) + (if home-phone + (progn + (insert (format "\"%s\"," (boh-maybe-truncate + (format "%s" (car (cdr home-phone))) + 29))) + (setq bare nil)) + (insert ",")) + + + ;; HP 200LX alternate phone field (maxlen 29) -- unused + (insert ",") + + + ;; HP 200LX fax phone field (maxlen 29) + (if fax-phone + (progn + (insert (format "\"%s\"," (boh-maybe-truncate + (format "%s" (car (cdr fax-phone))) ; the description + 29))) + (setq bare nil)) + (insert ",")) + ) + + + ;; HP 200LX title field (maxlen 38) -- unused + (insert ",") + + + ;; HP 200LX category field (maxlen 127) -- unused + (insert ",") + + + ;; HP 200LX company field (maxlen 82) -- used for BBDB company + (if comp + (insert (format "\"%s\"," (boh-maybe-truncate comp 82))) + (insert ",")) + + + ;; Addresses + ;; + (let ((addr (car addrs)) ;just take the first bbdb address + hp-addr1 hp-addr2 hp-city hp-state hp-zip) + + (if addr + (progn + (setq hp-addr1 (bbdb-address-street1 addr)) + (setq hp-addr2 (concat (bbdb-address-street2 addr) + (if (and (> (length (bbdb-address-street2 addr)) 0) + (> (length (bbdb-address-street3 addr)) 0)) + ", " "") + (bbdb-address-street3 addr))) + (setq hp-city (bbdb-address-city addr)) + (setq hp-state (bbdb-address-state addr)) + (setq hp-zip (bbdb-address-zip-string addr)))) + + ;; HP 200LX address 1 field (maxlen 82) + (if hp-addr1 + (progn + (insert (format "\"%s\"," (boh-maybe-truncate hp-addr1 82))) + (setq bare nil)) + (insert ",")) + + ;; HP 200LX address 2 field (maxlen 82) + (if hp-addr2 + (progn + (insert (format "\"%s\"," (boh-maybe-truncate hp-addr2 82))) + (setq bare nil)) + (insert ",")) + + ;; HP 200LX city field (maxlen 34) + (if hp-city + (progn + (insert (format "\"%s\"," (boh-maybe-truncate hp-city 34))) + (setq bare nil)) + (insert ",")) + + ;; HP 200LX state field (maxlen 39) + (if hp-state + (progn + (insert (format "\"%s\"," (boh-maybe-truncate hp-state 39))) + (setq bare nil)) + (insert ",")) + + ;; HP 200LX zip field (maxlen 16) + (if hp-zip + (progn + (insert (format "\"%s\"," (boh-maybe-truncate hp-zip 16))) + (setq bare nil)) + (insert ",")) + ) + + ;; BBDB Notes + + (let (hp-note) + (save-excursion + (set-buffer (get-buffer-create " *boh-scratch*")) + (kill-region (point-min) (point-max)) + + (while more-phones + (insert (format "%s: %s\t" + (car (car more-phones)) ; the tag + (car (cdr (car more-phones)))) ; the number + ) + (setq bare nil) + (setq more-phones (cdr more-phones))) + + ;; output BBDB email-addresses + (while net + (insert (format "%s\t" (car net))) + (setq bare nil) + (setq net (cdr net))) + + (if (stringp notes) + (setq notes (list (cons 'notes notes)))) + + (while notes + (let ((thisnote (car notes))) + (if (bbdb-field-shown-p (car thisnote)) + (progn + (setq bare nil) + (if (eq 'notes (car thisnote)) + (insert (format "Notes: %s\t" (boh-mangle-if-multi-line (cdr thisnote)))) + (insert (format "Note [%s]: %s\t" + (symbol-name (car thisnote)) + (boh-mangle-if-multi-line (cdr thisnote)))))))) + (setq notes (cdr notes))) + + (setq hp-note (buffer-string))) + + ;; HP 200LX notes field (32K for the entire record) + (if (> (length hp-note) 0) + (progn + (insert (format "\"%s\"" hp-note)) + (setq bare nil))) + ) + + ;; If record is bare, delete anything we may have inserted. + ;; otherwise, mark the end of this record. + (if (and bare bbdb-hp200lx-output-no-bare-names) + (delete-region begin (point)) + (insert "
\n")) ; HP 200LX end of record + )) + + ;; return current letter + current-letter)) + + +(defun boh-maybe-truncate (string maxlen) + "If STRING is longer than MAXLEN, returns a truncated version." + (if (> (length string) maxlen) + (substring string 0 maxlen) + string)) + + +(defun boh-mangle-if-multi-line (string) + "If STRING is has multiple lines, mangle it for output to HP200LX" + (if (string-match "\n" string) + (string-replace-regexp string "\n" "\t") ; tabs are used to denote new lines in the .cdf file + string)) |