[Emacs-diffs] Changes to emacs/lisp/gnus/gnus-registry.el,v

[Miles Bader]

CVSROOT:        /cvsroot/emacs
Module name:    emacs
Changes by:     Miles Bader <miles>     08/03/10 00:50:23

Index: lisp/gnus/gnus-registry.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/gnus/gnus-registry.el,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -b -r1.22 -r1.23
--- lisp/gnus/gnus-registry.el  1 Mar 2008 01:28:13 -0000       1.22
+++ lisp/gnus/gnus-registry.el  10 Mar 2008 00:50:20 -0000      1.23
@@ -80,20 +80,20 @@
 
 (defcustom gnus-registry-marks
   '((Important
-     (char . ?i)
-     (image . "summary_important"))
+     :char ?i
+     :image "summary_important")
     (Work
-     (char . ?w)
-     (image . "summary_work"))
+     :char ?w
+     :image "summary_work")
     (Personal
-     (char . ?p)
-     (image . "summary_personal"))
+     :char ?p
+     :image "summary_personal")
     (To-Do
-     (char . ?t)
-     (image . "summary_todo"))
+     :char ?t
+     :image "summary_todo")
     (Later
-     (char . ?l)
-     (image . "summary_later")))
+     :char ?l
+     :image "summary_later"))
 
   "List of registry marks and their options.
 
@@ -106,14 +106,16 @@
 Each entry must have an image string to be useful for visual
 display."
   :group 'gnus-registry
-  :type '(alist :key-type symbol
-               :value-type (set :tag "Mark details"
-                                 (cons :tag "Shortcut" 
-                                       (const :tag "Character code" char)
-                                       character)
-                                 (cons :tag "Visual" 
-                                       (const :tag "Image" image) 
-                                       string))))
+  :type '(repeat :tag "Registry Marks"
+                (cons :tag "Mark"
+                      (symbol :tag "Name")
+                      (checklist :tag "Options" :greedy t
+                                 (group :inline t
+                                        (const :format "" :value :char)
+                                        (character :tag "Character code"))
+                                 (group :inline t
+                                        (const :format "" :value :image)
+                                        (string :tag "Image"))))))
 
 (defcustom gnus-registry-default-mark 'To-Do
   "The default mark.  Should be a valid key for `gnus-registry-marks'."
@@ -130,10 +132,12 @@
   :group 'gnus-registry
   :type '(repeat regexp))
 
-(defcustom gnus-registry-install nil
+(defcustom gnus-registry-install 'ask
   "Whether the registry should be installed."
   :group 'gnus-registry
-  :type 'boolean)
+  :type '(choice (const :tag "Never Install" nil)
+                (const :tag "Always Install" t)
+                (const :tag "Ask Me" ask)))
 
 (defcustom gnus-registry-clean-empty t
   "Whether the empty registry entries should be deleted.
@@ -700,21 +704,19 @@
 
 FUNCTION should take two parameters, a mark symbol and the cell value."
   (dolist (mark-info gnus-registry-marks)
-    (let ((mark (car-safe mark-info))
-         (data (cdr-safe mark-info)))
-      (dolist (cell data)
-       (let ((cell-type (car-safe cell))
-             (cell-data (cdr-safe cell)))
-         (when (equal type cell-type)
-           (funcall function mark cell-data)))))))
+    (let* ((mark (car-safe mark-info))
+          (data (cdr-safe mark-info))
+          (cell-data (plist-get data type)))
+      (when cell-data
+       (funcall function mark cell-data)))))
 
 ;;; this is ugly code, but I don't know how to do it better
-;;; TODO: clear the gnus-registry-mark-map before running
-(defun gnus-registry-install-shortcuts-and-menus ()
+(defun gnus-registry-install-shortcuts ()
   "Install the keyboard shortcuts and menus for the registry.
 Uses `gnus-registry-marks' to find what shortcuts to install."
+  (let (keys-plist)
   (gnus-registry-do-marks 
-   'char
+     :char
    (lambda (mark data)
      (let ((function-format
            (format "gnus-registry-%%s-article-%s-mark" mark)))
@@ -750,23 +752,48 @@
               (interactive 
                (gnus-summary-work-articles current-prefix-arg))
               ;; actual code
+
+                ;; if this is called and the user doesn't want the
+                ;; registry enabled, we'll ask anyhow
+                (when (eq gnus-registry-install nil)
+                  (setq gnus-registry-install 'ask))
+
+                ;; now the user is asked if gnus-registry-install is 'ask
+                (when (gnus-registry-install-p)
               (gnus-registry-set-article-mark-internal 
                ;; all this just to get the mark, I must be doing it wrong
                (intern ,(symbol-name mark))
-               articles ,remove t))))))))
-  ;; I don't know how to do this inside the loop above, because
-  ;; gnus-define-keys is a macro
-  (gnus-define-keys (gnus-registry-mark-map "M" gnus-summary-mark-map)
-    "i" gnus-registry-set-article-Important-mark
-    "I" gnus-registry-remove-article-Important-mark
-    "w" gnus-registry-set-article-Work-mark
-    "W" gnus-registry-remove-article-Work-mark
-    "l" gnus-registry-set-article-Later-mark
-    "L" gnus-registry-remove-article-Later-mark
-    "p" gnus-registry-set-article-Personal-mark
-    "P" gnus-registry-remove-article-Personal-mark
-    "t" gnus-registry-set-article-To-Do-mark
-    "T" gnus-registry-remove-article-To-Do-mark))
+                   articles ,remove t)
+                  (dolist (article articles)
+                    (gnus-summary-update-article 
+                     article 
+                     (assoc article (gnus-data-list nil)))))))
+            (push (intern function-name) keys-plist)
+            (push shortcut keys-plist)
+            (gnus-message 
+             9 
+             "Defined mark handling function %s" 
+             function-name))))))
+    (gnus-define-keys-1
+     '(gnus-registry-mark-map "M" gnus-summary-mark-map) 
+     keys-plist)))
+
+;;; use like this:
+;;; (defalias 'gnus-user-format-function-M 
+;;;           'gnus-registry-user-format-function-M)
+(defun gnus-registry-user-format-function-M (headers)
+  (let* ((id (mail-header-message-id headers))
+        (marks (when id (gnus-registry-fetch-extra-marks id))))
+    (apply 'concat (mapcar (lambda(mark)
+                            (let ((c 
+                                   (plist-get
+                                    (cdr-safe 
+                                     (assoc mark gnus-registry-marks))
+                                    :char)))
+                              (if c
+                                  (list c)
+                                nil)))
+                          marks))))
 
 (defun gnus-registry-read-mark ()
   "Read a mark name from the user with completion."
@@ -1033,10 +1060,12 @@
 
 ;;;###autoload
 (defun gnus-registry-initialize ()
+"Initialize the Gnus registry."
   (interactive)
-  (setq gnus-registry-install t)
+  (gnus-message 5 "Initializing the registry")
+  (setq gnus-registry-install t)       ; in case it was 'ask or nil
   (gnus-registry-install-hooks)
-  (gnus-registry-install-shortcuts-and-menus)
+  (gnus-registry-install-shortcuts)
   (gnus-registry-read))
 
 ;;;###autoload
@@ -1068,11 +1097,24 @@
 
 (add-hook 'gnus-registry-unload-hook 'gnus-registry-unload-hook)
 
-(when gnus-registry-install
-  (gnus-registry-install-hooks)
-  (gnus-registry-read))
+(defun gnus-registry-install-p ()
+  (interactive)
+  (when (eq gnus-registry-install 'ask)
+    (setq gnus-registry-install
+         (gnus-y-or-n-p
+          (concat "Enable the Gnus registry?  "
+                  "See the variable `gnus-registry-install' "
+                  "to get rid of this query permanently. ")))
+    (when gnus-registry-install
+      ;; we just set gnus-registry-install to t, so initialize the registry!
+      (gnus-registry-initialize)))
+;;; we could call it here: (customize-variable 'gnus-registry-install)
+  gnus-registry-install)
+
+(when (gnus-registry-install-p)
+  (gnus-registry-initialize))
 
-;; TODO: a lot of things
+;; TODO: a few things
 
 (provide 'gnus-registry)