1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
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))
|
