Here's a bunch of fixes for various things (bugs and uncleanliness)
that I've accumulated, as diffs against recent CVS. Sorry they're all
in a lump. They address the following:
* Avoid loading CL at runtime;
* Use defalias, not fset (so loadhist works);
* Avoid some compiler warnings;
* Fix popup menu generation;
* Add sound support for Emacs 21 (untested);
* Prefer the preferred way of sending mail in Emacs;
* Don't mangle non-ASCII names when `cleaning' them if regexp
character classes are available.
* When looking for records in Gnus, snarf text that may need decoding
from the displayed article buffer, e.g. for QP-encoded names.
* Allow multilingual names in the BBDB file with Mule by using a
generic coding system to read and write it. Without this, you
can't deal with, say, Latin-1 and Latin-2 names correctly, let
alone Far Eastern ones. Unfortunately, it isn't
backwards-compatible. It might work to default the coding system
for reading and rely on autodetection, but that requires that
iso-2022 escapes occur in the part of the file for which detection
is done. Otherwise, to deal with a .bbdb containing non-ASCII
characters, find .bbdb and save it with the coding system
iso-2022-7bit. (In Emacs, it would probably be better to set
`bbdb-file-coding-system' to `emacs-mule'.)
To see the affect of the non-ASCII-related changes, find posts by,
say, Kai Großjohann and Pavel Janík.
I've only tested this in Emacs 21. It's possible Emacs 20 will need a
few extra fixes, particularly for CL-ish things which weren't in 20.
XEmacs _shouldn't_ be affected.
HTH.
2002-04-10 Dave Love <[EMAIL PROTECTED]>
* lisp/bbdb-gnus.el (bbdb/gnus-summary-show-all-recipients)
(bbdb/gnus-update-records): Revert last change
but use gnus-summary-toggle-header.
* lisp/bbdb.el: Require cl only when compiling.
Use defalias, not fset generally.
(bbdb-mapc): Define instead of aliasing mapcar.
(bbdb-submit-bug-report): Avoid useless lambda.
(bbdb-format-streets, bbdb-records): Use bbdb-mapc.
(bbdb-gui): Fix default, doc.
(bbdb-have-re-char-classes): New.
(bbdb-clean-username): Use it.
* lisp/bbdb-srv.el (bbdb-srv): Defalias, not fset.
(bbdb-header-start): Autoload.
* lisp/bbdb-snarf.el (bbdb-extract-address-component-regexps):
Match Outlook style.
(bbdb-extract-address-components): Avoid cadar, caddar.
* lisp/bbdb-rmail.el (bbdb-insinuate-rmail): Use defalias, not
fset.
* lisp/bbdb-migrate.el (bbdb-migrate, bbdb-migrate-change-dates):
Use bbdb-mapc.
(bbdb-migrate-record-lambda): Avoid caddr.
(bbdb-unmigrate-change-dates): Doc fix. Use bbdb-mapc.
* lisp/bbdb-gui.el: Use defalias, not fset generally.
(scrollbar-height, highlight-headers-hack-x-face-p): Defvar when
compiling.
(build-bbdb-insert-field-menu): Fix generation of actions.
* lisp/bbdb-com.el: Require cl and defvar
bbdb-extract-address-components-func only when compiling.
(bbdb-send-mail-internal): Try compose-mail first.
(auto-fill-hook): Defvar when compiling.
(bbdb-complete-name, bbdb-dial, bbdb-get-addresses): Avoid cadar.
(char-int): Don't fset it -- unused.
(bbdb-play-sound): Provide Emacs 21 case. Fix fallback case.
* lisp/bbdb.el (bbdb-file-coding-system): New variable.
(bbdb-buffer, bbdb-write-file-hook-fn): Use it.
Index: lisp/bbdb-com.el
===================================================================
RCS file: /cvsroot/bbdb/bbdb/lisp/bbdb-com.el,v
retrieving revision 1.147
diff -u -p -r1.147 bbdb-com.el
--- lisp/bbdb-com.el 13 Mar 2002 12:09:13 -0000 1.147
+++ lisp/bbdb-com.el 9 Apr 2002 17:01:57 -0000
@@ -25,8 +25,9 @@
(require 'bbdb)
;;(require 'bbdb-snarf) causes recursive compile!
-(defvar bbdb-extract-address-components-func);; bbdb-snarf
-(require 'cl)
+(eval-when-compile
+ (require 'cl)
+ (defvar bbdb-extract-address-components-func)) ;; bbdb-snarf
;; ARGH. fmh, dammit.
(require
(eval-and-compile
@@ -1871,11 +1872,13 @@ the name is always included."
(defun bbdb-send-mail-internal (&optional to subj records)
(let ((type (or bbdb-send-mail-style
- (cond ((featurep 'mh-e) 'mh)
+ ;; In Emacs, `compose-mail' gets whatever you've
+ ;; customized as your preferred `mail-user-agent'.
+ (cond ((fboundp 'compose-mail) 'compose-mail)
+ ((featurep 'mh-e) 'mh)
((featurep 'vm) 'vm)
((featurep 'message) 'message)
((featurep 'mew) 'mew)
- ((featurep 'compose-mail) 'compose-mail)
(t 'mail)))))
(cond
((eq type 'mh)
@@ -2220,6 +2223,8 @@ Currently only used by XEmacs."
:group 'bbdb-mua-specific
:type 'boolean)
+(eval-when-compile (defvar auto-fill-hook))
+
;;;###autoload
(defun bbdb-complete-name (&optional start-pos)
"Complete the user full-name or net-address before point (up to the
@@ -2309,7 +2314,7 @@ Completion behaviour can be controlled w
(switch-to-buffer standard-output))
;; use next address
(let* ((addrs (bbdb-record-net rec))
- (this-addr (or (cadr (member (cadar addr) addrs))
+ (this-addr (or (cadr (member (car (cdar addr)) addrs))
(nth 0 addrs))))
(if (= (length addrs) 1)
;; no alternatives. don't signal an error.
@@ -2798,19 +2803,28 @@ This is only used if bbdb-modem-dial is
:group 'bbdb-phone-dialing
:type 'integer)
-(defun bbdb-play-sound( num &optional volume )
+(defun bbdb-play-sound (num &optional volume)
"Play the specified touchtone number NUM at VOLUME.
Tries to use internal sound if available; falls back to
-bbdb-sound-player."
+`bbdb-sound-player'."
(if (featurep 'native-sound)
;; This requires the sound files to be loaded via bbdb-xemacs.
(funcall 'play-sound (intern (concat "touchtone" num))
bbdb-sound-volume)
- (if (and bbdb-sound-player
- (file-exists-p bbdb-sound-player))
- (call-process bbdb-sound-player nil nil nil
- (aref bbdb-sound-files (string-to-int num)))
- (error "BBDB has no means of playing sound."))))
+ (if (and (not (featurep 'xemacs))
+ ;; We can't tell a priori if Emacs 21 facility will
+ ;; actually work.
+ (condition-case nil
+ (play-sound (list 'sound
+ :file (aref bbdb-sound-files
+ (string-to-int num))
+ :volume (or volume bbdb-sound-volume)))
+ (error nil)))
+ (if (and bbdb-sound-player
+ (file-exists-p bbdb-sound-player))
+ (call-process bbdb-sound-player nil nil nil
+ (aref bbdb-sound-files num))
+ (error "BBDB has no means of playing sound.")))))
(eval-and-compile
(if (fboundp 'next-event)
@@ -2878,7 +2893,7 @@ is given."
(let ((alist bbdb-dial-local-prefix-alist))
(while alist
(if (string-match (concat "^" (eval (caar alist))) number)
- (setq shortnumber (concat (cadar alist)
+ (setq shortnumber (concat (car (cdar alist))
(substring number (match-end 0)))
alist nil))
(setq alist (cdr alist)))))
@@ -3381,10 +3396,6 @@ C-g again it will stop scanning."
;; Some cases are handled with signals in order to keep the changes in
;; bbdb-annotate-message-sender as minimal as possible.
-;; GNU vs XEmacs again. GAH.
-(or (fboundp 'char-int)
- (fset 'char-int 'identity))
-
(defun bbdb-prompt-for-create ()
"This function is used by `bbdb-update-records' to ask the user how to
proceed the processing of records."
@@ -3474,7 +3485,7 @@ Changing this variable will show its eff
header-content))
(while adlist
(setq fn (caar adlist)
- ad (cadar adlist))
+ ad (car (cdar adlist)))
;; ignore uninteresting addresses, this is kinda gross!
(if (or (not (stringp ignore-senders))
Index: lisp/bbdb-gnus.el
===================================================================
RCS file: /cvsroot/bbdb/bbdb/lisp/bbdb-gnus.el,v
retrieving revision 1.90
diff -u -p -r1.90 bbdb-gnus.el
--- lisp/bbdb-gnus.el 3 Mar 2002 22:17:59 -0000 1.90
+++ lisp/bbdb-gnus.el 10 Apr 2002 14:22:34 -0000
@@ -112,7 +112,8 @@ C-g again it will stop scanning."
(msg-id (bbdb/gnus-get-message-id))
records cache)
(save-excursion
- (set-buffer gnus-original-article-buffer)
+ (set-buffer (get-buffer gnus-article-buffer))
+ (gnus-summary-toggle-header 1)
(if (and msg-id (not bbdb/gnus-offer-to-create))
(setq cache (bbdb-message-cache-lookup msg-id)))
@@ -134,6 +135,7 @@ C-g again it will stop scanning."
offer-to-create)))
(if (and bbdb-message-caching-enabled msg-id)
(bbdb-encache-message msg-id records))))
+ (gnus-summary-toggle-header -1) ; assume hidden originally
records))
;;;###autoload
@@ -405,6 +407,8 @@ This function is meant to be used with t
;; this is a little bogus, since it will remain set after you've
;; quit Gnus
(or gnus-article-buffer (error "Not in Gnus!"))
+ ;; This is wrong for non-ASCII text. Why not use
+ ;; gnus-article-hide-signature?
(set-buffer gnus-original-article-buffer)
(save-restriction
(or (gnus-article-narrow-to-signature) (error "No signature!"))
@@ -501,9 +505,10 @@ addresses better than the traditionally
bbdb-display-layout))
(bbdb-auto-notes-alist nil))
(bbdb/gnus-pop-up-bbdb-buffer nil)
- (set-buffer gnus-original-article-buffer)
+ (set-buffer (get-buffer gnus-article-buffer))
+ (gnus-summary-toggle-header 1)
(bbdb-show-all-recipients)
- ))
+ (gnus-summary-toggle-header -1)))
;;; from Brian Edmonds' gnus-bbdb.el
;;;
Index: lisp/bbdb-gui.el
===================================================================
RCS file: /cvsroot/bbdb/bbdb/lisp/bbdb-gui.el,v
retrieving revision 1.28
diff -u -p -r1.28 bbdb-gui.el
--- lisp/bbdb-gui.el 1 Apr 2002 01:01:07 -0000 1.28
+++ lisp/bbdb-gui.el 9 Apr 2002 17:01:57 -0000
@@ -33,21 +33,21 @@
;; MIGRATE XXX
(eval-and-compile
(if (fboundp 'set-specifier)
- (fset 'bbdb-set-specifier 'set-specifier)
- (fset 'bbdb-set-specifier 'ignore))
+ (defalias 'bbdb-set-specifier 'set-specifier)
+ (defalias 'bbdb-set-specifier 'ignore))
(if (fboundp 'make-glyph)
- (fset 'bbdb-make-glyph 'make-glyph)
- (fset 'bbdb-make-glyph 'ignore))
+ (defalias 'bbdb-make-glyph 'make-glyph)
+ (defalias 'bbdb-make-glyph 'ignore))
(if (fboundp 'set-glyph-face)
- (fset 'bbdb-set-glyph-face 'set-glyph-face)
- (fset 'bbdb-set-glyph-face 'ignore))
+ (defalias 'bbdb-set-glyph-face 'set-glyph-face)
+ (defalias 'bbdb-set-glyph-face 'ignore))
(if (fboundp 'highlight-headers-x-face)
- (fset 'bbdb-highlight-headers-x-face 'highlight-headers-x-face)
- (fset 'bbdb-highlight-headers-x-face 'ignore))
+ (defalias 'bbdb-highlight-headers-x-face 'highlight-headers-x-face)
+ (defalias 'bbdb-highlight-headers-x-face 'ignore))
(if (fboundp 'highlight-headers-x-face-to-pixmap)
- (fset 'bbdb-highlight-headers-x-face-to-pixmap
+ (defalias 'bbdb-highlight-headers-x-face-to-pixmap
'highlight-headers-x-face-to-pixmap)
- (fset 'bbdb-highlight-headers-x-face-to-pixmap 'ignore)))
+ (defalias 'bbdb-highlight-headers-x-face-to-pixmap 'ignore)))
(if (featurep 'xemacs)
@@ -67,10 +67,11 @@
(eval-and-compile
(if (fboundp 'find-face)
- (fset 'bbdb-find-face 'find-face)
+ (defalias 'bbdb-find-face 'find-face)
(if (fboundp 'internal-find-face) ;; GRR.
- (fset 'bbdb-find-face 'internal-find-face)
- (fset 'bbdb-find-face 'ignore)))) ; noop - you probably don't HAVE faces.
+ ;; This should be facep in Emacs 21
+ (defalias 'bbdb-find-face 'internal-find-face)
+ (defalias 'bbdb-find-face 'ignore)))) ; noop - you probably don't HAVE faces.
(or (bbdb-find-face 'bbdb-name)
(face-differs-from-default-p (make-face 'bbdb-name))
@@ -94,12 +95,12 @@
;;; change bbdb-foo-extents below to vm-foo-extents, etc.
(eval-and-compile
(if (fboundp 'make-extent)
- (fset 'bbdb-make-extent 'make-extent)
- (fset 'bbdb-make-extent 'make-overlay))
+ (defalias 'bbdb-make-extent 'make-extent)
+ (defalias 'bbdb-make-extent 'make-overlay))
(if (fboundp 'delete-extent)
- (fset 'bbdb-delete-extent 'delete-extent)
- (fset 'bbdb-delete-extent 'delete-overlay))
+ (defalias 'bbdb-delete-extent 'delete-extent)
+ (defalias 'bbdb-delete-extent 'delete-overlay))
(if (fboundp 'mapcar-extents)
(defmacro bbdb-list-extents() `(mapcar-extents 'identity))
@@ -113,7 +114,7 @@
(list 'overlays-in s e)))
(if (fboundp 'set-extent-property)
- (fset 'bbdb-set-extent-property 'set-extent-property)
+ (defalias 'bbdb-set-extent-property 'set-extent-property)
(defun bbdb-set-extent-property( e p v )
(if (eq 'highlight p)
(if v
@@ -122,11 +123,11 @@
(overlay-put e p v)))
(if (fboundp 'extent-property)
- (fset 'bbdb-extent-property 'extent-property)
- (fset 'bbdb-extent-property 'overlay-get))
+ (defalias 'bbdb-extent-property 'extent-property)
+ (defalias 'bbdb-extent-property 'overlay-get))
(if (fboundp 'extent-at)
- (fset 'bbdb-extent-at 'extent-at)
+ (defalias 'bbdb-extent-at 'extent-at)
(defun bbdb-extent-at (pos buf tag) "NOT FULL XEMACS IMPLEMENTATION"
(let ((o (overlays-at pos))
minpri retval)
@@ -141,36 +142,37 @@
retval)))
(if (fboundp 'highlight-extent)
- (fset 'bbdb-highlight-extent 'highlight-extent)
- (fset 'bbdb-highlight-extent 'ignore)) ; XXX noop
+ (defalias 'bbdb-highlight-extent 'highlight-extent)
+ (defalias 'bbdb-highlight-extent 'ignore)) ; XXX noop
(if (fboundp 'extent-start-position)
- (fset 'bbdb-extent-start-position 'extent-start-position)
- (fset 'bbdb-extent-start-position 'overlay-start))
+ (defalias 'bbdb-extent-start-position 'extent-start-position)
+ (defalias 'bbdb-extent-start-position 'overlay-start))
(if (fboundp 'extent-end-position)
- (fset 'bbdb-extent-end-position 'extent-end-position)
- (fset 'bbdb-extent-end-position 'overlay-end))
+ (defalias 'bbdb-extent-end-position 'extent-end-position)
+ (defalias 'bbdb-extent-end-position 'overlay-end))
(if (fboundp 'extent-face)
- (fset 'bbdb-extent-face 'extent-face)
+ (defalias 'bbdb-extent-face 'extent-face)
(defun bbdb-extent-face (extent)
(overlay-get extent 'face)))
(if (fboundp 'set-extent-face)
- (fset 'bbdb-set-extent-face 'set-extent-face)
+ (defalias 'bbdb-set-extent-face 'set-extent-face)
(defun bbdb-set-extent-face (extent face) "set the face for an overlay"
(overlay-put extent 'face face)))
(if (fboundp 'set-extent-begin-glyph)
- (fset 'bbdb-set-extent-begin-glyph 'set-extent-begin-glyph)
- (fset 'bbdb-set-extent-begin-glyph 'ignore)) ; XXX noop
+ (defalias 'bbdb-set-extent-begin-glyph 'set-extent-begin-glyph)
+ (defalias 'bbdb-set-extent-begin-glyph 'ignore)) ; XXX noop
(if (fboundp 'set-extent-end-glyph)
- (fset 'bbdb-set-extent-end-glyph 'set-extent-end-glyph)
- (fset 'bbdb-set-extent-end-glyph 'ignore))) ; XXX noop
+ (defalias 'bbdb-set-extent-end-glyph 'set-extent-end-glyph)
+ (defalias 'bbdb-set-extent-end-glyph 'ignore))) ; XXX noop
+(eval-when-compile (defvar scrollbar-height))
;;;###autoload
(defun bbdb-fontify-buffer (&optional records)
(interactive)
@@ -252,7 +254,9 @@
;;; share the xface cache data with VM if it's around
(defvar vm-xface-cache (make-vector 29 0))
+(eval-when-compile (defvar highlight-headers-hack-x-face-p))
+;; In Emacs 21, this could use the x-face support from Gnus.
(defun bbdb-hack-x-face (face extent)
"Process a face property of a record and honour it.
Not done for GNU Emacs just yet, since it doesn't have image support
@@ -389,7 +393,9 @@ as of GNU Emacs 20.7"
'aka
(intern (car field)))))
(vector (car field)
- (list 'bbdb-insert-new-field (list 'quote type)
+ (list 'bbdb-insert-new-field
+ '(bbdb-current-record)
+ (list 'quote type)
(list 'bbdb-prompt-for-new-field-value
(list 'quote type)))
(not
Index: lisp/bbdb-hooks.el
===================================================================
RCS file: /cvsroot/bbdb/bbdb/lisp/bbdb-hooks.el,v
retrieving revision 1.71
diff -u -p -r1.71 bbdb-hooks.el
--- lisp/bbdb-hooks.el 20 Jan 2002 12:53:43 -0000 1.71
+++ lisp/bbdb-hooks.el 9 Apr 2002 17:01:57 -0000
@@ -83,6 +83,12 @@ which is the current time string."
;;; Determining whether to create a record based on the content of the
;;; current message.
+(eval-when-compile
+ (defvar vm-mail-buffer)
+ (defvar vm-message-pointer)
+ (autoload 'vm-start-of 'vm)
+ (autoload 'bbdb/vm-pop-up-bbdb-buffer "bbdb-vm"))
+
;;;###autoload
(defun bbdb-header-start ()
"Returns a marker at the beginning of the header block of the current
Index: lisp/bbdb-migrate.el
===================================================================
RCS file: /cvsroot/bbdb/bbdb/lisp/bbdb-migrate.el,v
retrieving revision 1.17
diff -u -p -r1.17 bbdb-migrate.el
--- lisp/bbdb-migrate.el 17 May 2001 17:15:31 -0000 1.17
+++ lisp/bbdb-migrate.el 9 Apr 2002 17:01:57 -0000
@@ -139,8 +139,8 @@ changes introduced after version %d is s
"Migrate the BBDB from the version on disk (the car of
`bbdb-file-format-migration') to the current version (in
`bbdb-file-format')."
- (mapc (bbdb-migrate-versions-lambda (car bbdb-file-format-migration))
- records)
+ (bbdb-mapc (bbdb-migrate-versions-lambda (car bbdb-file-format-migration))
+ records)
records)
;;;###autoload
@@ -190,7 +190,7 @@ results will be saved with SET."
(byte-compile `(lambda (rec)
,@(mapcar (lambda (ch)
`(,(cadr ch) rec
- (,(caddr ch)
+ (,(car (cddr ch))
(,(car ch) rec))))
changes)
rec)))
@@ -299,13 +299,14 @@ This uses the code that used to be in bb
addrs))
(defun bbdb-migrate-change-dates (rec)
- "Change date formats in timestamp and creation-date fields from
+ "Change date formats.
+Formats are changed in timestamp and creation-date fields from
\"dd mmm yy\" to \"yyyy-mm-dd\". Assumes the notes are passed in as an
argument."
- (mapc (lambda (rr)
- (when (memq (car rr) '(creation-date timestamp))
- (bbdb-migrate-change-dates-change-field rr)))
- rec)
+ (bbdb-mapc (lambda (rr)
+ (when (memq (car rr) '(creation-date timestamp))
+ (bbdb-migrate-change-dates-change-field rr)))
+ rec)
rec)
(defun bbdb-migrate-change-dates-change-field (field)
@@ -367,13 +368,14 @@ argument."
field date)))))
(defun bbdb-unmigrate-change-dates (rec)
- "Change date formats is timestamp and creation-date fields from
+ "Change date formats.
+Formats are changed in timestamp and creation-date fields from
\"yyyy-mm-dd\" to \"dd mmm yy\". Assumes the notes list is passed in
as an argument."
- (mapc (lambda (rr)
- (when (memq (car rr) '(creation-date timestamp))
- (bbdb-unmigrate-change-dates-change-field rr)))
- rec)
+ (bbdb-mapc (lambda (rr)
+ (when (memq (car rr) '(creation-date timestamp))
+ (bbdb-unmigrate-change-dates-change-field rr)))
+ rec)
rec)
(defun bbdb-unmigrate-change-dates-change-field (field)
Index: lisp/bbdb-rmail.el
===================================================================
RCS file: /cvsroot/bbdb/bbdb/lisp/bbdb-rmail.el,v
retrieving revision 1.62
diff -u -p -r1.62 bbdb-rmail.el
--- lisp/bbdb-rmail.el 12 Mar 2002 17:40:28 -0000 1.62
+++ lisp/bbdb-rmail.el 9 Apr 2002 17:01:57 -0000
@@ -160,17 +160,17 @@ Leaves original message, deleted, before
;; message invalidates the cache (which is based on message numbers).
;; Same for undigestifying.
(or (fboundp 'bbdb-orig-rmail-expunge)
- (fset 'bbdb-orig-rmail-expunge (symbol-function 'rmail-expunge)))
- (fset 'rmail-expunge 'bbdb/rmail-expunge)
+ (defalias 'bbdb-orig-rmail-expunge (symbol-function 'rmail-expunge)))
+ (defalias 'rmail-expunge 'bbdb/rmail-expunge)
(or (fboundp 'undigestify-rmail-message)
(autoload 'undigestify-rmail-message "undigest" nil t))
(if (eq (car-safe (symbol-function 'undigestify-rmail-message)) 'autoload)
(load (nth 1 (symbol-function 'undigestify-rmail-message))))
(or (fboundp 'bbdb-orig-undigestify-rmail-message)
- (fset 'bbdb-orig-undigestify-rmail-message
+ (defalias 'bbdb-orig-undigestify-rmail-message
(symbol-function 'undigestify-rmail-message)))
- (fset 'undigestify-rmail-message 'bbdb/undigestify-rmail-message)
+ (defalias 'undigestify-rmail-message 'bbdb/undigestify-rmail-message)
)
(provide 'bbdb-rmail)
Index: lisp/bbdb-snarf.el
===================================================================
RCS file: /cvsroot/bbdb/bbdb/lisp/bbdb-snarf.el,v
retrieving revision 1.35
diff -u -p -r1.35 bbdb-snarf.el
--- lisp/bbdb-snarf.el 12 Mar 2002 17:40:43 -0000 1.35
+++ lisp/bbdb-snarf.el 9 Apr 2002 17:01:57 -0000
@@ -412,7 +412,10 @@ See bbdb-extract-address-components for
:type 'function)
(defcustom bbdb-extract-address-component-regexps
- '(;; "name" <address>
+ '(;; "surname, firstname" <address> from Outlookers
+ ("\"\\([^\"]*\\)\"\\s-*<\\([^>]+\\)>"
+ (bbdb-clean-username (match-string 1 adstring)) 2)
+ ;; "name" <address>
("\"\\([^\"]*\\)\"\\s-*<\\([^>]+\\)>"
(car (mail-extract-address-components
(concat "\"" (match-string 1 adstring) "\"")))
@@ -506,8 +509,8 @@ If extracting fails one probably has to
nomatch t)
(while adcom-regexp
(let ((regexp (caar adcom-regexp))
- (fn (cadar adcom-regexp))
- (ad (caddar adcom-regexp)))
+ (fn (car (cdar adcom-regexp)))
+ (ad (cadr (cdar adcom-regexp))))
(cond ((string-match
(concat "^[^,]*\\("
bbdb-extract-address-component-ignore-regexp
Index: lisp/bbdb-srv.el
===================================================================
RCS file: /cvsroot/bbdb/bbdb/lisp/bbdb-srv.el,v
retrieving revision 1.60
diff -u -p -r1.60 bbdb-srv.el
--- lisp/bbdb-srv.el 6 Jan 2002 22:22:28 -0000 1.60
+++ lisp/bbdb-srv.el 9 Apr 2002 17:01:57 -0000
@@ -225,7 +225,9 @@ requested for a couple of seconds."
nil))
;;;###autoload
-(fset 'bbdb-srv 'bbdb/srv-handle-headers-with-delay)
+(defalias 'bbdb-srv 'bbdb/srv-handle-headers-with-delay)
+
+(autoload 'bbdb-header-start "bbdb-hooks")
;;;###autoload
(defun bbdb/srv-auto-create-mail-news-dispatcher ()
Index: lisp/bbdb.el
===================================================================
RCS file: /cvsroot/bbdb/bbdb/lisp/bbdb.el,v
retrieving revision 1.191
diff -u -p -r1.191 bbdb.el
--- lisp/bbdb.el 11 Mar 2002 20:48:59 -0000 1.191
+++ lisp/bbdb.el 9 Apr 2002 17:01:58 -0000
@@ -38,7 +38,7 @@
;;; $Id: bbdb.el,v 1.191 2002/03/11 20:48:59 waider Exp $
(require 'timezone)
-(require 'cl)
+(eval-when-compile (require 'cl))
(eval-when-compile ; pacify the compiler.
(autoload 'widget-group-match "wid-edit")
@@ -64,9 +64,10 @@
(defconst bbdb-version "2.35")
(defconst bbdb-version-date "$Date: 2002/03/11 20:48:59 $")
-(defcustom bbdb-gui (not (null window-system))
- "*Should the *BBDB* buffer be fontified?
-This variable has no effect if set outside of customize."
+(defcustom bbdb-gui (if (fboundp 'display-color-p) ; Emacs 21
+ (display-color-p)
+ (not (null window-system))) ; wrong for XEmacs?
+ "*Non-nil means fontify the *BBDB* buffer."
:group 'bbdb
:type 'boolean)
@@ -89,8 +90,10 @@ prompt the users on how to merge records
(defmacro unless (bool &rest forms) `(if ,bool nil ,@forms))
(defmacro when (bool &rest forms) `(if ,bool (progn ,@forms))))
(unless (fboundp 'save-current-buffer)
- (fset 'save-current-buffer 'save-excursion))
- (unless (fboundp 'mapc) (fset 'mapc 'mapcar))
+ (defalias 'save-current-buffer 'save-excursion))
+ (if (fboundp 'mapc)
+ (defalias 'bbdb-mapc 'mapc)
+ (defalias 'bbdb-mapc 'mapcar))
)
(unless (fboundp 'with-current-buffer)
@@ -125,7 +128,7 @@ prompt the users on how to merge records
bbdb-no-duplicates-p)
;; user variables
(sort (apropos-internal "^bbdb"
- (lambda (symbol) (user-variable-p symbol)))
+ 'user-variable-p)
(lambda (v1 v2) (string-lessp (format "%s" v1) (format "%s" v2))))
;; see what the user had loaded
(list 'features)
@@ -724,6 +727,11 @@ Database initialization function `bbdb-i
(defvar bbdb-mode-search-map nil
"Keymap for Insidious Big Brother Database searching")
+;; This value should be OK (but not optimal for Emacs, at least) with
+;; both Emacs and XEmacs.
+(defvar bbdb-file-coding-system 'iso-2022-7bit
+ "Coding system used for reading and writing `bbdb-file'.")
+
(defvar bbdb-suppress-changed-records-recording nil
"Whether to record changed records in variable `bbdb-changed-records'.
@@ -737,7 +745,6 @@ interface feature, and should only be su
automatically made to BBDB records which the user will not care directly
about.")
-
;;; These are the buffer-local variables we use.
;;; They are mentioned here so that the compiler doesn't warn about them
@@ -1103,9 +1110,11 @@ If the note is absent, returns a zero le
bbdb-buffer
(when (and bbdb-file-remote
(file-newer-than-file-p bbdb-file-remote bbdb-file))
- (copy-file bbdb-file-remote bbdb-file t t))
+ (let ((coding-system-for-write bbdb-file-coding-system))
+ (copy-file bbdb-file-remote bbdb-file t t)))
(setq bbdb-buffer
- (find-file-noselect bbdb-file 'nowarn))))
+ (let ((coding-system-for-read bbdb-file-coding-system))
+ (find-file-noselect bbdb-file 'nowarn)))))
(defmacro bbdb-with-db-buffer (&rest body)
(cons 'with-current-buffer
@@ -1308,10 +1317,10 @@ This is a possible identifying function
"Insert street subfields of address ADDR in current buffer.
This may be used by formatting functions listed in
`bbdb-address-formatting-alist'."
- (mapc (lambda(str)
- (indent-to indent)
- (insert str "\n"))
- (bbdb-address-streets addr)))
+ (bbdb-mapc (lambda(str)
+ (indent-to indent)
+ (insert str "\n"))
+ (bbdb-address-streets addr)))
(defun bbdb-format-address-continental (addr &optional indent)
"Insert formated continental address ADDR in current buffer.
@@ -2110,7 +2119,7 @@ optional arg DONT-CHECK-DISK is non-nil
(set (make-local-variable 'bbdb-propnames) nil)
(set (make-local-variable 'revert-buffer-function)
'bbdb-revert-buffer)
- (mapc (lambda (ff) (add-hook 'local-write-file-hooks ff))
+ (bbdb-mapc (lambda (ff) (add-hook 'local-write-file-hooks ff))
bbdb-write-file-hooks)
(setq bbdb-hashtable (make-vector bbdb-hashtable-size 0)))
(setq bbdb-modified-p (buffer-modified-p)
@@ -2352,7 +2361,8 @@ optional arg DONT-CHECK-DISK is non-nil
bbdb-file-remote))))
;; write the current buffer, which is `bbdb-file' (since this is called
;; from its `local-write-file-hooks'), into the `bbdb-file-remote'.
- (write-region (point-min) (point-max) bbdb-file-remote)))
+ (let ((coding-system-for-write bbdb-file-coding-system))
+ (write-region (point-min) (point-max) bbdb-file-remote))))
(defun bbdb-delete-record-internal (record)
(if (null (bbdb-record-marker record)) (error "bbdb: marker unpresent"))
@@ -3444,8 +3454,8 @@ passed as arguments to initiate the appr
supercite citation package.
w3 Initialize BBDB support for Web browsers."
- (fset 'advertized-bbdb-delete-current-field-or-record
- 'bbdb-delete-current-field-or-record)
+ (defalias 'advertized-bbdb-delete-current-field-or-record
+ 'bbdb-delete-current-field-or-record)
(require 'bbdb-autoloads)
