[emacs] update 4 drones
[~bandali/configs] / lisp / bbdb / bbdb-tex.el
1 ;;; bbdb-tex.el --- feed BBDB into LaTeX -*- lexical-binding: t -*-
2
3 ;; Copyright (C) 2010-2017 Free Software Foundation, Inc.
4
5 ;; Authors: Boris Goldowsky <boris@cs.rochester.edu>
6 ;; Dirk Grunwald <grunwald@cs.colorado.edu>
7 ;; Luigi Semenzato <luigi@paris.cs.berkeley.edu>
8
9 ;; This file is part of the Insidious Big Brother Database (aka BBDB),
10
11 ;; BBDB is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
15
16 ;; BBDB is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
20
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with BBDB. If not, see <http://www.gnu.org/licenses/>.
23
24 ;;; Commentary:
25
26 ;; This file lets you feed BBDB into LaTeX.
27 ;; See the BBDB info manual for documentation.
28 ;;
29 ;; In the *BBDB* buffer, type M-x `bbdb-tex' to convert the listing
30 ;; to LaTeX format.
31 ;;
32 ;; TeX macros appearing in the output:
33 ;; \name{first}{last}
34 ;; \organization{foo bar}
35 ;; \affix{foo bar}
36 ;; \aka{foo bar}
37 ;; \phone{key}{123 456 7890}
38 ;; \address{key}{foo bar}
39 ;; \mail{foo@bar.com}{Smith <foo@bar.com>}
40 ;; \xfield{key}{value}
41 ;; Each macro may appear multiple times.
42 ;;
43 ;; The detailed grammar of the output is defined in `bbdb-tex-alist'.
44 ;; The output starts with a prolog where you can specify LaTeX packages
45 ;; and other customizations in the usual way. The above macros should get
46 ;; defined, too. By default, this happens in the style file bbdb.sty that
47 ;; is shipped with BBDB.
48 ;;
49 ;; The body of the output contains the BBDB records. Usually, the records
50 ;; are placed inside some "bbdb" environment. You can customize which fields
51 ;; of each record should appear in the listing and in which order.
52 ;; Also, you can put separators between individual fields. A separator macro
53 ;; can also separate records when the first character of the last name differs
54 ;; from the first character of the last name of the previous record.
55 ;; The listing ends with an epilog.
56
57 ;; A few notes on "advanced usage" of `bbdb-tex':
58 ;;
59 ;; It should be possible to use `bbdb-tex' with all the bells and whistles
60 ;; of LaTeX by loading the appropriate LaTeX style files and packages or
61 ;; embedding the output of `bbdb-tex' into more complex LaTeX documents.
62 ;; For this you can customize the rules in `bbdb-tex-alist' and use
63 ;; customized style files for interpreting the TeX macros used by `bbdb-tex'.
64 ;;
65 ;; Generally, lisp customizations for `bbdb-tex' are intended to provide control
66 ;; of *what* appears in the TeX listing. But there are no lisp customization
67 ;; options to control the actual layout that should be handled by LaTeX.
68 ;; BBDB is shipped with one basic LaTeX style file bbdb.sty to handle
69 ;; the TeX macros listed above. You should customize this LaTeX style file
70 ;; to match your taste and / or your needs. Note also that `bbdb-tex-alist'
71 ;; allows you to specify an arbitrary number of rules that may use different
72 ;; style files for the above TeX macros.
73
74 ;; Generally, it will be advantageous to make all relevant style files
75 ;; and packages known to LaTeX by putting them in the appropriate directories
76 ;; of your TeX installation. Likely, the user variable `bbdb-tex-path'
77 ;; should not be used in such advanced cases. The main purpose of the
78 ;; inlining mechanism provided via `bbdb-tex-path' is that we can ship
79 ;; and install BBDB without worrying about the tricky question where to
80 ;; (auto-) install the basic style file bbdb.sty shipped with BBDB so that
81 ;; TeX finds it. Most often, it will be best to manually install even bbdb.sty
82 ;; in a directory where TeX finds it and bind `bbdb-tex-path' to t to fully
83 ;; suppress the inlining.
84 ;;
85 ;; Before generating the TeX output, the field values of a record are massaged
86 ;; by `bbdb-tex-field' that passes these values by default to `bbdb-tex-replace',
87 ;; see also `bbdb-tex-replace-list'. Instead the user may also define functions
88 ;; `bbdb-tex-output-...' that take precedence, see `bbdb-tex-field'.
89 ;;
90 ;; `bbdb-tex' understands one new BBDB xfield: tex-name, see also
91 ;; `bbdb-tex-name'. If this xfield is defined for a record,
92 ;; this will be used for the TeXed listing instead of the name field
93 ;; of that record. The value of the xfield tex-name is used verbatim,
94 ;; it does not see `bbdb-tex-field' and `bbdb-tex-replace-list'.
95 ;;
96 ;;
97 ;; This program was adapted for BBDB by Boris Goldowsky
98 ;; <boris@cs.rochester.edu> and Dirk Grunwald
99 ;; <grunwald@cs.colorado.edu> using a TeX format designed by Luigi
100 ;; Semenzato <luigi@paris.cs.berkeley.edu>.
101 ;; We are also grateful to numerous people on the bbdb-info
102 ;; mailing list for suggestions and bug reports.
103
104 ;;; Code:
105
106 (require 'bbdb)
107 (require 'bbdb-com)
108
109 ;;; Variables:
110
111 (defcustom bbdb-tex-name 'tex-name
112 "Xfield holding the name in TeX format.
113 The string in this field gets split into first and last name
114 using `bbdb-separator-alist'. The separator defaults to \"#\"."
115 :group 'bbdb-utilities-tex
116 :type '(symbol :tag "Xfield"))
117
118 (defcustom bbdb-tex-alist
119 `((multi-line
120 (demand (or address phone))
121 (prolog ,(concat "\\documentclass{article}\n\\usepackage{bbdb}\n"
122 "\\usepackage{multicol}\n"
123 "\\begin{document}\n\\begin{multicols}{2}"))
124 (record "\\begin{bbdbrecord}" name organization ; affix aka
125 (address t) (phone t) (mail t)
126 (xfields t nil
127 (omit ,bbdb-tex-name mail-alias creation-date timestamp))
128 "\\end{bbdbrecord}\n")
129 (separator "\\bbdbseparator{%s}\n")
130 (epilog ,(concat "\\noindent\\hrulefill\\\\\nPrinted \\today\n"
131 "\\end{multicols}\n\\end{document}"))
132 (options (bbdb-tex-linebreak "\\\\\\\\\n")
133 (bbdb-tex-address-layout 2)))
134
135 (one-line
136 (demand phone)
137 (prolog ,(concat "\\documentclass{article}\n\\usepackage{bbdb}\n"
138 "\\begin{document}\n\\begin{bbdb}{llllll}"))
139 (record name "&" (organization 1) "&" (phone 2 "&") "&" (mail 1)
140 "&" (address 1) "\\\\")
141 (separator "\\bbdbseparator{%s}")
142 (epilog "\\end{bbdb}\n\\end{document}")
143 (options (bbdb-tex-linebreak ", ")
144 (bbdb-tex-address-layout 3)))
145
146 (phone
147 (demand phone)
148 (prolog ,(concat "\\documentclass{article}\n\\usepackage{bbdb}\n"
149 "\\begin{document}\n\\begin{bbdb}{ll}"))
150 (record name "&" (phone 2 "&") "\\\\")
151 (separator "\\bbdbseparator{%s}")
152 (epilog "\\end{bbdb}\n\\end{document}")
153 (options (bbdb-tex-linebreak ", ")
154 (bbdb-tex-address-layout 3)))
155
156 (example ; another rule with more examples
157 (demand (or address phone))
158 (prolog ,(concat "\\documentclass{article}\n\\usepackage{bbdb}\n"
159 "\\usepackage{multicol}\n"
160 "\\begin{document}\n\\begin{multicols}{2}"))
161 (record "\\begin{bbdbrecord}" name organization
162 (address 1 nil (omit "work"))
163 (phone 2 nil (admit "home" "cell"))
164 (mail t)
165 (birthday t)
166 (xfields t nil
167 (omit ,bbdb-tex-name mail-alias creation-date timestamp))
168 "\\end{bbdbrecord}\n")
169 (separator "\\bbdbseparator{%s}\n")
170 (epilog ,(concat "\\noindent\\hrulefill\\\\\nPrinted \\today\n"
171 "\\end{multicols}\n\\end{document}"))
172 (options (bbdb-tex-linebreak "\\\\\\\\\n")
173 (bbdb-tex-address-layout 2))))
174
175 "Alist of rules for passing BBDB to LaTeX.
176 Each rule has the form (RULE LIST1 LIST2 ...).
177 The symbol RULE identifies the rule.
178 The remainder are lists LIST that should have one of these forms:
179
180 (demand FORM)
181
182 Here FORM is a lisp expression. A record will be TeXed only
183 if evaluating FORM yields a non-nil value for this record.
184 When FORM is evaluated, the symbols name, affix, organization, mail,
185 phone, address, and xfields are set to the corresponding values
186 of this record; these symbols are nil if the respective field
187 does not exist for this record.
188
189 (prolog STRING)
190
191 The string STRING is inserted at the beginning of the buffer.
192 If STRING contains the substring \"\\usepackage{foo}\" and
193 a file \"foo.sty\" exists within `bbdb-tex-path', replace
194 \"\\usepackage{foo}\" with the content of the file \"foo.sty\",
195 surrounded by \"\\makeatletter\" and \"\\makeatother\".
196 Note: This fails with more sophisticated LaTeX style files
197 using, e.g., optional arguments for the \"\\usepackage\" macro.
198
199 (record ELT1 ELT2 ...)
200
201 Here ELT may be one of the following:
202
203 IF ELT is name, this expands to \"\\name{first}{last}\"
204
205 If ELT is affix, organization, or aka, ELT expands to \"\\ELT{value}\".
206 Here the elements of ELT are concatenated to get one value.
207
208 If ELT is the key of an xfield, ELT expands to \"\\xfield{ELT}{value}\".
209
210 If ELT is a string, this is inserted \"as is\" in the TeX buffer.
211
212 ELT may also be a loop (FLD COUNT [SEPARATOR] [OPT...])
213 looping over the values of FLD.
214
215 If FLD is mail, this expands to \"\\mail{short}{long}\",
216 such as \"\\mail{foo@bar.com}{Smith <foo@bar.com>}\",
217 If FLD is phone, this expands to \"\\phone{key}{number}\"
218 If FLD is address, this expands to \"\\address{key}{value}\".
219 If FLD is xfields, this expands to \"\\xfield{key}{value}\".
220 If FLD is the key of an xfield, split the value of FLD
221 using `bbdb-separator-alist' to generate a list of values,
222 which then expand to \"\\xfield{FLD}{value}\".
223
224 If COUNT is a number, process at most COUNT values of FLD.
225 IF COUNT is t, process all values of FLD.
226
227 If SEPARATOR is non-nil, it is a string that is inserted between
228 the values of FLD. Insert COUNT - 1 instances of SEPARATOR,
229 even if there are fewer values of FLD.
230
231 If FLD is mail, phone, address, or xfields,
232 OPT may be a list (admit KEY ...) or (omit KEY ...).
233 Then a value is admitted or omitted if its key KEY is listed here.
234
235 (separator STRING)
236
237 When the first letter of the records' sortkey increases compared with
238 the previous record in the TeX listing, the new letter is formatted
239 using the format string STRING to generate a separator macro.
240
241 (epilog STRING)
242
243 The string STRING is inserted at the end of the buffer."
244 :group 'bbdb-utilities-tex)
245
246 (defcustom bbdb-tex-rule-default 'multi-line
247 "Default rule for BBDB tex.
248 This symbol should be a key in `bbdb-tex-alist'."
249 :group 'bbdb-utilities-tex
250 :type '(symbol :tag "rule"))
251
252 ;; FIXME
253 ;; (defcustom bbdb-tex-empty-fields nil
254 ;; "If non-nil generate TeX output even for empty fields."
255 ;; :group 'bbdb-utilities-tex)
256
257 (defcustom bbdb-tex-replace-list
258 '(("[#$%&_]" . "\\\\\\&")
259 ("<" . "\\\\textless ")
260 (">" . "\\\\textgreater ")
261 ("~" . "\\\\textasciitilde ")
262 ("{" . "\\\\textbraceleft ")
263 ("}" . "\\\\textbraceright "))
264 "Replacement list for TeX's special characters.
265 Each element is of the form (REGEXP . REPLACE)."
266 :group 'bbdb-utilities-tex
267 :type '(repeat (cons regexp string)))
268
269 (defcustom bbdb-tex-linebreak "\\\\\\\\\n"
270 "Replacement for linebreaks."
271 :group 'bbdb-utilities-tex
272 :type 'string)
273
274 (defcustom bbdb-tex-address-format-list bbdb-address-format-list
275 "List of address formatting rules for `bbdb-tex'.
276 Each element may take the same values as in `bbdb-address-format-list'.
277 The elements EDIT of `bbdb-address-format-list' are ignored."
278 :group 'bbdb-utilities-tex
279 :type '(repeat (list (choice (const :tag "Default" t)
280 (function :tag "Function")
281 (repeat (string)))
282 (choice (string)
283 (function :tag "Function"))
284 (choice (string)
285 (function :tag "Function"))
286 (choice (string)
287 (function :tag "Function")))))
288
289 (defcustom bbdb-tex-address-layout 2
290 "Address layout according to `bbdb-tex-address-format-list'.
291 2 is multi-line layout, 3 is one-line layout."
292 :group 'bbdb-utilities-tex)
293
294 (defcustom bbdb-tex-file "~/bbdb.tex"
295 "Default file name for TeXing BBDB."
296 :group 'bbdb-utilities-tex
297 :type 'file)
298
299 ;;; Internal variables
300
301 (defvar bbdb-tex-rule-last bbdb-tex-rule-default
302 "Last rule used for TeXing BBDB.")
303
304 (defvar bbdb-tex-file-last bbdb-tex-file
305 "Last used TeX file")
306
307 ;;; Functions:
308
309 ;; While we use `bbdb-tex-replace' only once in `bbdb-tex-field',
310 ;; we keep it as a separate function so that it can also be used
311 ;; inside user-defined functions `bbdb-tex-output-...'.
312 (defun bbdb-tex-replace (string)
313 "Apply replacement rules `bbdb-tex-replace-list' to STRING.
314 Also, replace linebreaks by `bbdb-tex-linebreak'."
315 (if (not string)
316 ""
317 (dolist (elt bbdb-tex-replace-list)
318 (setq string (replace-regexp-in-string (car elt) (cdr elt) string)))
319 (replace-regexp-in-string "\n" bbdb-tex-linebreak string)))
320
321 (defun bbdb-tex-field (field str)
322 "Massage string STR for LaTeX.
323 By default, STR is passed to `bbdb-tex-replace'.
324 The user may also define a function `bbdb-tex-output-FIELD'
325 that takes precedence."
326 (let ((fun (intern-soft (format "bbdb-tex-output-%s" field))))
327 (if fun
328 (funcall fun str)
329 (bbdb-tex-replace str))))
330
331 (defun bbdb-tex-list (list rule fun)
332 "Use function FUN to generate output for LIST according to RULE.
333 LIST is a list of field values such as a list of addresses.
334 RULE is an element of a record list as in `bbdb-tex-alist'
335 used to select the elements of LIST that get processed by calling FUN."
336 (let ((admit (cdr (assq 'admit rule)))
337 (omit (cdr (assq 'omit rule)))
338 (num (if (numberp (nth 1 rule)) (nth 1 rule)))
339 (sep (if (nth 2 rule) (concat (nth 2 rule) "\n")))
340 (i -1)
341 new-list elt)
342
343 ;; Select the relevant elements of LIST.
344 (cond (admit
345 (dolist (l list)
346 (if (member (elt l 0) admit)
347 (push l new-list)))
348 (setq new-list (nreverse new-list)))
349
350 (omit
351 (dolist (l list)
352 (unless (member (elt l 0) omit)
353 (push l new-list)))
354 (setq new-list (nreverse new-list)))
355
356 (t
357 (setq new-list list)))
358
359 (cond ((not num)
360 (insert (mapconcat fun new-list (or sep ""))))
361 ((not sep)
362 (while (and (< (setq i (1+ i)) num)
363 (setq elt (pop new-list)))
364 (insert (funcall fun elt))))
365 (t
366 (while (< (setq i (1+ i)) num)
367 (if (setq elt (pop new-list))
368 (insert (funcall fun elt)))
369 (if (< (1+ i) num)
370 (insert sep)))))))
371
372 ;;;###autoload
373 (defun bbdb-tex (records file rule)
374 "Generate FILE for TeXing RECORDS.
375 Interactively, use BBDB prefix \
376 \\<bbdb-mode-map>\\[bbdb-do-all-records], see `bbdb-do-all-records'.
377 RULE should be an element of `bbdb-tex-alist'."
378 (interactive
379 (list (bbdb-do-records)
380 (read-file-name
381 (format "TeX file: (default %s) "
382 (abbreviate-file-name bbdb-tex-file-last))
383 (file-name-directory bbdb-tex-file-last)
384 bbdb-tex-file-last)
385 (intern (completing-read (format "Rule: (default %s) "
386 bbdb-tex-rule-last)
387 bbdb-tex-alist nil t
388 nil nil (symbol-name bbdb-tex-rule-last)))))
389 ;; Remember our choice for `bbdb-tex-file-last'.
390 (setq bbdb-tex-file-last (expand-file-name file))
391
392 (find-file bbdb-tex-file-last)
393 (let* ((buffer-undo-list t)
394 (rule (assq rule bbdb-tex-alist))
395 (demand (nth 1 (assq 'demand rule)))
396 (separator (nth 1 (assq 'separator rule)))
397 current-letter p-symbols p-values)
398 (erase-buffer)
399
400 ;; Options
401 (dolist (option (cdr (assq 'options rule)))
402 (push (car option) p-symbols)
403 (push (cadr option) p-values))
404 (cl-progv p-symbols p-values
405
406 ;; Prolog
407 (let ((prolog (nth 1 (assq 'prolog rule))))
408 (when prolog
409 (insert prolog)
410 (when (consp bbdb-tex-path)
411 (goto-char (point-min))
412 (while (re-search-forward "\\\\usepackage[ \t\n]*{\\([^}]+\\)}" nil t)
413 (let ((sty (locate-file (match-string 1) bbdb-tex-path '(".sty"))))
414 (when sty
415 (replace-match (format "\n\\\\makeatletter\n%% begin %s\n%% end %s\n\\\\makeatother\n" sty sty))
416 (save-excursion
417 (forward-line -2)
418 (insert-file-contents sty))))))
419 (goto-char (point-max))
420 (unless (bolp) (insert "\n"))
421 (insert "% end BBDB prolog\n")))
422
423 ;; Process Records
424 (dolist (record (bbdb-record-list records))
425 (let* ((first-letter
426 (substring (bbdb-record-sortkey record) 0 1))
427 (firstname (bbdb-record-firstname record))
428 (lastname (bbdb-record-lastname record))
429 (name (bbdb-record-name record))
430 (name-lf (bbdb-record-name-lf record))
431 (organization (bbdb-record-organization record))
432 (affix (bbdb-record-affix record))
433 (aka (bbdb-record-aka record))
434 (mail (bbdb-record-mail record))
435 (phone (bbdb-record-phone record))
436 (address (bbdb-record-address record))
437 (xfields (bbdb-record-xfields record))
438 (lex-env `((firstname . ,firstname) (lastname . ,lastname)
439 (name . ,name) (name-lf . ,name-lf) (aka . ,aka)
440 (organization . ,organization) (affix . ,affix)
441 (mail . ,mail) (phone . ,phone)
442 (address . ,address) (xfields . ,xfields)))
443 (bbdb-address-format-list bbdb-tex-address-format-list))
444
445 ;; A record is processed only if the form DEMAND
446 ;; evaluates to a non-nil value.
447 (when (or (not demand)
448 (eval demand lex-env))
449
450 ;; Separator
451 (if (and separator
452 (not (and current-letter
453 (equal first-letter current-letter))))
454 (insert (format separator (upcase first-letter)) "\n"))
455 (setq current-letter first-letter)
456
457 (dolist (elt (cdr (assq 'record rule)))
458 (cond ((stringp elt)
459 (insert elt "\n"))
460
461 ((eq elt 'name) ; name of record
462 (let ((tex-name (and bbdb-tex-name
463 (bbdb-record-field record bbdb-tex-name)))
464 (fmt "\\name{%s}{%s}\n"))
465 (if tex-name
466 (let ((first-last (bbdb-split bbdb-tex-name tex-name)))
467 (cond ((eq 2 (length first-last))
468 (insert (format fmt (car first-last) (cadr first-last))))
469 ((eq 1 (length first-last))
470 (insert (format fmt "" (car first-last))))
471 (t (error "TeX name %s cannot be split" tex-name))))
472 (insert (format fmt
473 (bbdb-tex-field 'firstname firstname)
474 (bbdb-tex-field 'lastname lastname))))))
475
476 ;; organization, affix or aka as single string
477 ((memq elt '(organization affix aka))
478 (let ((val (bbdb-record-field record elt)))
479 (if val
480 (insert (format "\\%s{%s}\n" elt
481 (bbdb-tex-field elt (bbdb-concat elt val)))))))
482
483 ;; organization, affix or aka as list of strings
484 ((memq (car elt) '(organization affix aka))
485 (bbdb-tex-list
486 (bbdb-record-field record (car elt))
487 elt
488 `(lambda (o)
489 (format "\\%s{%s}\n" ',(car elt)
490 (bbdb-tex-field ',(car elt) o)))))
491
492 ((eq (car elt) 'mail) ; mail
493 (bbdb-tex-list
494 mail elt
495 (lambda (m)
496 (format "\\mail{%s}{%s}\n"
497 ;; No processing of plain mail address
498 (nth 1 (bbdb-decompose-bbdb-address m))
499 (bbdb-tex-field 'mail m)))))
500
501 ((eq (car elt) 'address) ; address
502 (bbdb-tex-list
503 address elt
504 (lambda (a)
505 (format "\\address{%s}{%s}\n"
506 (bbdb-tex-field 'address-label (bbdb-address-label a))
507 (bbdb-tex-field 'address (bbdb-format-address
508 a bbdb-tex-address-layout))))))
509
510 ((eq (car elt) 'phone) ; phone
511 (bbdb-tex-list
512 phone elt
513 (lambda (p)
514 (format "\\phone{%s}{%s}\n"
515 (bbdb-tex-field 'phone-label (bbdb-phone-label p))
516 (bbdb-tex-field 'phone (bbdb-phone-string p))))))
517
518 ((eq (car elt) 'xfields) ; list of xfields
519 (bbdb-tex-list
520 (bbdb-record-field record 'xfields)
521 elt
522 (lambda (x)
523 (format "\\xfield{%s}{%s}\n"
524 (bbdb-tex-field 'xfield-label (symbol-name (car x)))
525 (bbdb-tex-field 'xfield (cdr x))))))
526
527 ((symbolp elt) ; xfield as single string
528 ;; The value of an xfield may be a sexp instead of a string.
529 ;; Ideally, a sexp should be formatted by `pp-to-string',
530 ;; then printed verbatim.
531 (let ((val (format "%s" (bbdb-record-field record elt))))
532 (if val
533 (insert (format "\\xfield{%s}{%s}\n" elt
534 (bbdb-tex-field elt (bbdb-concat elt val)))))))
535
536 ((consp elt) ; xfield as list of strings
537 (bbdb-tex-list
538 (bbdb-split (car elt)
539 (format "%s" (bbdb-record-field record (car elt))))
540 elt
541 `(lambda (x)
542 (format "\\xfield{%s}{%s}\n" ',(car elt)
543 (bbdb-tex-field ',(car elt) x)))))
544
545 (t (error "Rule `%s' undefined" elt)))))))
546
547 ;; Epilog
548 (let ((epilog (nth 1 (assq 'epilog rule))))
549 (when epilog
550 (insert "% begin BBDB epilog\n" epilog)
551 (unless (bolp) (insert "\n"))))))
552 (setq buffer-undo-list nil)
553 (save-buffer))
554
555 (provide 'bbdb-tex)
556
557 ;;; bbdb-tex.el ends here