[Commit-womb] addressbook ChangeLog addressbook.el

[Jose E. Marchesi]

CVSROOT:        /cvsroot/womb
Module name:    addressbook
Changes by:     Jose E. Marchesi <jemarch>      07/05/05 00:19:11

Modified files:
        .              : ChangeLog addressbook.el 

Log message:
        Code POLISHed

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/addressbook/ChangeLog?cvsroot=womb&r1=1.1&r2=1.2
http://cvs.savannah.gnu.org/viewcvs/addressbook/addressbook.el?cvsroot=womb&r1=1.1.1.1&r2=1.2

Patches:
Index: ChangeLog
===================================================================
RCS file: /cvsroot/womb/addressbook/ChangeLog,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -b -r1.1 -r1.2
--- ChangeLog   4 May 2007 23:07:03 -0000       1.1
+++ ChangeLog   5 May 2007 00:19:11 -0000       1.2
@@ -1,4 +1,40 @@
 2007-05-05  Jose E. Marchesi  <address@hidden>
 
+       * addressbook.el (addrbook-get-prop-fields): use
+       `addrbook-get-prop-fields'
+       (addrbook-get-prop-parameters): simplified
+       (addrbook-property-in-group-p): simplified
+       (addrbook-get-prop-default-type): simplified
+       (addrbook-value-empty-p): simplified
+       (addrbook-number-of-values): simplified
+       (addrbook-get-card-fn): simplified
+       (addrbook-attribute-nodisplay): simplified
+       (addrbook-display-attribute-photo-logo): simplified
+       (addrbook-display-attribute-type): simplified
+       (addrbook-group-hidden-p): simplified
+       (addrbook-hide-show-group): simplified
+       (addrbook-get-current-group): simplified
+       (addrbook-get-text-property-line): simplified
+       (addrbook-redisplay-group): simplified
+       (addrbook-group-in-display-p): simplified
+       (addrbook-read-cards): simplified
+       (addrbook-add-attribute-type): simplified
+       (addrbook-remove-attribute-type): simplified
+       (addrbook-delete-card): simplified
+       (addrbook-add-attribute): simplified
+       (addrbook-next-card): simplified
+       (addrbook-previous-card): simplified
+       (addrbook-quit): simplified
+       (addrbook-goto-next-group): simplified
+       (addrbook-toggle-hide-show-group): simplified
+       (addrbook-hide-all-groups): simplified
+       (addrbook-show-all-groups): simplified
+       (addrbook-cycle-groups): simplified
+       (addrbook-fast-selection): simplified
+       (addrbook-select-group): simplified
+       (addrbook-select-property): simplified
+       (addrbook-select-field): simplified
+       (addressbook): simplified
+
        * New ChangeLog
 

Index: addressbook.el
===================================================================
RCS file: /cvsroot/womb/addressbook/addressbook.el,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -u -b -r1.1.1.1 -r1.2
--- addressbook.el      4 May 2007 22:20:06 -0000       1.1.1.1
+++ addressbook.el      5 May 2007 00:19:11 -0000       1.2
@@ -5,7 +5,7 @@
 ;; Maintainer: Jose E. Marchesi
 ;; Keywords: contacts, applications
 
-;; $Id: addressbook.el,v 1.1.1.1 2007/05/04 22:20:06 jemarch Exp $
+;; $Id: addressbook.el,v 1.2 2007/05/05 00:19:11 jemarch Exp $
 
 ;; This file is NOT part of GNU Emacs.
 
@@ -420,7 +420,7 @@
   (nth 3 property))
 
 (defun addrbook-get-prop-fields (property)
-  (let ((fields (nth 3 property))
+  (let ((fields (addrbook-get-prop-fields-list property))
         (result nil) field)
     (dolist (field fields)
       (setq result (cons (car field) result)))
@@ -436,7 +436,7 @@
   (cadr (assoc field-name fields)))
 
 (defun addrbook-get-prop-parameters (prop)
-  (cdr (cdr (cdr (cdr prop)))))
+  (nthcdr 4 prop))
 
 (defun addrbook-get-prop-parameter (prop param-name)
   (let ((prop-parameters (addrbook-get-prop-parameters prop)))
@@ -452,9 +452,8 @@
 
 (defun addrbook-property-in-group-p (attr group-props)
   (let ((attr-name (vcard-attr-get-name attr)))
-    (if (assoc attr-name group-props)
-        t
-      nil)))
+    (when (assoc attr-name group-props)
+      t)))
 
 (defun addrbook-get-property (attr-name)
   (let (group result)
@@ -468,9 +467,8 @@
 (defun addrbook-get-prop-default-type (prop-name)
   (let* ((property (addrbook-get-property prop-name))
          (prop-type (addrbook-get-prop-parameter property "type")))
-    (if prop-type
-        (car (car prop-type))
-      nil)))
+    (when prop-type
+      (car (car prop-type)))))
 
 ;;; Cards
 
@@ -492,26 +490,19 @@
 
 (defun addrbook-value-empty-p (values)
   "Return t if VALUES is empty"
-  (if (listp values)
+  (when (listp values)
       (if (cdr values)
-          (if (not (equal (car values) ""))
-              nil
+        (when (equal (car values) "")
             (addrbook-value-empty-p (cdr values)))
-        (if (not (equal (car values) ""))
-            nil
-          t))
-    (if values
-        nil
-      t)))
+      (equal (car values) ""))))
 
 (defun addrbook-number-of-values (values)
   (if (listp values)
       (let (value
             (nov 0))
-        (dolist (value values)
+        (dolist (value values nov)
           (if (not (equal value ""))
-              (setq nov (+ nov 1))))
-        nov)
+              (setq nov (+ nov 1)))))
     1))
 
 (defun addrbook-get-card-fn (&optional with-aka card-number)
@@ -536,31 +527,30 @@
          (name-suffix-p (and name-suffix
                              (not (equal name-suffix ""))))
          (result ""))
-    (if name-prefix-p
+    (when name-prefix-p
         (setq result (concat result name-prefix)))
-    (if name-first-name-p
-        (progn
-          (if name-prefix-p
-              (setq result (concat result " ")))
-          (setq result (concat result name-first-name))))
-    (if name-surname-p
-        (progn
-          (if (or name-prefix-p name-first-name-p)
-              (setq result (concat result " ")))
-          (setq result (concat result name-surname))))
-    (if name-suffix-p
-        (progn
-          (if (or name-prefix-p name-first-name-p name-surname-p)
-              (setq result (concat result " ")))
-          (setq result (concat result name-suffix))))
-    (if (and with-aka
-             name-aka-p)
-        (progn
-          (if (or name-prefix-p name-first-name-p name-surname-p
-                  name-suffix-p)
-              (setq result (concat result " ")))
+    (when name-first-name-p
+      (setq result (concat result
+                           (when name-prefix-p " ")
+                           name-first-name)))
+    (when name-surname-p
+      (setq result (concat result
+                           (when (or name-prefix-p 
+                                     name-first-name-p) " ")
+                           name-surname)))
+    (when name-suffix-p
+      (setq result (concat result
+                           (when (or name-prefix-p
+                                     name-first-name-p
+                                     name-surname-p) " ")
+                           name-suffix)))
+    (when (and with-aka name-aka-p)
           (setq result (concat result 
-                               (concat "(" name-aka ")")))))
+                           (when (or name-prefix-p
+                                     name-fist-name-p
+                                     name-surname-p
+                                     name-suffix-p) " ")
+                           "(" name-aka ")")))
     result))
 
 ;;; Attributes
@@ -638,10 +628,8 @@
 (defun addrbook-attribute-nodisplay (attr nodisplay-attrs)
   (let ((attr-name (vcard-attr-get-name attr)))
     (if nodisplay-attrs
-        (if (equal (car nodisplay-attrs) attr-name)
-            t
-          (addrbook-attribute-nodisplay attr (cdr nodisplay-attrs)))
-      nil)))
+      (or (equal (car nodisplay-attrs) attr-name)
+          (addrbook-attribute-nodisplay attr (cdr nodisplay-attrs))))))
 
 (defun addrbook-display-attribute (attr-index)
   "Display the ATTR-INDEXth attribute"
@@ -697,12 +685,11 @@
     (setq image-type
           (cadr (assoc photo-type addrbook-image-types)))
     ;; Display the image or a link
-    (if (and addrbook-display-images
+    (when (and addrbook-display-images
              (display-images-p)
              image-type
              (image-type-available-p image-type)
              (not (addrbook-photo-displayed-p)))
-        (progn
           ;; Get image data
           (if (equal photo-value "url")
               (save-excursion
@@ -726,7 +713,7 @@
                           (propertize "[photo]" 
                                       'identification-photo t
                                       'attr-index attr-index
-                                      'attr-subindex nil)))))))
+                                  'attr-subindex nil))))))
 
 (defun addrbook-display-attribute-regular (attr-index)
   (let* ((card (addrbook-get-card addrbook-current-card))
@@ -805,22 +792,19 @@
       (setq printable-type-list
             (cons (nth 1 (assoc attr-type type-param)) printable-type-list)))
     (setq printable-type-list (reverse printable-type-list))
-    (if attr-type-params
-        (progn
+    (when attr-type-params
           (insert " ")
           (insert "(")
           (insert (propertize
                    (addrbook-list-to-csv printable-type-list)
                    'face 'addrbook-attribute-type))
-          (insert ")")))))
+      (insert ")"))))
 
 (defun addrbook-group-hidden-p (group)
   (save-excursion
     (let ((group-exist (addrbook-goto-group group)))
-      (if (and group-exist
-               (get-text-property group-exist 'invisible))
-          t
-        nil))))
+      (and group-exist
+           (get-text-property group-exist 'invisible)))))
 
 (defun addrbook-hide-show-group (group show-p)
   "Hide GROUP attributes from the screen"
@@ -829,8 +813,7 @@
           (group-real-begin-pos nil)
           (group-end-pos nil)
           (group-begin-pos nil))
-      (if group-exist
-          (progn
+      (when group-exist
             (setq group-real-begin-pos (next-single-property-change (point) 
'group))
             (goto-char group-real-begin-pos)
             (setq group-end-pos (next-single-property-change (point) 'group))
@@ -843,17 +826,16 @@
                                           '(invisible nil)))
               (put-text-property group-real-begin-pos
                                  (- group-end-pos 1)
-                                 'invisible t)))))))
+                             'invisible t))))))
 
 (defun addrbook-get-current-group ()
   "Return the group affecting current buffer point, or nil"
   (let ((prop-change-pos (previous-single-property-change
                           (point) 'group)))
-    (if prop-change-pos
+    (when prop-change-pos
         (save-excursion
           (goto-char (- prop-change-pos 1))
-          (get-text-property (point) 'group))
-      nil)))
+        (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
@@ -863,8 +845,7 @@
                                (point) prop nil (line-end-position)))
         (previous-point-with-prop (previous-single-property-change
                                    (point) prop nil 
(line-beginning-position))))
-    (if current-point
-        current-point
+    (or current-point
       (if next-point-with-prop
           (get-text-property next-point-with-prop prop)
         (get-text-property previous-point-with-prop prop)))))
@@ -908,12 +889,11 @@
   "Redisplay GROUP in the screen"
   (save-excursion
     (let ((group-exist (addrbook-goto-group group)))
-      (if group-exist
-          (progn
+      (when group-exist
             ;; Remove old group contents
             (addrbook-erase-group-region)
             ;; Display the group
-            (addrbook-display-group (addrbook-get-group group)))))))
+        (addrbook-display-group (addrbook-get-group group))))))
       
 (defun addrbook-erase-tagged-region (tag)
   "Erase the region tagged with the same TAG value"
@@ -966,9 +946,7 @@
         (goto-char (+ (line-beginning-position) column-backup))))))
 
 (defun addrbook-group-in-display-p (group-symbol)
-  (if (addrbook-goto-group group-symbol)
-      t
-    nil))
+  (addrbook-goto-group group-symbol))
 
 (defun addrbook-photo-displayed-p ()
   (next-single-property-change (point-min) 'identification-photo))
@@ -981,11 +959,9 @@
     (insert-file-contents addrbook-file)
     (setq addrbook-cards (vcard-parse-region (point-min)
                                              (point-max)))
-    (if addrbook-cards
-        (progn
+    (when addrbook-cards
           (addrbook-make-params-explicit)
-          t)
-      nil)))
+      t)))
 
 (defun addrbook-make-params-explicit ()
   "Make unambiguous anonymous params explicit.
@@ -1118,7 +1094,6 @@
                                      "\"" (addrbook-get-card-fn) "\""
                                      " <" sendto-address ">"))))))
 
-
 (defun addrbook-add-attribute-type ()
   "Add a new type to the attribute under point"
   (interactive)
@@ -1141,8 +1116,7 @@
                   (if (equal (cadr type)
                              new-type)
                       (setq result (car type))))
-                (if result
-                    (progn
+                (when result
                       (if (addrbook-prop-parameter-allow-duplicates property 
"type")
                           ;; Add the new type
                           (vcard-attr-add-property attr "type" result)
@@ -1151,7 +1125,7 @@
                       ;; Redisplay attribute
                       (addrbook-redisplay-attr-at-point)
                       ;; Addressbook modified
-                      (add-to-list 'addrbook-modified-cards 
addrbook-current-card)))))))
+                  (add-to-list 'addrbook-modified-cards 
addrbook-current-card))))))
     (goto-char point-backup)))
 
 (defun addrbook-remove-attribute-type ()
@@ -1179,14 +1153,13 @@
                     (if (equal (cadr type)
                                new-type)
                         (setq result (car type))))
-                  (if result
-                      (progn
+                  (when result
                         ;; Add the new type
                         (vcard-attr-remove-property attr "type" result)
                         ;; Redisplay attribute
                         (addrbook-redisplay-attr-at-point)
                         ;; Addressbook modified
-                        (add-to-list 'addrbook-modified-cards 
addrbook-current-card))))))))
+                    (add-to-list 'addrbook-modified-cards 
addrbook-current-card)))))))
     (goto-char point-backup)))
 
 (defun addrbook-delete-card ()
@@ -1195,15 +1168,14 @@
   (let ((buffer-read-only nil)
         (current-card addrbook-current-card)
         (prompt "Are you sure you want to delete current contact? "))
-    (if (yes-or-no-p prompt)
-        (progn
+    (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))))))
+        (addrbook-display-card current-card)))))
 
 (defun addrbook-create-card ()
   "Create a new card"
@@ -1231,12 +1203,8 @@
              (group-attr (addrbook-get-group-prop group-attrs attr-name))
              (attr-title (addrbook-get-prop-title group-attr))
              (attr-fields (addrbook-get-prop-fields-list group-attr))
-             (attr-field (if attr-subindex
-                             (nth attr-subindex attr-fields)
-                           nil))
-             (attr-field-name (if attr-field
-                                  (addrbook-get-prop-field-name attr-field)
-                                nil))
+             (attr-field (when attr-subindex (nth attr-subindex attr-fields)))
+             (attr-field-name (when attr-field (addrbook-get-prop-field-name 
attr-field)))
              (prompt (concat "Are you sure you want to delete "
                              (if attr-subindex
                                  (concat "field " attr-field-name)
@@ -1258,11 +1226,10 @@
 (defun addrbook-add-attribute ()
   "Add a new attribute to the current card"
   (interactive)
-  (let* ((buffer-read-only nil)
+  (let* (buffer-read-only
          (backup-point (point))
-         (group-symbol nil)
-         (group nil)
-         (group-attrs nil)
+         group-symbol
+         group group-attrs 
          (i 0)
          (current-card (addrbook-get-card addrbook-current-card)))
     ;; Get group
@@ -1286,12 +1253,10 @@
                      field-index (property-value "") prompt 
                      (continue t)) 
                 ;; Get field
-                (if property-fields
-                    (progn
+                (when property-fields
                       (setq field-index (addrbook-select-field group-symbol 
property-name))
-                      (setq continue field-index)))
-                (if continue
-                    (progn
+                  (setq continue field-index))
+                (when continue
                       ;; Ask for a new value for the property or field
                       (setq prompt (concat 
                                     property-title
@@ -1340,7 +1305,7 @@
                         ;; Redisplay the entire card
                         (addrbook-redisplay-card))
                       ;; This card has been modified
-                      (add-to-list 'addrbook-modified-cards 
addrbook-current-card)))))))
+                  (add-to-list 'addrbook-modified-cards 
addrbook-current-card))))))
     (goto-char backup-point)))
 
 (defun addrbook-save-cards (prefix)
@@ -1359,7 +1324,7 @@
 (defun addrbook-next-card ()
   "Display the next card"
   (interactive)
-  (let ((buffer-read-only nil))
+  (let (buffer-read-only)
     (if (equal addrbook-current-card (- (length addrbook-cards) 1))
         (message "No more cards")
       (addrbook-display-card (+ addrbook-current-card 1)))))
@@ -1367,7 +1332,7 @@
 (defun addrbook-previous-card ()
   "Display the previous card"
   (interactive)
-  (let ((buffer-read-only nil))
+  (let (buffer-read-only)
     (if (equal addrbook-current-card 0)
         (message "First card")
       (addrbook-display-card (- addrbook-current-card 1)))))
@@ -1375,9 +1340,9 @@
 (defun addrbook-quit ()
   "Exit the addressbook"
   (interactive)
-  (if (not (equal (length addrbook-modified-cards) 0))
-      (if (yes-or-no-p "Save addressbook? ")
-          (addrbook-save-cards nil)))
+  (if (and (not (equal (length addrbook-modified-cards) 0))
+           (yes-or-no-p "Save addressbook? "))
+      (addrbook-save-cards nil))
   (if (equal (length (window-list)) 1)
       (progn
         (kill-buffer addrbook-buffer)
@@ -1436,16 +1401,13 @@
   "Leave the point at the beginning of the next group"
   (let ((next-point))
     (setq next-point (next-single-property-change (point) 'group))
-    (if next-point
-        (progn
+    (when next-point
           (if (get-text-property next-point 'group)
               (goto-char next-point)
             (goto-char next-point)
             (setq next-point (next-single-property-change (point) 'group))
-            (if next-point
-                (goto-char next-point)
-              nil)))
-      nil)))
+        (when next-point
+          (goto-char next-point))))))
 
 (defun addrbook-toggle-hide-show-group ()
   "When staying on a parameters group title, toggle visibility of the group"
@@ -1453,27 +1415,24 @@
   (let ((buffer-read-only nil)
         (group (get-text-property (point) 'group))
         (group-content-pos nil))
-    (if group
-        (progn
+    (when group
           ;; 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)
-              ;; Show the group
               (addrbook-hide-show-group group t)
-            ;; Hide the group
-            (addrbook-hide-show-group group nil))))))
+        (addrbook-hide-show-group group nil)))))
 
 (defun addrbook-hide-all-groups ()
   "Hide all displayed groups"
   (interactive)
-  (let ((buffer-read-only nil))
+  (let (buffer-read-only)
     (dolist (group addrbook-displayed-groups nil)
       (addrbook-hide-show-group group nil))))
 
 (defun addrbook-show-all-groups ()
   "Show all displayed groups"
   (interactive)
-  (let ((buffer-read-only nil))
+  (let (buffer-read-only)
     (dolist (group addrbook-displayed-groups nil)
       (addrbook-hide-show-group group t))))
 
@@ -1481,10 +1440,9 @@
   "Cycle to next group"
   (interactive)
   (let ((next-group-pos (addrbook-goto-next-group)))
-    (if (not next-group-pos)
-        (progn
+    (when (not next-group-pos)
           (goto-char (point-min))
-          (addrbook-goto-next-group)))))
+      (addrbook-goto-next-group))))
 
 ;;;; Modeline
 
@@ -1514,7 +1472,7 @@
          (buf (current-buffer))
          (fwidth (+ maxlen 3 1 3))
          (ncol (/ (- (window-width) 4) fwidth))
-         name count result char i (key-list nil))
+         name count result char i key-list)
     (save-window-excursion
       (set-buffer (get-buffer-create " *AddrBook Groups*"))
       (delete-other-windows)
@@ -1604,7 +1562,7 @@
 
 (defun addrbook-select-group ()
   "Select a group interactively and return its symbol"
-  (let ((names nil) group group-elt letter (result nil))
+  (let (names group group-elt letter result)
     ;; Build the names list
     (dolist (group-elt addrbook-properties)
       (setq names
@@ -1624,7 +1582,7 @@
   "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 nil) attr attr-elt letter (result nil))
+         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))
@@ -1648,7 +1606,7 @@
          (group-props (addrbook-get-group-props group))
          (property (assoc prop-name group-props))
          (prop-fields (addrbook-get-prop-fields-list property))
-         (letter nil) field result i)
+         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))
@@ -1749,15 +1707,14 @@
       (with-temp-file addrbook-file))
   (catch 'exit
     (let ((buffer (get-buffer addrbook-buffer-name)))
-      (if (not buffer)
-          (progn
-            (if (not (addrbook-read-cards))
-                (if (not (addrbook-create-card-2))
-                    (throw 'exit t)))
+      (when (not buffer)
+        (if (and (not (addrbook-read-cards))
+                 (not (addrbook-create-card-2)))
+            (throw 'exit t))
             (setq buffer (get-buffer-create addrbook-buffer-name))
             (set-buffer buffer)
             (addrbook-mode)
-            (addrbook-display-card 0)))
+        (addrbook-display-card 0))
       (switch-to-buffer-other-window buffer)
       (setq buffer-read-only t)
       (setq addrbook-buffer buffer))))