Version 19.12 of XEmacs will no longer have some extent functions that have
been around for backwards compatibility purposes. Below is a patch from
version 1.50 of bbdb which includes both the new extent interface and a hack
to display xfaces that was written by Jamie at Lucid but seems to have been
released.
Stig
*** /tmp/bbdb-1.50/bbdb-lucid.el Tue Nov 30 23:32:05 1993
--- bbdb-lucid.el Mon Jan 2 19:00:09 1995
***************
*** 1,9 ****
;;; -*- Mode:Emacs-Lisp -*-
;;; This file is the part of the Insidious Big Brother Database (aka BBDB),
! ;;; copyright (c) 1992 Jamie Zawinski <[EMAIL PROTECTED]>.
;;; Mouse sensitivity and menus for Lucid GNU Emacs.
! ;;; last change 30-nov-93.
;;; 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
--- 1,10 ----
;;; -*- Mode:Emacs-Lisp -*-
;;; This file is the part of the Insidious Big Brother Database (aka BBDB),
! ;;; copyright (c) 1992, 1993, 1994 Jamie Zawinski <[EMAIL PROTECTED]>.
;;; Mouse sensitivity and menus for Lucid GNU Emacs.
! ;;; Extents code fixed up by Jonathan Stigelman <[EMAIL PROTECTED]>
! ;;; last change 2-jan-95
;;; 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
***************
*** 24,30 ****
;;; 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.)
! (or (string-match "Lucid" emacs-version)
(error "This file only works in Lucid GNU Emacs."))
(require 'bbdb)
--- 25,31 ----
;;; 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.)
! (or (string-match "XEmacs\\|Lucid" emacs-version)
(error "This file only works in Lucid GNU Emacs."))
(require 'bbdb)
***************
*** 38,44 ****
(or (find-face 'bbdb-company)
(face-differs-from-default-p (make-face 'bbdb-company))
! (make-face-italic 'bbdb-company))
(or (find-face 'bbdb-field-value)
(make-face 'bbdb-field-value))
--- 39,45 ----
(or (find-face 'bbdb-company)
(face-differs-from-default-p (make-face 'bbdb-company))
! (copy-face 'italic 'bbdb-company))
(or (find-face 'bbdb-field-value)
(make-face 'bbdb-field-value))
***************
*** 53,70 ****
(set-buffer bbdb-buffer-name)
;; first delete existing extents
(map-extents (function (lambda (x y)
! (if (eq (extent-data x) 'bbdb)
(delete-extent x))))
(current-buffer) (point-min) (point-max) nil)
(let ((rest bbdb-records)
! record start end elided-p p e)
(while rest
(setq record (car (car rest))
elided-p (eq (nth 1 (car rest)) t)
start (marker-position (nth 2 (car rest)))
end (1- (or (nth 2 (car (cdr rest))) (point-max))))
! (set-extent-attribute (setq e (make-extent start end)) 'highlight)
! (set-extent-data e 'bbdb)
(goto-char start)
(if elided-p
(progn
--- 54,73 ----
(set-buffer bbdb-buffer-name)
;; first delete existing extents
(map-extents (function (lambda (x y)
! (if (extent-property x 'bbdb)
(delete-extent x))))
(current-buffer) (point-min) (point-max) nil)
(let ((rest bbdb-records)
! record face start end elided-p p e)
(while rest
(setq record (car (car rest))
elided-p (eq (nth 1 (car rest)) t)
+ face (and (not elided-p) (bbdb-record-getprop record 'face))
start (marker-position (nth 2 (car rest)))
end (1- (or (nth 2 (car (cdr rest))) (point-max))))
! (setq e (make-extent start end))
! (set-extent-property e 'highlight t)
! (set-extent-property e 'bbdb t)
(goto-char start)
(if elided-p
(progn
***************
*** 76,90 ****
(if (search-forward " - " p t)
(progn
(setq e (make-extent (point) p))
! (set-extent-data e 'bbdb)
(set-extent-face e 'bbdb-company)
! (set-extent-attribute e 'highlight)
(forward-char -3))
(goto-char p))
(setq e (make-extent start (point)))
! (set-extent-data e 'bbdb)
(set-extent-face e 'bbdb-name)
! (set-extent-attribute e 'highlight)
(forward-line 1)
(while (< (point) end)
(skip-chars-forward " \t")
--- 79,94 ----
(if (search-forward " - " p t)
(progn
(setq e (make-extent (point) p))
! (set-extent-property e 'bbdb t)
(set-extent-face e 'bbdb-company)
! (set-extent-property e 'highlight t)
(forward-char -3))
(goto-char p))
(setq e (make-extent start (point)))
! (set-extent-property e 'bbdb t)
(set-extent-face e 'bbdb-name)
! (set-extent-property e 'highlight t)
! (if face (bbdb-hack-x-face face e))
(forward-line 1)
(while (< (point) end)
(skip-chars-forward " \t")
***************
*** 93,107 ****
(progn
(setq e (make-extent p (match-end 0)))
(set-extent-face e 'bbdb-field-name)
! (set-extent-data e 'bbdb)))
(while (progn (forward-line 1)
(looking-at "^\\(\t\t \\| \\)")))
(setq e (make-extent p (1- (point))))
! (set-extent-data e 'bbdb)
(set-extent-face e 'bbdb-field-value)
! (set-extent-attribute e 'highlight))
(setq rest (cdr rest))))))
(defvar global-bbdb-menu-commands
'(["Save BBDB" bbdb-save-db t]
["Elide All Records" bbdb-elide-record t]
--- 97,132 ----
(progn
(setq e (make-extent p (match-end 0)))
(set-extent-face e 'bbdb-field-name)
! (set-extent-property e 'bbdb t)))
(while (progn (forward-line 1)
(looking-at "^\\(\t\t \\| \\)")))
(setq e (make-extent p (1- (point))))
! (set-extent-property e 'bbdb t)
(set-extent-face e 'bbdb-field-value)
! (set-extent-property e 'highlight t))
(setq rest (cdr rest))))))
+
+ (defun bbdb-hack-x-face (face extent)
+ ;; requires lemacs 19.10 version of highlight-headers.el
+ (cond
+ ((and (boundp 'highlight-headers-hack-x-face-p)
+ highlight-headers-hack-x-face-p
+ (fboundp 'highlight-headers-x-face))
+ (setq face (bbdb-split face "\n"))
+ (while face
+ (highlight-headers-x-face (car face) extent)
+ (let ((b (extent-property extent 'begin-glyph)))
+ (cond (b ; I'd like this to be an end-glyph instead
+ (set-extent-property extent 'begin-glyph nil)
+ (set-extent-property extent 'end-glyph b))))
+ (setq face (cdr face))
+ (cond (face ; there are more, so clone the extent
+ (setq extent (make-extent
+ (extent-start-position extent)
+ (extent-end-position extent)))
+ (set-extent-property extent 'bbdb t)))))))
+
(defvar global-bbdb-menu-commands
'(["Save BBDB" bbdb-save-db t]
["Elide All Records" bbdb-elide-record t]
***************
*** 234,240 ****
(let ((extent (or (extent-at (point) (current-buffer) 'highlight)
(error "")))
record field face)
! (or (eq (extent-data extent) 'bbdb)
(error "not a bbdb extent"))
(highlight-extent extent t) ; shouldn't be necessary...
(goto-char (extent-start-position extent))
--- 259,265 ----
(let ((extent (or (extent-at (point) (current-buffer) 'highlight)
(error "")))
record field face)
! (or (extent-property extent 'bbdb)
(error "not a bbdb extent"))
(highlight-extent extent t) ; shouldn't be necessary...
(goto-char (extent-start-position extent))
