[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Commit-womb] addressbook ChangeLog addressbook.el
|
From: |
Jose E. Marchesi |
|
Subject: |
[Commit-womb] addressbook ChangeLog addressbook.el |
|
Date: |
Mon, 07 May 2007 18:56:52 +0000 |
CVSROOT: /cvsroot/womb
Module name: addressbook
Changes by: Jose E. Marchesi <jemarch> 07/05/07 18:56:52
Modified files:
. : ChangeLog addressbook.el
Log message:
Restructuration of sources. See the commentary section of the file for
more info.
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/addressbook/ChangeLog?cvsroot=womb&r1=1.9&r2=1.10
http://cvs.savannah.gnu.org/viewcvs/addressbook/addressbook.el?cvsroot=womb&r1=1.8&r2=1.9
Patches:
Index: ChangeLog
===================================================================
RCS file: /cvsroot/womb/addressbook/ChangeLog,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -b -r1.9 -r1.10
--- ChangeLog 6 May 2007 23:09:46 -0000 1.9
+++ ChangeLog 7 May 2007 18:56:52 -0000 1.10
@@ -2,6 +2,7 @@
* addressbook.el (addrbook-summary-mode): Added mailer function to
the summary.
+ Sources reestructured.
2007-05-06 Jose E. Marchesi <address@hidden>
Index: addressbook.el
===================================================================
RCS file: /cvsroot/womb/addressbook/addressbook.el,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -b -r1.8 -r1.9
--- addressbook.el 6 May 2007 23:09:46 -0000 1.8
+++ addressbook.el 7 May 2007 18:56:52 -0000 1.9
@@ -5,7 +5,7 @@
;; Maintainer: Jose E. Marchesi
;; Keywords: contacts, applications
-;; $Id: addressbook.el,v 1.8 2007/05/06 23:09:46 jemarch Exp $
+;; $Id: addressbook.el,v 1.9 2007/05/07 18:56:52 jemarch Exp $
;; This file is NOT part of GNU Emacs.
@@ -26,7 +26,50 @@
;;;; Commentary:
-;; A simple addressbook
+;; A simple vCard based addressbook for Emacs
+;;
+;; File Contents
+;; =============
+;;
+;; * Constants
+;; * Customization
+;; * Variables
+;;
+;; * Properties management functions
+;;
+;; ** Groups
+;; ** Properties
+;; ** Cards
+;; ** Attributes
+;;
+;; * Addressbook contact editor
+;;
+;; ** Constants
+;; ** Variables
+;; ** Contact buffer management
+;; ** Display functions
+;; ** Modeline management
+;; ** Commands
+;; ** Major mode
+;;
+;; * Addressbook summary
+;;
+;; ** Constants
+;; ** Variables
+;; ** Summary buffer management
+;; ** Display functions
+;; ** Commands
+;; ** Modeline management
+;; ** Major mode
+;;
+;; * General commands (usable from all addressbook modes)
+;; * Backend management
+;; * Utility functions
+;;
+;; ** Fast selection
+;; ** Search functions
+;;
+;; * Entry points to the addressbook
;;; Code:
@@ -40,14 +83,10 @@
(defconst addrbook-version "0.1"
"Version of the addressbook")
-(defconst addrbook-buffer-name "*AddressBook*"
- "Name of the buffer for the addressbook")
-
-(defconst addrbook-summary-buffer-name "*AddressBook Summary*"
- "Name of the buffer for the addressbook summary")
-
;;;; Customization
+;;; General settings
+
(defgroup addrbook nil
"Addressbook subsytem"
:group 'applications)
@@ -261,9 +300,6 @@
(defvar addrbook-current-card nil
"Number of current card")
-(defvar addrbook-properties-nodisplay
- '("sound" "agent" "version" "uid" "label" "mailer" "uid"))
-
(defvar addrbook-properties
'((identification-properties
"Identification"
@@ -408,15 +444,6 @@
?s))
"vCard specification standard properties")
-(defvar addrbook-mode-map nil
- "Keymap for addrbook-mode")
-
-(defvar addrbook-summary-mode-map nil
- "Keymap for addrbook-summary-mode")
-
-(defvar addrbook-displayed-groups nil
- "List of displayed property groups")
-
(defvar addrbook-required-attrs '("n")
"List of required attributes")
@@ -424,15 +451,7 @@
'(("url" "value") ("content-id" "value"))
"General vCard parameters")
-(defvar addrbook-mode-line-string " AddressBook"
- "String to display on the mode line when in the addressbook mode.
-If `nil', do not show anything.")
-
-(defvar addrbook-summary-mode-line-string " AddressBook Sum"
- "String to display on the mode line when in the addressbook summary mode.
-If `nil', do not show anything.")
-
-;;;; Managing properties group data
+;;;; Properties management functions
;;; Groups
(defun addrbook-get-group (group-symbol)
@@ -456,7 +475,7 @@
(result nil))
(dolist (attr (addrbook-get-card addrbook-current-card))
(if (and (addrbook-property-in-group-p attr group-attrs)
- (not (member (vcard-attr-get-name attr)
addrbook-properties-nodisplay)))
+ (not (member (vcard-attr-get-name attr)
addrbook-contact-properties-nodisplay)))
(setq result t)))
result))
@@ -664,18 +683,42 @@
(setcar (nthcdr 2 custom-group) props-data)))
-;;;; Addrbook contact
+;;;; Addressbook contact editor
+
+;;; Constants
+
+(defconst addrbook-contact-buffer-name "*AddressBook Contact*"
+ "Name of the buffer for the addressbook contact editor")
+
+;;; Variables
+
+(defvar addrbook-contact-properties-nodisplay
+ '("sound" "agent" "version" "uid" "label" "mailer" "uid"))
+
+(defvar addrbook-contact-mode-map nil
+ "Keymap for addrbook-contact-mode")
+
+(defvar addrbook-contact-displayed-groups nil
+ "List of displayed property groups")
+
+(defvar addrbook-contact-mode-line-string " ABook Contact"
+ "String to display on the mode line when in the addressbook mode.
+If `nil', do not show anything.")
-(defun addrbook-contact ()
+;;; Contact buffer management
+
+(defun addrbook-create-contact-buffer ()
"Create a new addressbook buffer to show contact information"
- (setq buffer (get-buffer-create addrbook-buffer-name))
+ (setq buffer (get-buffer-create addrbook-contact-buffer-name))
(set-buffer buffer)
- (addrbook-mode))
+ (addrbook-contact-mode))
(defun addrbook-show-contact ()
- (switch-to-buffer-other-window (get-buffer addrbook-buffer-name)))
+ (switch-to-buffer-other-window (get-buffer addrbook-contact-buffer-name)))
+
+;;; Display functions
-(defun addrbook-display-card (numcard)
+(defun addrbook-contact-display-card (numcard)
"Display the NUMCARD card into the addressbook buffer"
(save-excursion
(let ((card (addrbook-get-card numcard)))
@@ -685,30 +728,30 @@
(setq addrbook-current-card numcard)
(insert "\n\n")
;; Reset displayed groups list
- (setq addrbook-displayed-groups nil)
+ (setq addrbook-contact-displayed-groups nil)
;; Display groups
- (mapcar #'addrbook-display-group addrbook-properties)
- ;; Hide all groups not present in addrbook-display-group
- (dolist (group addrbook-displayed-groups nil)
+ (mapcar #'addrbook-contact-display-group addrbook-properties)
+ ;; Hide all groups not present in addrbook-display-groups
+ (dolist (group addrbook-contact-displayed-groups nil)
(if (not (member group addrbook-display-groups))
- (addrbook-hide-show-group group nil)))
+ (addrbook-contact-hide-show-group group nil)))
;; Set mode line contents
- (addrbook-set-mode-line (+ addrbook-current-card 1)
+ (addrbook-contact-set-mode-line (+ addrbook-current-card 1)
(length addrbook-cards)))))))
-(defun addrbook-display-group (group)
+(defun addrbook-contact-display-group (group)
(if (addrbook-group-has-properties-p group)
(let ((group-region-begin (make-marker))
(group-region-end nil))
(set-marker group-region-begin (point))
- (addrbook-display-properties group)
+ (addrbook-contact-display-properties group)
(insert "\n")
(setq group-region-end (point))
(put-text-property (marker-position group-region-begin)
group-region-end
'group-region (car group)))))
-(defun addrbook-display-properties (group)
+(defun addrbook-contact-display-properties (group)
"Display the GROUP properties from the current card"
(let* ((card (addrbook-get-card addrbook-current-card))
(group-name (addrbook-get-group-name group))
@@ -716,7 +759,7 @@
(num-attributes (vcard-get-num-attributes card))
(i 0))
;; Mark this group as displayed
- (add-to-list 'addrbook-displayed-groups (addrbook-get-group-symbol group))
+ (add-to-list 'addrbook-contact-displayed-groups (addrbook-get-group-symbol
group))
(insert (propertize group-name 'face 'addrbook-properties-group-name
'group (addrbook-get-group-symbol group)))
(insert "\n\n")
@@ -724,17 +767,17 @@
(dotimes (i num-attributes)
(let ((attr (vcard-get-attribute card i)))
(if (and (equal (vcard-attr-get-name attr) (addrbook-get-prop-name
property))
- (not (addrbook-attribute-nodisplay attr
addrbook-properties-nodisplay))
+ (not (addrbook-contact-attribute-nodisplay attr
addrbook-contact-properties-nodisplay))
(addrbook-property-in-group-p attr group-props))
- (addrbook-display-attribute i)))))))
+ (addrbook-contact-display-attribute i)))))))
-(defun addrbook-attribute-nodisplay (attr nodisplay-attrs)
+(defun addrbook-contact-attribute-nodisplay (attr nodisplay-attrs)
(let ((attr-name (vcard-attr-get-name attr)))
(if nodisplay-attrs
(or (equal (car nodisplay-attrs) attr-name)
- (addrbook-attribute-nodisplay attr (cdr nodisplay-attrs))))))
+ (addrbook-contact-attribute-nodisplay attr (cdr nodisplay-attrs))))))
-(defun addrbook-display-attribute (attr-index)
+(defun addrbook-contact-display-attribute (attr-index)
"Display the ATTR-INDEXth attribute"
(let* ((card (addrbook-get-card addrbook-current-card))
(attr (vcard-get-attribute card attr-index))
@@ -743,14 +786,14 @@
((equal attr-name "fn")
t)
((equal attr-name "n")
- (addrbook-display-attribute-n attr-index))
+ (addrbook-contact-display-attribute-n attr-index))
((or (equal attr-name "photo")
(equal attr-name "logo"))
- (addrbook-display-attribute-photo-logo attr-index))
+ (addrbook-contact-display-attribute-photo-logo attr-index))
(t
- (addrbook-display-attribute-regular attr-index)))))
+ (addrbook-contact-display-attribute-regular attr-index)))))
-(defun addrbook-display-attribute-n (attr-index)
+(defun addrbook-contact-display-attribute-n (attr-index)
(let* ((card (addrbook-get-card addrbook-current-card))
(attr (vcard-get-attribute card attr-index))
(attr-value (vcard-attr-get-values attr))
@@ -759,7 +802,7 @@
(additional-names (nth 2 attr-value))
(name-prefix (nth 3 attr-value))
(name-suffix (nth 4 attr-value)))
- (addrbook-display-attribute-regular attr-index)
+ (addrbook-contact-display-attribute-regular attr-index)
;; Insert name on the first line
(save-excursion
(goto-char (point-min))
@@ -770,7 +813,7 @@
'face 'addrbook-contact-title
'title t)))))
-(defun addrbook-display-attribute-photo-logo (attr-index)
+(defun addrbook-contact-display-attribute-photo-logo (attr-index)
;; Photographs has a type and may be:
;;
;; 1. Inline
@@ -782,7 +825,7 @@
(photo-value (car (vcard-attr-get-parameter attr "value")))
(image-type nil)
(image-data nil))
- (addrbook-display-attribute-regular attr-index)
+ (addrbook-contact-display-attribute-regular attr-index)
;; Insert photo in buffer
;; Determine emacs image type
(setq image-type
@@ -792,7 +835,7 @@
(display-images-p)
image-type
(image-type-available-p image-type)
- (not (addrbook-photo-displayed-p)))
+ (not (addrbook-contact-photo-displayed-p)))
;; Get image data
(if (equal photo-value "url")
(save-excursion
@@ -818,7 +861,7 @@
'attr-index attr-index
'attr-subindex nil))))))
-(defun addrbook-display-attribute-regular (attr-index)
+(defun addrbook-contact-display-attribute-regular (attr-index)
(let* ((card (addrbook-get-card addrbook-current-card))
(attr (vcard-get-attribute card attr-index))
(attr-name (vcard-attr-get-name attr))
@@ -838,7 +881,7 @@
'face 'addrbook-attribute-title-name
'attr-compound-title t
'attr-index attr-index))
- (addrbook-display-attribute-type attr-index)
+ (addrbook-contact-display-attribute-type attr-index)
(insert ":")
(insert "\n")
(dotimes (i (length prop-fields))
@@ -867,7 +910,7 @@
'face 'addrbook-attribute-title-name
'attr-index attr-index
'attr-subindex nil))
- (addrbook-display-attribute-type attr-index)
+ (addrbook-contact-display-attribute-type attr-index)
(insert ":")
(insert " ")
;; Insert attribute value
@@ -881,7 +924,7 @@
(put-text-property attr-region-begin attr-region-end
'attr-region attr-index)))
-(defun addrbook-display-attribute-type (attr-index)
+(defun addrbook-contact-display-attribute-type (attr-index)
(let* ((card (addrbook-get-card addrbook-current-card))
(attr (vcard-get-attribute card attr-index))
(attr-name (vcard-attr-get-name attr))
@@ -903,16 +946,16 @@
'face 'addrbook-attribute-type))
(insert ")"))))
-(defun addrbook-group-hidden-p (group)
+(defun addrbook-contact-group-hidden-p (group)
(save-excursion
- (let ((group-exist (addrbook-goto-group group)))
+ (let ((group-exist (addrbook-contact-goto-group group)))
(and group-exist
(get-text-property group-exist 'invisible)))))
-(defun addrbook-hide-show-group (group show-p)
+(defun addrbook-contact-hide-show-group (group show-p)
"Hide GROUP attributes from the screen"
(save-excursion
- (let ((group-exist (addrbook-goto-group group))
+ (let ((group-exist (addrbook-contact-goto-group group))
(group-real-begin-pos nil)
(group-end-pos nil)
(group-begin-pos nil))
@@ -931,7 +974,7 @@
(- group-end-pos 1)
'invisible t))))))
-(defun addrbook-get-current-group ()
+(defun addrbook-contact-get-current-group ()
"Return the group affecting current buffer point, or nil"
(let ((prop-change-pos (previous-single-property-change
(point) 'group)))
@@ -940,31 +983,18 @@
(goto-char (- prop-change-pos 1))
(get-text-property (point) 'group)))))
-(defun addrbook-get-text-property-line (prop)
- "Return the value of text property PROP in the nearest position on current
line
-that has PROP defined as a text property"
- (let ((current-point (get-text-property (point) prop))
- (next-point-with-prop (next-single-property-change
- (point) prop nil (line-end-position)))
- (previous-point-with-prop (previous-single-property-change
- (point) prop nil
(line-beginning-position))))
- (or current-point
- (if next-point-with-prop
- (get-text-property next-point-with-prop prop)
- (get-text-property previous-point-with-prop prop)))))
-
-(defun addrbook-get-current-attr-index ()
+(defun addrbook-contact-get-current-attr-index ()
"Return the attribute index of the attribute displayed in the current line"
(addrbook-get-text-property-line 'attr-index))
-(defun addrbook-get-current-attr-subindex ()
+(defun addrbook-contact-get-current-attr-subindex ()
"Return the attribute subindex of the attribute displayed in the current
line"
(addrbook-get-text-property-line 'attr-subindex))
-(defun addrbook-get-current-attr-compound-title ()
+(defun addrbook-contact-get-current-attr-compound-title ()
(addrbook-get-text-property-line 'attr-compound-title))
-(defun addrbook-goto-group (group)
+(defun addrbook-contact-goto-group (group)
"Leave the point at the beginning of GROUP"
(let ((group-begin-pos nil)
(found nil)
@@ -983,64 +1013,43 @@
(setq group-exist nil)))
group-exist))
-(defun addrbook-redisplay-card ()
+(defun addrbook-contact-redisplay-card ()
"Redisplay current card"
(erase-buffer)
- (addrbook-display-card addrbook-current-card))
+ (addrbook-contact-display-card addrbook-current-card))
-(defun addrbook-redisplay-group (group)
+(defun addrbook-contact-redisplay-group (group)
"Redisplay GROUP in the screen"
(save-excursion
- (let ((group-exist (addrbook-goto-group group)))
+ (let ((group-exist (addrbook-contact-goto-group group)))
(when group-exist
;; Remove old group contents
- (addrbook-erase-group-region)
+ (addrbook-contact-erase-group-region)
;; Display the group
- (addrbook-display-group (addrbook-get-group group))))))
-
-(defun addrbook-erase-tagged-region (tag)
- "Erase the region tagged with the same TAG value"
- (let ((begin-pos (previous-single-property-change (point) tag))
- (end-pos (next-single-property-change (point) tag)))
- (if (equal (point) (point-min))
- (setq begin-pos (point-min))
- (if (not (equal (get-text-property (point) tag)
- (get-text-property (- (point) 1) tag)))
- (setq begin-pos (point))))
- (if (equal (point) (point-max))
- (setq end-pos (point-max))
- (if (not (equal (get-text-property (point) tag)
- (get-text-property (+ (point) 1) tag)))
- (setq end-pos (+ point 1))))
- (cond ((and begin-pos end-pos)
- (delete-region begin-pos end-pos))
- ((and begin-pos (not end-pos))
- (delete-region begin-pos (point-max)))
- ((and (not begin-pos) end-pos)
- (delete-region (point-min) end-pos)))))
+ (addrbook-contact-display-group (addrbook-get-group group))))))
-(defun addrbook-erase-group-region ()
+(defun addrbook-contact-erase-group-region ()
"Erase the region used by the group in point"
(addrbook-erase-tagged-region 'group-region))
-(defun addrbook-erase-attr-region ()
+(defun addrbook-contact-erase-attr-region ()
"Erase the region used by the attribute in point"
(addrbook-erase-tagged-region 'attr-region))
-(defun addrbook-redisplay-attr-at-point ()
+(defun addrbook-contact-redisplay-attr-at-point ()
"Redisplay the attribute at point"
(let* ((column-backup (current-column))
(line-backup (line-number-at-pos (point)))
- (group-symbol (addrbook-get-current-group))
- (attr-index (addrbook-get-current-attr-index)))
+ (group-symbol (addrbook-contact-get-current-group))
+ (attr-index (addrbook-contact-get-current-attr-index)))
(if (and group-symbol attr-index)
(let* ((card (addrbook-get-card addrbook-current-card))
(group (addrbook-get-group group-symbol))
(group-attrs (addrbook-get-group-props group))
group-aregion-begin group-region-end)
- (addrbook-erase-attr-region)
+ (addrbook-contact-erase-attr-region)
(setq group-region-begin (point))
- (addrbook-display-attribute attr-index)
+ (addrbook-contact-display-attribute attr-index)
(setq group-region-end (point))
(put-text-property group-region-begin
group-region-end
@@ -1048,168 +1057,22 @@
(goto-line line-backup)
(goto-char (+ (line-beginning-position) column-backup))))))
-(defun addrbook-group-in-display-p (group-symbol)
- (addrbook-goto-group group-symbol))
+(defun addrbook-contact-in-display-p (group-symbol)
+ (addrbook-contact-goto-group group-symbol))
-(defun addrbook-photo-displayed-p ()
+(defun addrbook-contact-photo-displayed-p ()
(next-single-property-change (point-min) 'identification-photo))
-;;;; Data file management functions
-
-(defun addrbook-read-cards ()
- "Read cards from addressbook file"
- (with-temp-buffer
- (insert-file-contents addrbook-file)
- (setq addrbook-cards (vcard-parse-region (point-min)
- (point-max)))
- (when addrbook-cards
- (addrbook-make-params-explicit)
- t)))
-
-(defun addrbook-make-params-explicit ()
- "Make unambiguous anonymous params explicit.
-
-It uses `addrbook-general-params' and the type parameter for each property
-defined in `addrbook-properties'"
- (let ((i 0))
- (dolist (card addrbook-cards)
- (dotimes (i (vcard-get-num-attributes card))
- (let* ((attr (vcard-get-attribute card i))
- (attr-name (vcard-attr-get-name attr))
- (attr-props (cdr (vcard-attr-get-proplist attr)))
- (property (addrbook-get-property attr-name))
- param
- (j 0))
- (dotimes (j (length attr-props))
- (let* ((param (nth j attr-props))
- (param-name (if (and param
- (listp param))
- (car param)
- nil))
- (param-value (if (and param
- (listp param))
- (cdr param)
- param)))
- ;; Search the param name in general-value
- (if (not param-name)
- (let* ((general-param (assoc param-value
addrbook-general-params))
- (general-param-name (if general-param (cadr
general-param)))
- (prop-types (addrbook-get-prop-parameter property
"type")))
- (if general-param-name
- (setq param-name general-param-name)
- (if (and prop-types
- (assoc param-value prop-types))
- (setq param-name "type")))
- (if param-name
- (setcar (nthcdr j attr-props) (cons param-name
param-value))))))))))))
-
-(defun addrbook-write-data (filename)
- "Write cards information to FILENAME, discarding any
-previous content."
- (with-temp-file filename
- (dotimes (i (length addrbook-cards))
- (let ((card (addrbook-get-card i)))
- (vcard-insert card)
- (if (not (equal i (- (length addrbook-cards) 1)))
- (insert "\n\n"))))))
-
-(defun addrbook-export-card ()
- "Export current card data to a file"
- (interactive)
- (let ((filename (read-file-name "Export vCard to file: "))
- (card (addrbook-get-card addrbook-current-card)))
- (with-temp-file filename
- (vcard-insert card))
- (message "vCard exported")))
-
-(defun addrbook-create-card-2 ()
- "Create a new card with minimum identification properties and insert it
-into `addrbook-cards'.
-
-Return the index position of the new card"
- (let* (new-card
- (n-surname (read-from-minibuffer "Surname: "))
- (n-first-name (read-from-minibuffer "First name: "))
- (n-aka (read-from-minibuffer "AKA: "))
- (n-name-prefix (read-from-minibuffer "Name prefix: "))
- (n-name-suffix (read-from-minibuffer "Name suffix: "))
- (no-values (and (equal n-surname "")
- (equal n-first-name "")
- (equal n-aka "")
- (equal n-name-prefix "")
- (equal n-name-suffix "")))
- (new-card-index (length addrbook-cards)))
- (if no-values
- (progn
- (message "Contact not created")
- nil)
- ;; Create a new card
- (setq new-card (vcard-add-attribute new-card
- (cons (list "n")
- (list n-surname
- n-first-name
- n-aka
- n-name-prefix
- n-name-suffix))))
- (addrbook-set-card new-card-index new-card)
- (add-to-list 'addrbook-modified-cards new-card-index)
- new-card-index)))
-
-;;;; Utility functions
-
-(defun addrbook-list-to-csv (list)
- (let ((result "")
- i)
- (dotimes (i (length list))
- (setq result (concat result (nth i list)))
- (if (not (equal i (- (length list) 1)))
- (setq result (concat result ","))))
- result))
-
-(defun addrbook-open ()
- "Open the addressbook"
- (or (addrbook-read-cards)
- (addrbook-create-card-2)))
-
-;;;; Commands
-
-(defun addrbook-send-email ()
- "Send an email to current contact"
- (interactive)
- (let* ((card (addrbook-get-card addrbook-current-card))
- (mail-addresses (vcard-ref card (list "email")))
- mail-names name i attr sendto-address letter)
- (dotimes (i (length mail-addresses))
- (let* ((attr (nth i mail-addresses))
- (attr-type (car (vcard-attr-get-parameter attr "type"))))
- (if (equal attr-type "internet")
- (setq mail-names (cons (list (car (vcard-attr-get-values attr))
- (+ ?a i))
- mail-names)))))
- (setq mail-names (reverse mail-names))
- (if (not mail-names)
- (message "Contact doesnt have a suitable smtp address")
- (if (equal (length mail-names) 1)
- (setq sendto-address (car (car mail-names)))
- (setq letter (addrbook-fast-selection mail-names "Select email address
to send mail to"))
- (dolist (name mail-names)
- (if (equal letter
- (cadr name))
- (setq sendto-address (car name)))))
- ;; Send the email
- (if sendto-address
- (compose-mail-other-frame (concat
- "\"" (addrbook-get-card-fn) "\""
- " <" sendto-address ">"))))))
+;;; Commands
-(defun addrbook-add-attribute-type ()
+(defun addrbook-contact-add-attribute-type ()
"Add a new type to the attribute under point"
(interactive)
(let ((buffer-read-only nil)
(point-backup (point))
- (group-symbol (addrbook-get-current-group))
- (attr-index (addrbook-get-current-attr-index))
- (attr-subindex (addrbook-get-current-attr-subindex)))
+ (group-symbol (addrbook-contact-get-current-group))
+ (attr-index (addrbook-contact-get-current-attr-index))
+ (attr-subindex (addrbook-contact-get-current-attr-subindex)))
(if (and attr-index
(not attr-subindex))
(let* ((card (addrbook-get-card addrbook-current-card))
@@ -1231,19 +1094,19 @@
;; Replace current type
(vcard-attr-set-property attr "type" result))
;; Redisplay attribute
- (addrbook-redisplay-attr-at-point)
+ (addrbook-contact-redisplay-attr-at-point)
;; Addressbook modified
(add-to-list 'addrbook-modified-cards
addrbook-current-card))))))
(goto-char point-backup)))
-(defun addrbook-remove-attribute-type ()
+(defun addrbook-contact-remove-attribute-type ()
"Remove a type from the attribute under point"
(interactive)
(let ((buffer-read-only nil)
(point-backup (point))
- (group-symbol (addrbook-get-current-group))
- (attr-index (addrbook-get-current-attr-index))
- (attr-subindex (addrbook-get-current-attr-subindex)))
+ (group-symbol (addrbook-contact-get-current-group))
+ (attr-index (addrbook-contact-get-current-attr-index))
+ (attr-subindex (addrbook-contact-get-current-attr-subindex)))
(if (and attr-index
(not attr-subindex))
(let* ((card (addrbook-get-card addrbook-current-card))
@@ -1265,42 +1128,19 @@
;; Add the new type
(vcard-attr-remove-property attr "type" result)
;; Redisplay attribute
- (addrbook-redisplay-attr-at-point)
+ (addrbook-contact-redisplay-attr-at-point)
;; Addressbook modified
(add-to-list 'addrbook-modified-cards
addrbook-current-card)))))))
(goto-char point-backup)))
-(defun addrbook-delete-card ()
- "Delete the current card"
- (interactive)
- (let ((buffer-read-only nil)
- (current-card addrbook-current-card)
- (prompt "Are you sure you want to delete current contact? "))
- (when (yes-or-no-p prompt)
- (if (equal current-card (- (length addrbook-cards) 1))
- (setq current-card (- (length addrbook-cards) 2)))
- (addrbook-remove-card addrbook-current-card)
- (add-to-list 'addrbook-modified-cards current-card)
- (if (equal (length addrbook-cards) 0)
- (addrbook-quit)
- (addrbook-display-card current-card)))))
-
-(defun addrbook-create-card ()
- "Create a new card"
- (interactive)
- (let ((buffer-read-only nil)
- (new-card-index (addrbook-create-card-2)))
- (if new-card-index
- (addrbook-display-card new-card-index))))
-
-(defun addrbook-delete-attribute ()
+(defun addrbook-contact-delete-attribute-type ()
"Delete the attribute under point"
(interactive)
(let ((buffer-read-only nil)
(point-backup (point))
- (group-symbol (addrbook-get-current-group))
- (attr-index (addrbook-get-current-attr-index))
- (attr-subindex (addrbook-get-current-attr-subindex)))
+ (group-symbol (addrbook-contact-get-current-group))
+ (attr-index (addrbook-contact-get-current-attr-index))
+ (attr-subindex (addrbook-contact-get-current-attr-subindex)))
(if (and group-symbol attr-index)
(let* ((group (addrbook-get-group group-symbol))
(group-attrs (addrbook-get-group-props group))
@@ -1321,17 +1161,17 @@
elt)
(if (yes-or-no-p prompt)
(if (and (member attr-name addrbook-required-attrs)
- (or (addrbook-get-current-attr-compound-title)
+ (or (addrbook-contact-get-current-attr-compound-title)
(equal (addrbook-number-of-values attr-value) 1)))
(error "Trying to delete a required attribute")
(addrbook-delete-attr attr-index attr-subindex)
(if (not (equal attr-name "photo"))
- (addrbook-redisplay-group group-symbol)
- (addrbook-redisplay-card))))))
+ (addrbook-contact-redisplay-group group-symbol)
+ (addrbook-contact-redisplay-card))))))
(goto-char point-backup)
(add-to-list 'addrbook-modified-cards addrbook-current-card)))
-(defun addrbook-add-attribute ()
+(defun addrbook-contact-add-attribute ()
"Add a new attribute to the current card"
(interactive)
(let* (buffer-read-only
@@ -1341,15 +1181,15 @@
(i 0)
(current-card (addrbook-get-card addrbook-current-card)))
;; Get group
- (setq group-symbol (or (addrbook-get-current-group)
+ (setq group-symbol (or (addrbook-contact-get-current-group)
(addrbook-select-group)))
(setq group (addrbook-get-group group-symbol))
(setq group-attrs (addrbook-get-group-props group))
(if group-symbol
(let (attr-index attr-subindex property-index)
;; Get property
- (setq attr-index (addrbook-get-current-attr-index))
- (setq attr-subindex (addrbook-get-current-attr-subindex))
+ (setq attr-index (addrbook-contact-get-current-attr-index))
+ (setq attr-subindex (addrbook-contact-get-current-attr-subindex))
(if (and attr-index attr-subindex)
(let ((attr (vcard-get-attribute current-card attr-index)))
(setq property-name (vcard-attr-get-name attr)))
@@ -1403,85 +1243,27 @@
(vcard-attr-set-property new-attr "value" "url"))
(setq current-card (vcard-add-attribute current-card
new-attr))))
(addrbook-set-card addrbook-current-card current-card)
- (if (addrbook-group-in-display-p group-symbol)
+ (if (addrbook-contact-in-display-p group-symbol)
(progn
;; Redisplay the group with new contents
- (addrbook-redisplay-group group-symbol)
+ (addrbook-contact-redisplay-group group-symbol)
;; Hide the group if it was hidden
- (if (addrbook-group-hidden-p group)
- (addrbook-hide-show-group group nil)))
+ (if (addrbook-contact-group-hidden-p group)
+ (addrbook-contact-hide-show-group group nil)))
;; Redisplay the entire card
- (addrbook-redisplay-card))
+ (addrbook-contact-redisplay-card))
;; This card has been modified
(add-to-list 'addrbook-modified-cards
addrbook-current-card))))))
(goto-char backup-point)))
-(defun addrbook-save-cards (prefix)
- "Save cards into addrbook-file"
- (interactive "P")
- (if prefix
- (addrbook-export-card)
- ;; Save all cards into addressbook-file
- (if (equal (length addrbook-modified-cards) 0)
- (message "addressbook not saved")
- (addrbook-write-data addrbook-file)
- (setq addrbook-modified-cards nil)
- (set-buffer-modified-p nil)
- (message "addressbook saved"))))
-
-(defun addrbook-next-contact ()
- "Display the next card"
- (interactive)
- (let (buffer-read-only window-list win)
- (if (equal addrbook-current-card (- (length addrbook-cards) 1))
- (message "No more cards")
- (addrbook-display-card (+ addrbook-current-card 1))
- (let ((summary-buffer (get-buffer addrbook-summary-buffer)))
- (when summary-buffer
- (setq window-list (get-buffer-window-list summary-buffer nil t))
- (dolist (win window-list)
- (with-selected-window (get-buffer-window summary-buffer t)
- (addrbook-summary-goto-contact addrbook-current-card nil))))))))
-
-(defun addrbook-previous-contact ()
- "Display the previous card"
- (interactive)
- (let (buffer-read-only)
- (if (equal addrbook-current-card 0)
- (message "First card")
- (addrbook-display-card (- addrbook-current-card 1))
- (let ((summary-buffer (get-buffer addrbook-summary-buffer)))
- (when summary-buffer
- (setq window-list (get-buffer-window-list summary-buffer nil t))
- (dolist (win window-list)
- (with-selected-window (get-buffer-window summary-buffer t)
- (addrbook-summary-goto-contact addrbook-current-card nil))))))))
-
-(defun addrbook-quit ()
- "Exit the addressbook"
- (interactive)
- (if (and (not (equal (length addrbook-modified-cards) 0))
- (yes-or-no-p "Save addressbook? "))
- (addrbook-save-cards nil))
- (let ((contact-buffer (get-buffer addrbook-buffer-name))
- (summary-buffer (get-buffer addrbook-summary-buffer-name)))
- (if summary-buffer
- (kill-buffer summary-buffer))
- (if contact-buffer
- (if (equal (length (window-list)) 1)
- (progn
- (kill-buffer addrbook-buffer)
- (delete-frame))
- (kill-buffer-and-window)))))
-
-(defun addrbook-edit-attribute ()
+(defun addrbook-contact-edit-attribute ()
(interactive)
"Edit the value of the attribute located in the current line"
(let ((buffer-read-only nil)
- (group-symbol (addrbook-get-current-group))
- (attr-index (addrbook-get-current-attr-index))
- (attr-subindex (addrbook-get-current-attr-subindex))
- (attr-compound-title-p (addrbook-get-current-attr-compound-title)))
+ (group-symbol (addrbook-contact-get-current-group))
+ (attr-index (addrbook-contact-get-current-attr-index))
+ (attr-subindex (addrbook-contact-get-current-attr-subindex))
+ (attr-compound-title-p
(addrbook-contact-get-current-attr-compound-title)))
(if (and group-symbol attr-index (not attr-compound-title-p))
(let* ((group (addrbook-get-group group-symbol))
(group-attrs (addrbook-get-group-props group))
@@ -1513,15 +1295,15 @@
;; Mark the current card as modified
(add-to-list 'addrbook-modified-cards addrbook-current-card)
;; Redisplay attribute
- ;; FIXME: use addrbook-redisplay-attr-at-point
+ ;; FIXME: use addrbook-contact-redisplay-attr-at-point
(let ((column-backup (current-column))
(line-backup (line-number-at-pos (point))))
- (addrbook-erase-attr-region)
- (addrbook-display-attribute attr-index)
+ (addrbook-contact-erase-attr-region)
+ (addrbook-contact-display-attribute attr-index)
(goto-line line-backup)
(goto-char (+ (line-beginning-position) column-backup)))))))
-(defun addrbook-goto-next-group ()
+(defun addrbook-contact-goto-next-group ()
"Leave the point at the beginning of the next group"
(let ((next-point))
(setq next-point (next-single-property-change (point) 'group))
@@ -1533,7 +1315,7 @@
(when next-point
(goto-char next-point))))))
-(defun addrbook-toggle-hide-show-group ()
+(defun addrbook-contact-toggle-hide-show-group ()
"When staying on a parameters group title, toggle visibility of the group"
(interactive)
(let ((buffer-read-only nil)
@@ -1543,223 +1325,99 @@
;; Search for visibility properties in group contents
(setq group-content-pos (next-single-property-change (point) 'group))
(if (get-text-property group-content-pos 'invisible)
- (addrbook-hide-show-group group t)
- (addrbook-hide-show-group group nil)))))
+ (addrbook-contact-hide-show-group group t)
+ (addrbook-contact-hide-show-group group nil)))))
-(defun addrbook-hide-all-groups ()
+(defun addrbook-contact-hide-all-groups ()
"Hide all displayed groups"
(interactive)
(let (buffer-read-only)
- (dolist (group addrbook-displayed-groups nil)
- (addrbook-hide-show-group group nil))))
+ (dolist (group addrbook-contact-displayed-groups nil)
+ (addrbook-contact-hide-show-group group nil))))
-(defun addrbook-show-all-groups ()
+(defun addrbook-contact-show-all-groups ()
"Show all displayed groups"
(interactive)
(let (buffer-read-only)
- (dolist (group addrbook-displayed-groups nil)
- (addrbook-hide-show-group group t))))
+ (dolist (group addrbook-contact-displayed-groups nil)
+ (addrbook-contact-hide-show-group group t))))
-(defun addrbook-cycle-groups ()
+(defun addrbook-contact-cycle-groups ()
"Cycle to next group"
(interactive)
- (let ((next-group-pos (addrbook-goto-next-group)))
+ (let ((next-group-pos (addrbook-contact-goto-next-group)))
(when (not next-group-pos)
(goto-char (point-min))
- (addrbook-goto-next-group))))
+ (addrbook-contact-goto-next-group))))
-;;;; Modeline
+;;; Modeline management
-;;; FIXME: this is ugly
-(defun addrbook-set-mode-line (card-number total-cards)
+(defun addrbook-contact-set-mode-line (card-number total-cards)
"Update the modeline of the current buffer"
- (when addrbook-mode-line-string
- (setq mode-line-buffer-identification
- (list 24
- addrbook-mode-line-string
- ": "
- (list 10
- (format "%d/%d" card-number total-cards))))))
-
-;;; FIXME: this is ugly
-(defun addrbook-summary-set-mode-line (card-number total-cards)
- "Update the mdoeline of the current summary buffer"
- (when addrbook-summary-mode-line-string
+ ;; FIXME: this is ugly
+ (when addrbook-contact-mode-line-string
(setq mode-line-buffer-identification
(list 24
- addrbook-summary-mode-line-string
+ addrbook-contact-mode-line-string
": "
(list 10
(format "%d/%d" card-number total-cards))))))
-;;;; Group/Attribute fast selection
-;;; Adapted from `org-fast-tag-selection' in org.el by Carsten Dominic
-;;;
-;;; Thanks Carsten! ;P
-(defun addrbook-fast-selection (names prompt)
- "Fast group tag selection with single keys.
-
-NAMES is an association list of the form:
-
- ((\"NAME1\" char1) ...)
-
-Each character should identify only one name."
- (let* ((maxlen (apply 'max (mapcar (lambda (name)
- (string-width (car name))) names)))
- (buf (current-buffer))
- (fwidth (+ maxlen 3 1 3))
- (ncol (/ (- (window-width) 4) fwidth))
- name count result char i key-list)
- (save-window-excursion
- (set-buffer (get-buffer-create " *AddrBook Groups*"))
- (delete-other-windows)
- (split-window-vertically)
- (switch-to-buffer-other-window (get-buffer-create " *AddrBook Groups*"))
- (erase-buffer)
- (insert prompt ":")
- (insert "\n\n")
- (setq count 0)
- (while (setq name (pop names))
- (setq key-list (cons (cadr name) key-list))
- (insert "[" (cadr name) "] "
- (car name)
- (make-string (- fwidth 4 (length (car name))) ?\ ))
- (when (= (setq count (+ count 1)) ncol)
- (insert "\n")
- (setq count 0)))
- (goto-char (point-min))
- (if (fboundp 'fit-window-to-buffer)
- (fit-window-to-buffer))
- (catch 'exit
- (while t
- (message "[a-z0-9...]: Select entry [RET]: Exit")
- (setq char (let ((inhibit-quit t)) (read-char-exclusive)))
- (cond
- ((= char ?\r)
- (setq result nil)
- (throw 'exit t))
- ((member char key-list)
- (setq result char)
- (throw 'exit t)))))
- result)))
+;;; Major mode
+(defun addrbook-contact-mode ()
+ "A major mode for contact editing
-(defun addrbook-select-type (attr-name)
- (let* ((property (addrbook-get-property attr-name))
- (prop-types (addrbook-get-prop-parameter property "type")))
- (let (type-names type letter result)
- (dolist (type prop-types)
- (setq type-names
- (cons (cdr type) type-names)))
- (setq type-names (reverse type-names))
- (setq letter (addrbook-fast-selection type-names "Select attribute
type"))
- (if letter
- (dolist (type type-names)
- (if (equal letter
- (cadr type))
- (setq result (car type)))))
- result)))
+Commands:
+\\{addrbook-contact-mode-map}"
+ (interactive)
+ (kill-all-local-variables)
+ (setq addrbook-contact-mode-map (make-keymap))
+ (define-key addrbook-contact-mode-map "c" 'addrbook-create-card)
+ (define-key addrbook-contact-mode-map "D" 'addrbook-delete-card)
+ (define-key addrbook-contact-mode-map "n" 'addrbook-next-contact)
+ (define-key addrbook-contact-mode-map "p" 'addrbook-previous-contact)
+ (define-key addrbook-contact-mode-map "s" 'addrbook-save-cards)
+ (define-key addrbook-contact-mode-map "x" 'addrbook-export-card)
+ (define-key addrbook-contact-mode-map "q" 'addrbook-quit)
+ (define-key addrbook-contact-mode-map "e"
'addrbook-contact-edit-attribute)
+ (define-key addrbook-contact-mode-map (kbd "SPC")
'addrbook-contact-toggle-hide-show-group)
+ (define-key addrbook-contact-mode-map (kbd "TAB")
'addrbook-contact-cycle-groups)
+ (define-key addrbook-contact-mode-map "d"
'addrbook-contact-delete-attribute-type)
+ (define-key addrbook-contact-mode-map "a"
'addrbook-contact-add-attribute)
+ (define-key addrbook-contact-mode-map "t"
'addrbook-contact-add-attribute-type)
+ (define-key addrbook-contact-mode-map "r"
'addrbook-contact-remove-attribute-type)
+ (define-key addrbook-contact-mode-map "m" 'addrbook-send-email)
+ (define-key addrbook-contact-mode-map "H"
'addrbook-contact-hide-all-groups)
+ (define-key addrbook-contact-mode-map "S"
'addrbook-contact-show-all-groups)
+ (define-key addrbook-contact-mode-map "h" 'addrbook-summarize)
+ (use-local-map addrbook-contact-mode-map)
+ (setq mode-name "ABook Contact")
+ (setq major-mode 'addrbook-contact-mode))
-(defun addrbook-select-non-existing-type (attr)
- (let* ((attr-name (vcard-attr-get-name attr))
- (property (addrbook-get-property attr-name))
- (prop-types (addrbook-get-prop-parameter property "type"))
- (attr-types (vcard-attr-get-parameter attr "type")))
- (let (type-names type letter result)
- (dolist (type prop-types)
- (if (not (member (car type) attr-types))
- (setq type-names
- (cons (cdr type) type-names))))
- (setq type-names (reverse type-names))
- (setq letter (addrbook-fast-selection type-names "Select attribute
type"))
- (if letter
- (dolist (type type-names)
- (if (equal letter
- (cadr type))
- (setq result (car type)))))
- result)))
+;;;; Addressbook Summary
-(defun addrbook-select-existing-type (attr)
- (let* ((attr-name (vcard-attr-get-name attr))
- (property (addrbook-get-property attr-name))
- (prop-types (addrbook-get-prop-parameter property "type"))
- (attr-types (vcard-attr-get-parameter attr "type")))
- (let (type-names type letter result)
- (dolist (type prop-types)
- (if (member (car type) attr-types)
- (setq type-names
- (cons (cdr type) type-names))))
- (setq type-names (reverse type-names))
- (setq letter (addrbook-fast-selection type-names "Select attribute
type"))
- (if letter
- (dolist (type type-names)
- (if (equal letter
- (cadr type))
- (setq result (car type)))))
- result)))
+;;; Constants
-(defun addrbook-select-group ()
- "Select a group interactively and return its symbol"
- (let (names group group-elt letter result)
- ;; Build the names list
- (dolist (group-elt addrbook-properties)
- (setq names
- (cons (list (addrbook-get-group-name group-elt)
- (addrbook-get-group-letter group-elt))
- names)))
- (setq names (reverse names))
- ;; Call the fast menu function to get the desired group
- (setq letter (addrbook-fast-selection names "Select group"))
- (dolist (group-elt addrbook-properties)
- (if (and (addrbook-get-group-letter group-elt)
- (equal letter (addrbook-get-group-letter group-elt)))
- (setq result (addrbook-get-group-symbol group-elt))))
- result))
+(defconst addrbook-summary-buffer-name "*AddressBook Summary*"
+ "Name of the buffer for the addressbook summary")
-(defun addrbook-select-property (group-symbol)
- "Select a property interactively from GROUP and return its name"
- (let* ((group (addrbook-get-group group-symbol))
- (group-props (addrbook-get-group-props group))
- names attr attr-elt letter result)
- ;; Build the names list
- (dolist (prop group-props)
- (if (and (not (member (addrbook-get-prop-name prop)
addrbook-required-attrs))
- (addrbook-get-prop-letter prop))
- (setq names
- (cons (list (addrbook-get-prop-title prop)
- (addrbook-get-prop-letter prop))
- names))))
- (setq names (reverse names))
- ;; Call the fast menu function to get the desired group
- (setq letter (addrbook-fast-selection names "Select property"))
- (dolist (prop group-props)
- (if (and (addrbook-get-prop-letter prop)
- (equal letter (addrbook-get-prop-letter prop)))
- (setq result (addrbook-get-prop-name prop))))
- result))
+;;; Variables
-(defun addrbook-select-field (group-symbol prop-name)
- "Select a field interactively from PROP-NAME"
- (let* ((group (addrbook-get-group group-symbol))
- (group-props (addrbook-get-group-props group))
- (property (assoc prop-name group-props))
- (prop-fields (addrbook-get-prop-fields-list property))
- letter field result i)
- (setq letter (addrbook-fast-selection prop-fields "Select property field"))
- (dotimes (i (length prop-fields))
- (setq field (nth i prop-fields))
- (if (equal letter (addrbook-get-prop-field-letter field))
- (setq result i)))
- result))
+(defvar addrbook-summary-mode-map nil
+ "Keymap for addrbook-summary-mode")
-;;;; Summary management
+(defvar addrbook-summary-mode-line-string " ABook Summary"
+ "String to display on the mode line when in the addressbook summary mode.
+If `nil', do not show anything.")
+;;; Summary buffer management
(defun addrbook-make-summary-buffer ()
(save-excursion
(let ((buffer (get-buffer-create addrbook-summary-buffer-name)))
(set-buffer buffer)
(addrbook-summary-mode)
- (addrbook-display-summary)
+ (addrbook-summary-redisplay)
(setq buffer-read-only t)
(setq addrbook-summary-buffer buffer)
buffer)))
@@ -1768,7 +1426,7 @@
"Open the addressbook and show the summary window"
(let ((buffer (get-buffer addrbook-summary-buffer-name)))
(when (not buffer)
- (when (not (get-buffer addrbook-buffer-name))
+ (when (not (get-buffer addrbook-contact-buffer-name))
(addrbook-open))
(setq buffer (addrbook-make-summary-buffer)))
(switch-to-buffer-other-window addrbook-summary-buffer)
@@ -1795,10 +1453,12 @@
(setq addrbook-summary-buffer (get-buffer-create
addrbook-summary-buffer-name))
(set-buffer addrbook-summary-buffer)
(addrbook-summary-mode)
- (addrbook-display-summary)))
+ (addrbook-summary-redisplay)))
addrbook-summary-buffer)
-(defun addrbook-display-summary ()
+;;; Display functions
+
+(defun addrbook-summary-redisplay ()
(erase-buffer)
(let (card-index card name)
(dotimes (card-index (length addrbook-cards))
@@ -1839,14 +1499,16 @@
(overlay-put highlight-overlay 'face 'addrbook-summary-selected-card))
(addrbook-summary-set-mode-line (+ numcard 1) (length addrbook-cards))
(when (and update-contact-buffer
- (get-buffer addrbook-buffer-name))
+ (get-buffer addrbook-contact-buffer-name))
(save-excursion
- (set-buffer (get-buffer addrbook-buffer-name))
- (addrbook-display-card numcard))))))
+ (set-buffer (get-buffer addrbook-contact-buffer-name))
+ (addrbook-contact-display-card numcard))))))
(defun addrbook-summary-get-current-card ()
(get-text-property (point) 'card-index))
+;;; Commands
+
(defun addrbook-summary-next-contact ()
"Select the next card in the summary buffer"
(interactive)
@@ -1871,10 +1533,10 @@
"Open an addressbook buffer to show the current selected card"
(interactive)
(let ((card-index (addrbook-summary-get-current-card)))
- (when (not (get-buffer addrbook-buffer-name))
+ (when (not (get-buffer addrbook-contact-buffer-name))
(save-excursion
- (addrbook-contact)
- (addrbook-display-card card-index)))
+ (addrbook-create-contact-buffer)
+ (addrbook-contact-display-card card-index)))
(addrbook-show-contact)))
(defun addrbook-summary-quit ()
@@ -1882,69 +1544,20 @@
(interactive)
(addrbook-quit))
-;;;; Searching
-
-(defun addrbook-attr-matches-p (attr regexp)
- (let (result value
- (attr-values (vcard-attr-get-values attr)))
- (if (listp attr-values)
- (dolist (value attr-values)
- (if (string-match regexp value)
- (setq result t)))
- (setq result (string-match regexp attr-values)))
- result))
-
-(defun addrbook-search-cards (regexp &optional properties)
- "Search for REGEXP in card data and return a list with the indexes
-of matching cards.
-
-PROPERTIES is a list of property names.
-If PROPERTIES is specified and non-nil, the search is performed only in those
-attributes."
- (let (card prop attr card-index attr-index result)
- (dotimes (card-index (length addrbook-cards))
- (setq card (addrbook-get-card card-index))
- (dotimes (attr-index (vcard-get-num-attributes card))
- (setq attr (vcard-get-attribute card attr-index))
- (if (and (or (not properties)
- (member (vcard-attr-get-name attr) properties))
- (addrbook-attr-matches-p attr regexp))
- (add-to-list 'result card-index))))
- (reverse result)))
-
-
+;; Modeline management
-;;;; Modes and launchers
-
-(defun addrbook-mode ()
- "A major mode for the addressbook window
+(defun addrbook-summary-set-mode-line (card-number total-cards)
+ "Update the mdoeline of the current summary buffer"
+ ;; FIXME: this is ugly
+ (when addrbook-summary-mode-line-string
+ (setq mode-line-buffer-identification
+ (list 24
+ addrbook-summary-mode-line-string
+ ": "
+ (list 10
+ (format "%d/%d" card-number total-cards))))))
-Commands:
-\\{addrbook-mode-map}"
- (interactive)
- (kill-all-local-variables)
- (setq addrbook-mode-map (make-keymap))
- (define-key addrbook-mode-map "c" 'addrbook-create-card)
- (define-key addrbook-mode-map "D" 'addrbook-delete-card)
- (define-key addrbook-mode-map "n" 'addrbook-next-contact)
- (define-key addrbook-mode-map "p" 'addrbook-previous-contact)
- (define-key addrbook-mode-map "s" 'addrbook-save-cards)
- (define-key addrbook-mode-map "x" 'addrbook-export-card)
- (define-key addrbook-mode-map "q" 'addrbook-quit)
- (define-key addrbook-mode-map "e" 'addrbook-edit-attribute)
- (define-key addrbook-mode-map (kbd "SPC")
'addrbook-toggle-hide-show-group)
- (define-key addrbook-mode-map (kbd "TAB") 'addrbook-cycle-groups)
- (define-key addrbook-mode-map "d" 'addrbook-delete-attribute)
- (define-key addrbook-mode-map "a" 'addrbook-add-attribute)
- (define-key addrbook-mode-map "t" 'addrbook-add-attribute-type)
- (define-key addrbook-mode-map "r" 'addrbook-remove-attribute-type)
- (define-key addrbook-mode-map "m" 'addrbook-send-email)
- (define-key addrbook-mode-map "H" 'addrbook-hide-all-groups)
- (define-key addrbook-mode-map "S" 'addrbook-show-all-groups)
- (define-key addrbook-mode-map "h" 'addrbook-summarize)
- (use-local-map addrbook-mode-map)
- (setq mode-name "AddressBook")
- (setq major-mode 'addrbook-mode))
+;;; Major mode
(defun addrbook-summary-mode ()
"A major mode for the addressbook summary window
@@ -1963,6 +1576,461 @@
(setq mode-name "AddressBook Summary")
(setq major-mode 'addrbook-summary-mode))
+;;;; General commands (usable from all addressbook modes)
+
+(defun addrbook-send-email ()
+ "Send an email to current contact"
+ (interactive)
+ (let* ((card (addrbook-get-card addrbook-current-card))
+ (mail-addresses (vcard-ref card (list "email")))
+ mail-names name i attr sendto-address letter)
+ (dotimes (i (length mail-addresses))
+ (let* ((attr (nth i mail-addresses))
+ (attr-type (car (vcard-attr-get-parameter attr "type"))))
+ (if (equal attr-type "internet")
+ (setq mail-names (cons (list (car (vcard-attr-get-values attr))
+ (+ ?a i))
+ mail-names)))))
+ (setq mail-names (reverse mail-names))
+ (if (not mail-names)
+ (message "Contact doesnt have a suitable smtp address")
+ (if (equal (length mail-names) 1)
+ (setq sendto-address (car (car mail-names)))
+ (setq letter (addrbook-fast-selection mail-names "Select email address
to send mail to"))
+ (dolist (name mail-names)
+ (if (equal letter
+ (cadr name))
+ (setq sendto-address (car name)))))
+ ;; Send the email
+ (if sendto-address
+ (compose-mail-other-frame (concat
+ "\"" (addrbook-get-card-fn) "\""
+ " <" sendto-address ">"))))))
+
+(defun addrbook-delete-card ()
+ "Delete the current card"
+ (interactive)
+ (let ((buffer-read-only nil)
+ (current-card addrbook-current-card)
+ (prompt "Are you sure you want to delete current contact? "))
+ (when (yes-or-no-p prompt)
+ (if (equal current-card (- (length addrbook-cards) 1))
+ (setq current-card (- (length addrbook-cards) 2)))
+ (addrbook-remove-card addrbook-current-card)
+ (add-to-list 'addrbook-modified-cards current-card)
+ (if (equal (length addrbook-cards) 0)
+ (addrbook-quit)
+ (addrbook-contact-display-card current-card)))))
+
+(defun addrbook-create-card ()
+ "Create a new card"
+ (interactive)
+ (let ((buffer-read-only nil)
+ (new-card-index (addrbook-create-card-2)))
+ (if new-card-index
+ (addrbook-contact-display-card new-card-index))))
+
+(defun addrbook-save-cards (prefix)
+ "Save cards into addrbook-file"
+ (interactive "P")
+ (if prefix
+ (addrbook-export-card)
+ ;; Save all cards into addressbook-file
+ (if (equal (length addrbook-modified-cards) 0)
+ (message "addressbook not saved")
+ (addrbook-write-data addrbook-file)
+ (setq addrbook-modified-cards nil)
+ (set-buffer-modified-p nil)
+ (message "addressbook saved"))))
+
+(defun addrbook-next-contact ()
+ "Display the next card"
+ (interactive)
+ (let (buffer-read-only window-list win)
+ (if (equal addrbook-current-card (- (length addrbook-cards) 1))
+ (message "No more cards")
+ (addrbook-contact-display-card (+ addrbook-current-card 1))
+ (let ((summary-buffer (get-buffer addrbook-summary-buffer)))
+ (when summary-buffer
+ (setq window-list (get-buffer-window-list summary-buffer nil t))
+ (dolist (win window-list)
+ (with-selected-window (get-buffer-window summary-buffer t)
+ (addrbook-summary-goto-contact addrbook-current-card nil))))))))
+
+(defun addrbook-previous-contact ()
+ "Display the previous card"
+ (interactive)
+ (let (buffer-read-only)
+ (if (equal addrbook-current-card 0)
+ (message "First card")
+ (addrbook-contact-display-card (- addrbook-current-card 1))
+ (let ((summary-buffer (get-buffer addrbook-summary-buffer)))
+ (when summary-buffer
+ (setq window-list (get-buffer-window-list summary-buffer nil t))
+ (dolist (win window-list)
+ (with-selected-window (get-buffer-window summary-buffer t)
+ (addrbook-summary-goto-contact addrbook-current-card nil))))))))
+
+(defun addrbook-quit ()
+ "Exit the addressbook"
+ (interactive)
+ (if (and (not (equal (length addrbook-modified-cards) 0))
+ (yes-or-no-p "Save addressbook? "))
+ (addrbook-save-cards nil))
+ (let ((contact-buffer (get-buffer addrbook-contact-buffer-name))
+ (summary-buffer (get-buffer addrbook-summary-buffer-name)))
+ (if summary-buffer
+ (kill-buffer summary-buffer))
+ (if contact-buffer
+ (if (equal (length (window-list)) 1)
+ (progn
+ (kill-buffer addrbook-buffer)
+ (delete-frame))
+ (kill-buffer-and-window)))))
+
+
+;;;; Backend management
+
+(defun addrbook-read-cards ()
+ "Read cards from addressbook file"
+ (with-temp-buffer
+ (insert-file-contents addrbook-file)
+ (setq addrbook-cards (vcard-parse-region (point-min)
+ (point-max)))
+ (when addrbook-cards
+ (addrbook-make-params-explicit)
+ t)))
+
+(defun addrbook-make-params-explicit ()
+ "Make unambiguous anonymous params explicit.
+
+It uses `addrbook-general-params' and the type parameter for each property
+defined in `addrbook-properties'"
+ (let ((i 0))
+ (dolist (card addrbook-cards)
+ (dotimes (i (vcard-get-num-attributes card))
+ (let* ((attr (vcard-get-attribute card i))
+ (attr-name (vcard-attr-get-name attr))
+ (attr-props (cdr (vcard-attr-get-proplist attr)))
+ (property (addrbook-get-property attr-name))
+ param
+ (j 0))
+ (dotimes (j (length attr-props))
+ (let* ((param (nth j attr-props))
+ (param-name (if (and param
+ (listp param))
+ (car param)
+ nil))
+ (param-value (if (and param
+ (listp param))
+ (cdr param)
+ param)))
+ ;; Search the param name in general-value
+ (if (not param-name)
+ (let* ((general-param (assoc param-value
addrbook-general-params))
+ (general-param-name (if general-param (cadr
general-param)))
+ (prop-types (addrbook-get-prop-parameter property
"type")))
+ (if general-param-name
+ (setq param-name general-param-name)
+ (if (and prop-types
+ (assoc param-value prop-types))
+ (setq param-name "type")))
+ (if param-name
+ (setcar (nthcdr j attr-props) (cons param-name
param-value))))))))))))
+
+(defun addrbook-write-data (filename)
+ "Write cards information to FILENAME, discarding any
+previous content."
+ (with-temp-file filename
+ (dotimes (i (length addrbook-cards))
+ (let ((card (addrbook-get-card i)))
+ (vcard-insert card)
+ (if (not (equal i (- (length addrbook-cards) 1)))
+ (insert "\n\n"))))))
+
+(defun addrbook-export-card ()
+ "Export current card data to a file"
+ (interactive)
+ (let ((filename (read-file-name "Export vCard to file: "))
+ (card (addrbook-get-card addrbook-current-card)))
+ (with-temp-file filename
+ (vcard-insert card))
+ (message "vCard exported")))
+
+(defun addrbook-create-card-2 ()
+ "Create a new card with minimum identification properties and insert it
+into `addrbook-cards'.
+
+Return the index position of the new card"
+ (let* (new-card
+ (n-surname (read-from-minibuffer "Surname: "))
+ (n-first-name (read-from-minibuffer "First name: "))
+ (n-aka (read-from-minibuffer "AKA: "))
+ (n-name-prefix (read-from-minibuffer "Name prefix: "))
+ (n-name-suffix (read-from-minibuffer "Name suffix: "))
+ (no-values (and (equal n-surname "")
+ (equal n-first-name "")
+ (equal n-aka "")
+ (equal n-name-prefix "")
+ (equal n-name-suffix "")))
+ (new-card-index (length addrbook-cards)))
+ (if no-values
+ (progn
+ (message "Contact not created")
+ nil)
+ ;; Create a new card
+ (setq new-card (vcard-add-attribute new-card
+ (cons (list "n")
+ (list n-surname
+ n-first-name
+ n-aka
+ n-name-prefix
+ n-name-suffix))))
+ (addrbook-set-card new-card-index new-card)
+ (add-to-list 'addrbook-modified-cards new-card-index)
+ new-card-index)))
+
+;;;; Utility functions
+
+(defun addrbook-list-to-csv (list)
+ (let ((result "")
+ i)
+ (dotimes (i (length list))
+ (setq result (concat result (nth i list)))
+ (if (not (equal i (- (length list) 1)))
+ (setq result (concat result ","))))
+ result))
+
+(defun addrbook-open ()
+ "Open the addressbook"
+ (or (addrbook-read-cards)
+ (addrbook-create-card-2)))
+
+(defun addrbook-get-text-property-line (prop)
+ "Return the value of text property PROP in the nearest position on current
line
+that has PROP defined as a text property"
+ (let ((current-point (get-text-property (point) prop))
+ (next-point-with-prop (next-single-property-change
+ (point) prop nil (line-end-position)))
+ (previous-point-with-prop (previous-single-property-change
+ (point) prop nil
(line-beginning-position))))
+ (or current-point
+ (if next-point-with-prop
+ (get-text-property next-point-with-prop prop)
+ (get-text-property previous-point-with-prop prop)))))
+
+(defun addrbook-erase-tagged-region (tag)
+ "Erase the region tagged with the same TAG value"
+ (let ((begin-pos (previous-single-property-change (point) tag))
+ (end-pos (next-single-property-change (point) tag)))
+ (if (equal (point) (point-min))
+ (setq begin-pos (point-min))
+ (if (not (equal (get-text-property (point) tag)
+ (get-text-property (- (point) 1) tag)))
+ (setq begin-pos (point))))
+ (if (equal (point) (point-max))
+ (setq end-pos (point-max))
+ (if (not (equal (get-text-property (point) tag)
+ (get-text-property (+ (point) 1) tag)))
+ (setq end-pos (+ point 1))))
+ (cond ((and begin-pos end-pos)
+ (delete-region begin-pos end-pos))
+ ((and begin-pos (not end-pos))
+ (delete-region begin-pos (point-max)))
+ ((and (not begin-pos) end-pos)
+ (delete-region (point-min) end-pos)))))
+
+;;; Fast selection
+
+(defun addrbook-fast-selection (names prompt)
+ "Fast group tag selection with single keys.
+
+NAMES is an association list of the form:
+
+ ((\"NAME1\" char1) ...)
+
+Each character should identify only one name."
+ ;; Adapted from `org-fast-tag-selection' in org.el by Carsten Dominic
+ ;; Thanks Carsten! ;P
+ (let* ((maxlen (apply 'max (mapcar (lambda (name)
+ (string-width (car name))) names)))
+ (buf (current-buffer))
+ (fwidth (+ maxlen 3 1 3))
+ (ncol (/ (- (window-width) 4) fwidth))
+ name count result char i key-list)
+ (save-window-excursion
+ (set-buffer (get-buffer-create " *AddrBook Groups*"))
+ (delete-other-windows)
+ (split-window-vertically)
+ (switch-to-buffer-other-window (get-buffer-create " *AddrBook Groups*"))
+ (erase-buffer)
+ (insert prompt ":")
+ (insert "\n\n")
+ (setq count 0)
+ (while (setq name (pop names))
+ (setq key-list (cons (cadr name) key-list))
+ (insert "[" (cadr name) "] "
+ (car name)
+ (make-string (- fwidth 4 (length (car name))) ?\ ))
+ (when (= (setq count (+ count 1)) ncol)
+ (insert "\n")
+ (setq count 0)))
+ (goto-char (point-min))
+ (if (fboundp 'fit-window-to-buffer)
+ (fit-window-to-buffer))
+ (catch 'exit
+ (while t
+ (message "[a-z0-9...]: Select entry [RET]: Exit")
+ (setq char (let ((inhibit-quit t)) (read-char-exclusive)))
+ (cond
+ ((= char ?\r)
+ (setq result nil)
+ (throw 'exit t))
+ ((member char key-list)
+ (setq result char)
+ (throw 'exit t)))))
+ result)))
+
+(defun addrbook-select-type (attr-name)
+ (let* ((property (addrbook-get-property attr-name))
+ (prop-types (addrbook-get-prop-parameter property "type")))
+ (let (type-names type letter result)
+ (dolist (type prop-types)
+ (setq type-names
+ (cons (cdr type) type-names)))
+ (setq type-names (reverse type-names))
+ (setq letter (addrbook-fast-selection type-names "Select attribute
type"))
+ (if letter
+ (dolist (type type-names)
+ (if (equal letter
+ (cadr type))
+ (setq result (car type)))))
+ result)))
+
+(defun addrbook-select-non-existing-type (attr)
+ (let* ((attr-name (vcard-attr-get-name attr))
+ (property (addrbook-get-property attr-name))
+ (prop-types (addrbook-get-prop-parameter property "type"))
+ (attr-types (vcard-attr-get-parameter attr "type")))
+ (let (type-names type letter result)
+ (dolist (type prop-types)
+ (if (not (member (car type) attr-types))
+ (setq type-names
+ (cons (cdr type) type-names))))
+ (setq type-names (reverse type-names))
+ (setq letter (addrbook-fast-selection type-names "Select attribute
type"))
+ (if letter
+ (dolist (type type-names)
+ (if (equal letter
+ (cadr type))
+ (setq result (car type)))))
+ result)))
+
+(defun addrbook-select-existing-type (attr)
+ (let* ((attr-name (vcard-attr-get-name attr))
+ (property (addrbook-get-property attr-name))
+ (prop-types (addrbook-get-prop-parameter property "type"))
+ (attr-types (vcard-attr-get-parameter attr "type")))
+ (let (type-names type letter result)
+ (dolist (type prop-types)
+ (if (member (car type) attr-types)
+ (setq type-names
+ (cons (cdr type) type-names))))
+ (setq type-names (reverse type-names))
+ (setq letter (addrbook-fast-selection type-names "Select attribute
type"))
+ (if letter
+ (dolist (type type-names)
+ (if (equal letter
+ (cadr type))
+ (setq result (car type)))))
+ result)))
+
+(defun addrbook-select-group ()
+ "Select a group interactively and return its symbol"
+ (let (names group group-elt letter result)
+ ;; Build the names list
+ (dolist (group-elt addrbook-properties)
+ (setq names
+ (cons (list (addrbook-get-group-name group-elt)
+ (addrbook-get-group-letter group-elt))
+ names)))
+ (setq names (reverse names))
+ ;; Call the fast menu function to get the desired group
+ (setq letter (addrbook-fast-selection names "Select group"))
+ (dolist (group-elt addrbook-properties)
+ (if (and (addrbook-get-group-letter group-elt)
+ (equal letter (addrbook-get-group-letter group-elt)))
+ (setq result (addrbook-get-group-symbol group-elt))))
+ result))
+
+(defun addrbook-select-property (group-symbol)
+ "Select a property interactively from GROUP and return its name"
+ (let* ((group (addrbook-get-group group-symbol))
+ (group-props (addrbook-get-group-props group))
+ names attr attr-elt letter result)
+ ;; Build the names list
+ (dolist (prop group-props)
+ (if (and (not (member (addrbook-get-prop-name prop)
addrbook-required-attrs))
+ (addrbook-get-prop-letter prop))
+ (setq names
+ (cons (list (addrbook-get-prop-title prop)
+ (addrbook-get-prop-letter prop))
+ names))))
+ (setq names (reverse names))
+ ;; Call the fast menu function to get the desired group
+ (setq letter (addrbook-fast-selection names "Select property"))
+ (dolist (prop group-props)
+ (if (and (addrbook-get-prop-letter prop)
+ (equal letter (addrbook-get-prop-letter prop)))
+ (setq result (addrbook-get-prop-name prop))))
+ result))
+
+(defun addrbook-select-field (group-symbol prop-name)
+ "Select a field interactively from PROP-NAME"
+ (let* ((group (addrbook-get-group group-symbol))
+ (group-props (addrbook-get-group-props group))
+ (property (assoc prop-name group-props))
+ (prop-fields (addrbook-get-prop-fields-list property))
+ letter field result i)
+ (setq letter (addrbook-fast-selection prop-fields "Select property field"))
+ (dotimes (i (length prop-fields))
+ (setq field (nth i prop-fields))
+ (if (equal letter (addrbook-get-prop-field-letter field))
+ (setq result i)))
+ result))
+
+;;; Search functions
+
+(defun addrbook-attr-matches-p (attr regexp)
+ (let (result value
+ (attr-values (vcard-attr-get-values attr)))
+ (if (listp attr-values)
+ (dolist (value attr-values)
+ (if (string-match regexp value)
+ (setq result t)))
+ (setq result (string-match regexp attr-values)))
+ result))
+
+(defun addrbook-search-cards (regexp &optional properties)
+ "Search for REGEXP in card data and return a list with the indexes
+of matching cards.
+
+PROPERTIES is a list of property names.
+If PROPERTIES is specified and non-nil, the search is performed only in those
+attributes."
+ (let (card prop attr card-index attr-index result)
+ (dotimes (card-index (length addrbook-cards))
+ (setq card (addrbook-get-card card-index))
+ (dotimes (attr-index (vcard-get-num-attributes card))
+ (setq attr (vcard-get-attribute card attr-index))
+ (if (and (or (not properties)
+ (member (vcard-attr-get-name attr) properties))
+ (addrbook-attr-matches-p attr regexp))
+ (add-to-list 'result card-index))))
+ (reverse result)))
+
+;;;; Entry points to the addressbook
+
;;;###autoload
(defun addressbook ()
"Open the addressbook"
@@ -1971,7 +2039,7 @@
(not (file-exists-p addrbook-file)))
(with-temp-file addrbook-file))
(catch 'exit
- (let ((buffer (get-buffer addrbook-buffer-name)))
+ (let ((buffer (get-buffer addrbook-contact-buffer-name)))
(when (not buffer)
(let ((show-card-index 0)
(user-input (when addrbook-ask-for-search
@@ -1985,10 +2053,10 @@
(message "No contacts found")
(throw 'exit t))
;; Goto the first card with matched data
- (addrbook-contact)
- (addrbook-display-card show-card-index)
+ (addrbook-create-contact-buffer)
+ (addrbook-contact-display-card show-card-index)
(setq addrbook-modified-cards nil)
- (switch-to-buffer-other-window (get-buffer
addrbook-buffer-name))
+ (switch-to-buffer-other-window (get-buffer
addrbook-contact-buffer-name))
(setq buffer-read-only t)
(setq addrbook-buffer buffer))
;; Goto the summary
- [Commit-womb] addressbook ChangeLog addressbook.el, (continued)
- [Commit-womb] addressbook ChangeLog addressbook.el, Jose E. Marchesi, 2007/05/06
- [Commit-womb] addressbook ChangeLog addressbook.el, Jose E. Marchesi, 2007/05/07
- [Commit-womb] addressbook ChangeLog addressbook.el, Jose E. Marchesi, 2007/05/07
- [Commit-womb] addressbook ChangeLog addressbook.el, Jose E. Marchesi, 2007/05/07
- [Commit-womb] addressbook ChangeLog addressbook.el, Jose E. Marchesi, 2007/05/08
- [Commit-womb] addressbook ChangeLog addressbook.el, Jose E. Marchesi, 2007/05/08
- [Commit-womb] addressbook ChangeLog addressbook.el, Jose E. Marchesi, 2007/05/08
- [Commit-womb] addressbook ChangeLog addressbook.el, Jose E. Marchesi, 2007/05/08
- [Commit-womb] addressbook ChangeLog addressbook.el, Jose E. Marchesi, 2007/05/08
- [Commit-womb] addressbook ChangeLog addressbook.el, Jose E. Marchesi, 2007/05/08
- [Commit-womb] addressbook ChangeLog addressbook.el,
Jose E. Marchesi <=
- [Commit-womb] addressbook ChangeLog addressbook.el, Xavier Maillard, 2007/05/08
- [commit-womb] addressbook ChangeLog addressbook.el, Jose E. Marchesi, 2007/05/09