- (dolist (remove '(t nil))
- (let* ((variant-name (if remove "remove" "set"))
- (function-name (format function-format variant-name))
- (shortcut (format "%c" data))
- (shortcut (if remove (upcase shortcut) shortcut)))
- (unintern function-name)
- (eval
- `(defun
- ;; function name
- ,(intern function-name)
- ;; parameter definition
- (&rest articles)
- ;; documentation
- ,(format
- "Apply the %s mark to process-marked ARTICLES."
- mark)
- ;; interactive definition
- (interactive
- (gnus-summary-work-articles current-prefix-arg))
- ;; actual code
- (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))
+ (dolist (remove '(t nil))
+ (let* ((variant-name (if remove "remove" "set"))
+ (function-name (format function-format variant-name))
+ (shortcut (format "%c" data))
+ (shortcut (if remove (upcase shortcut) shortcut)))
+ (unintern function-name obarray)
+ (eval
+ `(defun
+ ;; function name
+ ,(intern function-name)
+ ;; parameter definition
+ (&rest articles)
+ ;; documentation
+ ,(format
+ "%s the %s mark over process-marked ARTICLES."
+ (upcase-initials variant-name)
+ mark)
+ ;; interactive definition
+ (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)
+ (gnus-message
+ 9
+ "Applying mark %s to %d articles"
+ ,(symbol-name mark) (length articles))
+ (dolist (article articles)
+ (gnus-summary-update-article
+ article
+ (assoc article (gnus-data-list nil)))))))
+ (push (intern function-name) keys-plist)
+ (push shortcut keys-plist)
+ (push (vector (format "%s %s"
+ (upcase-initials variant-name)
+ (symbol-name mark))
+ (intern function-name) t)
+ gnus-registry-misc-menus)
+ (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)
+ (add-hook 'gnus-summary-menu-hook
+ (lambda ()
+ (easy-menu-add-item
+ gnus-summary-misc-menu
+ nil
+ (cons "Registry Marks" gnus-registry-misc-menus))))))
+
+;;; 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))))