[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] master bf82c71 2/2: Merge commit 'ae75eeb6f3a0fa8598d06c3b14ead86
|
From: |
Eric Abrahamsen |
|
Subject: |
[elpa] master bf82c71 2/2: Merge commit 'ae75eeb6f3a0fa8598d06c3b14ead8606918a446' |
|
Date: |
Sun, 12 Mar 2017 04:33:50 -0400 (EDT) |
branch: master
commit bf82c713b510b4ae13180e3eb3ceb4a147d02803
Merge: a390efc ae75eeb
Author: Eric Abrahamsen <address@hidden>
Commit: Eric Abrahamsen <address@hidden>
Merge commit 'ae75eeb6f3a0fa8598d06c3b14ead8606918a446'
---
packages/gnorb/NEWS | 13 +++
packages/gnorb/README.org | 23 ++---
packages/gnorb/gnorb-bbdb.el | 80 ++++++++---------
packages/gnorb/gnorb-gnus.el | 17 +++-
packages/gnorb/gnorb-org.el | 89 ++++++++++++------
packages/gnorb/gnorb-registry.el | 11 ++-
packages/gnorb/gnorb-utils.el | 190 ++++++++++++++++++++++++++++++---------
packages/gnorb/gnorb.el | 4 +-
packages/gnorb/nngnorb.el | 66 ++++++++------
9 files changed, 334 insertions(+), 159 deletions(-)
diff --git a/packages/gnorb/NEWS b/packages/gnorb/NEWS
index 623f685..e51edd9 100644
--- a/packages/gnorb/NEWS
+++ b/packages/gnorb/NEWS
@@ -1,5 +1,18 @@
GNU Emacs Gnorb NEWS -- history of user-visible changes. -*- org -*-
+* Version 1.1.3 [2017-03-12 Sun]
+** Provide a better interface for trigger action selection
+New function `gnorb-select-from-list' providing a nicer interface for
+choosing items from a list.
+** Change to format of gnorb-org-trigger-actions
+Due to previous item, this custom option has changed format, see
+docstring for details.
+** Compatibility with newest BBDB
+Updates to match newest version of BBDB in package repos (mostly with
+regard to displaying multi-line field values, BBDB is now
+lexically bound).
+** Many compiler fixes, and lexical binding
+Move to lexical binding.
* Version 1.1.0 [2015-04-23 Thu]
** New trigger actions
Two new trigger actions allow you to capture a new sibling or child
diff --git a/packages/gnorb/README.org b/packages/gnorb/README.org
index 9e2f9bd..7c45f2f 100644
--- a/packages/gnorb/README.org
+++ b/packages/gnorb/README.org
@@ -84,19 +84,9 @@ composing messages from... Or maybe it's just a case of NIH.
Provide an Org Agenda command that does an email search for messages
received in the visible date span, or day under point, etc. Make it
work in the calendar, as well?
-*** DONE Capture to child/subtree trigger actions
-:LOGBOOK:
-- State "DONE" from "TODO" [2015-03-17 Tue 17:42]
-:END:
-Add trigger actions that create new sibling or child headings on the
-original Org heading.
*** TODO Gnus message tagging
Allow tagging of Gnus messages, by giving the message's registry entry
an 'org-tags key.
-*** TODO Email subtree export to doc and rtf
-When using `gnorb-email-subtree', provide built-in options for
-exporting to doc and rtf attachments; these are such commonly-needed
-formats. Do the odt conversion automatically.
*** TODO Collect BBDB messages by thread
At present, when you collect message links on a BBDB contact, each
message is a separate link. If you have lengthy conversations with
@@ -112,3 +102,16 @@ automatically.
*** TODO gnorb-bbdb-view
Provide a `gnorb-bbdb-view' command that opens a Summary buffer
containing all the tracked messages from the contact(s) under point.
+*** DONE Email subtree export to doc and rtf
+:LOGBOOK:
+- State "DONE" from "TODO" [2017-03-11 Sat 12:35]
+:END:
+When using `gnorb-email-subtree', provide built-in options for
+exporting to doc and rtf attachments; these are such commonly-needed
+formats. Do the odt conversion automatically.
+*** DONE Capture to child/subtree trigger actions
+:LOGBOOK:
+- State "DONE" from "TODO" [2015-03-17 Tue 17:42]
+:END:
+Add trigger actions that create new sibling or child headings on the
+original Org heading.
diff --git a/packages/gnorb/gnorb-bbdb.el b/packages/gnorb/gnorb-bbdb.el
index 6603a5e..6ce7c5c 100644
--- a/packages/gnorb/gnorb-bbdb.el
+++ b/packages/gnorb/gnorb-bbdb.el
@@ -1,4 +1,4 @@
-;;; gnorb-bbdb.el --- The BBDB-centric functions of gnorb
+;;; gnorb-bbdb.el --- The BBDB-centric functions of gnorb -*-
lexical-binding: t -*-
;; Copyright (C) 2014 Free Software Foundation, Inc.
@@ -20,11 +20,16 @@
;;; Commentary:
-;;
+;; The Gnorb package has no hard dependency on BBDB, so you'll have to
+;; install it manually. Gnorb is compatible with whichever version of
+;; BBDB is current in the Emacs package manager. I believe it comes
+;; from Melpa.
;;; Code:
-(require 'bbdb nil t)
+(require 'bbdb)
+(require 'bbdb-com)
+(require 'bbdb-mua)
(require 'gnorb-utils)
(require 'cl-lib)
@@ -102,7 +107,7 @@ mentioned in the docstring of `format-time-string', which
see."
:group 'gnorb-bbdb
:type 'string)
-(defface gnorb-bbdb-link (org-compatible-face 'org-link nil)
+(defface gnorb-bbdb-link 'org-link
"Custom face for displaying message links in the *BBDB* buffer.
Defaults to org-link."
:group 'gnorb-bbdb)
@@ -145,10 +150,10 @@ returns either t or nil. In this case, the second element
of the
list is disregarded.
All following elements should be field setters for the message to
-be composed, just as in `gnus-posting-styles'.
+be composed, just as in `gnus-posting-styles'."
-An example value might look like:"
- :group 'gnorb-bbdb)
+ :group 'gnorb-bbdb
+ :type 'list)
(when (fboundp 'bbdb-record-xfield-string)
(fset (intern (format "bbdb-read-xfield-%s"
@@ -158,8 +163,8 @@ An example value might look like:"
(fset (intern (format "bbdb-display-%s-multi-line"
gnorb-bbdb-org-tag-field))
- (lambda (record)
- (gnorb-bbdb-display-org-tags record))))
+ (lambda (record indent)
+ (gnorb-bbdb-display-org-tags record indent))))
(defun gnorb-bbdb-read-org-tags (&optional init)
"Read Org mode tags, with `completing-read-multiple'."
@@ -171,12 +176,12 @@ An example value might look like:"
"[ \t\n]*"))
(crm-local-completion-map bbdb-crm-local-completion-map)
(table (cl-mapcar #'car
- (org-global-tags-completion-table
- (org-agenda-files))))
+ (org-global-tags-completion-table
+ (org-agenda-files))))
(init (if (consp init)
- (bbdb-join init
- (nth 2 (assq gnorb-bbdb-org-tag-field
- bbdb-separator-alist)))
+ (apply #'bbdb-concat (nth 2 (assq gnorb-bbdb-org-tag-field
+ bbdb-separator-alist))
+ init)
init)))
(completing-read-multiple
"Tags: " table
@@ -184,7 +189,7 @@ An example value might look like:"
(bbdb-split gnorb-bbdb-org-tag-field
(bbdb-read-string "Tags: " init))))
-(defun gnorb-bbdb-display-org-tags (record)
+(defun gnorb-bbdb-display-org-tags (record indent)
"Display the Org tags associated with the record.
Org tags are stored in the `gnorb-bbdb-org-tags-field'."
@@ -194,16 +199,14 @@ Org tags are stored in the `gnorb-bbdb-org-tags-field'."
record
gnorb-bbdb-org-tag-field)))
(when val
- ;; We already know that `fmt' and `indent' are dynamically
- ;; bound, shut up about it.
- (with-no-warnings
- (bbdb-display-text (format fmt gnorb-bbdb-org-tag-field)
- `(xfields ,full-field field-label)
- 'bbdb-field-name)
- (if (consp val)
- (bbdb-display-list val gnorb-bbdb-org-tag-field "\n")
- (insert
- (bbdb-indent-string (concat val "\n") indent)))))))
+ (bbdb-display-text (format (format " %%%ds: " (- indent 3))
+ gnorb-bbdb-org-tag-field)
+ `(xfields ,full-field field-label)
+ 'bbdb-field-name)
+ (if (consp val)
+ (bbdb-display-list val gnorb-bbdb-org-tag-field "\n")
+ (insert
+ (bbdb-indent-string (concat val "\n") indent))))))
(defvar message-mode-hook)
@@ -244,7 +247,7 @@ is non-nil (as in interactive calls) be verbose."
(defun gnorb-bbdb-configure-posting-styles (recs)
;; My most magnificent work of copy pasta!
(dolist (r recs)
- (let (field val label rec-val element filep
+ (let (field val label rec-val filep
element v value results name address)
(dolist (style gnorb-bbdb-posting-styles)
(setq field (pop style)
@@ -333,7 +336,6 @@ is non-nil (as in interactive calls) be verbose."
(setq name (assq 'name results)
address (assq 'address results))
(setq results (delq name (delq address results)))
- (gnus-make-local-hook 'message-setup-hook)
(setq results (sort results (lambda (x y)
(string-lessp (car x) (car y)))))
(dolist (result results)
@@ -442,7 +444,7 @@ a prefix arg and \"*\", the prefix arg must come first."
;;;###autoload
(defun gnorb-bbdb-cite-contact (rec)
- (interactive (list (gnorb-prompt-for-bbdb-record)))
+ (interactive (list (bbdb-completing-read-record "Record: ")))
(let ((mail-string (bbdb-dwim-mail rec)))
(if (called-interactively-p 'any)
(insert mail-string)
@@ -452,7 +454,7 @@ a prefix arg and \"*\", the prefix arg must come first."
(when (boundp 'bbdb-xfield-label-list)
(add-to-list 'bbdb-xfield-label-list gnorb-bbdb-messages-field nil 'eq))
-(defun gnorb-bbdb-display-messages (record format)
+(defun gnorb-bbdb-display-messages (record format &optional indent)
"Show links to the messages collected in the
`gnorb-bbdb-messages-field' field of a BBDB record. Each link
will be formatted using the format string in
@@ -468,14 +470,13 @@ layout type."
(define-key map (kbd "<RET>") 'gnorb-bbdb-RET-open-link)
(when val
(when (eq format 'multi)
- (with-no-warnings ; For `fmt'
- (bbdb-display-text (format fmt gnorb-bbdb-messages-field)
- `(xfields ,full-field field-label)
- 'bbdb-field-name)))
+ (bbdb-display-text (format (format " %%%ds: " (- indent 3))
+ gnorb-bbdb-messages-field)
+ `(xfields ,full-field field-label)
+ 'bbdb-field-name))
(insert (cond ((and (stringp val)
(eq format 'multi))
- (with-no-warnings ; For `indent'
- (bbdb-indent-string (concat val "\n") indent)))
+ (bbdb-indent-string (concat val "\n") indent))
((listp val)
;; Why aren't I using `bbdb-display-list' with a
;; preformatted list of messages?
@@ -510,8 +511,8 @@ layout type."
(fset (intern (format "bbdb-display-%s-multi-line"
gnorb-bbdb-messages-field))
- (lambda (record)
- (gnorb-bbdb-display-messages record 'multi)))
+ (lambda (record indent)
+ (gnorb-bbdb-display-messages record 'multi indent)))
(fset (intern (format "bbdb-display-%s-one-line"
gnorb-bbdb-messages-field))
@@ -522,7 +523,7 @@ layout type."
(fset (intern (format "bbdb-read-xfield-%s"
gnorb-bbdb-messages-field))
- (lambda (&optional init)
+ (lambda (&optional _init)
(user-error "This field shouldn't be edited manually")))
;; Open links from the *BBDB* buffer.
@@ -545,8 +546,7 @@ that contact will start collecting links to messages."
current-prefix-arg))
(unless (fboundp 'bbdb-record-xfield-string)
(user-error "This function only works with the git version of BBDB"))
- (let* ((record (bbdb-current-record))
- msg-list target-msg)
+ (let (msg-list target-msg)
(if (not (memq gnorb-bbdb-messages-field
(mapcar 'car (bbdb-record-xfields record))))
(when (y-or-n-p
diff --git a/packages/gnorb/gnorb-gnus.el b/packages/gnorb/gnorb-gnus.el
index e425ca2..dd46351 100644
--- a/packages/gnorb/gnorb-gnus.el
+++ b/packages/gnorb/gnorb-gnus.el
@@ -1,4 +1,4 @@
-;;; gnorb-gnus.el --- The gnus-centric fuctions of gnorb
+;;; gnorb-gnus.el --- The gnus-centric fuctions of gnorb -*- lexical-binding:
t -*-
;; Copyright (C) 2014 Free Software Foundation, Inc.
@@ -25,13 +25,22 @@
;;; Code:
(require 'gnus)
+(require 'gnus-sum)
+(require 'gnus-art)
+(require 'message)
+(require 'org)
+(require 'org-attach)
+(require 'org-capture)
(require 'gnorb-utils)
+(require 'mm-decode)
(declare-function org-gnus-article-link "org-gnus"
(group newsgroups message-id x-no-archive))
(declare-function org-gnus-follow-link "org-gnus"
(group article))
+(defvar org-refile-targets)
+
(defgroup gnorb-gnus nil
"The Gnus bits of Gnorb."
:tag "Gnorb Gnus"
@@ -160,7 +169,7 @@ each message."
(when data
(gnorb-gnus-attach-part data))))
-(defun gnorb-gnus-attach-part (handle &optional org-heading)
+(defun gnorb-gnus-attach-part (handle)
"Attach HANDLE to an existing org heading."
(let* ((filename (gnorb-gnus-save-part handle))
(org-refile-targets gnorb-gnus-trigger-refile-targets)
@@ -246,7 +255,7 @@ save them into `gnorb-tmp-dir'."
(when (and org-note-abort
(or gnorb-gnus-capture-always-attach
(org-capture-get :gnus-attachments)))
- (condition-case error
+ (condition-case nil
(progn (org-attach-delete-all)
(setq abort-note 'clean)
;; remove any gnorb-mail-header values here
@@ -744,7 +753,7 @@ option `gnorb-gnus-hint-relevant-article' is non-nil."
"M-x gnorb-gnus-incoming-do-todo")))
(t nil)))))
-(add-hook 'gnus-article-prepare-hook 'gnorb-gnus-hint-relevant-message)
+(add-hook 'gnus-select-article-hook 'gnorb-gnus-hint-relevant-message)
(defun gnorb-gnus-insert-format-letter-maybe (header)
(if (not (memq (car (gnus-find-method-for-group
diff --git a/packages/gnorb/gnorb-org.el b/packages/gnorb/gnorb-org.el
index 34cd803..bd787db 100644
--- a/packages/gnorb/gnorb-org.el
+++ b/packages/gnorb/gnorb-org.el
@@ -1,4 +1,4 @@
-;;; gnorb-org.el --- The Org-centric functions of gnorb
+;;; gnorb-org.el --- The Org-centric functions of gnorb -*- lexical-binding: t
-*-
;; Copyright (C) 2014 Free Software Foundation, Inc.
@@ -25,7 +25,25 @@
;;; Code:
(require 'gnorb-utils)
-(require 'cl-lib)
+(eval-when-compile (require 'cl-lib))
+
+(defvar gnorb-bbdb-posting-styles)
+(defvar gnorb-bbdb-org-tag-field)
+(defvar bbdb-buffer-name)
+(defvar message-alternative-emails)
+
+;; This many autoloads means either we should require bbdb outright,
+;; or something needs refactoring.
+(autoload 'gnorb-bbdb-configure-posting-styles "gnorb-bbdb")
+(autoload 'gnorb-registry-org-id-search "gnorb-registry")
+(autoload 'bbdb-completing-read-record "bbdb")
+(autoload 'bbdb-record-name "bbdb")
+(autoload 'bbdb-message-search "bbdb")
+(autoload 'bbdb-mail-address "bbdb")
+(autoload 'bbdb-record-xfield "bbdb")
+(autoload 'bbdb-records "bbdb")
+(autoload 'bbdb-search "bbdb")
+(autoload 'bbdb-display-records "bbdb")
(defgroup gnorb-org nil
"The Org bits of Gnorb."
@@ -39,12 +57,12 @@
:type 'hook)
(defcustom gnorb-org-trigger-actions
- '(("todo state" . todo)
- ("take note" . note)
- ("don't associate" . no-associate)
- ("only associate" . associate)
- ("capture to child" . cap-child)
- ("capture to sibling" . cap-sib))
+ '((?t "todo state" todo)
+ (?n "take note" note)
+ (?d "don't associate" no-associate)
+ (?o "only associate" associate)
+ (?c "capture to child" cap-child)
+ (?s "capture to sibling" cap-sib))
"List of potential actions that can be taken on headings.
When triggering an Org heading after receiving or sending a
@@ -64,12 +82,11 @@ The two \"capture\" options will use the value of
template.
You can also add custom actions to the list. Actions should be a
-cons of a string tag and a symbol indicating a custom function.
-This function will be called on the heading in question, and
-passed a plist containing information about the message from
-which we're triggering."
- :group 'gnorb-org
- :type 'list)
+list of three elements: a character key, a string tag and a
+symbol indicating a custom function. The custom function will be
+called on the heading in question, and passed a plist containing
+information about the message from which we're triggering."
+:group 'gnorb-org :type 'list :version "1.1.3")
(defcustom gnorb-org-msg-id-key "GNORB_MSG_ID"
"The name of the org property used to store the Message-IDs
@@ -81,6 +98,8 @@ which we're triggering."
(defcustom gnorb-org-mail-scan-scope 2
"Number of paragraphs to scan for mail-related links.
+Or set to 'all to scan the whole subtree.
+
When handling a TODO heading with `gnorb-org-handle-mail', Gnorb
will typically reply to the most recent message associated with
this heading. If there are no such messages, or message tracking
@@ -88,7 +107,10 @@ is disabled entirely, or `gnorb-org-handle-mail' has been
called
with a prefix arg, the heading and body text of the subtree under
point will instead be scanned for gnus:, mailto:, and bbdb:
links. This option controls how many paragraphs of body text to
-scan. Set to 0 to only look in the heading.")
+scan. Set to 0 to only look in the heading."
+ :group 'gnorb-org
+ :type '(choice (const :tag "Whole subtree" all)
+ (integer :tag "Number of paragraphs")))
(make-obsolete-variable
'gnorb-org-mail-scan-strategies
@@ -123,7 +145,7 @@ There's really no reason to use this instead of regular old
`org-insert-link' with BBDB completion. But there might be in the
future!"
;; this needs to handle an active region.
- (interactive (list (gnorb-prompt-for-bbdb-record)))
+ (interactive (list (bbdb-completing-read-record "Record: ")))
(let* ((name (bbdb-record-name rec))
(link (concat "bbdb:" (org-link-escape name))))
(org-store-link-props :type "bbdb" :name name
@@ -146,7 +168,7 @@ we came from."
(setq gnorb-message-org-ids nil)
(gnorb-restore-layout))
-(defun gnorb-org-extract-links (&optional arg region)
+(defun gnorb-org-extract-links (&optional _arg region)
"See if there are viable links in the subtree under point."
;; We're not currently using the arg. What could we do with it?
(let (strings)
@@ -177,7 +199,7 @@ we came from."
strings)
((numberp gnorb-org-mail-scan-scope)
(cl-subseq
- (nreverse strings)
+ (reverse strings)
0 (min
(length strings)
(1+ gnorb-org-mail-scan-scope))))
@@ -208,6 +230,17 @@ See the docstring of `gnorb-org-handle-mail' for details."
(gnorb-collect-ids)))))
(gnorb-org-extract-mail-tracking assoc-msg-ids arg region))))
+(defun gnorb-user-address-match-p (addr)
+ "Return t if ADDR seems to match the user's email address."
+ (cond
+ ((stringp message-alternative-emails)
+ (string-match-p message-alternative-emails
+ addr))
+ ((functionp message-alternative-emails)
+ (funcall message-alternative-emails addr))
+ (user-mail-address
+ (string-match-p user-mail-address addr))))
+
(defun gnorb-org-extract-mail-tracking (assoc-msg-ids &optional arg region)
(let* ((all-links (gnorb-org-extract-links nil region))
@@ -220,11 +253,8 @@ See the docstring of `gnorb-org-handle-mail' for details."
(cl-remove-if
(lambda (m)
(let ((from (car (gnus-registry-get-id-key m 'sender))))
- (or (null from)
- (string-match-p
- user-mail-address from)
- (string-match-p
- message-alternative-emails from))))
+ (and from
+ (null (gnorb-user-address-match-p from)))))
assoc-msg-ids)
(lambda (r l)
(time-less-p
@@ -480,7 +510,9 @@ async, subtreep, visible-only, and body-only."
"Correspondence between export backends and their
respective (usual) file extensions. Ugly way to do it, but what
the hey..."
- :group 'gnorb-org)
+ :group 'gnorb-org
+ :type '(repeat
+ (list symbol string)))
(defvar org-export-show-temporary-export-buffer)
@@ -545,7 +577,8 @@ default set of parameters."
"Should the capture process store a link to the gnus message or
BBDB record under point, even if it's not part of the template?
You'll probably end up needing it, anyway."
- :group 'gnorb-org)
+ :group 'gnorb-org
+ :type 'boolean)
(defun gnorb-org-capture-collect-link ()
(when gnorb-org-capture-collect-link-p
@@ -568,7 +601,8 @@ default set of parameters."
Records are considered matching if they have an `org-tags' field
matching the current Agenda search. The name of that field can be
customized with `gnorb-bbdb-org-tag-field'."
- :group 'gnorb-org)
+ :group 'gnorb-org
+ :type 'boolean)
(defcustom gnorb-org-bbdb-popup-layout 'pop-up-multi-line
"Default BBDB buffer layout for automatic Org Agenda display."
@@ -597,7 +631,7 @@ search."
(eq org-agenda-type 'tags))
(or (called-interactively-p 'any)
gnorb-org-agenda-popup-bbdb))
- (let ((todo-only nil)
+ (let ((org--matcher-tags-todo-only nil)
(str (or str org-agenda-query-string))
(re
"^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL\\([<=>]\\{1,2\\}\\)\\([0-9]+\\)\\|\\(\\(?:[[:alnum:]_]+\\(?:\\\\-\\)*\\)+\\)\\([<>=]\\{1,2\\}\\)\\({[^}]+}\\|\"[^\"]*\"\\|-?[.0-9]+\\(?:[eE][-+]?[0-9]+\\)?\\)\\|[[:alnum:address@hidden)")
or-terms term rest out-or acc tag-clause)
@@ -626,6 +660,7 @@ search."
rec-tags))
(case-fold-search t)
(org-trust-scanner-tags t))
+ ;; This is bad, we're lexically bound, now.
(eval tag-clause)))))
(bbdb-records))))))
((eq major-mode 'org-mode)
diff --git a/packages/gnorb/gnorb-registry.el b/packages/gnorb/gnorb-registry.el
index 565e54e..0e588d7 100644
--- a/packages/gnorb/gnorb-registry.el
+++ b/packages/gnorb/gnorb-registry.el
@@ -1,4 +1,4 @@
-;;; gnorb-registry.el --- Registry implementation for Gnorb
+;;; gnorb-registry.el --- Registry implementation for Gnorb -*-
lexical-binding: t -*-
;; Copyright (C) 2014 Free Software Foundation, Inc.
@@ -97,7 +97,7 @@ to the message's registry entry, under the `gnorb-ids' key."
(when (and (org-capture-get :gnorb-id)
org-note-abort)
(with-no-warnings ; For `abort-note'
- (condition-case error
+ (condition-case nil
(let* ((msg-id (format "<%s>" (plist-get org-store-link-plist
:message-id)))
(existing-org-ids (gnus-registry-get-id-key msg-id 'gnorb-ids))
(org-id (org-capture-get :gnorb-id)))
@@ -154,7 +154,7 @@ after an Org heading is deleted, for instance."
(let ((assoc-msgs (gnorb-registry-org-id-search org-id))
(gnorb-id-tracker
(registry-lookup-secondary gnus-registry-db 'gnorb-ids)))
- (mapcar
+ (mapc
(lambda (msg-id)
(let ((org-ids
(gnus-registry-get-id-key msg-id 'gnorb-ids)))
@@ -230,7 +230,7 @@ number of tracked messages, the number of tracked headings,
and how much of the
(gnorb-flush-dead-associations t)
(gnorb-refresh-usage-status))))))
-(defun gnorb-refresh-usage-status (&optional ignore-auto noconfirm)
+(defun gnorb-refresh-usage-status ()
"Clear and re-format the *Gnorb Usage* buffer."
(let ((messages (length (gnorb-registry-tracked-messages)))
(headings (length (gnorb-registry-tracked-headings)))
@@ -280,7 +280,7 @@ your Org files."
(let ((id (org-id-get))
(props (org-entry-get-multivalued-property
(point) gnorb-org-msg-id-key))
- links group id)
+ links)
(when props
;; If the property is set, we should probably assume that any
;; Gnus links in the subtree are relevant, and should also be
@@ -293,7 +293,6 @@ your Org files."
(cl-second (split-string l "#")) nil nil
id (cl-first (split-string l "#"))))
(dolist (p props)
- (setq id )
(gnorb-registry-make-entry p nil nil id nil)
;; This function will try to find the group for the message
;; and set that value on the registry entry if it can find
diff --git a/packages/gnorb/gnorb-utils.el b/packages/gnorb/gnorb-utils.el
index dcf2898..e2f7f7a 100644
--- a/packages/gnorb/gnorb-utils.el
+++ b/packages/gnorb/gnorb-utils.el
@@ -1,4 +1,4 @@
-;;; gnorb-utils.el --- Common utilities for all gnorb stuff.
+;;; gnorb-utils.el --- Common utilities for all gnorb stuff -*-
lexical-binding: t -*-
;; Copyright (C) 2014 Free Software Foundation, Inc.
@@ -24,14 +24,19 @@
;;; Code:
-(require 'cl-lib)
+(eval-when-compile (require 'cl-lib))
+(require 'pcase)
+(require 'org)
+(require 'org-agenda)
+(require 'org-element)
(require 'mailcap)
(mailcap-parse-mimetypes)
(defgroup gnorb nil
"Glue code between Gnus, Org, and BBDB."
- :tag "Gnorb")
+ :tag "Gnorb"
+ :group 'mail)
(make-obsolete-variable
'gnorb-trigger-todo-default
@@ -39,21 +44,6 @@
`gnorb-org-trigger-actions'"
"September 8, 2014" 'set)
-(defun gnorb-prompt-for-bbdb-record ()
- "Prompt the user for a BBDB record."
- (let ((recs (bbdb-records))
- name)
- (while (> (length recs) 1)
- (setq name
- (completing-read
- (format "Filter records by regexp (%d remaining): "
- (length recs))
- (mapcar 'bbdb-record-name recs)))
- (setq recs (bbdb-search recs name name name nil nil)))
- (if recs
- (car recs)
- (error "No matching records"))))
-
(defvar gnorb-tmp-dir (make-temp-file "emacs-gnorb" t)
"Temporary directory where attachments etc are saved.")
@@ -175,6 +165,8 @@ link.
3. Otherwise just follow the link as usual, in the current
window."
+ (unless (gnus-alive-p)
+ (gnus))
(let* ((sum-buffer (gnus-summary-buffer-name group))
(target-buffer
(cond
@@ -204,16 +196,118 @@ window."
;; We've probably already bracketed the id, but just in case this is
;; called from elsewhere...
(let* ((id (gnorb-bracket-message-id id))
- (art-no (cdr (gnus-request-head id group)))
(arts (gnus-group-unread group))
- success)
+ artno success)
+ (or (setq artno (car (gnus-registry-get-id-key id 'artno)))
+ (progn
+ (setq artno (cdr (gnus-request-head id group)))
+ (gnus-registry-set-id-key id 'artno (list artno))))
(gnus-activate-group group)
(setq success (gnus-group-read-group arts t group))
(if success
- (gnus-summary-goto-article (or art-no id) nil t)
+ (gnus-summary-goto-article artno nil t)
(signal 'error "Group could not be opened."))))
-(defun gnorb-trigger-todo-action (arg &optional id)
+;; I'd like to suggest this as a general addition to Emacs. *Very*
+;; tired of abusing `completing-read' for this purpose.
+(defconst gnorb-select-valid-chars
+ (append (number-sequence 97 122)
+ (number-sequence 65 90))
+ "A list of characters that are suitable for using as selection
+ keys.")
+
+(defvar gnorb-select-choice-buffer "*Selections*"
+ "The name of the buffer used to pop up selections.")
+
+(defun gnorb-select-from-list (prompt collection &optional key-func)
+ "Prompt the user to select something from COLLECTION.
+
+Selection can happen in a few different ways, depending on the
+nature of COLLECTION. Its elements can be:
+
+1. A plain string. Simply default to `completing-read'.
+
+2. (string object). The function uses `completing-read' on the
+ strings, returning the selected object.
+
+3. (number object). As above, but the user enters a number.
+
+4. (character string object). As #3, but \"string\" is displayed
+ as a string label for object.
+
+5. (number string object). As above, with numbers.
+
+COLLECTION can be passed in ready-made. Alternately, KEY-FUNC
+can be provided. The collection will be constructed by mapping
+this function over the list of objects, and then appending each
+object to the corresponding result. In other words, KEY-FUNC
+should return one of the types above, minus the final \"object\"
+element.
+
+Alternately, KEY-FUNC can be the symbol 'char, in which case the
+elements of COLLECTION will automatically be keyed to ascending
+characters (52 or fewer), or 'number, which does the same with
+numbers (no upper bound)."
+ (interactive)
+ (let ((len (length collection)))
+ (cl-labels ((pop-up-selections
+ (collection &optional charp)
+ (pop-to-buffer gnorb-select-choice-buffer
+ '(display-buffer-in-side-window ((side .
bottom))) t)
+ (dolist (c collection)
+ (insert (format "%s: %s\n"
+ (if charp
+ (char-to-string (car c))
+ (car c))
+ (nth 1 c))))))
+ (setq collection
+ (pcase key-func
+ ((pred null)
+ collection)
+ ('char
+ (if (> len 52)
+ (error "Use the char option with fewer than 52 items")
+ ;; These distinctions between char/string
+ ;; and number/char are totally manufactured.
+ (seq-mapn #'list gnorb-select-valid-chars collection)))
+ ('number
+ (seq-mapn #'list (number-sequence 1 len) collection))
+ ((and func (pred functionp))
+ (seq-map (lambda (el)
+ (let ((res (funcall func el)))
+ (if (atom res)
+ (list res el)
+ (append res
+ (list el)))))
+ collection))
+ (_ (error "Invalid key-func: %s" key-func))))
+ ;; We only test the car of collection to see what type it is. If
+ ;; elements are mismatched, it's not our problem.
+ (unwind-protect
+ (pcase (car collection)
+ ((pred stringp)
+ (completing-read prompt collection nil t))
+ ((pred symbolp)
+ (intern-soft (completing-read prompt collection nil t)))
+ (`(,(pred stringp) ,_)
+ (nth 1 (assoc (completing-read prompt collection nil t)
+ collection)))
+ ;; Looks like pcase might be the wrong tool for this job.
+ ((or `(,(and c (pred numberp) (guard (memq c
gnorb-select-valid-chars))) ,_)
+ `(,(and c (pred numberp) (guard (memq c
gnorb-select-valid-chars))) ,_ ,_))
+ (pop-up-selections collection t)
+ (car (last (assq (read-char
+ (propertize prompt 'face 'minibuffer-prompt))
+ collection))))
+ ((or `(,(pred numberp) ,_)
+ `(,(pred numberp) ,_ ,_))
+ (pop-up-selections collection)
+ (car (last (assq (read-number prompt)
+ collection)))))
+ (when-let ((win (get-buffer-window gnorb-select-choice-buffer)))
+ (quit-window win))))))
+
+(defun gnorb-trigger-todo-action (_arg &optional id)
"Do the actual restore action. Two main things here. First: if
we were in the agenda when this was called, then keep us in the
agenda. Then let the user choose an action from the value of
@@ -235,13 +329,11 @@ agenda. Then let the user choose an action from the value
of
(id (or id
(org-with-point-at root-marker
(org-id-get-create))))
- (action (cdr (assoc
- (org-completing-read
- (format
- "Trigger action on %s: "
- (gnorb-pretty-outline id))
- gnorb-org-trigger-actions nil t)
- gnorb-org-trigger-actions))))
+ (action (gnorb-select-from-list
+ (format
+ "Trigger action on %s: "
+ (gnorb-pretty-outline id))
+ gnorb-org-trigger-actions)))
(unless agenda-p
(org-reveal))
(cl-labels
@@ -401,24 +493,28 @@ message."
So far we're checking the registry, then the groups in
`gnorb-gnus-sent-groups'. Use search engines? Other clever
methods?"
- (let (candidates server-group)
+ (let (candidates server-group check)
(setq msg-id (gnorb-bracket-message-id msg-id))
(catch 'found
(when gnorb-tracking-enabled
- ;; Make a big list of all the groups where this message might
- ;; conceivably be.
- (setq candidates
- (append (gnus-registry-get-id-key msg-id 'group)
- gnorb-gnus-sent-groups))
- (while (setq server-group (pop candidates))
- (when (and (stringp server-group)
- (not
- (string-match-p
- "\\(nnir\\|nnvirtual\\|UNKNOWN\\)"
- server-group))
- (ignore-errors
- (gnus-request-head msg-id server-group)))
- (throw 'found server-group))))
+ (setq candidates (gnus-registry-get-id-key msg-id 'group))
+ (if (= 1 (length candidates))
+ (throw 'found (car candidates))
+ (setq candidates (append candidates gnorb-gnus-sent-groups))
+ (while (setq server-group (pop candidates))
+ (when (and (stringp server-group)
+ (string-match-p "+" server-group)
+ (not
+ (string-match-p
+ "\\(nnir\\|nnvirtual\\|UNKNOWN\\)"
+ server-group)))
+ (setq check
+ (ignore-errors
+ (gnus-request-head msg-id server-group)))
+ (when check
+ (gnus-registry-set-id-key msg-id 'group (list server-group))
+ (gnus-registry-set-id-key msg-id 'artno (list (cdr check)))
+ (throw 'found (car check)))))))
nil)))
(defun gnorb-collect-ids (&optional id)
@@ -499,10 +595,16 @@ registry be in use, and should be called after the call to
(require 'gnorb-registry)
(with-eval-after-load 'gnus-registry
(add-to-list 'gnus-registry-extra-entries-precious 'gnorb-ids)
+ (add-to-list 'gnus-registry-extra-entries-precious 'artno)
(add-to-list 'gnus-registry-track-extra 'gnorb-ids))
(add-hook
'gnus-started-hook
(lambda ()
+ ;; The require may be necessary in order to get
+ ;; `gnus-user-format-function-g' defined before it's used. That
+ ;; function is likely the first hit on gnorb-gnus, and there's no
+ ;; way to autoload it, as it is dynamically defined.
+ (require 'gnorb-gnus)
(unless (gnus-registry-install-p)
(user-error "Gnorb tracking requires that the Gnus registry be
installed."))
(add-hook 'org-capture-mode-hook 'gnorb-registry-capture)
diff --git a/packages/gnorb/gnorb.el b/packages/gnorb/gnorb.el
index d7e9289..3311e4a 100644
--- a/packages/gnorb/gnorb.el
+++ b/packages/gnorb/gnorb.el
@@ -1,8 +1,8 @@
-;;; gnorb.el --- Glue code between Gnus, Org, and BBDB
+;;; gnorb.el --- Glue code between Gnus, Org, and BBDB -*- lexical-binding: t
-*-
;; Copyright (C) 2014 Free Software Foundation, Inc.
-;; Version: 1.1.2
+;; Version: 1.1.3
;; Package-Requires: ((cl-lib "0.5"))
;; Maintainer: Eric Abrahamsen <address@hidden>
diff --git a/packages/gnorb/nngnorb.el b/packages/gnorb/nngnorb.el
index bb0ddfd..4d17c9b 100644
--- a/packages/gnorb/nngnorb.el
+++ b/packages/gnorb/nngnorb.el
@@ -1,4 +1,4 @@
-;;; nngnorb.el --- Gnorb backend for Gnus
+;;; nngnorb.el --- Gnorb backend for Gnus -*- lexical-binding: t -*-
;; Copyright (C) 2014 Free Software Foundation, Inc.
@@ -59,7 +59,7 @@
(add-to-list 'nnir-engines
'(gnorb nnir-run-gnorb))
-(defun nnir-run-gnorb (query server &optional group)
+(defun nnir-run-gnorb (query _server &optional _group)
"Run the actual search for messages to display. See nnir.el for
some details of how this gets called.
@@ -144,26 +144,33 @@ be scanned for gnus messages, and those messages
displayed."
(when rel-msg-id
(setq msg-ids (append (delq nil rel-msg-id) msg-ids)))))
(when msg-ids
- (dolist (id msg-ids)
- (let ((link (gnorb-msg-id-to-link id)))
- (when link
- (push link links)))))
- (setq links (delete-dups links))
+ (dolist (id msg-ids)
+ (let ((link (gnorb-msg-id-to-link id)))
+ (when link
+ (push link links)))))
+ (setq links (sort (delete-dups links) 'string<))
(unless (gnus-alive-p)
(gnus))
(dolist (m links (when vectors
- (nreverse vectors)))
- (let (server-group msg-id result artno)
+ (reverse vectors)))
+ (let (server-group msg-id artno check)
(setq m (org-link-unescape m))
(when (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" m)
(setq server-group (match-string 1 m)
msg-id (gnorb-bracket-message-id
(match-string 3 m))
- result (ignore-errors (gnus-request-head msg-id
server-group)))
- (when result
- (setq artno (cdr result))
- (when (and (integerp artno) (> artno 0))
- (push (vector server-group artno 100) vectors)))))))))
+ artno (or (car (gnus-registry-get-id-key msg-id 'artno))
+ (when (setq check
+ (cdr (ignore-errors
+ (gnus-request-head
+ msg-id server-group))))
+ (gnus-registry-set-id-key
+ msg-id 'artno
+ (list check))
+ check)))
+ (when artno
+ (when (and (integerp artno) (> artno 0))
+ (push (vector server-group artno 100) vectors)))))))))
(defvar gnorb-summary-minor-mode-map (make-sparse-keymap)
"Keymap for use in Gnorb's *Summary* minor mode.")
@@ -259,10 +266,17 @@ continue to provide tracking of sent messages."
(gnus-summary-mail-forward n t)
(gnorb-summary-reply-hook))
-(defun gnorb-summary-reply-hook (&rest args)
+(defun gnorb-summary-reply-hook (&rest _args)
"Function that runs after any command that creates a reply."
;; Not actually a "hook"
- (let* ((msg-id (aref message-reply-headers 4))
+ (let* ((msg-id (if message-reply-headers
+ (aref message-reply-headers 4)
+ ;; When forwarding messages,
+ ;; `message-reply-headers' is nil.
+ (save-excursion
+ (let ((case-fold-search t))
+ (when (re-search-forward "message-id: +\\(.*\\)$"
(point-max) t)
+ (match-string 1))))))
(org-id (car-safe (gnus-registry-get-id-key msg-id 'gnorb-ids)))
(compose-marker (make-marker))
(attachments (buffer-local-value
@@ -341,31 +355,31 @@ the message being included in this search."
(defvar nngnorb-status-string "")
-(defun nngnorb-retrieve-headers (articles &optional group server fetch-old)
+(defun nngnorb-retrieve-headers (_articles &optional _group _server _fetch-old)
(with-current-buffer nntp-server-buffer
(erase-buffer))
'nov)
-(defun nngnorb-open-server (server &optional definitions)
+(defun nngnorb-open-server (_server &optional _definitions)
t)
-(defun nngnorb-close-server (&optional server)
+(defun nngnorb-close-server (&optional _server)
t)
(defun nngnorb-request-close ()
t)
-(defun nngnorb-server-opened (&optional server)
+(defun nngnorb-server-opened (&optional _server)
t)
-(defun nngnorb-status-message (&optional server)
+(defun nngnorb-status-message (&optional _server)
nngnorb-status-string)
-(defun nngnorb-request-article (article &optional group server to-buffer)
+(defun nngnorb-request-article (_article &optional _group _server _to-buffer)
(setq nngnorb-status-string "No such group")
nil)
-(defun nngnorb-request-group (group &optional server fast info)
+(defun nngnorb-request-group (_group &optional _server _fast _info)
(let (deactivate-mark)
(with-current-buffer nntp-server-buffer
(erase-buffer)
@@ -373,15 +387,15 @@ the message being included in this search."
(setq nngnorb-status-string "No such group")
nil)
-(defun nngnorb-close-group (group &optional server)
+(defun nngnorb-close-group (_group &optional _server)
t)
-(defun nngnorb-request-list (&optional server)
+(defun nngnorb-request-list (&optional _server)
(with-current-buffer nntp-server-buffer
(erase-buffer))
t)
-(defun nngnorb-request-post (&optional server)
+(defun nngnorb-request-post (&optional _server)
(setq nngnorb-status-string "Read-only server")
nil)
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [elpa] master bf82c71 2/2: Merge commit 'ae75eeb6f3a0fa8598d06c3b14ead8606918a446',
Eric Abrahamsen <=