Ok, this time I have a patch. Here is what I wanted to do: I wanted
two new layouts -- one suitable for printing all the info I would like
to carry around and hand to my girlfriend, and one for phone numbers
only to keep by the phone.
(add-to-list 'bbdb-display-layout-alist
'(printable (order net icq aim irc-nick phones addresses
notes www)
(indentation . 6)
(primary . t)
(toggle . t)))
(add-to-list 'bbdb-display-layout-alist
'(phonebook (order phones)
(indentation . 10)
(toggle . t)
(test and name phones)))
This requires a patch to recognize the two new options in
bbdb-display-layout-alist entries, primary and test, and for
convenience a function to select the display directly without toggling
(because if you use a test attribute, some records might disappear, so
if you have four displays A B C D and you want to use D and records
disappear in C, then there is no way to show those records in D.
* lisp/bbdb.el (bbdb-display-layout-alist): Extended custom type
to include primary and test, and fixed phone to phones, and
address to addresses.
(bbdb-format-record-layout-one-line): Take primary into account.
(bbdb-format-record-layout-multi-line): Take primary into account.
(bbdb-format-record): Take test into account, use multi-line
layout function if none was found.
* lisp/bbdb-com.el (bbdb-display-record-with-layout): New.
(bbdb-toggle-all-records-display-layout): Print layout used.
Cheers,
Alex.
*** bbdb.el.~1.196.~ Mon Dec 2 23:00:45 2002
--- bbdb.el Sun Dec 22 11:41:16 2002
***************
*** 1209,1214 ****
--- 1209,1216 ----
(omit . FIELD-LIST) + + nil
(name-end . INTEGER) + - 40
(indentation . INTEGER) - + 14
+ (primary . BOOL) - + nil
+ (test . SEXP) + + nil
- toggle: controls if this layout is included when toggeling the display layout
- order: defines a user specific order for the fields, where `t' is a place
***************
*** 1216,1222 ****
- omit: is a list of fields which should not be displayed or `t' to exclude all
fields except those listed in the order option
- name-end: sets the column where the name should end in one-line layout.
! - indentation: sets the level of indentation for multi-line display."
:group 'bbdb
:type
`(repeat
--- 1218,1230 ----
- omit: is a list of fields which should not be displayed or `t' to exclude all
fields except those listed in the order option
- name-end: sets the column where the name should end in one-line layout.
! - indentation: sets the level of indentation for multi-line display.
! - primary: controls wether only the primary net is shown or all are shown.
! - test: a lisp expression controlling wether the record is to be displayed.
!
! When you add a new layout FOO, you can write a corresponding layout
! function bbdb-format-record-layout-FOO. If you do not write your own
! layout function, the multi-line layout will be used."
:group 'bbdb
:type
`(repeat
***************
*** 1224,1236 ****
(choice :tag "Layout type"
(const one-line)
(const multi-line)
(const full-multi-line)
(symbol))
(set :tag "Properties"
(cons :tag "Order"
(const :tag "List of fields to order by" order)
! (repeat (choice (const phone)
! (const address)
(const net)
(const AKA)
(const notes)
--- 1232,1245 ----
(choice :tag "Layout type"
(const one-line)
(const multi-line)
+ (const pop-up-multi-line)
(const full-multi-line)
(symbol))
(set :tag "Properties"
(cons :tag "Order"
(const :tag "List of fields to order by" order)
! (repeat (choice (const phones)
! (const addresses)
(const net)
(const AKA)
(const notes)
***************
*** 1240,1247 ****
:value (omit . nil)
(cons :tag "List of fields to omit"
(const :tag "Fields not to display" omit)
! (repeat (choice (const phone)
! (const address)
(const net)
(const AKA)
(const notes)
--- 1249,1256 ----
:value (omit . nil)
(cons :tag "List of fields to omit"
(const :tag "Fields not to display" omit)
! (repeat (choice (const phones)
! (const addresses)
(const net)
(const AKA)
(const notes)
***************
*** 1259,1265 ****
(number :tag "Column"))
(cons :tag "Toggle"
(const :tag "The layout is included when toggling display
layout" toggle)
! boolean)))))
(defcustom bbdb-display-layout 'multi-line
"*The default display layout."
--- 1268,1291 ----
(number :tag "Column"))
(cons :tag "Toggle"
(const :tag "The layout is included when toggling display
layout" toggle)
! boolean)
! (cons :tag "Primary Net Only"
! (const :tag "Only the primary net address is included" primary)
! boolean)
! (cons :tag "Test"
! (const :tag "Show only records passing this test" test)
! (choice (const :tag "No test" nil)
! (cons :tag "List of required fields"
! (const :tag "Choose from the attributes in the
following set:" and)
! (set
! (const name)
! (const company)
! (const net)
! (const phones)
! (const addresses)
! (const notes)))
! (sexp :tag "Lisp expression")))))))
!
(defcustom bbdb-display-layout 'multi-line
"*The default display layout."
***************
*** 1459,1464 ****
--- 1485,1492 ----
(put-text-property start (point) 'bbdb-field (list 'net net))))
(defun bbdb-format-record-layout-one-line (layout record field-list)
+ "Record formatting function for the one-line layout.
+ See `bbdb-display-layout-alist' for more."
;; name and company
(bbdb-format-record-name-company record)
(let ((name-end (or (bbdb-display-layout-get-option layout 'name-end)
***************
*** 1474,1480 ****
;; guarantee one space after name - company
(insert " ")
(indent-to name-end))
-
;; rest of the fields
(let (start field contentfun formatfun values value)
(while field-list
--- 1502,1507 ----
***************
*** 1484,1489 ****
--- 1511,1519 ----
(if (fboundp contentfun)
(setq values (eval (list contentfun record)))
(setq values (bbdb-record-getprop record field)))
+ (when (and (eq field 'net)
+ (bbdb-display-layout-get-option layout 'primary))
+ (setq values (list (car values))))
(when values
(if (not (listp values)) (setq values (list values)))
(setq formatfun (intern (format "bbdb-format-record-%s-%s"
***************
*** 1515,1535 ****
(insert "\n"))
(defun bbdb-format-record-layout-multi-line (layout record field-list)
(bbdb-format-record-name-company record)
(insert "\n")
-
(let* ((notes (bbdb-record-raw-notes record))
(indent (or (bbdb-display-layout-get-option layout 'indentation) 14))
(fmt (format " %%%ds: " indent))
start field)
-
(if (stringp notes)
(setq notes (list (cons 'notes notes))))
-
(while field-list
(setq field (car field-list)
start (point))
-
(cond ((eq field 'phones)
(let ((phones (bbdb-record-phones record))
loc phone)
--- 1545,1563 ----
(insert "\n"))
(defun bbdb-format-record-layout-multi-line (layout record field-list)
+ "Record formatting function for the multi-line layout.
+ See `bbdb-display-layout-alist' for more."
(bbdb-format-record-name-company record)
(insert "\n")
(let* ((notes (bbdb-record-raw-notes record))
(indent (or (bbdb-display-layout-get-option layout 'indentation) 14))
(fmt (format " %%%ds: " indent))
start field)
(if (stringp notes)
(setq notes (list (cons 'notes notes))))
(while field-list
(setq field (car field-list)
start (point))
(cond ((eq field 'phones)
(let ((phones (bbdb-record-phones record))
loc phone)
***************
*** 1571,1577 ****
(put-text-property start (point) 'bbdb-field
'(net field-name))
(setq start (point))
! (insert (mapconcat (function identity) net ", ") "\n")
(put-text-property start (point) 'bbdb-field '(net)))))
((eq field 'aka)
(let ((aka (bbdb-record-aka record)))
--- 1599,1607 ----
(put-text-property start (point) 'bbdb-field
'(net field-name))
(setq start (point))
! (if (bbdb-display-layout-get-option layout 'primary)
! (insert (car net) "\n")
! (insert (mapconcat (function identity) net ", ") "\n"))
(put-text-property start (point) 'bbdb-field '(net)))))
((eq field 'aka)
(let ((aka (bbdb-record-aka record)))
***************
*** 1604,1611 ****
(insert (make-string indent ?\ )))))
(insert "\n"))
(put-text-property start (point) 'bbdb-field
! (list 'property note))))
! )
(setq field-list (cdr field-list)))))
(defalias 'bbdb-format-record-layout-full-multi-line
--- 1634,1640 ----
(insert (make-string indent ?\ )))))
(insert "\n"))
(put-text-property start (point) 'bbdb-field
! (list 'property note)))))
(setq field-list (cdr field-list)))))
(defalias 'bbdb-format-record-layout-full-multi-line
***************
*** 1616,1638 ****
(defun bbdb-format-record (record &optional layout)
"Insert a formatted version of RECORD into the current buffer.
! LAYOUT can be `one-line' for one-line layout and
! `multi-line' for multi-line layout.
! For compatibility reasons one might alos write t for one-line and nil for
multi-line layout."
(bbdb-debug (if (bbdb-record-deleted-p record)
(error "plus ungood: formatting deleted record")))
-
(setq layout (cond ((eq nil layout)
'multi-line)
! ((eq t layout)
'one-line)
((symbolp layout)
layout)
(t
(error "Unknown layout `%s'" layout))))
-
(let* ((layout-spec (assoc layout bbdb-display-layout-alist))
(omit-list (bbdb-display-layout-get-option layout-spec 'omit))
(order-list (bbdb-display-layout-get-option layout-spec 'order))
(all-fields (append '(phones addresses net aka)
--- 1645,1667 ----
(defun bbdb-format-record (record &optional layout)
"Insert a formatted version of RECORD into the current buffer.
!
! LAYOUT can be a symbol describing a layout in
! `bbdb-display-layout-alist'. For compatibility reasons, LAYOUT can
! also be nil or t, where t stands for the one-line, and nil for the
multi-line layout."
(bbdb-debug (if (bbdb-record-deleted-p record)
(error "plus ungood: formatting deleted record")))
(setq layout (cond ((eq nil layout)
'multi-line)
! ((eq t layout)
'one-line)
((symbolp layout)
layout)
(t
(error "Unknown layout `%s'" layout))))
(let* ((layout-spec (assoc layout bbdb-display-layout-alist))
+ (test (bbdb-display-layout-get-option layout-spec 'test))
(omit-list (bbdb-display-layout-get-option layout-spec 'omit))
(order-list (bbdb-display-layout-get-option layout-spec 'order))
(all-fields (append '(phones addresses net aka)
***************
*** 1641,1683 ****
'(notes)
(mapcar (lambda (r) (car r)) raw-notes)))))
format-function field-list)
!
! (if (functionp omit-list)
! (setq omit-list (funcall omit-list record layout)))
! (if (functionp order-list)
! (setq order-list (funcall order-list record layout)))
!
! ;; first omit unwanted records
! (when (and omit-list (or (not order-list) (memq t order-list)))
! (if (not (listp omit-list))
! ;; t => show nothing
! (setq all-fields nil)
! ;; listp => show all fields except those listed here
! (while omit-list
! (setq all-fields (delete (car omit-list) all-fields)
! omit-list (cdr omit-list)))))
!
! ;; then order them
! (if (not order-list)
! (setq field-list all-fields)
! (if (not (memq t order-list))
! (setq field-list order-list)
! (setq order-list (reverse order-list))
! (setq all-fields (delete nil (mapcar (lambda (f)
! (if (memq f order-list) nil f))
! all-fields)))
! (while order-list
! (if (eq t (car order-list))
! (setq field-list (append all-fields field-list))
! (setq field-list (cons (car order-list) field-list)))
! (setq order-list (cdr order-list)))))
!
! ;; call the actual format function
! (setq format-function
! (intern (format "bbdb-format-record-layout-%s" layout)))
! (if (functionp format-function)
! (funcall format-function layout record field-list)
! (error "No format function for layout `%s'!" layout))))
(defun bbdb-frob-mode-line (n)
(setq mode-line-buffer-identification
--- 1670,1720 ----
'(notes)
(mapcar (lambda (r) (car r)) raw-notes)))))
format-function field-list)
! (when (or (not test)
! ;; bind some variables for the test
! (let ((name (bbdb-record-name record))
! (company (bbdb-record-company record))
! (net (bbdb-record-net record))
! (phones (bbdb-record-phones record))
! (addresses (bbdb-record-addresses record))
! (notes (bbdb-record-raw-notes record)))
! ;; this must evaluate to non-nil if the record is to be shown
! (eval test)))
! (if (functionp omit-list)
! (setq omit-list (funcall omit-list record layout)))
! (if (functionp order-list)
! (setq order-list (funcall order-list record layout)))
! ;; first omit unwanted fields
! (when (and omit-list (or (not order-list) (memq t order-list)))
! (if (not (listp omit-list))
! ;; t => show nothing
! (setq all-fields nil)
! ;; listp => show all fields except those listed here
! (while omit-list
! (setq all-fields (delete (car omit-list) all-fields)
! omit-list (cdr omit-list)))))
! ;; then order them
! (if (not order-list)
! (setq field-list all-fields)
! (if (not (memq t order-list))
! (setq field-list order-list)
! (setq order-list (reverse order-list))
! (setq all-fields (delete nil (mapcar (lambda (f)
! (if (memq f order-list)
! nil
! f))
! all-fields)))
! (while order-list
! (if (eq t (car order-list))
! (setq field-list (append all-fields field-list))
! (setq field-list (cons (car order-list) field-list)))
! (setq order-list (cdr order-list)))))
! ;; call the actual format function
! (setq format-function
! (intern (format "bbdb-format-record-layout-%s" layout)))
! (if (functionp format-function)
! (funcall format-function layout record field-list)
! (bbdb-format-record-layout-multi-line layout record field-list)))))
(defun bbdb-frob-mode-line (n)
(setq mode-line-buffer-identification
***************
*** 1763,1770 ****
(setq records (cdr records))))
(and (not bbdb-gag-messages)
(not bbdb-silent-running)
! (message "Formatting...done."))
! )
(set-buffer bbdb-buffer-name)
(if (and append first)
(let ((cons (assq first bbdb-records))
--- 1800,1806 ----
(setq records (cdr records))))
(and (not bbdb-gag-messages)
(not bbdb-silent-running)
! (message "Formatting...done.")))
(set-buffer bbdb-buffer-name)
(if (and append first)
(let ((cons (assq first bbdb-records))
*** bbdb-com.el.~1.154.~ Mon Sep 23 13:07:34 2002
--- bbdb-com.el Sun Dec 22 11:51:33 2002
***************
*** 1498,1503 ****
--- 1498,1504 ----
(caar layout-alist))
(t
(caadr (memq desired-state layout-alist)))))
+ (message "Using %S layout" desired-state)
(bbdb-change-records-state-and-redisplay desired-state records)))
;;;###autoload
***************
*** 1548,1553 ****
--- 1549,1567 ----
arg
(if (not (bbdb-do-all-records-p))
(list (assq (bbdb-current-record) bbdb-records)))))
+
+ ;;;###autoload
+ (defun bbdb-display-record-with-layout (layout &optional records)
+ "Show all the fields of the current record using LAYOUT."
+ (interactive (list (completing-read "Layout: "
+ (mapcar (lambda (i)
+ (list (symbol-name (car i))))
+ bbdb-display-layout-alist))))
+ (when (stringp layout)
+ (setq layout (intern layout)))
+ (when (null records)
+ (setq records bbdb-records))
+ (bbdb-change-records-state-and-redisplay layout records))
;;;###autoload
(defun bbdb-omit-record (n)
-------------------------------------------------------
This sf.net email is sponsored by:ThinkGeek
Welcome to geek heaven.
http://thinkgeek.com/sf
_______________________________________________
[EMAIL PROTECTED]
https://lists.sourceforge.net/lists/listinfo/bbdb-info
BBDB Home Page: http://bbdb.sourceforge.net/
