I've done some work on modifying bbdb-lucid.el to also work with FSF
emacs (19.24). I'd like some people to give this a try and see if it
works for you. I'd especially like feedback in the nature of
improvements... this is the first draft here.
What I did was move the majority of what used to be bbdb-lucid to
bbdb-display, but with calls to lucid-only functions changed into
calls to new bbdb functions, which are defined (differently!) in
bbdb-display-fsf and bbdb-display-lucid. So if I did my job well,
this should still work for lucid, but in reality that claim also needs
testing, since I made a few other changes as well (ie, tried to get the
"Finger All" menu item to work; it used to refer to a non-existent
function bbdb-finger-record).
So give this a try and let me know how it does. Installation is just
(if window-system (require 'bbdb-display))
Send fixes to me & I'll hopefully I'll be able to report back to the
list with an imporved, safer version soon (which perhaps could make it
into the next release of BBDB?)
Bng
shar: saving bbdb-display-fsf.el (Text)
#!/bin/sh
# This is a shell archive (produced by shar 3.49)
# To extract the files from this archive, save it to a file, remove
# everything above the "!/bin/sh" line above, and type "sh file_name".
#
# made 05/31/1994 22:02 UTC by [EMAIL PROTECTED]
# Source directory /home/diamond/u14/boris/emacs/lisp
#
# existing files will NOT be overwritten unless -c is specified
#
# This shar contains:
# length mode name
# ------ ---------- ------------------------------------------
# 2919 -rw-r--r-- bbdb-display-fsf.el
# 2468 -rw-r--r-- bbdb-display-lucid.el
# 7587 -rw-r--r-- bbdb-display.el
#
# ============= bbdb-display-fsf.el ==============
if test -f 'bbdb-display-fsf.el' -a X"$1" != X"-c"; then
echo 'x - skipping bbdb-display-fsf.el (File already exists)'
else
echo 'x - extracting bbdb-display-fsf.el (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'bbdb-display-fsf.el' &&
;;; bbdb-display-fsf.el -- FSF Specific definitions for bbdb-display.
X
;;; This file is an extension to the Insidious Big Brother Database (aka BBDB),
;;; Copyright (c) 1994 Boris Goldowsky <[EMAIL PROTECTED]>
;;; Derived from bbdb-lucid.el, (c) 1992 Jamie Zawinski <[EMAIL PROTECTED]>.
;;; Last change 31-may-94.
X
;;; This 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.
;;;
;;; This program 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.
X
(require 'lmenu)
X
(define-key bbdb-mode-map [down-mouse-3] 'bbdb-menu)
X
(or (internal-find-face 'bbdb-name)
X (face-differs-from-default-p (make-face 'bbdb-name))
X (copy-face 'underline 'bbdb-name))
X
(or (internal-find-face 'bbdb-company)
X (face-differs-from-default-p (make-face 'bbdb-company))
X (copy-face 'italic 'bbdb-company))
X
(or (internal-find-face 'bbdb-field-value)
X (copy-face 'default 'bbdb-field-value))
X
(or (internal-find-face 'bbdb-field-name)
X (face-differs-from-default-p (make-face 'bbdb-field-name))
X (copy-face 'bold 'bbdb-field-name))
X
(defalias 'bbdb-extent-start-position 'overlay-start)
X
(defsubst bbdb-extent-face (e)
X (overlay-get e 'face))
X
(defsubst bbdb-overlay-length (o)
X (- (overlay-end o) (overlay-start o)))
X
(defun bbdb-extent-at (pos buffer prop)
X ;; compatibility function added by Bng.
X ;; in lucid, extent-at
X "Find overlay enclosing POSITION in BUFFER that has PROPERTY.
Returns nil if no such overlay was found."
X (interactive "e")
X (let ((obuf (current-buffer)))
X (set-buffer buffer)
X (let* ((list (overlays-at pos))
X (best (car list))
X (bestlength (if best (bbdb-overlay-length best))))
X (foreach (cdr list)
X '(lambda (o)
X (if (overlay-get o prop)
X (let ((length (bbdb-overlay-length o)))
X (if (< length bestlength)
X (setq best o
X bestlength length))))))
X (set-buffer obuf)
X best)))
X
(defun bbdb-make-extent (from to &optional face highlight)
X (let ((o (make-overlay from to)))
X (overlay-put o 'bbdb t)
X (if face
X (overlay-put o 'face face))
X (if highlight
X (overlay-put o 'mouse-face 'highlight))
X o))
X
(defun bbdb-delete-extents ()
X ;; delete existing extents
X (overlay-recenter (point-min))
X (foreach (cdr (overlay-lists))
X (function (lambda (x)
X (if (overlay-get x 'bbdb)
X (delete-overlay x))))))
X
(provide 'bbdb-display-fsf)
X
;;; bbdb-fsf ends here.
SHAR_EOF
chmod 0644 bbdb-display-fsf.el ||
echo 'restore of bbdb-display-fsf.el failed'
Wc_c="`wc -c < 'bbdb-display-fsf.el'`"
test 2919 -eq "$Wc_c" ||
echo 'bbdb-display-fsf.el: original size 2919, current size' "$Wc_c"
fi
# ==shar: saving bbdb-display-lucid.el (Text)
shar: saving bbdb-display.el (Text)
=========== bbdb-display-lucid.el ==============
if test -f 'bbdb-display-lucid.el' -a X"$1" != X"-c"; then
echo 'x - skipping bbdb-display-lucid.el (File already exists)'
else
echo 'x - extracting bbdb-display-lucid.el (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'bbdb-display-lucid.el' &&
;;; bbdb-display-lucid.el -- Lucid GNU Emacs definitions for bbdb-display.
X
;;; This file is the part of the Insidious Big Brother Database (aka BBDB),
;;; Copyright (c) 1992 Jamie Zawinski <[EMAIL PROTECTED]>.
;;; Derived from bbdb-lucid.el, (c) 1992 Jamie Zawinski <[EMAIL PROTECTED]>.
;;; Last change 31-may-94.
X
;;; 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.
X
;;; This code is kind of kludgey, mostly because it needs to parse the contents
;;; of the *BBDB* buffer, since BBDB doesn't save the buffer-positions of the
;;; various fields when it fills in that buffer (doing that would be slow and
;;; cons a lot, so it doesn't seem to be worth it.)
X
(define-key bbdb-mode-map 'button3 'bbdb-menu)
X
(or (find-face 'bbdb-name)
X (face-differs-from-default-p (make-face 'bbdb-name))
X (set-face-underline-p 'bbdb-name t))
X
(or (find-face 'bbdb-company)
X (face-differs-from-default-p (make-face 'bbdb-company))
X (make-face-italic 'bbdb-company))
X
(or (find-face 'bbdb-field-value)
X (make-face 'bbdb-field-value))
X
(or (find-face 'bbdb-field-name)
X (face-differs-from-default-p (make-face 'bbdb-field-name))
X (copy-face 'bold 'bbdb-field-name))
X
(defalias 'bbdb-extent-start-position 'extent-start-position)
X
(defalias 'bbdb-extent-face 'extent-face)
X
(defalias 'bbdb-extent-at 'extent-at)
X
(defalias 'bbdb-find-face 'find-face)
X
(defun bbdb-delete-extents ()
X (map-extents (function (lambda (x y)
X (if (bbdb-extent-p x)
X (delete-extent x))))
X (current-buffer) (point-min) (point-max) nil))
X
(defun bbdb-make-extent (from to &optional face highlight)
X (let ((e (make-extent from to)))
X (set-extent-data e 'bbdb)
X (if face
X (bbdb-set-extent-face e face))
X (if highlight
X (bbdb-set-extent-attribute e 'highlight))
X e))
X
(provide 'bbdb-display-lucid)
SHAR_EOF
chmod 0644 bbdb-display-lucid.el ||
echo 'restore of bbdb-display-lucid.el failed'
Wc_c="`wc -c < 'bbdb-display-lucid.el'`"
test 2468 -eq "$Wc_c" ||
echo 'bbdb-display-lucid.el: original size 2468, current size' "$Wc_c"
fi
# ============= bbdb-display.el ==============
if test -f 'bbdb-display.el' -a X"$1" != X"-c"; then
echo 'x - skipping bbdb-display.el (File already exists)'
else
echo 'x - extracting bbdb-display.el (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'bbdb-display.el' &&
;;; bbdb-display.el -- Mouse sensitivity & menus for Lucid and FSF Emacs.
X
;;; This file is an extension to the Insidious Big Brother Database (aka BBDB),
;;; Copyright (c) 1994 Boris Goldowsky <[EMAIL PROTECTED]>
;;; Derived from bbdb-lucid.el, (c) 1992 Jamie Zawinski <[EMAIL PROTECTED]>.
;;; Last change 31-may-94.
X
;;; This 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.
;;;
;;; This program 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.
X
;;; This code is kind of kludgey, mostly because it needs to parse the contents
;;; of the *BBDB* buffer, since BBDB doesn't save the buffer-positions of the
;;; various fields when it fills in that buffer (doing that would be slow and
;;; cons a lot, so it doesn't seem to be worth it.)
X
(require 'bbdb)
(require 'bbdb-com)
X
;; Version-specific set up:
(cond ((string-match "Lucid" emacs-version)
X (require 'bbdb-display-lucid))
X ((>= emacs-major-version 19)
X (require 'bbdb-display-fsf)))
X
(defvar bbdb-fontify-max 25
X ;; Functionality enhancement by Bng
X "Don't fontify BBDB buffer if it has more than this many records.
Otherwise everything gets very slow if there are many records to parse
and highlight.")
X
;##autoload
(defun bbdb-fontify-buffer ()
X (save-excursion
X (set-buffer bbdb-buffer-name)
X (bbdb-delete-extents)
X (if (> (length bbdb-records) bbdb-fontify-max)
X nil
X (let ((rest bbdb-records)
X record start end elided-p p e)
X (while rest
X (setq record (car (car rest))
X elided-p (eq (nth 1 (car rest)) t)
X start (marker-position (nth 2 (car rest)))
X end (1- (or (nth 2 (car (cdr rest))) (point-max))))
X (bbdb-make-extent start end nil 'region)
X (goto-char start)
X (if elided-p
X (progn
X (move-to-column 48)
X (skip-chars-backward " \t"))
X (end-of-line))
X (setq p (point))
X (goto-char start)
X (if (search-forward " - " p t)
X (progn
X (bbdb-make-extent (point) p 'bbdb-company nil)
X (forward-char -3))
X (goto-char p))
X (bbdb-make-extent start (point) 'bbdb-name 'highlight)
X (forward-line 1)
X (while (< (point) end)
X (skip-chars-forward " \t")
X (setq p (point))
X (and (looking-at "[^:\n]+:")
X (progn
X (bbdb-make-extent p (match-end 0) 'bbdb-field-name nil)))
X (while (progn (forward-line 1)
X (looking-at "^\\(\t\t \\| \\)")))
X (bbdb-make-extent p (1- (point)) 'bbdb-field-value 'highlight))
X (setq rest (cdr rest)))))))
X
X
;; modified by Bng in an attempt to make it work.
;; referenced bbdb-finger-records, which doesn't exist.
(defvar global-bbdb-menu-commands
X '(["Save BBDB" bbdb-save-db t]
X ["Elide All Records" (bbdb-elide-all-records-internal nil) t]
X ["Finger All Records" (bbdb-finger (mapcar 'car bbdb-records)) t]
X ["BBDB Manual" bbdb-info t]
X ["BBDB Quit" bbdb-bury-buffer t]
X ))
X
(defun build-bbdb-finger-menu (record)
X (let ((addrs (bbdb-record-net record)))
X (if (cdr addrs)
X (cons "Finger..."
X (nconc
X (mapcar '(lambda (addr)
X (vector addr (list 'bbdb-finger record addr)
X t))
X addrs)
X (list "----"
X (vector "Finger all addresses"
X (list 'bbdb-finger record ''(4)) t))))
X (vector (concat "Finger " (car addrs))
X (list 'bbdb-finger record (car addrs)) t))))
X
X
(defun build-bbdb-sendmail-menu (record)
X (let ((addrs (bbdb-record-net record)))
X (if (cdr addrs)
X (cons "Send Mail..."
X (mapcar '(lambda (addr)
X (vector addr (list 'bbdb-send-mail-internal
X (bbdb-dwim-net-address record addr))
X t))
X addrs))
X (vector (concat "Send mail to " (car addrs))
X (list 'bbdb-send-mail-internal
X (bbdb-dwim-net-address record (car addrs)))
X t))))
X
X
(defun build-bbdb-field-menu (record field)
X (let ((type (car field)))
X (nconc
X (list
X (concat "Commands for "
X (cond ((eq type 'property)
X (concat "\""
X (symbol-name (if (consp (car (cdr field)))
X (car (car (cdr field)))
X (car (cdr field))))
X "\" field:"))
X ((eq type 'name) "Name field:")
X ((eq type 'company) "Company field:")
X ((eq type 'net) "Network Addresses field:")
X ((eq type 'aka) "Alternate Names field:")
X (t
X (concat "\"" (aref (nth 1 field) 0) "\" "
X (capitalize (symbol-name type)) " field:"))))
X "-----"
X ["Edit Field" bbdb-edit-current-field t]
X )
X (if (memq type '(name company))
X nil
X (list ["Delete Field" bbdb-delete-current-field-or-record t]))
X (cond ((eq type 'phone)
X (list (vector (concat "Dial " (bbdb-phone-string (car (cdr field))))
X (list 'bbdb-dial (list 'quote field) nil) t)))
X )
X )))
X
X
(defun build-bbdb-insert-field-menu (record)
X (cons "Insert New Field..."
X (mapcar
X '(lambda (field)
X (let ((type (if (string= (car field) "AKA")
X 'aka
X (intern (car field)))))
X (vector (car field)
X (list 'bbdb-insert-new-field (list 'quote type)
X (list 'bbdb-prompt-for-new-field-value
X (list 'quote type)))
X (not
X (or (and (eq type 'net) (bbdb-record-net record))
X (and (eq type 'aka) (bbdb-record-aka record))
X (and (eq type 'notes) (bbdb-record-notes record))
X (and (consp (bbdb-record-raw-notes record))
X (assq type (bbdb-record-raw-notes record))))))))
X (append '(("phone") ("address") ("net") ("AKA") ("notes"))
X (bbdb-propnames)))))
X
X
(defun build-bbdb-menu (record field)
X (append
X '("bbdb-menu" "Global BBDB Commands" "-----")
X global-bbdb-menu-commands
X (if record
X (list
X "-----"
X (concat "Commands for record \""
X (bbdb-record-name record) "\":")
X "-----"
X (vector "Delete Record"
X (list 'bbdb-delete-current-record record) t)
X (if (nth 1 (assq record bbdb-records))
X ["Unelide Record" bbdb-elide-record t]
X ["Elide Record" bbdb-elide-record t])
X ["Omit Record" bbdb-omit-record t]
X ["Refile (Merge) Record" bbdb-refile-record t]
X ))
X (if record
X (list (build-bbdb-finger-menu record)))
X (if (and record (bbdb-record-net record))
X (list (build-bbdb-sendmail-menu record)))
X (if record
X (list (build-bbdb-insert-field-menu record)))
X (if field
X (cons "-----" (build-bbdb-field-menu record field)))
X ))
X
;##autoload
(defun bbdb-menu (e)
X (interactive "e")
X (mouse-set-point e)
X (require 'bbdb-com)
X (beginning-of-line)
X (popup-menu
X (save-window-excursion
X (save-excursion
X (mouse-set-point e)
X (let ((extent (bbdb-extent-at (point) (current-buffer) 'bbdb))
X record field face)
X (if (null extent)
X nil
X (goto-char (bbdb-extent-start-position extent))
X (beginning-of-line)
X (setq record (bbdb-current-record)
X face (bbdb-extent-face extent)
X field (cond ((memq face
X '(bbdb-name bbdb-field-value
X bbdb-field-name))
X (bbdb-current-field))
X ((eq face 'bbdb-company)
X (cons 'company (cdr (bbdb-current-field))))
X (t nil))))
X (build-bbdb-menu record field))))))
X
(bbdb-add-hook 'bbdb-list-hook 'bbdb-fontify-buffer)
X
(provide 'bbdb-display)
SHAR_EOF
chmod 0644 bbdb-display.el ||
echo 'restore of bbdb-display.el failed'
Wc_c="`wc -c < 'bbdb-display.el'`"
test 7587 -eq "$Wc_c" ||
echo 'bbdb-display.el: original size 7587, current size' "$Wc_c"
fi
exit 0
