Since Boris released a new version of bbdb-print lately, I dare to send my
bbdb-letter.el to the list. bbdb-letter was inspired by bbdb-print and I used
some ideas and small portions of code from it.
Originally, bbdb-letter was intended to create letters from the address
entries of bbdb-records, however, the concept became more general. You can
also create faxes from fax numbers, address/phone lists or booklets, or even
report files which may be imported into other address databases.
I have used this code by myself for quite some time and I never distributed it
to a larger group of users. Therfore, there will be bugs (I've used it with
Emacs 19 only), the letter formats may be inappropriate for you, and the
documentation may be weak. Please let me know your opinions. Any comments,
additions, and bug reports are welcome.
The code may be (it should not!) incompatiple with bbdb-print, since
bbdb-print is its ancestor.
Finally, thanks to Franz Kurfess, who tested my very first peaces of code.
Josef
;;; This is bbdb-letter.el, version 0.95.
;;; It was partly derived from bbdb-print.el, version 2.3.
;;;
;;; The Insidious Big Brother Database 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 1, or (at your
;;; option) any later version.
;;;
;;; BBDB 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 GNU Emacs; see the file COPYING. If not, write to
;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;;
;;;
;;;
;;; This module is for creating formatted excerpts of BBDB databases.
;;; It can be used to create letter templates or address/phone lists
;;; with LaTeX/TeX. It might also be used to create, e.g., import
;;; files for a EXCEL(tm) database.
;;;
;;; USE: In the *BBDB* buffer, type l or *l to create a template of
;;; the current bbdb-record or of all the currently displayed
;;; records using the format (usually LaTeX/TeX) it will prompt
;;; for. It will prompt you for a filename and for
;;; a format (type of document). Then run LaTeX/TeX (or an
;;; appropriate processor on that file and
;;; print it out.
;;;
;;; In order to use bbdb-letter for personal purposes, it is
;;; very likely that you will need to define your own document
;;; types/formats.
;;;
;;; Please direct any comments, improvements, or bug reports to
;;; [EMAIL PROTECTED] I would also be happy to
;;; integrate new document types/formats.
;;;
;;; INSTALLATION: Put this file somewhere on your load-path.
;;; Put (require 'bbdb-letter) in your .emacs, or autoload it.
;;; Put bbdb-print.tex (from bbdb-print) somewhere on your
;;; TEXINPUTS path, or put its absolute pathname in
;;; bbdb-print-format-file-name.
;;;
;;; DEFINITION OF DOCUMENT TYPES/FORMATS: New document types for
;;; bbdb-letter are defined by extending or redefining the variable
;;; bbdb-letter-alist.
;;;
;;; Any pair of bbdb-letter-alist consists of a string denoting
;;; the document type and a number of elisp expressions. The
;;; elisp expressions should assign (setq ...) values to the
;;; variables bbdb-print-prolog, bbdb-print-separator,
;;; bbdb-print-record, bbdb-print-epilog, and
;;; bbdb-print-address-default.
;;;
;;; Customization usually extends bbdb-letter-alist as follows:
;;; (setq bbdb-letter-alist
;;; (append bbdb-letter-alist
;;; '((\"myown letter\"
;;; ;;
;;; (setq bbdb-letter-prolog
;;; '(\"\\documentstyle ...
;;; ... ))))))")
;;; VARIABLES:
;;; bbdb-letter-prolog
;;; A list of strings forming the beginning of the LaTeX/TeX
;;; document.
;;; bbdb-letter-separator
;;; A string which is passed to format to produce a
;;; separator, when the first character changes.
;;; bbdb-letter-separator may also have the value nil.
;;; bbdb-letter-epilog
;;; A list of strings forming the end of the LaTeX/TeX.
;;; document.
;;; bbdb-letter-address-default
;;; String denoting the default address location.
;;; bbdb-letter-phone-default
;;; String denoting the default phone location.
;;; bbdb-letter-record
;;; This is a list consisting of strings, bbdb-keywords,
;;; lists, (bball ...) or (bbif ...) exprs.
;;;
;;; NOTE: An expression (bbif condition ifbranch elsebranch)
;;; or (bball ...) is NOT a regular elisp expression! It can
;;; not be evaluated! It is simply a data structure or macro
;;; which will be expanded later.
;;;
;;; If an element of the list bbdb-letter-record is a
;;; string: This string is copied to the output document
;;; (escape characters "\" for elisp strings are
;;; necessary)
;;; bbdb-keyword: this is interpreted as a bbdb keyword. It
;;; is a symbol and it may be one out of
;;; ('name 'firstname 'lastname 'company 'aka 'net
;;; 'notes 'addresses 'address-location 'address-street1
;;; 'address-street2 'address-street3 'address-city
;;; 'address-state 'address-zip-string 'phone-location
;;; 'phone-string 'phones)
;;; or a user defined keyword of a bbdb record (see
;;; bbdb-propnames for user defined keywords).
;;; bbif: has the form
;;; (bbif 'bbdb-keyword if-part else-part)
;;; where if-part and else-part again is a string,
;;; bbdb-keyword, list, (bball ...) or (bbif ...) expr.
;;; bball: has the form
;;; (bball addresses-or-phones separator)
;;; where addresses-or-phones is one of
;;; ('addresses 'phones)
;;; and separator again is a string,
;;; bbdb-keyword, list, (bball ...) or (bbif ...) expr.
;;; list: This is only for grouping. Any element of the list
;;; is a string, bbdb-keyword, list, (bball ...) or
;;; (bbif ...) expr.
;;;
;;; EXAMPLE:
;;; see also (defvar bbdb-letter-alist ...) below.
;;;
;;; (setq bbdb-letter-alist
;;; (append bbdb-letter-alist
;;; '(("my own letter"
;;; ;;
;;; (setq bbdb-letter-prolog
;;; '("\\documentstyle[11pt,iso]{myletter}\n"
;;; "\\germanletter\n"
;;; "\\dvips % Driver-Selection\n"
;;; "% --- Signature\n"
;;; "\\name{\\vspace{2cm}(Steven Spielberg)}\n"
;;; "\\aktzei{}\n"
;;; "\\begin{document}\n\n"))
;;; ;;
;;; (setq bbdb-letter-separator "\\separator{%s}\n\n")
;;; ;;
;;; (setq bbdb-letter-record
;;; '("\\begin{letter}{"
;;; (bbif title title "Mr") " "
;;; ;; well, this requires that you have a user defined
;;; ;; field called tex-name ...
;;; (bbif tex-name tex-name (bbif name name)) " \\\\"
;;; (bbif company (company " \\\\"))
;;; (bbif address-street1 (address-street1 " \\\\"))
;;; (bbif address-street2 (address-street2 " \\\\"))
;;; (bbif address-street3 (address-street3 " \\\\"))
;;; "[1ex]\n" "{\\bf "
;;; address-zip-string " " address-city "}}\n"
;;; "\\opening{Dear Mr.\ "
;;; lastname ",}\n"
;;; "\\sloppy\n"
;;; "%****************** BEGIN TEXT ******************\n\n"
;;; "%****************** END TEXT ******************\n"
;;; "\\closing{Sincerely yours}\n"
;;; "%\\cop{}\n"
;;; "%\\encl{}\n"
;;; "\\end{letter}\n\n"))
;;; ;;
;;; (setq bbdb-letter-epilog '("\\end{document}\n"))
;;; ;;
;;; (setq bbdb-letter-address-default "office"))
;;; )))
;;;
;;; This program was written by Josef Schneeberger
;;; <[EMAIL PROTECTED]>. The code is based on the bbdb-print
;;; (version 2.3) program of Boris Goldowsky
;;; <[EMAIL PROTECTED]> and Dirk Grunwald
;;; <[EMAIL PROTECTED]> using a TeX format given to Dirk by
;;; someone at Berkeley. Thanks to Tim Geisler
;;; <[EMAIL PROTECTED]> and
;;; [EMAIL PROTECTED] (Franz Kurfess) for comments and
;;; bug reports.
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; ToDo:
;;; 1. Documentation strings for all variables and function definition
;;; 2. insert quotation feature of bbdb-print.el. I think the best variant
;;; would be to introduce a new keword "bbquote" (like "bball" or "bbif")
;;; 3. "<lastname>.tex" as default-filename
;;; 4. Default for Documenttype
;;; 5. texinfo file (integrated into the bbdb documentation)
;;;
;;;for debugging ...
;;;(insert (apply 'concat (bbdb-format myrecord mystringlist nil 'latex)))
;;;(bbdb-record-get-field-internal-2 (bbdb-current-record) 'name)
;;;(("project") ("title") ("alias") ("country") ("telex") ("tex-name"))
;;;(setq myrecord (bbdb-current-record))
(require 'bbdb)
(require 'bbdb-com)
(define-key bbdb-mode-map "l" 'bbdb-compose-letter)
;;;
;;; Variables
;;;
(defvar bbdb-letter-file-name "bbdb.tex"
"*Default file name for printouts of BBDB database.")
(defvar bbdb-letter-directory-name "~/"
"*Default directory for printouts of BBDB database.")
(defvar bbdb-letter-address-default nil
"*String denoting the default address location.")
(defvar bbdb-letter-phone-default nil
"*String denoting the default phone location.")
(defvar bbdb-letter-prolog nil
"*A list of strings forming the beginning of the LaTeX/TeX document.")
(defvar bbdb-letter-separator nil
"*A string which is passed to format to produce a separator, when
the first character changes.
bbdb-letter-separator may also have the value nil.")
(defvar bbdb-letter-record nil
"*This is a list consisting of strings, bbdb-keywords, lists,
(bball ...) or (bbif ...) exprs.
See documentation for more details.")
(defvar bbdb-letter-epilog nil
"*A list of strings forming the end of the LaTeX/TeX document.")
(defvar bbdb-letter-alist
'(("LaTeX letter"
;;
(setq bbdb-letter-prolog
'("\\documentstyle{letter}\n"
"\\name{Dr. L. User}\n"
"\\signature{Larry User}\n"
"\\address{3245 Foo St.\\\\Gnu York}\n"
"\\location{Room 374}\n"
"\\telephone{(415)123-4567}\n"
"% \\makelabels\n"
"\\begin{document}\n\n"))
;;
(setq bbdb-letter-separator "")
;;
(setq bbdb-letter-record
'("\\begin{letter}{"
(bbif title title "Mr.") " "
(bbif tex-name tex-name (bbif name name)) " \\\\"
(bbif company (company " \\\\"))
(bbif address-street1 (address-street1 " \\\\"))
(bbif address-street2 (address-street2 " \\\\"))
(bbif address-street3 (address-street3 " \\\\"))
"[1ex]\n" "{\\bf "
address-city ", " address-zip-string "}}\n"
"\\opening{Dear "
firstname ",}\n"
"\\sloppy\n"
"%****************** Start TEXT ******************\n\n"
"%****************** End TEXT ******************\n"
"\\closing{ Yours truly,}\n"
"%\\cop{}\n"
"%\\encl{}\n"
"\\end{letter}\n\n"))
;;
(setq bbdb-letter-epilog '("\\end{document}\n"))
;;
(setq bbdb-letter-address-default nil)) ; if nil, no default
("A4 LaTeX letter"
;;
(setq bbdb-letter-prolog
'("\\documentstyle{a4letter}\n"
"\\name{Dr. L. User}\n"
"\\signature{Larry User}\n"
"\\address{3245 Foo St.\\\\Gnu York}\n"
"\\location{Room 374}\n"
"\\telephone{(415)123-4567}\n"
"% \\makelabels\n"
"\\begin{document}\n\n"))
;;
(setq bbdb-letter-separator "")
;;
(setq bbdb-letter-record
'("\\begin{letter}{"
(bbif title title "Mr.") " "
(bbif tex-name tex-name (bbif name name)) " \\\\"
(bbif company (company " \\\\"))
(bbif address-street1 (address-street1 " \\\\"))
(bbif address-street2 (address-street2 " \\\\"))
(bbif address-street3 (address-street3 " \\\\"))
"[1ex]\n" "{\\bf "
address-city ", " address-zip-string "}}\n"
"\\opening{Dear "
firstname ",}\n"
"\\sloppy\n"
"%****************** Start TEXT ******************\n\n"
"%****************** End TEXT ******************\n"
"\\closing{ Yours truly,}\n"
"%\\cop{}\n"
"%\\encl{}\n"
"\\end{letter}\n\n"))
;;
(setq bbdb-letter-epilog '("\\end{document}\n"))
;;
(setq bbdb-letter-address-default nil)) ; if nil, no default
("LaTeX multiple letter"
;;
(setq bbdb-letter-prolog
'("\\documentstyle{letter}\n"
"\\name{Dr. L. User}\n"
"\\signature{Larry User}\n"
"\\address{3245 Foo St.\\\\Gnu York}\n"
"\\location{Room 374}\n"
"\\telephone{(415)123-4567}\n"
"% \\makelabels\n"
"\\newcommand{\\MYLETTER}[2]{"
"\\begin{letter}{#1}"
"\\opening{#2}\n"
" \\sloppy\n"
" %****************** Start TEXT ******************\n\n"
" %****************** End TEXT ******************\n"
" \\closing{ Yours truly,}\n"
" %\\cop{}\n"
" %\\encl{}\n"
" \\end{letter}}\n\n"
"\\begin{document}\n\n"))
;;
(setq bbdb-letter-separator nil)
;;
(setq bbdb-letter-record
'("\\MYLETTER{"
(bbif title title "Mr.") " "
(bbif tex-name tex-name (bbif name name)) " \\\\"
(bbif company (company " \\\\"))
(bbif address-street1 (address-street1 " \\\\"))
(bbif address-street2 (address-street2 " \\\\"))
(bbif address-street3 (address-street3 " \\\\"))
"[1ex] " "{\\bf "
address-city ", " address-zip-string
"}}{Dear " firstname ",}\n\n"))
;;
(setq bbdb-letter-epilog '("\\end{document}\n"))
;;
(setq bbdb-letter-address-default nil)) ; if nil, no default
("phone list"
;;
(setq bbdb-letter-prolog '("\\documentstyle[supertab]{article}\n"
"\\begin{document}\n\n"
"\\begin{supertabular}{|ll|r|}\n"))
;;
(setq bbdb-letter-separator
"\\hline\n\\multicolumn{3}{|c|}{\\bf %s}\\\\\n\\hline\n")
;;
(setq bbdb-letter-record
'(lastname ", & " firstname " & " phone-string " \\\\\n"))
;;
(setq bbdb-letter-epilog '("\\hline\n"
"\\end{supertabular}\n"
"\\end{document}\n"))
;;
(setq bbdb-letter-address-default nil))
("address booklet"
;;
(setq bbdb-letter-prolog '("\\documentstyle[iso]{article}\n"
"\\setlength{\\parindent}{0pt}\n"
"\\setlength{\\textheight}{16cm}\n"
"\\begin{document}\n"
"\\small\n"))
;;
(setq bbdb-letter-separator "\\newpage\n")
;;
(setq bbdb-letter-record
'("\\parbox[t]{6cm}{"
"\\underline{" firstname " " lastname "} \\\\"
(bbif company (company " \\\\[1ex]\n") "[1ex]\n")
"\\hspace*{2mm}\\begin{tabular}[t]{p{60mm}}\n"
(bball addresses
("{\\it " address-location "}\\\\\n"
(bbif address-street1 (address-street1 " \\\\"))
(bbif address-street2 (address-street2 " \\\\"))
(bbif address-street3 (address-street3 " \\\\"))
" {\\bf " address-zip-string " " address-city
"}\\\\[1ex]"))
" \\end{tabular}}\n"
"\\hspace{-2cm}\n"
"\\parbox[t]{5cm}{\\hfill\n"
" \\begin{tabular}[t]{r}\n"
(bball phones
(phone-location ": " phone-string " \\\\"))
" \\end{tabular}}\\\\[2ex]\n"))
;;
(setq bbdb-letter-epilog '("\\end{document}\n"))
;;
(setq bbdb-letter-address-default nil)) ; if nil, no default
("simple name list"
;;
(setq bbdb-letter-prolog '("\\documentstyle{article}\n"
"\\begin{document}\n"))
;;
(setq bbdb-letter-separator
"\n{\\bf %s}\\\\\n\\hline\n")
;;
(setq bbdb-letter-record
'(lastname ", " firstname " \\\\\n"))
;;
(setq bbdb-letter-epilog '("\\end{document}\n"))
;;
(setq bbdb-letter-address-default nil))
("BBDB print list syle"
;;
(setq bbdb-letter-prolog
'("%%%% ====== Phone/Address list in -*-TeX-*- Format =====\n"
"%%%% *LIKE* bbdb-print, version 3.0\n\n"
"\\input bbdb-print\n"
"\\input multicol\n\n"
"% See bbdb-print.tex with the following parameters\n"
"\\setsize{6}\n"
"\\setseparator{2}\n"
"\\threecol\n\n"))
;;
(setq bbdb-letter-separator "\\separator{%s}\n\n")
(setq bbdb-letter-record
'("\\beginrecord\n"
"\\firstline{"
(bbif tex-name tex-name (firstname " " lastname))
"}{}\n"
(bbif company ("\\comp{" company "}\n"))
(bbif phones
(bball phones
("\\phone{" phone-location ": " phone-string
"}\n")))
(bbif net ("\\email{" net "}\n"))
(bbif addresses
(bball addresses
("\\address{"
(bbif address-street1 (address-street1 " \\\\"))
(bbif address-street2 (address-street2 " \\\\"))
(bbif address-street3 (address-street3 " \\\\"))
(bbif address-city (address-city))
(bbif address-state (", " address-state))
(bbif address-zip-string
(", " address-zip-string))
"}\n")))
(bbif notes ("\\notes{" notes "}\n"))
"\\endrecord\n\n"))
;;
(setq bbdb-letter-epilog '("\\endaddresses\n\\bye\n"))
;;
(setq bbdb-letter-address-default nil)) ; if nil, no default
)
"*Alist defining document types for bbdb-letter.
Any pair of bbdb-letter-alist consists of a string denoting the
document type and a number of elisp expressions. The elisp expressions
should assign (setq ...) values to the variables bbdb-letter-prolog,
bbdb-letter-separator, bbdb-letter-record, bbdb-letter-epilog, and
bbdb-letter-address-default.
Customization usually extends bbdb-letter-alist as follows:
(setq bbdb-letter-alist
(append bbdb-letter-alist
'((\"myown letter\"
;;
(setq bbdb-letter-prolog
'(\"\\documentstyle ...
... ))))))")
(defvar current-char nil)
(defvar bbdb-current-address nil)
(defvar bbdb-current-phone nil)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun bbdb-compose-letter (bbdb-record)
"Compose a letter out from the selected BBDB entries.
The first (most-recently-added) address is used if there are more than one.
\\<bbdb-mode-map>
If \"\\[bbdb-apply-next-command-to-all-records]\\[bbdb-compose-letter]\" is \
used instead of simply \"\\[bbdb-compose-letter]\", then letters are created \
to all of the
folks listed in the *BBDB* buffer instead of just the person at point."
(interactive (list (if (bbdb-do-all-records-p)
(mapcar 'car bbdb-records)
(bbdb-current-record))))
(let ((file-name
(expand-file-name
(read-file-name "Print To File: "
(concat bbdb-letter-directory-name
bbdb-letter-file-name))))
(completion-ignore-case t))
(find-file file-name)
(if (if (> (buffer-size) 0)
(not (yes-or-no-p "File is not empty; delete contents "))
nil)
nil
(delete-region (point-min) (point-max))
(mapcar 'eval
(cdr (assoc (completing-read "Type of document: "
bbdb-letter-alist
nil t)
bbdb-letter-alist)))
(if (consp bbdb-record)
(bbdb-compose-letter-many bbdb-record)
(bbdb-compose-letter-1 bbdb-record)))))
(defun bbdb-compose-letter-1 (bbdb-record)
(if bbdb-inside-electric-display
(bbdb-electric-throw-to-execute
(list 'bbdb-compose-letter bbdb-record)))
;; else...
(cond ((null bbdb-record) (error "record unexists"))
; ((null (bbdb-record-addresses bbdb-record))
; (error "Current record unhas addresses."))
(t (insert (apply 'concat (bbdb-format bbdb-record bbdb-letter-record)))
(goto-char (point-max)) (insert (apply 'concat bbdb-letter-epilog))
(goto-char (point-min)) (insert (apply 'concat bbdb-letter-prolog))
)))
(defun bbdb-compose-letter-many (bbdb-records)
(if bbdb-inside-electric-display
(bbdb-electric-throw-to-execute
(list 'bbdb-compose-letter-many (list 'quote bbdb-records))))
;; else...
(let (first-char)
(insert (apply 'concat bbdb-letter-prolog))
(while bbdb-records
;;
;; Section header, if neccessary.
;;
(setq first-char (substring (concat (bbdb-record-sortkey
(car bbdb-records)) "?") 0 1))
(if (and current-char
(string-equal first-char current-char))
nil
(if bbdb-letter-separator
(insert (format bbdb-letter-separator (upcase first-char))))
(setq current-char first-char))
;;
;; the record itself
;;
(insert (apply 'concat
(bbdb-format (car bbdb-records) bbdb-letter-record)))
(setq bbdb-records (cdr bbdb-records)))
(insert (apply 'concat bbdb-letter-epilog)))
(if (re-search-backward "^Subject: $" nil t) (end-of-line)))
(defun bbdb-format (record stringlist &optional quotation)
;;
;; This expands the description of a list of strings and the
;; corresponding substructures. The resulting list is concatenated
;; an inserted into the buffer.
;;
(setq bbdb-current-address nil)
(setq bbdb-current-phone nil)
(let (nsl ns)
(while stringlist
(setq ns (bbdb-format-1 record (car stringlist) quotation))
(if (listp ns)
(setq nsl (append nsl ns))
(setq nsl (append nsl (list ns))))
(setq stringlist (cdr stringlist)))
nsl))
(defun bbdb-format-1 (record string &optional quotation)
;;
;; Subfunction of bbdb-format to expand a single item on the
;; stringlist passed to bbdb-format. If the item is a list,
;; bbdb-format-1 is called recursively. Lists may be one of bbif,
;; bball or simply a list for blocking.
;;
(cond ((stringp string) string)
((symbolp string)
;; be shure to return nil if there is an empty string.
(bbdb-record-get-field-string record string quotation))
((listp string)
(cond ((eq (car string) 'bbif)
(if (bbdb-record-get-field-string record (nth 1 string)
quotation)
(bbdb-format-1 record (nth 2 string) quotation)
(if (> (length string) 3)
(bbdb-format-1 record (nthcdr 3 string) quotation))))
((and (eq (car string) 'bball)
(eq (nth 1 string) 'addresses))
(mapcar (function (lambda (a)
(setq bbdb-current-address a)
(bbdb-format-1 record (nth 2 string)
quotation)))
(bbdb-record-addresses record)))
((and (eq (car string) 'bball)
(eq (nth 1 string) 'phones))
(mapcar (function (lambda (p)
(setq bbdb-current-phone p)
(bbdb-format-1 record (nth 2 string)
quotation)))
(bbdb-record-phones record)))
(t (let (nsl ns)
(while string
(setq ns (bbdb-format-1 record (car string) quotation))
(if (listp ns)
(setq nsl (append nsl ns))
(setq nsl (append nsl (list ns))))
(setq string (cdr string)))
(apply 'concat nsl)))))))
(defun bbdb-record-get-field-string (record field quotation)
;;
;; returns the database entry for a symbol.
;; We have to distinguish between standard fields and user defined
;; fields.
;;
(funcall
;; do not return the empty string !
(function (lambda (string) (if (and (stringp string) (string= string ""))
nil
string)))
(cond ((eq field 'name) (bbdb-record-name record))
((eq field 'net) (bbdb-record-net record))
((eq field 'aka) (bbdb-record-aka record))
((eq field 'firstname) (bbdb-record-firstname record))
((eq field 'lastname) (bbdb-record-lastname record))
((eq field 'company) (bbdb-record-company record))
((eq field 'notes) (bbdb-record-notes record))
((eq field 'phones) (bbdb-record-phones record))
((eq field 'addresses) (bbdb-record-addresses record))
((memq field '(address-location address-street1 address-street2
address-street3 address-city address-state
address-zip-string))
(bbdb-record-get-addressfield-string record field))
((memq field '(phone-location phone-string))
(bbdb-record-get-phonefield-string record field))
((and (listp (bbdb-record-raw-notes record))
(assq field (bbdb-record-raw-notes record)))
(cdr (assq field (bbdb-record-raw-notes record))))
((assoc (symbol-name field) (bbdb-propnames))
nil) ; field is defined, but the current
; record has no such entry.
; Therfore nil
(t (error "doubleplus ungood: unknown field type %s\n
You probably did not define field type %s in your BBDB database." field)))))
(defun bbdb-record-get-addressfield-string (record field)
(let* ((addrs (bbdb-record-addresses record))
(addrs-alist (mapcar (function (lambda (a)
(cons (bbdb-address-location a) a)))
addrs))
(completion-ignore-case t))
(if (not addrs)
;; return nil if there is no address
nil
(cond (bbdb-current-address nil)
;; ... else
;; if there is only one address ... grab it
((= (length addrs) 1)
(setq bbdb-current-address (car addrs)))
;; ... else
;; try to find bbdb-letter-address-default address
((and bbdb-letter-address-default
(assoc bbdb-letter-address-default addrs-alist))
(while addrs
(cond ((equal bbdb-letter-address-default
(bbdb-address-location (car addrs)))
(setq bbdb-current-address (car addrs))
(setq addrs nil))
(t (setq addrs (cdr addrs))))))
;; ... else
;; if nothing was found, ask user
(t (setq bbdb-current-address
(cdr (assoc (completing-read
(format "Which Address of %s: "
(bbdb-record-name record))
addrs-alist nil t)
addrs-alist)))) )
;; ... now, return the field info ...
(cond ((eq field 'address-location)
(bbdb-address-location bbdb-current-address))
((eq field 'address-street1)
(bbdb-address-street1 bbdb-current-address))
((eq field 'address-street2)
(bbdb-address-street2 bbdb-current-address))
((eq field 'address-street3)
(bbdb-address-street3 bbdb-current-address))
((eq field 'address-city)
(bbdb-address-city bbdb-current-address))
((eq field 'address-state)
(bbdb-address-state bbdb-current-address))
((eq field 'address-zip-string)
(bbdb-address-zip-string bbdb-current-address))))
))
(defun bbdb-record-get-phonefield-string (record field)
(let* ((phones (bbdb-record-phones record))
(phns-alist (mapcar (function (lambda (p)
(cons (bbdb-phone-location p) p)))
phones))
(completion-ignore-case t))
(if (not phones)
;; return nil if there is no phones
nil
(cond (bbdb-current-phone nil)
;; ... else
;; if there is only one phone ... grab it
((= (length phones) 1)
(setq bbdb-current-phone (car phones)))
;; ... else
;; try to find bbdb-letter-phone-default phone
((and bbdb-letter-phone-default
(assoc bbdb-letter-phone-default phns-alist))
(while phones
(cond ((equal bbdb-letter-phone-default
(bbdb-phone-location (car phones)))
(setq bbdb-current-phone (car phones))
(setq phones nil))
(t (setq phones (cdr phones))))))
;; ... else
;; if nothing was found, ask user
(t (setq bbdb-current-phone
(cdr (assoc (completing-read
(format "Which Phone/Fax of %s: "
(bbdb-record-name record))
phns-alist nil t)
phns-alist)))) )
;; ... now, return the field info ...
(cond ((eq field 'phone-location)
(bbdb-phone-location bbdb-current-phone))
((eq field 'phone-string)
(bbdb-phone-string bbdb-current-phone))))
))
;;
;; ... this was stolen from bbdb-print
;; but not yet used ...
;;
(defun bbdb-print-tex-quote (string)
"Quote any unquoted TeX special characters that appear in STRING.
In other words, # alone will be replaced by \#, but \^ will be left for
TeX to process as an accent."
(if string
(save-excursion
(set-buffer (get-buffer-create " bbdb-print-tex-quote"))
(delete-region (point-min) (point-max))
(insert string)
(goto-char (point-min))
(while (not (eobp))
(cond ((looking-at "[<>=]+")
(replace-match "$\\&$"))
((and (looking-at "[#$%&~_]")
(not (eq ?\\ (char-after (1- (point))))))
(replace-match "\\\\\\&"))
((and (looking-at "[{}]")
(not (eq ?\\ (char-after (1- (point))))))
(replace-match "$\\\\\\&$"))
((and (looking-at "\\^")
(not (eq ?\\ (char-after (1- (point))))))
(replace-match "\\\\^{ }"))
(t (forward-char 1))))
(buffer-string))))
(provide 'bbdb-letter)
