blob: 279238a357e374b16609c224867fdb0dae823e0c (
plain)
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
|
;;; 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-export.el
;;;
(defvar bbdb-export-buffer-name "*BBDB* Export"
"*Default buffer name for exporting the contents of the *BBDB* buffer.")
(defvar bbdb-export-compactly nil
"If nil, the exported records are compactly printed.
Otherwise the exported forms are indented for human-readability (at a
cost of somewhat longer processing time for exporting records.
The default value is nil.")
(defun bbdb-export ()
"Print the selected BBDB entries"
(interactive)
(save-excursion
(let ((to-buffer (get-buffer-create bbdb-export-buffer-name))
(records (progn (set-buffer bbdb-buffer-name)
bbdb-records))
(current-letter ""))
;; wipe to-buffer
(switch-to-buffer to-buffer)
(delete-region (point-min) (point-max))
;; insert header, records, trailer
(bexp-buffer-insert-header)
(while records
(setq current-letter (bexp-do-record (car (car records)) current-letter))
(setq records (cdr records)))
(bexp-buffer-insert-trailer)
(goto-char (point-min))
(search-forward "(progn")
(search-backward "(progn")
(indent-sexp)
))
(message "BBDB export buffer %s generated." bbdb-export-buffer-name))
(defun bexp-do-record (record current-letter)
"Insert the bbdb RECORD in export format."
(let* ((name (bbdb-record-name record))
(comp (bbdb-record-company record))
(net (bbdb-record-net record))
(phones (bbdb-record-phones record))
(addrs (bbdb-record-addresses record))
(notes (bbdb-record-raw-notes record))
(first-letter (upcase (substring (concat (bbdb-record-sortkey record) "?") 0 1))))
(if (not (string-equal first-letter current-letter))
(progn (message "Now processing \"%s\" entries..." first-letter)
(sleep-for 1)))
(bexp-buffer-insert-record name comp net addrs phones notes)
first-letter))
(defun bexp-buffer-insert-header()
(insert ";;; ======= Start of Exported BBDB Records =======\n")
(insert "(progn
(require 'bbdb-com)
(defun bbdb-maybe-create (name company net &optional addrs phones notes)
\"Try to add a record to BBDB if it does not already exist.\"
(condition-case err
(progn
(bbdb-create-internal name company net addrs phones notes)
(message \"%s %s added.\" name (if net (concat \"<\" net \">\") \"\"))
(sleep-for 1))
(error (ding)
(message \"%s %s skipped. (%s)\"
name
(if net (concat \"<\" net \">\") \"\")
(car (cdr err)))
(sleep-for 1))))\n\n")
(normal-mode))
(defun bexp-buffer-insert-trailer()
(insert ")\n")
(insert ";;; ======= End of Exported BBDB Records =======\n"))
(defun bexp-buffer-insert-record (name comp net addrs phones notes)
(let ((begin (point))
end)
(message "Exporting %s" name)
(insert (format "(bbdb-maybe-create %s %s '%s '%s '%s '%s)\n"
(prin1-to-string (concat name "--IMPORTED"))
(prin1-to-string comp)
(prin1-to-string net)
(prin1-to-string addrs)
(prin1-to-string phones)
(prin1-to-string notes)
))
(setq end (point))
(if (not bbdb-export-compactly)
(progn
;; format region
(narrow-to-region begin end)
(goto-char begin)
(replace-string " '(" "\n'(")
(goto-char begin)
(replace-string "\" \"" "\"\n\"")
(goto-char begin)
(replace-string "((" "(\n(")
(goto-char begin)
(replace-string "))" ")\n)")
(goto-char begin)
(replace-string "([" "(\n[")
(goto-char begin)
(replace-string "])" "]\n)")
(goto-char begin)
(replace-string ") (" ")\n(")
(goto-char begin)
(replace-string "] [" "]\n[")
(goto-char (point-max))
(lisp-indent-region begin (point))
(widen)))
))
(provide 'bbdb-export)
|
