[elpa] master 0d69d15 3/4: Squashed 'packages/gnorb/' changes from 4e7039a..a387d85
branch: master commit 0d69d15d20b69f439c1a1ed451e06f77b1252b3e Author: Eric Abrahamsen Commit: Eric Abrahamsen Squashed 'packages/gnorb/' changes from 4e7039a..a387d85 a387d85 Bump version to 1.1.0 git-subtree-dir: packages/gnorb git-subtree-split: a387d8515871d9f06b193a461745697eb25f3872 --- NEWS | 10 ++ gnorb.el |2 +- 2 files changed, 11 insertions(+), 1 deletions(-) diff --git a/NEWS b/NEWS index 59bc343..623f685 100644 --- a/NEWS +++ b/NEWS @@ -1,5 +1,15 @@ GNU Emacs Gnorb NEWS -- history of user-visible changes. -*- org -*- +* Version 1.1.0 [2015-04-23 Thu] +** New trigger actions +Two new trigger actions allow you to capture a new sibling or child +heading relative to the heading you're triggering. +** Persistent Gnorb groups +Give a prefix argument to `gnorb-org-view' to create a named, +persistent group containing tracked headings. +** Gnorb registry usage reports +Call `gnorb-report-tracking-usage' to see how much of the Gnus +registry Gnorb is occupying, and run cleaning routines. * Version 1.0.1 [2014-10-22 Wed] ** Deleting associations It's now possible to delete associations between messages and diff --git a/gnorb.el b/gnorb.el index cb7d908..35db4f6 100644 --- a/gnorb.el +++ b/gnorb.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2014 Free Software Foundation, Inc. -;; Version: 1.0.1 +;; Version: 1.1.0 ;; Package-Requires: ((cl-lib "0.5")) ;; Maintainer: Eric Abrahamsen
[elpa] master f9b63e4 4/4: Merge commit '0d69d15d20b69f439c1a1ed451e06f77b1252b3e' from gnorb
branch: master commit f9b63e405daf25088fa663c3a1c65f66701b914a Merge: 57629db 0d69d15 Author: Eric Abrahamsen Commit: Eric Abrahamsen Merge commit '0d69d15d20b69f439c1a1ed451e06f77b1252b3e' from gnorb --- packages/gnorb/NEWS | 10 ++ packages/gnorb/gnorb.el |2 +- 2 files changed, 11 insertions(+), 1 deletions(-) diff --git a/packages/gnorb/NEWS b/packages/gnorb/NEWS index 59bc343..623f685 100644 --- a/packages/gnorb/NEWS +++ b/packages/gnorb/NEWS @@ -1,5 +1,15 @@ GNU Emacs Gnorb NEWS -- history of user-visible changes. -*- org -*- +* Version 1.1.0 [2015-04-23 Thu] +** New trigger actions +Two new trigger actions allow you to capture a new sibling or child +heading relative to the heading you're triggering. +** Persistent Gnorb groups +Give a prefix argument to `gnorb-org-view' to create a named, +persistent group containing tracked headings. +** Gnorb registry usage reports +Call `gnorb-report-tracking-usage' to see how much of the Gnus +registry Gnorb is occupying, and run cleaning routines. * Version 1.0.1 [2014-10-22 Wed] ** Deleting associations It's now possible to delete associations between messages and diff --git a/packages/gnorb/gnorb.el b/packages/gnorb/gnorb.el index 0c9557e..ead6ac3 100644 --- a/packages/gnorb/gnorb.el +++ b/packages/gnorb/gnorb.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2014 Free Software Foundation, Inc. -;; Version: 1.0.1 +;; Version: 1.1.0 ;; Package-Requires: ((cl-lib "0.5")) ;; Maintainer: Eric Abrahamsen
[elpa] master updated (c7a6156 -> f9b63e4)
girzel pushed a change to branch master. from c7a6156 Merge commit 'e2452a3e77ef6ea6b193292d2c0bbbe93dd4b078' from swiper new 3e5c11a Squashed 'packages/gnorb/' changes from 321b23b..4e7039a new 57629db Merge commit '3e5c11a13981a1ff613cb4442ad644285c44e481' from gnorb new 0d69d15 Squashed 'packages/gnorb/' changes from 4e7039a..a387d85 new f9b63e4 Merge commit '0d69d15d20b69f439c1a1ed451e06f77b1252b3e' from gnorb Summary of changes: packages/gnorb/NEWS | 10 ++ packages/gnorb/README.org| 29 - packages/gnorb/gnorb-bbdb.el | 37 ++--- packages/gnorb/gnorb-gnus.el | 288 ++ packages/gnorb/gnorb-org.el | 46 --- packages/gnorb/gnorb-registry.el | 132 ++--- packages/gnorb/gnorb-utils.el| 162 +++--- packages/gnorb/gnorb.el | 10 +- packages/gnorb/gnorb.info| 199 ++- packages/gnorb/gnorb.org | 108 +++ packages/gnorb/gnorb.texi| 132 + packages/gnorb/nngnorb.el| 34 +++-- 12 files changed, 839 insertions(+), 348 deletions(-)
[elpa] master 57629db 2/4: Merge commit '3e5c11a13981a1ff613cb4442ad644285c44e481' from gnorb
branch: master commit 57629db9a7dc542f17f553ce362dacd01db70279 Merge: c7a6156 3e5c11a Author: Eric Abrahamsen Commit: Eric Abrahamsen Merge commit '3e5c11a13981a1ff613cb4442ad644285c44e481' from gnorb --- packages/gnorb/README.org| 29 - packages/gnorb/gnorb-bbdb.el | 37 ++--- packages/gnorb/gnorb-gnus.el | 288 ++ packages/gnorb/gnorb-org.el | 46 --- packages/gnorb/gnorb-registry.el | 132 ++--- packages/gnorb/gnorb-utils.el| 162 +++--- packages/gnorb/gnorb.el |8 +- packages/gnorb/gnorb.info| 199 ++- packages/gnorb/gnorb.org | 108 +++ packages/gnorb/gnorb.texi| 132 + packages/gnorb/nngnorb.el| 34 +++-- 11 files changed, 828 insertions(+), 347 deletions(-) diff --git a/packages/gnorb/README.org b/packages/gnorb/README.org index 1f8f82f..9e2f9bd 100644 --- a/packages/gnorb/README.org +++ b/packages/gnorb/README.org @@ -16,7 +16,31 @@ mini mailboxes. *Note for previous users*: If you were using Gnorb from Github before it shifted to the Elpa repository, the email tracking mechanism has changed, please see the manual for details. +** Known bugs/issues +*** Gnus Registry +Prior to late December, 2014, the Gnus registry had some issues with +preserving "precious" entries while pruning. +When the registry approaches its maximum size it will delete excess +entries, a process referred to as "pruning". "Precious" entries are +those that contain important information: they should not be pruned. + +Gnorb uses the registry to track associations between messages and Org +headings, and marks those entries as precious. The entire process of +tracking, in fact, relies on these entries being preserved, and Gnorb +goes to some lengths to protect this information. Older versions of +the registry could nevertheless delete those entries. + +These issues are fixed circa the end of December, 2014, around "Ma +Gnus v0.12", whatever that means. If you think there's a possibility +your registry is full, and associations are being deleted, you might +consider upgrading to a recent Gnus. +*** Multiple Associations +Gnorb theoretically supports email messages being associated with +multiple Org headings. In practice, however, this situation hasn't +been thought through completely, and you may experience weirdness. If +you do, and you have some ideas about how it should be handled, please +contact the author and suggest them. ** Installation It's easiest to install Gnorb from Elpa: run `list-packages' and look @@ -60,7 +84,10 @@ 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? -*** TODO Capture to child/subtree trigger actions +*** 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 diff --git a/packages/gnorb/gnorb-bbdb.el b/packages/gnorb/gnorb-bbdb.el index 572a4b9..eb2f6eb 100644 --- a/packages/gnorb/gnorb-bbdb.el +++ b/packages/gnorb/gnorb-bbdb.el @@ -150,8 +150,6 @@ be composed, just as in `gnus-posting-styles'. An example value might look like:" :group 'gnorb-bbdb) -(defvar message-mode-hook) - (when (fboundp 'bbdb-record-xfield-string) (fset (intern (format "bbdb-read-xfield-%s" gnorb-bbdb-org-tag-field)) @@ -207,6 +205,8 @@ Org tags are stored in the `gnorb-bbdb-org-tags-field'." (insert (bbdb-indent-string (concat val "\n") indent))) +(defvar message-mode-hook) + ;;;###autoload (defun gnorb-bbdb-mail (records &optional subject n verbose) "\\Acts just like `bbdb-mail', except runs @@ -392,14 +392,16 @@ both, use \"C-u\" before the \"*\"." (mapconcat 'identity (delete-dups - (cl-mapcan (lambda (r) -(bbdb-record-xfield-split r gnorb-bbdb-org-tag-field)) - records)) + (cl-mapcan + (lambda (r) + (bbdb-record-xfield-split r gnorb-bbdb-org-tag-field)) + records)) "|"))) (if tag-string ;; C-u = all headings, not just todos - (org-tags-view (not (equal current-prefix-arg '(4))) - tag-string) + (if (equal current-prefix-arg '(4)) + (org-tags-view nil tag-string) + (org-tags-view t tag-string)) (error "No org-tags field present" ;;;###autoload @@ -424
[elpa] master 3e5c11a 1/4: Squashed 'packages/gnorb/' changes from 321b23b..4e7039a
branch: master commit 3e5c11a13981a1ff613cb4442ad644285c44e481 Author: Eric Abrahamsen Commit: Eric Abrahamsen Squashed 'packages/gnorb/' changes from 321b23b..4e7039a 4e7039a Various compiler-inspired improvements 9b2b269 Use with-eval-after-load not eval-after-load 86fa893 Fix up all cl-lib calls a59dac2 Use hook for determining Gnorb summary minor mode 4d3de61 Various documentation improvements acb91c5 Fix doc error 6fd368d Provide more format marks in summary buffers d9a1d89 Remove unused let variable 3f9c534 Report Gnorb email tracking usage 0f18c45 Allow persistent nnir search groups 2d30b0c Reset window conf after nnir-run-gnorb 160f43a New function for returning all tracked messages 9efae5a Fix call to cl-subseq ce764a5 fixup with new quick reply command b0fe9ae New command `gnorb-gnus-quick-reply' 5897188 Capture to child/sibling is done 4f99dd7 Handle conditions where `registry-search' returns nil b951675 Merge capture-to-child branch 13bb840 Hint which heading will be triggered c13f4df Better check for capture cleanup dfa0043 Safer usage of cl-subseq 94fe1b8 Incorporate changes from Stefan M d2e1e11 Mention registry bugs in README a4089f8 Fix completing-read in message disassociation 9c910c9 Re-raise errors in the triggering process 648f5a7 Remove process mark after bulk association 84ff7a7 Don't let attach errors derail the trigger process 819b1e5 Suggest binding gnorb-org-view in Org Agenda 9d64acb Update gnorb-registry-capture to use convenience funcs cc7d45b Be more careful handling org tags on BBDB records f585c03 condition-case the incoming trigger process 821a6b2 Allow bulk association of messages 4b19c83 New function for pruning dead associations 09679fa Misspelled function name 41c6778 nngnorb should be a virtual server 6e6ee46 Zap another with-eval-after-load c3279d2 Fix tracking messages from virtual groups 9220a10 Docstring fix c8b80c5 Bugfix for gnorb-gnus-view 8c333ee Merge pull request #20 from totherme/master 3801ad7 Check both gnus version and emacs version. 94f6897 Don't use with-eval-after-load fd91084 Remove incorrect "fix" for Gnus 5.13 8a9c167 Fix the cl-lib loading stuff git-subtree-dir: packages/gnorb git-subtree-split: 4e7039a15b47244e7bd2c580d8bce976a6116b5a --- README.org| 29 ++- gnorb-bbdb.el | 41 - gnorb-gnus.el | 280 - gnorb-org.el | 60 +++ gnorb-registry.el | 118 +++--- gnorb-utils.el| 169 ++-- gnorb.el | 11 +- gnorb.info| 199 +- gnorb.org | 108 +++-- gnorb.texi| 132 +++-- nngnorb.el| 36 --- 11 files changed, 834 insertions(+), 349 deletions(-) diff --git a/README.org b/README.org index 1f8f82f..9e2f9bd 100644 --- a/README.org +++ b/README.org @@ -16,7 +16,31 @@ mini mailboxes. *Note for previous users*: If you were using Gnorb from Github before it shifted to the Elpa repository, the email tracking mechanism has changed, please see the manual for details. +** Known bugs/issues +*** Gnus Registry +Prior to late December, 2014, the Gnus registry had some issues with +preserving "precious" entries while pruning. +When the registry approaches its maximum size it will delete excess +entries, a process referred to as "pruning". "Precious" entries are +those that contain important information: they should not be pruned. + +Gnorb uses the registry to track associations between messages and Org +headings, and marks those entries as precious. The entire process of +tracking, in fact, relies on these entries being preserved, and Gnorb +goes to some lengths to protect this information. Older versions of +the registry could nevertheless delete those entries. + +These issues are fixed circa the end of December, 2014, around "Ma +Gnus v0.12", whatever that means. If you think there's a possibility +your registry is full, and associations are being deleted, you might +consider upgrading to a recent Gnus. +*** Multiple Associations +Gnorb theoretically supports email messages being associated with +multiple Org headings. In practice, however, this situation hasn't +been thought through completely, and you may experience weirdness. If +you do, and you have some ideas about how it should be handled, please +contact the author and suggest them. ** Installation It's easiest to install Gnorb from Elpa: run `list-packages' and look @@ -60,7 +84,10 @@ 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
[elpa] master 510f0ff 2/2: Merge commit 'faf966b6b5921074da6b99477e1f0bea29b45f6f'
branch: master commit 510f0ff8885932ebd0322b8f5bc4efc943be512e Merge: 34753b4 faf966b Author: Eric Abrahamsen Commit: Eric Abrahamsen Merge commit 'faf966b6b5921074da6b99477e1f0bea29b45f6f' --- packages/gnorb/gnorb-gnus.el |7 +++ packages/gnorb/gnorb-org.el |2 +- packages/gnorb/gnorb.el |2 +- 3 files changed, 5 insertions(+), 6 deletions(-) diff --git a/packages/gnorb/gnorb-gnus.el b/packages/gnorb/gnorb-gnus.el index a77a7ed..e425ca2 100644 --- a/packages/gnorb/gnorb-gnus.el +++ b/packages/gnorb/gnorb-gnus.el @@ -309,10 +309,7 @@ information about the outgoing message into 'gnorb-org-restore-after-send t)) (setq gnorb-message-org-ids nil) -;; This sets the global value, but the hook is made buffer-local in -;; `gnus-inews-add-send-actions', so this is ignored -;(add-hook 'message-header-hook 'gnorb-gnus-check-outgoing-headers) -(add-hook 'message-send-hook 'gnorb-gnus-check-outgoing-headers t) +(add-hook 'message-sent-hook 'gnorb-gnus-check-outgoing-headers t) ;;;###autoload (defun gnorb-gnus-outgoing-do-todo (&optional arg) @@ -628,6 +625,8 @@ reply." (targ (car-safe related-headings))) (if targ (let ((ret (make-marker))) + (setq gnorb-window-conf (current-window-configuration)) + (move-marker gnorb-return-marker (point)) ;; Assume the first heading is the one we want. (gnorb-registry-make-entry msg-id from subject targ group) diff --git a/packages/gnorb/gnorb-org.el b/packages/gnorb/gnorb-org.el index 3392111..78d636b 100644 --- a/packages/gnorb/gnorb-org.el +++ b/packages/gnorb/gnorb-org.el @@ -164,7 +164,7 @@ we came from." :raw-value head) strings) - (org-element-map tree 'paragraph + (org-element-map tree '(paragraph drawer) (lambda (p) (push (org-element-interpret-data p) strings)) diff --git a/packages/gnorb/gnorb.el b/packages/gnorb/gnorb.el index ead6ac3..d2800f0 100644 --- a/packages/gnorb/gnorb.el +++ b/packages/gnorb/gnorb.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2014 Free Software Foundation, Inc. -;; Version: 1.1.0 +;; Version: 1.1.1 ;; Package-Requires: ((cl-lib "0.5")) ;; Maintainer: Eric Abrahamsen
[elpa] master faf966b 1/2: Squashed 'packages/gnorb/' changes from a387d85..538b5bd
branch: master commit faf966b6b5921074da6b99477e1f0bea29b45f6f Author: Eric Abrahamsen Commit: Eric Abrahamsen Squashed 'packages/gnorb/' changes from a387d85..538b5bd 538b5bd Bump version to 1.1.1 209b938 Attach outgoing message check to message-sent-hook 51439a1 Look in drawers for potential mail links 2783829 Save return config for quick reply git-subtree-dir: packages/gnorb git-subtree-split: 538b5bd743b430d914d3a3046ad6545418c238a1 --- gnorb-gnus.el |7 +++ gnorb-org.el |2 +- gnorb.el |2 +- 3 files changed, 5 insertions(+), 6 deletions(-) diff --git a/gnorb-gnus.el b/gnorb-gnus.el index a77a7ed..e425ca2 100644 --- a/gnorb-gnus.el +++ b/gnorb-gnus.el @@ -309,10 +309,7 @@ information about the outgoing message into 'gnorb-org-restore-after-send t)) (setq gnorb-message-org-ids nil) -;; This sets the global value, but the hook is made buffer-local in -;; `gnus-inews-add-send-actions', so this is ignored -;(add-hook 'message-header-hook 'gnorb-gnus-check-outgoing-headers) -(add-hook 'message-send-hook 'gnorb-gnus-check-outgoing-headers t) +(add-hook 'message-sent-hook 'gnorb-gnus-check-outgoing-headers t) ;;;###autoload (defun gnorb-gnus-outgoing-do-todo (&optional arg) @@ -628,6 +625,8 @@ reply." (targ (car-safe related-headings))) (if targ (let ((ret (make-marker))) + (setq gnorb-window-conf (current-window-configuration)) + (move-marker gnorb-return-marker (point)) ;; Assume the first heading is the one we want. (gnorb-registry-make-entry msg-id from subject targ group) diff --git a/gnorb-org.el b/gnorb-org.el index d54e9ba..99e5247 100644 --- a/gnorb-org.el +++ b/gnorb-org.el @@ -164,7 +164,7 @@ we came from." :raw-value head) strings) - (org-element-map tree 'paragraph + (org-element-map tree '(paragraph drawer) (lambda (p) (push (org-element-interpret-data p) strings)) diff --git a/gnorb.el b/gnorb.el index 35db4f6..63124d9 100644 --- a/gnorb.el +++ b/gnorb.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2014 Free Software Foundation, Inc. -;; Version: 1.1.0 +;; Version: 1.1.1 ;; Package-Requires: ((cl-lib "0.5")) ;; Maintainer: Eric Abrahamsen
[elpa] master 990d508: New option gnorb-org-log-add-link
branch: master commit 990d508978ce5aae51228eae37186d50cedb8583 Author: Eric Abrahamsen Commit: Eric Abrahamsen New option gnorb-org-log-add-link * packages/gnorb/gnorb-org.el (gnorb-org-log-add-link): When non-nil, a message link will be added to any log note that is taken as part of the trigger process. * packages/gnorb/gnorb-utils.el (gnorb-trigger-todo-action): Maybe add link to log note. (gnorb-msg-id-to-link): Adjust calling signature to allow passing the group in. * packages/gnorb/gnorb.org: Document. --- packages/gnorb/gnorb-org.el | 10 +++ packages/gnorb/gnorb-utils.el | 22 -- packages/gnorb/gnorb.info | 159 -- packages/gnorb/gnorb.org | 13 ++-- packages/gnorb/gnorb.texi | 56 +++ 5 files changed, 132 insertions(+), 128 deletions(-) diff --git a/packages/gnorb/gnorb-org.el b/packages/gnorb/gnorb-org.el index 6790078..324f646 100644 --- a/packages/gnorb/gnorb-org.el +++ b/packages/gnorb/gnorb-org.el @@ -89,6 +89,16 @@ information about the message from which we're triggering." :type 'list :package-version '(gnorb . "1.1.3")) +(defcustom gnorb-org-log-add-link t + "When non-nil, add a message link in a heading's LOGBOOK. +When triggering an Org heading from a message, and adding a log +note, the message id will be added to the text of the log note. +When later viewing the messages, call `gnorb-org-view' with point +on a particular logbook item to automatically go to the linked +message." + :group 'gnorb-org + :type 'boolean) + (defcustom gnorb-org-msg-id-key "GNORB_MSG_ID" "The name of the org property used to store the Message-IDs from relevant messages. This is no longer used, and will be diff --git a/packages/gnorb/gnorb-utils.el b/packages/gnorb/gnorb-utils.el index 36bab54..8810a18 100644 --- a/packages/gnorb/gnorb-utils.el +++ b/packages/gnorb/gnorb-utils.el @@ -346,7 +346,12 @@ agenda. Then let the user choose an action from the value of (format "Trigger action on %s: " (gnorb-pretty-outline id)) - gnorb-org-trigger-actions))) + gnorb-org-trigger-actions)) +(link (when gnorb-org-log-add-link +(format "[[gnus:%s][message]] " +(gnorb-msg-id-to-link + (plist-get gnorb-gnus-message-info :msg-id) + (plist-get gnorb-gnus-message-info :group)) (unless agenda-p (org-reveal)) (cl-labels @@ -367,7 +372,7 @@ agenda. Then let the user choose an action from the value of (note (org-with-point-at root-marker (make-entry (org-id-get-create)) -(call-interactively 'org-add-note))) +(org-add-log-setup 'note nil nil nil (or link nil (todo (if agenda-p (progn @@ -376,7 +381,9 @@ agenda. Then let the user choose an action from the value of (call-interactively 'org-agenda-todo)) (org-with-point-at root-marker (make-entry (org-id-get-create)) - (call-interactively 'org-todo + (call-interactively 'org-todo) + (when link + (setq org-log-note-extra link) (no-associate nil) (associate @@ -385,7 +392,7 @@ agenda. Then let the user choose an action from the value of ;; We're going to capture a new heading ((cap-child cap-sib) (org-with-point-at root-marker - (setq gnorb-trigger-capture-location (point-marker))) +(setq gnorb-trigger-capture-location (point-marker))) (let ((entry ;; Pick a template. (copy-sequence (org-capture-select-template @@ -483,10 +490,11 @@ to those symbols." (push link (alist-get sym alist) alist))) -(defun gnorb-msg-id-to-link (msg-id) +(defun gnorb-msg-id-to-link (msg-id &optional server-group) "Create a full Org link to the message MSG-ID. -The main work is figuring out which group the message is in." - (let ((server-group (car (gnorb-msg-id-request-head msg-id +If SERVER-GROUP isn't given, try to figure it out." + (let ((server-group (or server-group + (car (gnorb-msg-id-request-head msg-id) (when server-group (org-link-escape (concat server-group "#" diff --git a/packages/gnorb/gnorb.info b/packages/gnorb/gnorb.info index 09fc886..c1a54f3 100644 --- a/packages/gnorb/gnorb.info +++ b/packages/gnorb/gnorb.info @@ -1,4 +1,4 @@ -This is gnorb.info, produced by makeinfo version 6.3 from gnorb.texi. +This is gnorb.info, produced by makeinfo version 6.5 from gno
[elpa] master a2c281e 1/5: Gnorb: New option gnorb-gnus-tick-all-tracked-messages
branch: master commit a2c281e26e3988327bf2ee64fc3c2b83f41e02ee Author: Eric Abrahamsen Commit: Eric Abrahamsen Gnorb: New option gnorb-gnus-tick-all-tracked-messages Fixes #34 * packages/gnorb/gnorb-gnus.el (gnorb-gnus-tick-all-tracked-messages): New option, does what it says. * packages/gnorb/gnorb-gnus.el (gnorb-gnus-incoming-do-todo): Maybe tick messages here. (gnorb-gnus-quick-reply): And here. * packages/gnorb/gnorb.info: Document. --- packages/gnorb/gnorb-gnus.el | 28 packages/gnorb/gnorb.info| 10 +++--- packages/gnorb/gnorb.org | 3 +++ packages/gnorb/gnorb.texi| 4 4 files changed, 34 insertions(+), 11 deletions(-) diff --git a/packages/gnorb/gnorb-gnus.el b/packages/gnorb/gnorb-gnus.el index 0c21b58..abf0739 100644 --- a/packages/gnorb/gnorb-gnus.el +++ b/packages/gnorb/gnorb-gnus.el @@ -110,6 +110,13 @@ register." :group 'gnorb-gnus :type 'boolean) +(defcustom gnorb-gnus-tick-all-tracked-messages nil + "When non-nil, add the tick mark to all tracked messages. +This happens only once, at the time the association is created. +Ticks can be safely removed later." + :group 'gnorb-gnus + :type 'boolean) + (defcustom gnorb-gnus-summary-mark-format-letter "g" "Format letter to be used as part of your `gnus-summary-line-format', to indicate in the *Summary* buffer @@ -528,14 +535,14 @@ work." ;;;###autoload (defun gnorb-gnus-incoming-do-todo (arg &optional id) - "Call this function from a received gnus message to store a -link to the message, prompt for a related Org heading, visit the -heading, and trigger an action on it \(see -`gnorb-org-trigger-actions'\). - -If you've set up message tracking \(with -`gnorb-tracking-initialize'\), Gnorb can guess which Org heading -you probably want to trigger, which can save some time. It does + "Use the message under point to trigger an action on an Org heading. +This function stores a link to the message, prompts for a related +Org heading, visits the heading, and triggers an action on +it (see `gnorb-org-trigger-actions'). + +If you've set up message tracking (with +`gnorb-tracking-initialize'), Gnorb can guess which Org heading +you probably want to trigger, which can save some time. It does this by looking in the References header, and seeing if any of the messages referenced there are already being tracked by any headings. @@ -646,6 +653,8 @@ you'll stay in the Gnus summary buffer." (message "Message text copied to kill ring" (with-current-buffer buf (dolist (a articles) + (when gnorb-gnus-tick-all-tracked-messages + (gnus-summary-mark-article a gnus-ticked-mark)) (gnus-summary-update-article a (error ;; If these are left populated after an error, it plays hell @@ -686,6 +695,9 @@ reply." (let ((ret (make-marker))) (setq gnorb-window-conf (current-window-configuration)) (move-marker gnorb-return-marker (point)) + (when gnorb-gnus-tick-all-tracked-messages + (gnus-summary-mark-article art-no gnus-ticked-mark)) + (gnus-summary-update-article art-no) ;; Assume the first heading is the one we want. (gnorb-registry-make-entry msg-id from subject targ group) diff --git a/packages/gnorb/gnorb.info b/packages/gnorb/gnorb.info index c1a54f3..0d848db 100644 --- a/packages/gnorb/gnorb.info +++ b/packages/gnorb/gnorb.info @@ -663,6 +663,10 @@ File: gnorb.info, Node: User Options 2, Up: Misc Gnus Treat all capture templates as if they had the :gnus-attachments key set to “t”. This only has any effect if you’re capturing from a Gnus summary or article buffer. +‘gnorb-gnus-tick-all-tracked-messages’ + When non-nil, always add the tick mark to messages when they are + first associated with an Org heading. The mark can be safely + deleted afterwards. ‘gnorb-trigger-todo-default’ Set to either ’note or ’todo to tell ‘gnorb-gnus-incoming-do-todo’ what to do by default. You can reach the non-default behavior by @@ -775,9 +779,9 @@ Node: User Options22106 Node: Misc Org23629 Node: Inserting BBDB links23804 Node: User Options 124060 -Node: Misc Gnus26958 -Node: User Options 227120 -Node: Default Keybindings30057 +Node: Misc Gnus26774 +Node: User Options 226936 +Node: Default Keybindings30078 End Tag Table diff --git a/packages/gnorb/gnorb.org b/packages/gnorb/gnorb.org index b3f71fd..1d77eae 100644 --- a/packages/gnorb/gnorb.org +++ b/packages/gnorb/gnorb.org @@ -464,6 +464,9 @@ insert an Org link to that record at point. if they had the :gnus-attachments key set to "t". This only has any effect if you're capturing from a Gnus summary or article
[elpa] master updated (59cbc41 -> 335dd95)
girzel pushed a change to branch master. from 59cbc41 Use local binding of `post-command-hook' to reset wrap flag new a2c281e Gnorb: New option gnorb-gnus-tick-all-tracked-messages new a60a0a2 Gnorb: Consolidate all after-capture functions into one new 9df5a40 Gnorb: Tweak manual a bit new 8ebb0e1 Gnorb: Tweaks to gnorb-org-extract-mail-tracking new 335dd95 Gnorb: Try harder to find the nngnorb server Summary of changes: packages/gnorb/README.org| 2 +- packages/gnorb/gnorb-gnus.el | 138 + packages/gnorb/gnorb-org.el | 14 +++- packages/gnorb/gnorb.info| 179 ++- packages/gnorb/gnorb.org | 104 + packages/gnorb/gnorb.texi| 115 ++- 6 files changed, 308 insertions(+), 244 deletions(-)
[elpa] master 9df5a40 3/5: Gnorb: Tweak manual a bit
branch: master commit 9df5a40caf82034fc3df1e34d6d8907f17cfad14 Author: Eric Abrahamsen Commit: Eric Abrahamsen Gnorb: Tweak manual a bit * packages/gnorb/gnorb.org: Move the "Likely Workflow" section higher, people probably want to read that first. * packages/gnorb/README.org: Mention the manual in the README. --- packages/gnorb/README.org | 2 +- packages/gnorb/gnorb.info | 175 +++--- packages/gnorb/gnorb.org | 101 +- packages/gnorb/gnorb.texi | 111 +++-- 4 files changed, 199 insertions(+), 190 deletions(-) diff --git a/packages/gnorb/README.org b/packages/gnorb/README.org index 1ee55a6..f52340a 100644 --- a/packages/gnorb/README.org +++ b/packages/gnorb/README.org @@ -11,7 +11,7 @@ Probably the most interesting thing Gnorb does is tracking correspondences between Gnus email messages and Org headings. Rather than "turning your inbox into a TODO list", as some software puts it, Gnorb (kind of) does the opposite: turning your TODO headings into -mini mailboxes. +mini mailboxes. See the Info manual for details. *Note for previous users*: If you were using Gnorb from Github before it shifted to the Elpa repository, the email tracking mechanism has diff --git a/packages/gnorb/gnorb.info b/packages/gnorb/gnorb.info index 0d848db..f409266 100644 --- a/packages/gnorb/gnorb.info +++ b/packages/gnorb/gnorb.info @@ -30,6 +30,7 @@ Gnorb Manual Email Tracking +* Likely Workflow:: * Tracking Setup:: * Beginning and Continuing the Tracking Process:: * Trigger Actions:: @@ -37,7 +38,6 @@ Email Tracking * Hinting in Gnus:: * Message Attachments:: * Registry Usage:: -* Likely Workflow:: Misc BBDB @@ -135,6 +135,7 @@ agenda rather than in Gnus. * Menu: +* Likely Workflow:: * Tracking Setup:: * Beginning and Continuing the Tracking Process:: * Trigger Actions:: @@ -142,12 +143,66 @@ agenda rather than in Gnus. * Hinting in Gnus:: * Message Attachments:: * Registry Usage:: -* Likely Workflow:: -File: gnorb.info, Node: Tracking Setup, Next: Beginning and Continuing the Tracking Process, Up: Email Tracking +File: gnorb.info, Node: Likely Workflow, Next: Tracking Setup, Up: Email Tracking + +4.1 Likely Workflow +=== + +First of all, here’s a hypothetical workflow to show you how tracking +works. + + Say you receive an email from Jimmy, who wants to rent a room in your +house. “I’ll respond to this later,” you think. + + You capture an Org TODO from the email, writing a headline “Jimmy +renting a room”, and give it a REPLY keyword. Gnorb quietly records the +correspondence between the email and the TODO, using the Gnus registry. + + The next day, looking at your Agenda, you see the TODO and decide to +respond to the email. You hit “C-c t” on the heading, and Gnorb finds +Jimmy’s email and starts a reply to it. + + You tell Jimmy the room’s available in March, and send the message. +Gnorb takes you back to the heading, and asks you to trigger an action +on it. You choose “todo state”, and change the heading keyword to WAIT. + + Two days later, Jimmy replies to your message, saying that March is +perfect. When you open his response, Gnorb politely reminds you that +the message is relevant to an existing TODO. You hit “C-c t” on the +message, and are again taken to the TODO and asked to trigger an action. +Again you choose “todo state”, and change the heading keyword back to +REPLY. + + You get another email, from Samantha, warning you not to rent the +room to Jimmy. She even attaches a picture of a room in her house, as +it looked after Jimmy had stayed there for six months. It’s bad. You +hit “C-c t” on her message, and pick the “Jimmy renting a room” heading. +This time, you choose “take note” as the trigger action, and make a +brief note about how bad that room looked. Gnorb asks if you’d like to +attach the picture to the Org heading. You decide you will. + + Now it’s time to write to Jimmy and say something noncommittal. +Hitting “C-c t” on the heading would respond to Samantha’s email, the +most recent of the associated messages, which isn’t what you want. +Instead you hit “C-c v” on the heading, which opens up a Gnus *Summary* +buffer containing all four messages: Jimmy’s first, your response, his +response to that, and Samantha’s message. You pick Jimmy’s second +email, and reply to it normally. Gnorb asks if you’d like to send the +picture of the room as an attachment. You would not. When you send the +reply Gnorb tracks that as well, and does the “trigger an action” trick +again. + + In this way Gnorb helps you manage an entire conversation, possibly +with multiple threads and multiple participants. Mostly all you need to +do is hit “C-c t” on newly-received messages, and “C-c t” on the heading +when it’s time to compose a new reply. -4.1 Tracking Setup + +File: gnorb.info, Node: T
[elpa] master a60a0a2 2/5: Gnorb: Consolidate all after-capture functions into one
branch: master
commit a60a0a2249fcfe7544f373c23cd3bd981799a0f9
Author: Eric Abrahamsen
Commit: Eric Abrahamsen
Gnorb: Consolidate all after-capture functions into one
* packages/gnorb/gnorb-gnus.el (gnorb-gnus-after-capture-function):
This new function replaces gnorb-gnus-capture-attach, and
gnorb-gnus-capture-save-text. New: it also ticks the message as
needed, and updates the summary line.
---
packages/gnorb/gnorb-gnus.el | 89 +---
1 file changed, 50 insertions(+), 39 deletions(-)
diff --git a/packages/gnorb/gnorb-gnus.el b/packages/gnorb/gnorb-gnus.el
index abf0739..0750261 100644
--- a/packages/gnorb/gnorb-gnus.el
+++ b/packages/gnorb/gnorb-gnus.el
@@ -244,47 +244,58 @@ save them into `gnorb-tmp-dir'."
(when (or capture-p store)
(push filename gnorb-gnus-capture-attachments
-;;; Make the above work in the capture process
-
-(defun gnorb-gnus-capture-attach ()
- (when (and (or gnorb-gnus-capture-always-attach
-(org-capture-get :gnus-attachments))
-(with-current-buffer
-(org-capture-get :original-buffer)
- (memq major-mode '(gnus-summary-mode gnus-article-mode
-(require 'org-attach)
-(setq gnorb-gnus-capture-attachments nil)
-(gnorb-gnus-collect-all-attachments t)
-(map-y-or-n-p
- (lambda (a)
- (format "Attach %s to capture heading? "
- (file-name-nondirectory a)))
- (lambda (a) (org-attach-attach a nil 'mv))
- gnorb-gnus-capture-attachments
- '("file" "files" "attach"))
-(setq gnorb-gnus-capture-attachments nil)))
-
-(defun gnorb-gnus-capture-save-text ()
- (when (and gnorb-gnus-copy-message-text
-(with-current-buffer
-(org-capture-get :original-buffer)
- (memq major-mode '(gnus-summary-mode gnus-article-mode
+(defun gnorb-gnus-after-capture-function ()
+ "Do various things after starting the capture process.
+Currently includes:
+
+1. Offering to move all the attachments from the message we
+captured from onto the Org heading being captured.
+
+2. Possibly saving the text of the message we captured from (see
+`gnorb-gnus-copy-message-text').
+
+3. Possibly ticking the message we captured from (see
+`gnorb-gnus-tick-all-tracked-messages')."
+ (when (with-current-buffer
+ (org-capture-get :original-buffer)
+ (memq major-mode '(gnus-summary-mode gnus-article-mode)))
(save-window-excursion
(set-buffer (org-capture-get :original-buffer))
- (gnus-with-article-buffer
- (article-goto-body)
- (if (numberp gnorb-gnus-copy-message-text)
- (progn
- (copy-to-register
- gnorb-gnus-copy-message-text
- (point) (point-max))
- (message "Message text copied to register %c"
- gnorb-gnus-copy-message-text))
- (kill-new (buffer-substring (point) (point-max)))
- (message "Message text copied to kill ring"))
-
-(add-hook 'org-capture-mode-hook 'gnorb-gnus-capture-attach)
-(add-hook 'org-capture-mode-hook 'gnorb-gnus-capture-save-text)
+ (let ((art-no (gnus-summary-article-number)))
+
+ (when gnorb-gnus-copy-message-text
+ (gnus-with-article-buffer
+ (article-goto-body)
+ (if (numberp gnorb-gnus-copy-message-text)
+ (progn
+ (copy-to-register
+ gnorb-gnus-copy-message-text
+ (point) (point-max))
+ (message "Message text copied to register %c"
+ gnorb-gnus-copy-message-text))
+ (kill-new (buffer-substring (point) (point-max)))
+ (message "Message text copied to kill ring"
+
+ (when (or gnorb-gnus-capture-always-attach
+ (org-capture-get :gnus-attachments))
+ (require 'org-attach)
+ (setq gnorb-gnus-capture-attachments nil)
+ (gnorb-gnus-collect-all-attachments t)
+ (map-y-or-n-p
+ (lambda (a)
+(format "Attach %s to capture heading? "
+(file-name-nondirectory a)))
+ (lambda (a) (org-attach-attach a nil 'mv))
+ gnorb-gnus-capture-attachments
+ '("file" "files" "attach"))
+ (setq gnorb-gnus-capture-attachments nil))
+
+ (when gnorb-gnus-tick-all-tracked-messages
+ (gnus-summary-mark-article art-no gnus-ticked-mark))
+
+ (gnus-summary-update-article art-no)
+
+(add-hook 'org-capture-mode-hook 'gnorb-gnus-after-capture-function)
(defvar org-note-abort)
[elpa] master 335dd95 5/5: Gnorb: Try harder to find the nngnorb server
branch: master commit 335dd956d23eb6e981d76804564f94be33624823 Author: Eric Abrahamsen Commit: Eric Abrahamsen Gnorb: Try harder to find the nngnorb server * packages/gnorb/gnorb-gnus.el (gnorb-gnus-search-messages): Check gnus-secondary-select-methods, gnus-server-alist, and gnus-server-method-cache. --- packages/gnorb/gnorb-gnus.el | 25 +++-- 1 file changed, 19 insertions(+), 6 deletions(-) diff --git a/packages/gnorb/gnorb-gnus.el b/packages/gnorb/gnorb-gnus.el index 0750261..dfef37a 100644 --- a/packages/gnorb/gnorb-gnus.el +++ b/packages/gnorb/gnorb-gnus.el @@ -731,20 +731,31 @@ reply." (defun gnorb-gnus-search-messages (str persist &optional head-text ret) "Initiate a search for gnus message links in an org subtree. The arg STR can be one of two things: an Org heading id value -\(IDs should be prefixed with \"id+\"\), in which case links will +\(IDs should be prefixed with \"id+\"), in which case links will be collected from that heading, or a string corresponding to an Org tags search, in which case links will be collected from all matching headings. In either case, once a collection of links have been made, they will all be displayed in an ephemeral group on the \"nngnorb\" -server. There must be an active \"nngnorb\" server for this to -work." +server. There must be an active \"nngnorb\" server for this to +work. + +If PERSIST is non-nil, make a permanent group, and offer +HEAD-TEXT, if present, as its name. Otherwise create an +ephemeral one, with RET as the value of its quit-config." (interactive) (require 'nnir) (let* ((nnir-address (or (catch 'found - (dolist (s gnus-server-method-cache) + ;; Try very hard to find the server. + (when (assoc 'nngnorb gnus-secondary-select-methods) + (throw 'found +(format + "nngnorb:%s" + (nth 1 (assoc 'nngnorb + gnus-seconard-select-methods) + (dolist (s (append gnus-server-alist gnus-server-method-cache)) (when (eq 'nngnorb (cadr s)) (throw 'found (car s) (user-error @@ -756,8 +767,10 @@ work." (concat "gnorb-" str))) (method (list 'nnir nnir-address)) (spec (list - (cons 'nnir-specs (list (cons 'nnir-query-spec `((query . ,str))) - (cons 'nnir-group-spec `((,nnir-address ,(list name)) + (cons 'nnir-specs (list (cons 'nnir-query-spec + `((query . ,str))) + (cons 'nnir-group-spec + `((,nnir-address ,(list name)) (cons 'nnir-artlist nil (if persist (progn
[elpa] master 8ebb0e1 4/5: Gnorb: Tweaks to gnorb-org-extract-mail-tracking
branch: master commit 8ebb0e128b143f2ac1366504bd11881c6db5743b Author: Eric Abrahamsen Commit: Eric Abrahamsen Gnorb: Tweaks to gnorb-org-extract-mail-tracking * packages/gnorb/gnorb-org.el (gnorb-org-extract-mail-tracking): Fix gratuitious logicking. Pretend I was going to update the docstring, anyway. --- packages/gnorb/gnorb-org.el | 14 +++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/packages/gnorb/gnorb-org.el b/packages/gnorb/gnorb-org.el index 324f646..5c2ee61 100644 --- a/packages/gnorb/gnorb-org.el +++ b/packages/gnorb/gnorb-org.el @@ -252,8 +252,17 @@ See the docstring of `gnorb-org-handle-mail' for details." (user-mail-address (string-match-p user-mail-address addr +;; FIXME: Why did I break this off from +;; `gnorb-org-extract-mail-stuff'? It's only called from there, and +;; it's confusing to have them separate. (defun gnorb-org-extract-mail-tracking (assoc-msg-ids &optional arg region) - + "Return tracked mail links for the current Org subtree. +ASSOC-MSG-IDS is a list of message-ids that have already been +determined to be tracked by the subtree. Return the most recent +of these, as a candidate for composing a reply. If there are no +tracked messages, or if ARG (a prefix arg from earlier) is +non-nil, ignore these tracked ids and instead scan the +subtree (or REGION) for links, and use those instead." (let* ((all-links (gnorb-org-extract-links nil region)) ;; The latest (by the creation-time registry key) of all the ;; tracked messages that were not sent by our user. @@ -264,8 +273,7 @@ See the docstring of `gnorb-org-handle-mail' for details." (cl-remove-if-not (lambda (m) (let ((from (car (gnus-registry-get-id-key m 'sender - (or (null from) - (null (gnorb-user-address-match-p from) + (not (and from (gnorb-user-address-match-p from) assoc-msg-ids) (lambda (r l) (time-less-p
[elpa] master 43c2d33: Gnorb: Bump version to 1.3.3, tiny manual fix
branch: master
commit 43c2d3352f4ec83a82b8e0e08b23e7541299eee4
Author: Eric Abrahamsen
Commit: Eric Abrahamsen
Gnorb: Bump version to 1.3.3, tiny manual fix
* packages/gnorb/gnorb.el: Mostly just to flush recent changes.
* packages/gnorb/gnorb.org: Tiny fix.
---
packages/gnorb/gnorb.el | 2 +-
packages/gnorb/gnorb.info | 8
packages/gnorb/gnorb.org | 2 +-
packages/gnorb/gnorb.texi | 2 +-
4 files changed, 7 insertions(+), 7 deletions(-)
diff --git a/packages/gnorb/gnorb.el b/packages/gnorb/gnorb.el
index f2051ed..e022083 100644
--- a/packages/gnorb/gnorb.el
+++ b/packages/gnorb/gnorb.el
@@ -2,7 +2,7 @@
;; Copyright (C) 2014 Free Software Foundation, Inc.
-;; Version: 1.3.2
+;; Version: 1.3.3
;; Package-Requires: ((cl-lib "0.5"))
;; Maintainer: Eric Abrahamsen
diff --git a/packages/gnorb/gnorb.info b/packages/gnorb/gnorb.info
index f409266..d37e31e 100644
--- a/packages/gnorb/gnorb.info
+++ b/packages/gnorb/gnorb.info
@@ -357,7 +357,7 @@ will be made persistent across Gnus sessions. You can
re-run the search
and update the group contents by hitting “M-g” on the group in the Gnus
*Group* buffer.
- Calling ‘gnorb-gnus-view“ (”C-c v“) on a tracked message will take
+ Calling ‘gnorb-gnus-view’ (“C-c v”) on a tracked message will take
you to the tracked Org heading.
As a bonus, it’s possible to go into Gnus’ *Server* buffer, find the
@@ -782,9 +782,9 @@ Node: User Options22201
Node: Misc Org23724
Node: Inserting BBDB links23899
Node: User Options 124155
-Node: Misc Gnus26869
-Node: User Options 227031
-Node: Default Keybindings30173
+Node: Misc Gnus27053
+Node: User Options 227215
+Node: Default Keybindings30357
End Tag Table
diff --git a/packages/gnorb/gnorb.org b/packages/gnorb/gnorb.org
index f47dce5..18f1d36 100644
--- a/packages/gnorb/gnorb.org
+++ b/packages/gnorb/gnorb.org
@@ -258,7 +258,7 @@ will be made persistent across Gnus sessions. You can
re-run the
search and update the group contents by hitting "M-g" on the group in
the Gnus *Group* buffer.
-Calling `gnorb-gnus-view" ("C-c v") on a tracked message will take you
+Calling `gnorb-gnus-view' ("C-c v") on a tracked message will take you
to the tracked Org heading.
As a bonus, it's possible to go into Gnus' *Server* buffer, find the
diff --git a/packages/gnorb/gnorb.texi b/packages/gnorb/gnorb.texi
index 2e0eb76..3fefce4 100644
--- a/packages/gnorb/gnorb.texi
+++ b/packages/gnorb/gnorb.texi
@@ -376,7 +376,7 @@ will be made persistent across Gnus sessions. You can
re-run the
search and update the group contents by hitting ``M-g'' on the group in
the Gnus *Group* buffer.
-Calling `gnorb-gnus-view`` (''C-c v``) on a tracked message will take you
+Calling `gnorb-gnus-view' (``C-c v'') on a tracked message will take you
to the tracked Org heading.
As a bonus, it's possible to go into Gnus' *Server* buffer, find the
[elpa] master 96c83ef: Fix to after capture function, bump to 1.3.4
branch: master
commit 96c83ef907dec53c96d48aa91cfe6de2390ca8ac
Author: Eric Abrahamsen
Commit: Eric Abrahamsen
Fix to after capture function, bump to 1.3.4
* packages/gnorb/gnorb-gnus.el (gnorb-gnus-after-capture-function):
The order was incorrect, the attachment stuff needs to happen in the
capture buffer, the rest of it in the Gnus buffer.
* packages/gnorb/gnorb.el: Flush changes.
---
packages/gnorb/gnorb-gnus.el | 29 +++--
packages/gnorb/gnorb.el | 2 +-
2 files changed, 16 insertions(+), 15 deletions(-)
diff --git a/packages/gnorb/gnorb-gnus.el b/packages/gnorb/gnorb-gnus.el
index dfef37a..df50bb2 100644
--- a/packages/gnorb/gnorb-gnus.el
+++ b/packages/gnorb/gnorb-gnus.el
@@ -259,6 +259,21 @@ captured from onto the Org heading being captured.
(when (with-current-buffer
(org-capture-get :original-buffer)
(memq major-mode '(gnus-summary-mode gnus-article-mode)))
+;; This part needs to happen in the capture buffer.
+(when (or gnorb-gnus-capture-always-attach
+ (org-capture-get :gnus-attachments))
+ (require 'org-attach)
+ (setq gnorb-gnus-capture-attachments nil)
+ (gnorb-gnus-collect-all-attachments t)
+ (map-y-or-n-p
+ (lambda (a)
+(format "Attach %s to capture heading? "
+(file-name-nondirectory a)))
+ (lambda (a) (org-attach-attach a nil 'mv))
+ gnorb-gnus-capture-attachments
+ '("file" "files" "attach"))
+ (setq gnorb-gnus-capture-attachments nil))
+;; This part happens in the original summary/article buffer.
(save-window-excursion
(set-buffer (org-capture-get :original-buffer))
(let ((art-no (gnus-summary-article-number)))
@@ -276,20 +291,6 @@ captured from onto the Org heading being captured.
(kill-new (buffer-substring (point) (point-max)))
(message "Message text copied to kill ring"
- (when (or gnorb-gnus-capture-always-attach
- (org-capture-get :gnus-attachments))
- (require 'org-attach)
- (setq gnorb-gnus-capture-attachments nil)
- (gnorb-gnus-collect-all-attachments t)
- (map-y-or-n-p
- (lambda (a)
-(format "Attach %s to capture heading? "
-(file-name-nondirectory a)))
- (lambda (a) (org-attach-attach a nil 'mv))
- gnorb-gnus-capture-attachments
- '("file" "files" "attach"))
- (setq gnorb-gnus-capture-attachments nil))
-
(when gnorb-gnus-tick-all-tracked-messages
(gnus-summary-mark-article art-no gnus-ticked-mark))
diff --git a/packages/gnorb/gnorb.el b/packages/gnorb/gnorb.el
index e022083..066008c 100644
--- a/packages/gnorb/gnorb.el
+++ b/packages/gnorb/gnorb.el
@@ -2,7 +2,7 @@
;; Copyright (C) 2014 Free Software Foundation, Inc.
-;; Version: 1.3.3
+;; Version: 1.3.4
;; Package-Requires: ((cl-lib "0.5"))
;; Maintainer: Eric Abrahamsen
[elpa] master e004bc9 2/3: Gnorb: Re-work the capture hook functions.
branch: master
commit e004bc97cb0c4704e4a5346563a0f24c7b4fd129
Author: Eric Abrahamsen
Commit: Eric Abrahamsen
Gnorb: Re-work the capture hook functions.
* packages/gnorb/gnorb-gnus.el: Rename
gnorb-gnus-after-capture-function to gnorb-org-capture-function, and
move it to the gnorb-org file, where it belongs. Rename and move
gnorb-gnus-capture-abort-cleanup to gnorb-org-capture-abort-cleanup.
* packages/gnorb/gnorb-org.el (gnorb-org-capture-function): New
function. Delete gnorb-org-capture-collect-link, and make it part of
this function.
---
packages/gnorb/gnorb-gnus.el | 72 --
packages/gnorb/gnorb-org.el | 83 +---
2 files changed, 78 insertions(+), 77 deletions(-)
diff --git a/packages/gnorb/gnorb-gnus.el b/packages/gnorb/gnorb-gnus.el
index df50bb2..88b8327 100644
--- a/packages/gnorb/gnorb-gnus.el
+++ b/packages/gnorb/gnorb-gnus.el
@@ -244,78 +244,6 @@ save them into `gnorb-tmp-dir'."
(when (or capture-p store)
(push filename gnorb-gnus-capture-attachments
-(defun gnorb-gnus-after-capture-function ()
- "Do various things after starting the capture process.
-Currently includes:
-
-1. Offering to move all the attachments from the message we
-captured from onto the Org heading being captured.
-
-2. Possibly saving the text of the message we captured from (see
-`gnorb-gnus-copy-message-text').
-
-3. Possibly ticking the message we captured from (see
-`gnorb-gnus-tick-all-tracked-messages')."
- (when (with-current-buffer
- (org-capture-get :original-buffer)
- (memq major-mode '(gnus-summary-mode gnus-article-mode)))
-;; This part needs to happen in the capture buffer.
-(when (or gnorb-gnus-capture-always-attach
- (org-capture-get :gnus-attachments))
- (require 'org-attach)
- (setq gnorb-gnus-capture-attachments nil)
- (gnorb-gnus-collect-all-attachments t)
- (map-y-or-n-p
- (lambda (a)
-(format "Attach %s to capture heading? "
-(file-name-nondirectory a)))
- (lambda (a) (org-attach-attach a nil 'mv))
- gnorb-gnus-capture-attachments
- '("file" "files" "attach"))
- (setq gnorb-gnus-capture-attachments nil))
-;; This part happens in the original summary/article buffer.
-(save-window-excursion
- (set-buffer (org-capture-get :original-buffer))
- (let ((art-no (gnus-summary-article-number)))
-
- (when gnorb-gnus-copy-message-text
- (gnus-with-article-buffer
- (article-goto-body)
- (if (numberp gnorb-gnus-copy-message-text)
- (progn
- (copy-to-register
- gnorb-gnus-copy-message-text
- (point) (point-max))
- (message "Message text copied to register %c"
- gnorb-gnus-copy-message-text))
- (kill-new (buffer-substring (point) (point-max)))
- (message "Message text copied to kill ring"
-
- (when gnorb-gnus-tick-all-tracked-messages
- (gnus-summary-mark-article art-no gnus-ticked-mark))
-
- (gnus-summary-update-article art-no)
-
-(add-hook 'org-capture-mode-hook 'gnorb-gnus-after-capture-function)
-
-(defvar org-note-abort)
-
-(defun gnorb-gnus-capture-abort-cleanup ()
- (with-no-warnings ; For `org-note-abort'
-(when (and org-note-abort
- (or gnorb-gnus-capture-always-attach
- (org-capture-get :gnus-attachments)))
- (condition-case nil
-(progn (org-attach-delete-all)
- (setq abort-note 'clean)
- ;; remove any gnorb-mail-header values here
- )
- (error
- (setq abort-note 'dirty))
-
-(add-hook 'org-capture-prepare-finalize-hook
- 'gnorb-gnus-capture-abort-cleanup)
-
;;; Storing, removing, and acting on Org headers in messages.
(defvar gnorb-gnus-message-info nil
diff --git a/packages/gnorb/gnorb-org.el b/packages/gnorb/gnorb-org.el
index 5c2ee61..9cb5f0a 100644
--- a/packages/gnorb/gnorb-org.el
+++ b/packages/gnorb/gnorb-org.el
@@ -611,19 +611,92 @@ default set of parameters."
:group 'gnorb-org
:type 'boolean)
-(defun gnorb-org-capture-collect-link ()
+(defun gnorb-org-capture-function ()
+ "Do various things after starting the capture process.
+Currently includes:
+
+1. Offering to move all the attachments from the message we
+captured from onto the Org heading being captured.
+
+2. Possibly saving a link to wherever we came from (see
+`gnorb-org-capture-collect-link-p').
+
+3. Possibly saving the text of the message we captured from (see
+`gnorb-gnus-copy-message-text').
+
+4. Possibly ticking the message we captured from (see
+`gnorb-gnus
[elpa] master updated (f98d983 -> 0775e8c)
girzel pushed a change to branch master. from f98d983 packages/el-search: Some minor tweaks new 7431126 Gnorb: Only add one registry-related hook to the Org capture process new e004bc9 Gnorb: Re-work the capture hook functions. new 0775e8c Gnorb: Typo Summary of changes: packages/gnorb/gnorb-gnus.el | 74 +-- packages/gnorb/gnorb-org.el | 83 +--- packages/gnorb/gnorb-registry.el | 16 packages/gnorb/gnorb-utils.el| 3 +- packages/gnorb/gnorb.el | 2 +- 5 files changed, 81 insertions(+), 97 deletions(-)
[elpa] master 0775e8c 3/3: Gnorb: Typo
branch: master commit 0775e8c12f66a193365716ca6415be36cf7388ef Author: Eric Abrahamsen Commit: Eric Abrahamsen Gnorb: Typo * packages/gnorb/gnorb-gnus.el (gnorb-gnus-search-messages): Just an incredibly stupid typo. --- packages/gnorb/gnorb-gnus.el | 2 +- packages/gnorb/gnorb.el | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/packages/gnorb/gnorb-gnus.el b/packages/gnorb/gnorb-gnus.el index 88b8327..ce60199 100644 --- a/packages/gnorb/gnorb-gnus.el +++ b/packages/gnorb/gnorb-gnus.el @@ -683,7 +683,7 @@ ephemeral one, with RET as the value of its quit-config." (format "nngnorb:%s" (nth 1 (assoc 'nngnorb - gnus-seconard-select-methods) + gnus-secondary-select-methods) (dolist (s (append gnus-server-alist gnus-server-method-cache)) (when (eq 'nngnorb (cadr s)) (throw 'found (car s) diff --git a/packages/gnorb/gnorb.el b/packages/gnorb/gnorb.el index 066008c..9b79722 100644 --- a/packages/gnorb/gnorb.el +++ b/packages/gnorb/gnorb.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2014 Free Software Foundation, Inc. -;; Version: 1.3.4 +;; Version: 1.3.5 ;; Package-Requires: ((cl-lib "0.5")) ;; Maintainer: Eric Abrahamsen
[elpa] master 7431126 1/3: Gnorb: Only add one registry-related hook to the Org capture process
branch: master commit 743112674b4eb36fce5ee4b05cab348d49a3cf56 Author: Eric Abrahamsen Commit: Eric Abrahamsen Gnorb: Only add one registry-related hook to the Org capture process * packages/gnorb/gnorb-utils.el (gnorb-tracking-initialize): Delete `gnorb-registry-capture-abort-cleanup'. Instead of creating the association when the capture process begins, and then deleting the association if the capture is aborted, simply don't create the association unless we know that the capture process isn't aborted. --- packages/gnorb/gnorb-registry.el | 16 packages/gnorb/gnorb-utils.el| 3 +-- 2 files changed, 1 insertion(+), 18 deletions(-) diff --git a/packages/gnorb/gnorb-registry.el b/packages/gnorb/gnorb-registry.el index 51bce39..749c370 100644 --- a/packages/gnorb/gnorb-registry.el +++ b/packages/gnorb/gnorb-registry.el @@ -92,22 +92,6 @@ to the message's registry entry, under the `gnorb-ids' key." (plist-put org-capture-plist :gnorb-id org-id) (gnorb-registry-make-entry msg-id nil nil org-id nil - -(defun gnorb-registry-capture-abort-cleanup () - (when (and (org-capture-get :gnorb-id) -org-note-abort) -(with-no-warnings ; For `abort-note' - (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))) - (when (member org-id existing-org-ids) - (gnus-registry-set-id-key msg-id 'gnorb-ids - (remove org-id existing-org-ids))) - (setq abort-note 'clean)) - (error -(setq abort-note 'dirty)) - (defun gnorb-find-visit-candidates (ids &optional include-zombies) "For all message-ids in IDS (which should be a list of Message-ID strings, with angle brackets, or a single string of diff --git a/packages/gnorb/gnorb-utils.el b/packages/gnorb/gnorb-utils.el index 8810a18..050c3e3 100644 --- a/packages/gnorb/gnorb-utils.el +++ b/packages/gnorb/gnorb-utils.el @@ -617,8 +617,7 @@ registry be in use, and should be called after the call to (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) - (add-hook 'org-capture-prepare-finalize-hook 'gnorb-registry-capture-abort-cleanup) + (add-hook 'org-capture-prepare-finalize-hook #''gnorb-registry-capture) (setq gnorb-tracking-enabled t ;;;###autoload
[elpa] master faf9371: Provide Org tagging for Gnus messages
branch: master commit faf9371c788e9fd248d32858733be7e6d6c5228a Author: Eric Abrahamsen Commit: Eric Abrahamsen Provide Org tagging for Gnus messages * packages/gnorb/gnorb-gnus.el (gnorb-gnus-tag-message): New command for tagging messages. (gnorb-gnus-insert-tagged-messages): New command for inserting tagged messages into the Summary buffer. (gnorb-gnus-insert-format-tags): New function for displaying tags as part of a group format. (gnorb-gnus-summary-tags-format-letter): Option allowing the user to specify the format spec for tags. (gnorb-gnus-auto-tag-messages): Option governing the auto-tagging of messages. (gnorb-gnus-incoming-do-todo, gnorb-gnus-quick-reply): Possibly auto-tag messages. * packages/gnorb/gnorb-org.el (gnorb-org-munge-agenda-query-string): New function, with query string munging pulled out. * packages/gnorb/gnorb-registry.el (gnorb-registry-org-tag-search,gnorb-registry-tagged-messages, gnorb-registry-tracked-tags): New functions for retrieving tags and messages. * packages/gnorb/gnorb-utils.el (gnorb-install-defaults): Provide default keybindings for `gnorb-gnus-tag-message' and `gnorb-gnus-insert-tagged-messages'. * packages/gnorb/gnorb.org: Document. --- packages/gnorb/gnorb-gnus.el | 118 ++- packages/gnorb/gnorb-org.el | 56 ++- packages/gnorb/gnorb-registry.el | 13 + packages/gnorb/gnorb-utils.el| 2 + packages/gnorb/gnorb.info| 112 + packages/gnorb/gnorb.org | 38 + packages/gnorb/gnorb.texi| 46 ++- 7 files changed, 283 insertions(+), 102 deletions(-) diff --git a/packages/gnorb/gnorb-gnus.el b/packages/gnorb/gnorb-gnus.el index ce60199..27226ac 100644 --- a/packages/gnorb/gnorb-gnus.el +++ b/packages/gnorb/gnorb-gnus.el @@ -38,7 +38,7 @@ (group newsgroups message-id x-no-archive)) (declare-function org-gnus-follow-link "org-gnus" (group article)) - +(declare-function org-make-tags-matcher "org" (match)) (defvar org-refile-targets) (defgroup gnorb-gnus nil @@ -117,6 +117,14 @@ Ticks can be safely removed later." :group 'gnorb-gnus :type 'boolean) +(defcustom gnorb-gnus-auto-tag-messages nil + "When non-nil, tag messages with associated heading tags. +When creating associations between Org headings and messages, +automatically copy the heading's tags on to the message, using +the registry." + :group 'gnorb-gnus + :type 'boolean) + (defcustom gnorb-gnus-summary-mark-format-letter "g" "Format letter to be used as part of your `gnus-summary-line-format', to indicate in the *Summary* buffer @@ -128,6 +136,14 @@ Ticks can be safely removed later." :group 'gnorb-gnus :type 'string) +(defcustom gnorb-gnus-summary-tags-format-letter "G" + "Format letter to be replaced with message tags. +Add this format specification to your `gnus-summary-line-format' +to show the tags which are currently applied to the message. +Must be prefixed with \"u\", eg. \"%uG\"." + :group 'gnorb-gnus + :type 'string) + (defcustom gnorb-gnus-summary-mark "¡" "Default mark to insert in the summary format line of articles that are likely relevant to existing TODO headings." @@ -527,7 +543,7 @@ you'll stay in the Gnus summary buffer." ;; Specifically ask for zombies, so the user has chance to ;; flush them out. (gnorb-find-tracked-headings headers t))) -targ) +targ tags) (setq gnorb-gnus-message-info `(:subject ,subject :msg-id ,msg-id :to ,to :from ,from @@ -564,6 +580,7 @@ you'll stay in the Gnus summary buffer." (save-window-excursion (find-file (nth 1 targ)) (goto-char (nth 3 targ)) + (setq tags (org-get-tags)) (org-id-get-create ;; Either bulk associate multiple messages... (if (> (length articles) 1) @@ -595,6 +612,10 @@ you'll stay in the Gnus summary buffer." (dolist (a articles) (when gnorb-gnus-tick-all-tracked-messages (gnus-summary-mark-article a gnus-ticked-mark)) + (when gnorb-gnus-auto-tag-messages + (gnorb-gnus-tag-message +(mail-header-id (gnus-data-header (gnus-data-find a))) +tags)) (gnus-summary-update-article a (error ;; If these are left populated after an error, it plays hell @@ -637,10 +658,16 @@ reply." (move-marker gnorb-return-marker (point))
[elpa] master 5895bc3 2/2: Gnorb: Fix and bump to 1.4.2
branch: master commit 5895bc3b0863efcb5a08b2f9ba6c2cad7b079dd9 Author: Eric Abrahamsen Commit: Eric Abrahamsen Gnorb: Fix and bump to 1.4.2 * packages/gnorb/gnorb-utils.el (gnorb-tracking-initialize): Someday I'll learn to use the compiler. --- packages/gnorb/gnorb-utils.el | 2 +- packages/gnorb/gnorb.el | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/packages/gnorb/gnorb-utils.el b/packages/gnorb/gnorb-utils.el index 791c671..3db394d 100644 --- a/packages/gnorb/gnorb-utils.el +++ b/packages/gnorb/gnorb-utils.el @@ -617,7 +617,7 @@ registry be in use, and should be called after the call to (require 'gnorb-gnus) (unless (gnus-registry-install-p) (user-error "Gnorb tracking requires that the Gnus registry be installed.")) - (add-hook 'org-capture-prepare-finalize-hook #''gnorb-registry-capture) + (add-hook 'org-capture-prepare-finalize-hook #'gnorb-registry-capture) (setq gnorb-tracking-enabled t ;;;###autoload diff --git a/packages/gnorb/gnorb.el b/packages/gnorb/gnorb.el index e44eb46..efe72d6 100644 --- a/packages/gnorb/gnorb.el +++ b/packages/gnorb/gnorb.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2014 Free Software Foundation, Inc. -;; Version: 1.4.1 +;; Version: 1.4.2 ;; Package-Requires: ((cl-lib "0.5")) ;; Maintainer: Eric Abrahamsen
[elpa] master 2111d3f 1/2: Gnorb: New command for inserting tracked messages; bump to 1.4.1
branch: master commit 2111d3f3df06eeb5eb13c42148ff5f9ef43a0bf3 Author: Eric Abrahamsen Commit: Eric Abrahamsen Gnorb: New command for inserting tracked messages; bump to 1.4.1 * packages/gnorb/gnorb-gnus.el (gnorb-gnus-insert-tracked-messages): New command for inserting all tracked messages into the buffer. * packages/gnorb/gnorb.el: Bump. * packages/gnorb/gnorb-registry.el (gnorb-refresh-usage-status): Update this function to also show number of tagged messages, and tags. * packages/gnorb/README.org: TODO is done. * packages/gnorb/gnorb.info: Document tracked message insertion. --- packages/gnorb/README.org| 9 -- packages/gnorb/gnorb-gnus.el | 36 packages/gnorb/gnorb-registry.el | 59 packages/gnorb/gnorb-utils.el| 1 + packages/gnorb/gnorb.el | 2 +- packages/gnorb/gnorb.info| 49 - packages/gnorb/gnorb.org | 10 +++ packages/gnorb/gnorb.texi| 14 -- 8 files changed, 132 insertions(+), 48 deletions(-) diff --git a/packages/gnorb/README.org b/packages/gnorb/README.org index f52340a..5ba6e76 100644 --- a/packages/gnorb/README.org +++ b/packages/gnorb/README.org @@ -80,9 +80,6 @@ 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? -*** TODO Gnus message tagging -Allow tagging of Gnus messages, by giving the message's registry entry -an 'org-tags key. *** 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 @@ -98,6 +95,12 @@ 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 Gnus message tagging +:LOGBOOK: +- State "DONE" from "TODO" [2017-12-09 Sat 17:23] +:END: +Allow tagging of Gnus messages, by giving the message's registry entry +an 'org-tags key. *** DONE Email subtree export to doc and rtf :LOGBOOK: - State "DONE" from "TODO" [2017-03-11 Sat 12:35] diff --git a/packages/gnorb/gnorb-gnus.el b/packages/gnorb/gnorb-gnus.el index 27226ac..4027870 100644 --- a/packages/gnorb/gnorb-gnus.el +++ b/packages/gnorb/gnorb-gnus.el @@ -753,6 +753,42 @@ exclude. See Info node `(org)Matching tags and properties'." (message "No matching messages in this group" ;;;###autoload +(defun gnorb-gnus-insert-tracked-messages (show-all) + "Insert tracked messages into the Summary buffer. +Only inserts tracked messages belonging to this group. If +SHOW-ALL (interactively, the prefix arg) is non-nil, insert all +messages; otherwise only insert messages that are tracked by a +heading in a non-DONE state." + (interactive "P") + (let ((old (sort (mapcar 'car gnus-newsgroup-data) '<)) + (tracked-messages +(registry-search gnus-registry-db + :regex `((gnorb-ids ".+")) + :member `((group ,gnus-newsgroup-name) +(unless show-all + (setq tracked-messages + (cl-remove-if +(lambda (msg-id) + (let ((id (car-safe (gnus-registry-get-id-key + msg-id 'gnorb-ids +(or (null id) +(save-window-excursion + (org-id-goto id) + (org-entry-is-done-p) +tracked-messages))) +(if tracked-messages + (progn + (setq tracked-messages + (delq nil + (mapcar (lambda (id) + (cdr (gnus-request-head id gnus-newsgroup-name))) + tracked-messages))) + (gnus-summary-insert-articles tracked-messages) + (gnus-summary-limit (gnus-sorted-nunion tracked-messages old)) + (gnus-summary-position-point)) + (message "No tracked messages in this group" + +;;;###autoload (defun gnorb-gnus-search-messages (str persist &optional head-text ret) "Initiate a search for gnus message links in an org subtree. The arg STR can be one of two things: an Org heading id value diff --git a/packages/gnorb/gnorb-registry.el b/packages/gnorb/gnorb-registry.el index ca2d7f5..e6dc7b9 100644 --- a/packages/gnorb/gnorb-registry.el +++ b/packages/gnorb/gnorb-registry.el @@ -197,17 +197,18 @@ key." (defun gnorb-registry-tracked-headings () "Return all Org heading ids that are associated with messages." (hash-table-keys - (registry-lookup-secondary gnus-r
[elpa] master updated (1aad213 -> 5895bc3)
girzel pushed a change to branch master. from 1aad213 * copyright_exceptions: Update for new uni-confusables/gen-confusables.el new 2111d3f Gnorb: New command for inserting tracked messages; bump to 1.4.1 new 5895bc3 Gnorb: Fix and bump to 1.4.2 Summary of changes: packages/gnorb/README.org| 9 -- packages/gnorb/gnorb-gnus.el | 36 packages/gnorb/gnorb-registry.el | 59 packages/gnorb/gnorb-utils.el| 3 +- packages/gnorb/gnorb.el | 2 +- packages/gnorb/gnorb.info| 49 - packages/gnorb/gnorb.org | 10 +++ packages/gnorb/gnorb.texi| 14 -- 8 files changed, 133 insertions(+), 49 deletions(-)
[elpa] master updated (b8c5937 -> 0142fa0)
girzel pushed a change to branch master. from b8c5937 * stream/tests/stream-tests.el: Require 'generator' new f1c142b Gnorb: The proper link type is "mailto", not "mail" new 0142fa0 Prefer defalias to fset Summary of changes: packages/gnorb/gnorb-bbdb.el | 40 packages/gnorb/gnorb-gnus.el | 16 packages/gnorb/gnorb-org.el | 4 ++-- 3 files changed, 30 insertions(+), 30 deletions(-)
[elpa] master 0142fa0 2/2: Prefer defalias to fset
branch: master commit 0142fa028afe67dbca12418ddbaf40f7bc318365 Author: Eric Abrahamsen Commit: Eric Abrahamsen Prefer defalias to fset * packages/gnorb/gnorb-bbdb.el: * packages/gnorb/gnorb-gnus.el: Use defalias to construct ad-hoc function symbols. --- packages/gnorb/gnorb-bbdb.el | 40 packages/gnorb/gnorb-gnus.el | 16 2 files changed, 28 insertions(+), 28 deletions(-) diff --git a/packages/gnorb/gnorb-bbdb.el b/packages/gnorb/gnorb-bbdb.el index dd129ab..1c41848 100644 --- a/packages/gnorb/gnorb-bbdb.el +++ b/packages/gnorb/gnorb-bbdb.el @@ -166,15 +166,15 @@ be composed, just as in `gnus-posting-styles'." :type 'list) (when (fboundp 'bbdb-record-xfield-string) - (fset (intern (format "bbdb-read-xfield-%s" - gnorb-bbdb-org-tag-field)) - (lambda (&optional init) - (gnorb-bbdb-read-org-tags init))) + (defalias (intern (format "bbdb-read-xfield-%s" + gnorb-bbdb-org-tag-field)) +(lambda (&optional init) + (gnorb-bbdb-read-org-tags init))) - (fset (intern (format "bbdb-display-%s-multi-line" - gnorb-bbdb-org-tag-field)) - (lambda (record indent) - (gnorb-bbdb-display-org-tags record indent + (defalias (intern (format "bbdb-display-%s-multi-line" + gnorb-bbdb-org-tag-field)) +(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'." @@ -518,22 +518,22 @@ layout type." (t "")) -(fset (intern (format "bbdb-display-%s-multi-line" - gnorb-bbdb-messages-field)) - (lambda (record indent) - (gnorb-bbdb-display-messages record 'multi indent))) +(defalias (intern (format "bbdb-display-%s-multi-line" + gnorb-bbdb-messages-field)) + (lambda (record indent) +(gnorb-bbdb-display-messages record 'multi indent))) -(fset (intern (format "bbdb-display-%s-one-line" - gnorb-bbdb-messages-field)) - (lambda (record) - (gnorb-bbdb-display-messages record 'one))) +(defalias (intern (format "bbdb-display-%s-one-line" + gnorb-bbdb-messages-field)) + (lambda (record) +(gnorb-bbdb-display-messages record 'one))) ;; Don't allow direct editing of this field -(fset (intern (format "bbdb-read-xfield-%s" - gnorb-bbdb-messages-field)) - (lambda (&optional _init) - (user-error "This field shouldn't be edited manually"))) +(defalias (intern (format "bbdb-read-xfield-%s" + gnorb-bbdb-messages-field)) + (lambda (&optional _init) +(user-error "This field shouldn't be edited manually"))) ;; Open links from the *BBDB* buffer. diff --git a/packages/gnorb/gnorb-gnus.el b/packages/gnorb/gnorb-gnus.el index 4027870..77e21ce 100644 --- a/packages/gnorb/gnorb-gnus.el +++ b/packages/gnorb/gnorb-gnus.el @@ -908,10 +908,10 @@ option `gnorb-gnus-hint-relevant-article' is non-nil." (t " "))) " ")) -(fset (intern (concat "gnus-user-format-function-" - gnorb-gnus-summary-mark-format-letter)) - (lambda (header) - (gnorb-gnus-insert-format-letter-maybe header))) +(defalias (intern (concat "gnus-user-format-function-" + gnorb-gnus-summary-mark-format-letter)) + (lambda (header) +(gnorb-gnus-insert-format-letter-maybe header))) (defun gnorb-gnus-insert-format-tags (header) (let* ((id (mail-header-message-id header)) @@ -924,10 +924,10 @@ option `gnorb-gnus-hint-relevant-article' is non-nil." ":" (mapconcat #'identity tags ":") ":") ""))) -(fset (intern (concat "gnus-user-format-function-" - gnorb-gnus-summary-tags-format-letter)) - (lambda (header) - (gnorb-gnus-insert-format-tags header))) +(defalias (intern (concat "gnus-user-format-function-" + gnorb-gnus-summary-tags-format-letter)) + (lambda (header) +(gnorb-gnus-insert-format-tags header))) ;;;###autoload (defun gnorb-gnus-view ()
[elpa] master f1c142b 1/2: Gnorb: The proper link type is "mailto", not "mail"
branch: master commit f1c142b6db734f2867433681fd8f61565694c0fe Author: Eric Abrahamsen Commit: Eric Abrahamsen Gnorb: The proper link type is "mailto", not "mail" * packages/gnorb/gnorb-org.el (gnorb-org-extract-links, gnorb-org-handle-mail): Fix link type. --- packages/gnorb/gnorb-org.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/packages/gnorb/gnorb-org.el b/packages/gnorb/gnorb-org.el index 00b46d6..485b988 100644 --- a/packages/gnorb/gnorb-org.el +++ b/packages/gnorb/gnorb-org.el @@ -223,7 +223,7 @@ we came from." (insert s) (insert "\n")) (goto-char (point-min)) - (gnorb-scan-links (point-max) 'gnus 'mail 'bbdb 'ebdb) + (gnorb-scan-links (point-max) 'gnus 'mailto 'bbdb 'ebdb) (defun gnorb-org-extract-mail-stuff (&optional arg region) "Decide how to hande the Org heading under point as an email task. @@ -484,7 +484,7 @@ composed. FILE is a file to attach to the message." (gnorb-bbdb-configure-posting-styles (list (car b-recs)) (gnorb-org-setup-message (alist-get 'gnus links) - (append mails (alist-get 'mail links)) + (append mails (alist-get 'mailto links)) from cc bcc attachments text org-id))
[elpa] externals/ebdb 2a25117 6/9: New option ebdb-print-object-name
branch: externals/ebdb commit 2a251170a3e11d13c1550c3f1e236793f037f29a Author: Eric Abrahamsen Commit: Eric Abrahamsen New option ebdb-print-object-name * ebdb.el (ebdb-print-object-name): Local equivalent to eieio-print-object-name. (ebdb-db-save): Set eieio variable based on this option. --- ebdb.el | 17 +++-- 1 file changed, 15 insertions(+), 2 deletions(-) diff --git a/ebdb.el b/ebdb.el index de396a5..b3cf84c 100644 --- a/ebdb.el +++ b/ebdb.el @@ -182,7 +182,7 @@ to errors or database corruption." :type 'boolean) ;; Do not use this to prevent writing of object-names via -;; `eieio-print-object-names', older Emacs will choke if it's not +;; `eieio-print-object-name', older Emacs will choke if it's not ;; present. (defcustom ebdb-vacuum-databases t "When non-nil, minimize the size of database files. @@ -192,6 +192,18 @@ in the future more shrinkage may be possible." :group 'ebdb-eieio :type 'boolean) +(defcustom ebdb-print-object-name t + "When non-nil, print object names in the database files. +This is an EBDB-specific version of the option +`eieio-print-object-name', which only exists in Emacs 27 or +higher. It will have no effect in earlier versions of Emacs, but +do note that Emacs 26 or lower REQUIRES that the name be present, +and will raise an error if it is not. If there's a chance that a +database might be written by a newer Emacs, and read by an older, +do not set this to nil." + :group 'ebdb-eieio + :type 'boolean) + (defgroup ebdb nil "EBDB customizations" :group 'news @@ -3853,7 +3865,8 @@ the persistent save, or allow them to propagate.") (cl-defmethod ebdb-db-save ((db ebdb-db) &optional _prompt force) "Mark DB and all its records as \"clean\" after saving." (let ((recs (ebdb-dirty-records (slot-value db 'records))) - (eieio-print-indentation (null ebdb-vacuum-databases))) + (eieio-print-indentation (null ebdb-vacuum-databases)) + (eieio-print-object-name ebdb-print-object-name)) (when (or force recs (slot-value db 'dirty)) (setf (slot-value db 'dirty) nil) (dolist (r recs)
[elpa] externals/ebdb 9102219 7/9: Re-work ebdb-records-cite
branch: externals/ebdb commit 9102219eb28c1b02af4aa93dc4f72ae1706fbb3c Author: Eric Abrahamsen Commit: Eric Abrahamsen Re-work ebdb-records-cite * ebdb.el (ebdb-records-cite): I was trying to be too clever combining :around methods with &context specializers, and generally tripping over my own feet. This version has more duplicate code, but behaves correctly. --- ebdb.el | 121 +--- 1 file changed, 54 insertions(+), 67 deletions(-) diff --git a/ebdb.el b/ebdb.el index b3cf84c..356b90c 100644 --- a/ebdb.el +++ b/ebdb.el @@ -4980,79 +4980,66 @@ inserting it." (cl-defgeneric ebdb-records-cite (style records) "Return mode-appropriate mail strings for RECORDS. STYLE is a symbol, one of 'inline or 'list. This is interpreted -differently by different major modes. +differently by different major modes; the default looks like +\"Firstname Lastname \". This is a generic function that dispatches on the value of `major-mode'. It only inserts names and mail addresses.") +(cl-defmethod ebdb-records-cite ((_style (eql list)) +(records list)) + (mapconcat (lambda (pair) + (format "%s <%s>" + ;; TODO: Wrap non-ASCII record names in double + ;; quotes? + (ebdb-string (car pair)) + (ebdb-string (cdr pair +records "\n")) + (cl-defmethod ebdb-records-cite ((_style (eql inline)) +(records list)) + (mapconcat (lambda (pair) + (format "%s <%s>" + (ebdb-string (car pair)) + (ebdb-string (cdr pair +records ", ")) + +(cl-defmethod ebdb-records-cite ((_style (eql list)) +(records list) +&context (major-mode org-mode)) + (mapconcat (lambda (pair) + (format "- [[mailto:%s][%s]]"; + (slot-value (cdr pair) 'mail) + (ebdb-string (car pair +records "\n")) + +(cl-defmethod ebdb-records-cite ((_style (eql inline)) +(records list) +&context (major-mode org-mode)) + (mapconcat (lambda (pair) + (format "[[mailto:%s][%s]]"; + (slot-value (cdr pair) 'mail) + (ebdb-string (car pair +records ", ")) + +(cl-defmethod ebdb-records-cite ((_style (eql list)) (records list) -&context (major-mode message-mode)) - (when records -(mapcar (lambda (pair) - (format "%s <%s>" - (ebdb-string (car pair)) - (ebdb-string (cdr pair - records))) - -(cl-defmethod ebdb-records-cite :around ((_style (eql inline)) -(_records list) -&context (major-mode message-mode)) - (let ((lst (cl-call-next-method))) -(mapconcat #'identity lst ", "))) - - -(cl-defmethod ebdb-records-cite :around ((_style (eql list)) -(_records list) -&context (major-mode message-mode)) - (let ((lst (cl-call-next-method))) -(mapconcat #'identity lst "\n"))) - -(cl-defmethod ebdb-records-cite :around ((_style (eql list)) -(_records list) -&context (major-mode org-mode)) - (let ((list (cl-call-next-method))) -(mapconcat (lambda (elt) -(format "- %s" elt)) - list "\n"))) - -(cl-defmethod ebdb-records-cite :around ((_style (eql inline)) -(_records list) -&context (major-mode org-mode)) - (let ((lst (cl-call-next-method))) -(mapconcat #'identity lst " "))) - -(cl-defmethod ebdb-records-cite - (_style (records list) &context (major-mode org-mode)) - "Insert RECORDS as a list of org links." - (mapcar (lambda (pair) - (format "[[mailto:%s][%s]]"; - (slot-value (cdr pair) 'mail) - (ebdb-string (car pair - records)) - -(cl-defmethod ebdb-records-cite :around ((_style (eql list)) -(_records list) -&context (major-mode html-mode)) - (let ((list (cl-call-next-method))) -(mapconcat (lambda (l) -(format "%s" l)) - list "\n"
[elpa] externals/ebdb updated (5735686 -> 2c71ef9)
girzel pushed a change to branch externals/ebdb. from 5735686 New ebdb-fmt-field for the oneline style in EBDB buffers new 6395a75 Manipulation of ebdb-db-list *still* in the wrong place new c07f50b Get rid of ebdb-version new 4796722 Fix mail sorting new 639694c Docstring changes new 7f51a4e Make explicit "full" formatter new 2a25117 New option ebdb-print-object-name new 9102219 Re-work ebdb-records-cite new 44cce48 Absorb helm-ebdb package, rename to ebdb-helm new 2c71ef9 Bump EBDB version to 0.4.3 Summary of changes: ebdb-com.el | 180 +-- ebdb-helm.el| 79 +++ ebdb-migrate.el | 4 +- ebdb-mua.el | 96 +++-- ebdb.el | 434 +--- 5 files changed, 431 insertions(+), 362 deletions(-) create mode 100644 ebdb-helm.el
[elpa] externals/ebdb 7f51a4e 5/9: Make explicit "full" formatter
branch: externals/ebdb commit 7f51a4e1ae8be101ef09048908a1d6d9e8baa50d Author: Eric Abrahamsen Commit: Eric Abrahamsen Make explicit "full" formatter * ebdb-com.el (ebdb-full-formatter): New defconst holding the formatter used for displaying all a record's fields, even internal fields. (ebdb-display-records-completely): Use this new formatter. The old "clone" trick added a new spurious formatter to the formatter tracker every time it was called. --- ebdb-com.el | 17 ++--- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/ebdb-com.el b/ebdb-com.el index c7afbff..7688b01 100644 --- a/ebdb-com.el +++ b/ebdb-com.el @@ -428,6 +428,14 @@ position-marker mark)." :type 'ebdb-formatter-ebdb-oneline :group 'ebdb-record-display) +(defconst ebdb-full-formatter + (make-instance 'ebdb-formatter-ebdb-multiline +:include nil :exclude nil +:combine nil :collapse nil +:object-name "full formatter") + "Formatter used for displaying all values of a record. +This formatter should not be changed.") + (defun ebdb-available-ebdb-formatters () "A list of formatters available in the *EBDB* buffer. This list is also used for toggling layouts." @@ -1852,14 +1860,9 @@ With any other non-nil ARG, RECORDS are displayed expanded." ;;;###autoload (defun ebdb-display-records-completely (records) - "Display RECORDS using layout `full-multi-line' (i.e., display all fields)." + "Display all fields of RECORDS." (interactive (list (ebdb-do-records))) - (let* ((record (ebdb-current-record t)) - (current-fmt (nth 1 record)) -;; TODO: Something weird happens with duplication of -;; formatter objects when we do this. - (fmt (clone current-fmt :include nil :exclude nil))) -(ebdb-redisplay-records records fmt))) + (ebdb-redisplay-records records ebdb-full-formatter)) ;;;###autoload (defun ebdb-display-records-with-fmt (records fmt)
[elpa] externals/ebdb 44cce48 8/9: Absorb helm-ebdb package, rename to ebdb-helm
branch: externals/ebdb
commit 44cce4888dfbaf59f2c88f3181e0f7c2168fa30e
Author: Eric Abrahamsen
Commit: Eric Abrahamsen
Absorb helm-ebdb package, rename to ebdb-helm
* ebdb-helm.el: Don't requre helm, only declare-function.
---
ebdb-helm.el | 79
1 file changed, 79 insertions(+)
diff --git a/ebdb-helm.el b/ebdb-helm.el
new file mode 100644
index 000..9e6ebaf
--- /dev/null
+++ b/ebdb-helm.el
@@ -0,0 +1,79 @@
+;;; ebdb-helm.el --- Helm integration for EBDB -*- lexical-binding: t;
-*-
+
+;; Copyright (C) 2018 Free Software Foundation, Inc.
+
+;; Author: Eric Abrahamsen
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Helm integration for EBDB. Provides the command `helm-ebdb'.
+
+;;; Code:
+
+(require 'ebdb-com)
+
+(declare-function helm-other-buffer "ext:helm"
+ (any-sources any-buffer))
+
+(declare-function helm-marked-candidates "ext:helm"
+ (&key with-wildcard all-sources))
+
+(defun ebdb-helm-candidates ()
+ "Return a list of all records in the database."
+ (mapcar (lambda (rec)
+ (let* ((rec-string (ebdb-string rec))
+ (mails (ebdb-record-mail-canon rec))
+ (mail-list (when mails
+ (mapconcat #'identity
+ mails
+ " "
+ (cons (if mail-list
+ (concat rec-string
+ " => "
+ mail-list)
+ rec-string)
+ rec)))
+ (ebdb-records)))
+
+(defun ebdb-helm-display-records (_candidate)
+ "Display marked candidate(s)."
+ (ebdb-display-records
+ (helm-marked-candidates) nil nil t nil
+ (format "*%s*" ebdb-buffer-name)))
+
+(defun ebdb-helm-compose-mail (_candidate)
+ "Compose mail to marked candidate(s)."
+ (ebdb-mail (helm-marked-candidates) nil current-prefix-arg))
+
+(defun ebdb-helm-cite-records (_candidate)
+ "Insert mode-appropriate \"Name \" string candidate(s)."
+ (ebdb-cite-records (helm-marked-candidates) current-prefix-arg))
+
+(defvar helm-source-ebdb
+ '((name . "EBDB")
+(candidates . ebdb-helm-candidates)
+(action . (("Display" . ebdb-helm-display-records)
+ ("Send mail" . ebdb-helm-compose-mail)
+ ("Insert name and address" . ebdb-helm-cite-records)
+
+;;;###autoload
+(defun ebdb-helm ()
+ "Preconfigured `helm' for EBDB."
+ (interactive)
+ (helm-other-buffer 'helm-source-ebdb "*helm ebdb*"))
+
+(provide 'helm-ebdb)
+;;; helm-ebdb.el ends here
[elpa] externals/ebdb 639694c 4/9: Docstring changes
branch: externals/ebdb commit 639694c3c8f7f57ed54e66a9b5193ab1e1fe8e08 Author: Eric Abrahamsen Commit: Eric Abrahamsen Docstring changes Inspired by checkdoc. --- ebdb-com.el | 163 ++- ebdb-mua.el | 96 --- ebdb.el | 252 ++-- 3 files changed, 257 insertions(+), 254 deletions(-) diff --git a/ebdb-com.el b/ebdb-com.el index d9b49ce..c7afbff 100644 --- a/ebdb-com.el +++ b/ebdb-com.el @@ -71,9 +71,8 @@ windows by other splitting/display code." :group 'ebdb-record-display :type 'boolean) -(defcustom ebdb-fill-field-values 't - "If t, fill particularly long field values so that they fit -within the *EBDB* buffer." +(defcustom ebdb-fill-field-values t + "When non-nil, fill long field values." :group 'ebdb-record-display :type '(choice (const :tag "Always fill" nil) (const :tag "Never fill" t))) @@ -100,8 +99,8 @@ Used by `ebdb-mouse-menu'." (defcustom ebdb-name-face-alist '((ebdb-record-person . ebdb-person-name) (ebdb-record-organization . ebdb-organization-name)) - "Alist matching record class types to the face that should be - used to font-lock their names in the *EBDB* buffer." + "Alist of record class types to the face names. +Faces are used to font-lock their names in the *EBDB* buffer." :group 'ebdb-faces :type '(repeat (cons (ebdb-record :tag "Record type") (face :tag "Face" @@ -177,13 +176,11 @@ Used by `ebdb-mouse-menu'." ;;; Buffer-local variables for the database. (defvar-local ebdb-records nil "EBDB records list. - In the *EBDB* buffers it includes the records that are actually displayed and its elements are (RECORD DISPLAY-FORMAT MARKER-POS MARK).") (defvar-local ebdb-search-history nil "A list of lists of previously-displayed EBDB records in this buffer. - For each search in a user-initiated EBDB buffer, the previously-displayed EBDB records are pushed here, as a list of UUIDs. ebdb-mode keybindings make it possible to pop back to @@ -193,11 +190,12 @@ previous records.") "Precalculated mode line info for EBDB commands. This is a vector [INVERT-M INVERT]. -INVERT-M is the mode line info if `ebdb-search-invert' is non-nil.") +INVERT-M is the mode line info if variable `ebdb-search-invert' is non-nil.") (defun ebdb-get-records (prompt) "If inside the *EBDB* buffer get the current records. -In other buffers ask the user." +In other buffers ask the user. +Argument PROMPT is passed to `ebdb-completing-read-records'." (if (eql major-mode 'ebdb-mode) (ebdb-do-records) (ebdb-completing-read-records prompt))) @@ -367,10 +365,11 @@ display information." This is a child of `special-mode-map'.") (defun ebdb-current-record (&optional full) - "Return the record point is at. -If FULL is non-nil record includes the display information." + "Return the record under point. +If FULL is non-nil, return a list of (record formatter +position-marker mark)." (unless (eq major-mode 'ebdb-mode) -(error "This only works while in EBDB buffers.")) +(error "This only works while in EBDB buffers")) (let ((num (get-text-property (if (and (not (bobp)) (eobp)) (1- (point)) (point)) 'ebdb-record-number)) @@ -380,7 +379,7 @@ If FULL is non-nil record includes the display information." (if full record (car record (defun ebdb-current-field () - "Return current field point is on." + "Return record field under point." (unless (ebdb-current-record) (error "Not a EBDB record")) (or (get-text-property (point) 'ebdb-field) (get-text-property @@ -431,7 +430,6 @@ If FULL is non-nil record includes the display information." (defun ebdb-available-ebdb-formatters () "A list of formatters available in the *EBDB* buffer. - This list is also used for toggling layouts." (seq-filter (lambda (f) (object-of-class-p f 'ebdb-formatter-ebdb)) @@ -445,6 +443,7 @@ This list is also used for toggling layouts." ;; *EBDB* buffer formatting. (cl-defmethod ebdb-record-db-char-string ((record ebdb-record)) + "Return a char string indicating RECORDs databases." (let* ((dbs (slot-value (ebdb-record-cache record) 'database)) (char-string (concat @@ -1113,7 +1112,7 @@ popped up from." ;;;###autoload (define-derived-mode ebdb-mode special-mode "EBDB" - "Major mode for viewing and editing the Insidious Big Brother Database. + "Major mode for viewing and editin
[elpa] externals/ebdb c07f50b 2/9: Get rid of ebdb-version
branch: externals/ebdb commit c07f50bdbb0baf1c2500b0faccd832bfd574f6e5 Author: Eric Abrahamsen Commit: Eric Abrahamsen Get rid of ebdb-version * ebdb.el: Removing ebdb-version (function and variable) and ebdb-version-date. Sort of pointless with a package. --- ebdb-migrate.el | 4 ++-- ebdb.el | 19 +-- 2 files changed, 3 insertions(+), 20 deletions(-) diff --git a/ebdb-migrate.el b/ebdb-migrate.el index 35247c2..8010c3d 100644 --- a/ebdb-migrate.el +++ b/ebdb-migrate.el @@ -642,8 +642,8 @@ BBDB sets the default of that option." (unless file-format ; current file-format, but no file-format: line. (error "BBDB corrupted: no file-format line")) (if (> file-format ebdb-file-format) -(error "EBDB version %s understands file format %s but not %s." - ebdb-version ebdb-file-format file-format) +(error "EBDB understands file format %s but not %s." + ebdb-file-format file-format) (setq migrate (< file-format ebdb-file-format))) (unless (re-search-forward "^\\[" nil t) (error "Unreadabe BBDB file: no contacts found")) diff --git a/ebdb.el b/ebdb.el index c3318db..4174e24 100644 --- a/ebdb.el +++ b/ebdb.el @@ -93,12 +93,6 @@ of the `ebdb-field-role' field class.") "Enable debugging if non-nil during compile time. You really should not disable debugging. But it will speed things up.")) -(defvar ebdb-version "e" - "EBDB version.") - -(defvar ebdb-version-date "October 15, 2016" - "Date this version of EBDB was released.") - (defvar ebdb-silent-internal nil "Bind this to t to quiet things down - do not set it. See also `ebdb-silent'.") @@ -5096,22 +5090,11 @@ If PROMPT is non-nil prompt before saving." (set-buffer-modified-p nil (message "Saving the EBDB... done")) -;;;###autoload -(defun ebdb-version (&optional arg) - "Return string describing the version of EBDB. -With prefix ARG, insert string at point." - (interactive (list (or (and current-prefix-arg 1) t))) - (let ((version-string (format "EBDB version %s (%s)" -ebdb-version ebdb-version-date))) -(cond ((numberp arg) (insert (message version-string))) - ((eq t arg) (message version-string)) - (t version-string - ;;; Searching EBDB (defvar ebdb-search-invert nil - "Bind this variable to t in order to invert the result of `ebdb-search'.") + "Bind to t to invert the result of `ebdb-search'.") ;; Char folding: a simplified version of what happens in char-fold.el.
[elpa] externals/ebdb 2c71ef9 9/9: Bump EBDB version to 0.4.3
branch: externals/ebdb commit 2c71ef9e8d9a5d968eb0601a535b844cd593e62c Author: Eric Abrahamsen Commit: Eric Abrahamsen Bump EBDB version to 0.4.3 --- ebdb.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ebdb.el b/ebdb.el index 356b90c..38a68b1 100644 --- a/ebdb.el +++ b/ebdb.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2016-2017 Free Software Foundation, Inc. -;; Version: 0.4.2 +;; Version: 0.4.3 ;; Package-Requires: ((emacs "25.1") (cl-lib "0.5") (seq "2.15")) ;; Maintainer: Eric Abrahamsen
[elpa] externals/ebdb 4796722 3/9: Fix mail sorting
branch: externals/ebdb commit 47967221b77b0e3c75b8fa53d766cda8bbe8e9c1 Author: Eric Abrahamsen Commit: Eric Abrahamsen Fix mail sorting * ebdb.el: This was supposed to be an :after method, on ebdb-record-insert-field, not a :before. --- ebdb.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ebdb.el b/ebdb.el index 4174e24..126fbc5 100644 --- a/ebdb.el +++ b/ebdb.el @@ -3014,7 +3014,7 @@ If FIELD doesn't specify a year, use the current year." (cl-defmethod ebdb-record-organizations ((_record ebdb-record-entity)) nil) -(cl-defmethod ebdb-record-insert-field :before ((record ebdb-record-entity) +(cl-defmethod ebdb-record-insert-field :after ((record ebdb-record-entity) (_mail ebdb-field-mail) &optional _slot) "After giving RECORD a new mail field, sort RECORD's mails by
[elpa] externals/ebdb 6395a75 1/9: Manipulation of ebdb-db-list *still* in the wrong place
branch: externals/ebdb commit 6395a75e301552db956ed091aa5bd868cd610255 Author: Eric Abrahamsen Commit: Eric Abrahamsen Manipulation of ebdb-db-list *still* in the wrong place Despite d88895 * ebdb.el (ebdb-load): If a user were adding a database object directly to the list, it would not have gotten added to ebdb-db-list. --- ebdb.el | 21 +++-- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/ebdb.el b/ebdb.el index 6dca7b4..c3318db 100644 --- a/ebdb.el +++ b/ebdb.el @@ -4903,8 +4903,7 @@ important work is done by the `ebdb-db-load' method." (when (yes-or-no-p (format "%s does not exist, create? " s)) (setq s (make-instance 'ebdb-db-file :file s :dirty t)) ;; Try to get it on disk first. -(ebdb-db-save s))) -(cl-pushnew s ebdb-db-list)) +(ebdb-db-save s ((null (and (eieio-object-p s) (object-of-class-p s 'ebdb-db))) (error "Source %s must be a filename or instance of `ebdb-db'." s))) @@ -4915,14 +4914,16 @@ important work is done by the `ebdb-db-load' method." ;; Remove this database's records from ;; `ebdb-record-tracker'. (mapc #'delete-instance (slot-value s 'records)) - (sit-for 2))) -(if (and -(null ebdb-record-tracker) -(or (and (bound-and-true-p bbdb-file) - (file-exists-p bbdb-file)) -(file-exists-p (locate-user-emacs-file "bbdb" ".bbdb" - ;; We're migrating from a version of BBDB. - (ebdb-migrate-from-bbdb)) + (sit-for 2)) + (cl-pushnew s ebdb-db-list)) + +(when (and + (null ebdb-record-tracker) + (or (and (bound-and-true-p bbdb-file) + (file-exists-p bbdb-file)) + (file-exists-p (locate-user-emacs-file "bbdb" ".bbdb" + ;; We're migrating from a version of BBDB. + (ebdb-migrate-from-bbdb)) (message "Initializing EBDB records...") (if (fboundp 'make-thread) (let ((thread (make-thread #'ebdb-initialize-threadwise)))
[elpa] externals/ebdb d53ddc1 08/15: Use Gnus' window configuration for popping up EBDB buffers
branch: externals/ebdb commit d53ddc16cd6e3d6ac0361a69acdc62e6dcba3a8d Author: Eric Abrahamsen Commit: Eric Abrahamsen Use Gnus' window configuration for popping up EBDB buffers * ebdb-gnus.el (ebdb-gnus-window-configuration): New customization option for changing how the *EBDB-Gnus* buffer is displayed. Something still isn't working correctly here, though -- while the Gnus article buffers are now wrapped correctly, the EBDB buffer still isn't wrapped right. Relevant to #62 --- ebdb-gnus.el | 32 ++-- 1 file changed, 30 insertions(+), 2 deletions(-) diff --git a/ebdb-gnus.el b/ebdb-gnus.el index fa71944..88303cd 100644 --- a/ebdb-gnus.el +++ b/ebdb-gnus.el @@ -35,6 +35,28 @@ :group 'ebdb-mua) (put 'ebdb-mua-gnus 'custom-loads '(ebdb-gnus)) +(defcustom ebdb-gnus-window-configuration + `(article +,(cond + (gnus-use-trees + '(vertical 1.0 + (summary 0.25 point) + (tree 0.25) + (horizontal 1.0 + (article 1.0) + (ebdb-gnus 0.4 + (t + '(vertical 1.0 + (summary 0.25 point) + (horizontal 1.0 + (article 1.0) + (ebdb-gnus 0.4)) + "Gnus window configuration to include EBDB. +By default, this adds the *EBDB-Gnus* window to the right of the +article buffer, taking up 40% of the horizontal space." + :group 'ebdb-mua-gnus + :type 'list) + (defgroup ebdb-mua-gnus-scoring nil "Gnus-specific scoring EBDB customizations" :group 'ebdb-mua-gnus) @@ -189,13 +211,19 @@ Note that `\( is the backquote, NOT the quote '\(." ;; Insinuation ;; -(add-hook 'gnus-article-prepare-hook 'ebdb-mua-auto-update) +(add-hook 'gnus-article-prepare-hook #'ebdb-mua-auto-update) -(add-hook 'gnus-startup-hook 'ebdb-insinuate-gnus) +(add-hook 'gnus-startup-hook #'ebdb-insinuate-gnus) (defsubst ebdb-gnus-buffer-name () (format "*%s-Gnus*" ebdb-buffer-name)) +;; Tell Gnus how to display the *EBDB-Gnus* buffer. +(with-eval-after-load "gnus-win" + (add-to-list 'gnus-window-to-buffer + `(ebdb-gnus . ,(ebdb-gnus-buffer-name))) + (gnus-add-configuration ebdb-gnus-window-configuration)) + (cl-defmethod ebdb-make-buffer-name (&context (major-mode gnus-summary-mode)) "Produce a EBDB buffer name associated with Gnus." (ebdb-gnus-buffer-name))
[elpa] externals/ebdb updated (2c71ef9 -> 091a744)
girzel pushed a change to branch externals/ebdb. from 2c71ef9 Bump EBDB version to 0.4.3 new fea7c5e Fix font inheritance of mail addresses new 03d432d Don't append citation to kill ring in ebdb-cite-records-ebdb new 5e42dff Forgot to pop-to-buffer to after creating citation buffer new b228892 Change interactive behavior of ebdb-mail-aliases new fff770e ebdb-mua defgroup in wrong file new 78cfb2a Pop up EBDB windows before formatting records new 8e8c2e1 Make gnus-message window config stuff customizable new d53ddc1 Use Gnus' window configuration for popping up EBDB buffers new ff6e919 Add a basic language field new 76f8d4b Make it clear what field type we're prompting for new 41912b9 Improve check for field existence during snarf collapsing new b56bf29 Adjust snarfing regexp for names new bb01b5c Mostly re-write ebdb-snarf-collect new 925e0ea Remove mail-citation-prefix-regexp from strings to snarf new 091a744 Make phone number snarfing regexp less permissive Summary of changes: ebdb-com.el | 31 +- ebdb-gnus.el| 36 +-- ebdb-i18n.el| 4 +- ebdb-message.el | 33 +++--- ebdb-mua.el | 4 ++ ebdb-snarf.el | 182 +++- ebdb.el | 24 7 files changed, 187 insertions(+), 127 deletions(-)
[elpa] externals/ebdb fea7c5e 01/15: Fix font inheritance of mail addresses
branch: externals/ebdb commit fea7c5ee5dd88bd41775c6278d4e7a063ee8f2d2 Author: Eric Abrahamsen Commit: Eric Abrahamsen Fix font inheritance of mail addresses * ebdb-com.el (ebdb-mail-defunct, ebdb-mail-primary): Had the inheritance order reversed. --- ebdb-com.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ebdb-com.el b/ebdb-com.el index 7688b01..95a4125 100644 --- a/ebdb-com.el +++ b/ebdb-com.el @@ -156,12 +156,12 @@ Faces are used to font-lock their names in the *EBDB* buffer." :group 'ebdb-faces) (defface ebdb-mail-defunct - '((t :inherit ebdb-mail-default ebdb-defunct)) + '((t :inherit ebdb-defunct ebdb-mail-default)) "Face used to display a defunct mail address." :group 'ebdb-faces) (defface ebdb-mail-primary - '((t (:inherit ebdb-mail-default font-lock-builtin-face))) + '((t (:inherit font-lock-builtin-face ebdb-mail-default))) "Face used to display a record's primary mail address." :group 'ebdb-faces)
[elpa] externals/ebdb 78cfb2a 06/15: Pop up EBDB windows before formatting records
branch: externals/ebdb commit 78cfb2ab8644110e1771614fd50e67a0aa8877f2 Author: Eric Abrahamsen Commit: Eric Abrahamsen Pop up EBDB windows before formatting records * ebdb-com.el (ebdb-display-records): In most cases, this ought to allow filling of record values to work correctly, because `window-text-width' will return a reasonable value. This still isn't working for Gnus, possibly because of how Gnus' window configuration works. Partially addresses #62 --- ebdb-com.el | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/ebdb-com.el b/ebdb-com.el index 1643ef9..b2301e9 100644 --- a/ebdb-com.el +++ b/ebdb-com.el @@ -591,8 +591,6 @@ This happens in addition to any pre-defined indentation of STRING." field-list)) 0)) (label-fmt (format " %%%ds" indent)) -;; `window-text-width' doesn't work for pop-up buffers, -;; they're not displayed yet! How do we resolve this...? (fill-column (window-text-width)) (fill-prefix (make-string (+ 5 indent) ?\s)) (paragraph-start "[^:]+:[^\n]+$") @@ -777,6 +775,8 @@ name based on the current major mode." (list r fmt (make-marker) nil)) records)) + (ebdb-pop-up-window target-buffer select pop) + (unless (or ebdb-silent-internal ebdb-silent) (message "Formatting EBDB...")) (let ((record-number 0) @@ -795,7 +795,6 @@ name based on the current major mode." (message "Formatting EBDB...done.")) (set-buffer-modified-p nil) - (ebdb-pop-up-window target-buffer select pop) (goto-char (point-min)) (set-window-start (get-buffer-window (current-buffer)) (point)
[elpa] externals/ebdb 03d432d 02/15: Don't append citation to kill ring in ebdb-cite-records-ebdb
branch: externals/ebdb
commit 03d432d770d97bf0f64d4d6379e4ecd0f14538c1
Author: Eric Abrahamsen
Commit: Eric Abrahamsen
Don't append citation to kill ring in ebdb-cite-records-ebdb
* ebdb-com.el (ebdb-cite-records-ebdb): If I'd gone to the trouble of
setting up the temp buffer, why would I then stick the citations on
the kill ring?
---
ebdb-com.el | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/ebdb-com.el b/ebdb-com.el
index 95a4125..fb089c2 100644
--- a/ebdb-com.el
+++ b/ebdb-com.el
@@ -2176,7 +2176,7 @@ otherwise inline."
("org" (org-mode))
("html" (html-mode))
(_ (message-mode)))
-(ebdb-cite-records records arg t)))
+(ebdb-cite-records records arg)))
;;; completion
[elpa] externals/ebdb 091a744 15/15: Make phone number snarfing regexp less permissive
branch: externals/ebdb
commit 091a744b43541a54dd3e991d1832339edcd642c5
Author: Eric Abrahamsen
Commit: Eric Abrahamsen
Make phone number snarfing regexp less permissive
* ebdb-snarf.el (ebdb-snarf-routines): This regexp was silly. It was
matching tiny little numbers, wreaking havoc on the snarfing
process. Also, those little tiny numbers should have raised an error
in ebdb-parse for phones.
---
ebdb-snarf.el | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/ebdb-snarf.el b/ebdb-snarf.el
index 77c6984..3f3a7a8 100644
--- a/ebdb-snarf.el
+++ b/ebdb-snarf.el
@@ -50,7 +50,7 @@
(ebdb-field-url ,(concat "\\("
(regexp-opt ebdb-url-valid-schemes)
"//[^ \n\t]+\\)"))
-(ebdb-field-phone "\\(\\+?[[:digit:]]\\{1,3\\}[ )-.]?[[:digit:]
-.()]+\\)"))
+(ebdb-field-phone "\\(\\+?[[:digit:]]\\{1,3\\}[ )-.]?[[:digit:]
-.()]\\{6,\\}\\)"))
"An alist of EBDB field classes and related regexps.
[elpa] externals/ebdb 41912b9 11/15: Improve check for field existence during snarf collapsing
branch: externals/ebdb commit 41912b992473ea25b13a0d620bf72ba027baef3c Author: Eric Abrahamsen Commit: Eric Abrahamsen Improve check for field existence during snarf collapsing * ebdb-snarf.el (ebdb-snarf-collapse): Instead of looking for an ebdb-string match for an existing field, use the higher-level `ebdb-record-search'. This should end up being a bit smarter about knowing when a record already has a field. --- ebdb-snarf.el | 41 ++--- 1 file changed, 18 insertions(+), 23 deletions(-) diff --git a/ebdb-snarf.el b/ebdb-snarf.el index d307f23..fa892fd 100644 --- a/ebdb-snarf.el +++ b/ebdb-snarf.el @@ -265,29 +265,24 @@ vectors, usually to `ebdb-snarf-query'." (append fields names) (setq record rec))) (if record - (let (slot) - (dolist (f fields) - (condition-case nil - (progn - (setq slot (car (ebdb-record-field-slot-query - (eieio-object-class record) - `(nil . ,(eieio-object-class f) - ;; Make sure that record can accept field, and doesn't - ;; already have it. - (unless - (when (setq slot-val (ignore-errors -(ebdb-record-field record slot))) - (member (ebdb-string f) - (mapcar #'ebdb-string - (if (listp slot-val) - slot-val - (list slot-val) - (push f out-fields))) - (ebdb-unacceptable-field nil))) - (dolist (name names) - (unless (ebdb-record-search -record 'ebdb-field-name (ebdb-string name)) - (push name out-names + (dolist (f fields) + (condition-case nil + (progn + ;; Make sure that record can accept field, and doesn't + ;; already have it. + (when (and (car-safe (ebdb-record-field-slot-query + (eieio-object-class record) + `(nil . ,(eieio-object-class f + (null (ebdb-record-search + record + (eieio-object-class f) + (ebdb-string f + (push f out-fields))) + (ebdb-unacceptable-field nil))) + (dolist (name names) + (unless (ebdb-record-search +record 'ebdb-field-name (ebdb-string name)) + (push name out-names))) (setq out-names names out-fields fields)) (push (vector record out-names out-fields) output)))
[elpa] externals/ebdb 76f8d4b 10/15: Make it clear what field type we're prompting for
branch: externals/ebdb commit 76f8d4b373d1634512cd3c99ddcd65928b4e53e1 Author: Eric Abrahamsen Commit: Eric Abrahamsen Make it clear what field type we're prompting for * ebdb-i18n.el (ebdb-read): In these methods for address and phone fields, the label prompt used to come first, and told the user what kind of field they were adding. Now label prompts come last, and the internationalized methods prompt for country first, and it wasn't clear (especially during record creation) what field type was being prompted for. Clarify that here. --- ebdb-i18n.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ebdb-i18n.el b/ebdb-i18n.el index be29f33..7d70baf 100644 --- a/ebdb-i18n.el +++ b/ebdb-i18n.el @@ -681,7 +681,7 @@ for their symbol representations." &optional slots obj) (let ((country (cdr (assoc (completing-read - "Country: " + "Address country: " (ebdb-i18n-countries) nil nil (when obj (car (rassoc (ebdb-address-country obj) @@ -736,7 +736,7 @@ for their symbol representations." (if obj (slot-value obj 'country-code) (cdr (assoc (completing-read - "Country/Region: " + "Phone number country/region: " ebdb-i18n-phone-codes nil nil) ebdb-i18n-phone-codes (area-code (when obj (slot-value obj 'area-code
[elpa] externals/ebdb fff770e 05/15: ebdb-mua defgroup in wrong file
branch: externals/ebdb commit fff770e56a57eaf70c982a249668aa0a91e68221 Author: Eric Abrahamsen Commit: Eric Abrahamsen ebdb-mua defgroup in wrong file For some reason it was in ebdb-gnus.el. Move to ebdb-mua.el. --- ebdb-gnus.el | 4 ebdb-mua.el | 4 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/ebdb-gnus.el b/ebdb-gnus.el index 5182c4d..fa71944 100644 --- a/ebdb-gnus.el +++ b/ebdb-gnus.el @@ -30,10 +30,6 @@ (autoload 'message-make-domain "message") -(defgroup ebdb-mua nil - "Variables that specify the EBDB-MUA interface" - :group 'ebdb) - (defgroup ebdb-mua-gnus nil "Gnus-specific EBDB customizations" :group 'ebdb-mua) diff --git a/ebdb-mua.el b/ebdb-mua.el index b9be39f..01a998f 100644 --- a/ebdb-mua.el +++ b/ebdb-mua.el @@ -69,6 +69,10 @@ "For communication between `ebdb-update-records' and `ebdb-query-create'. It is a list with elements (NAME MAIL HEADER HEADER-CLASS MUA).") +(defgroup ebdb-mua nil + "Variables that specify the EBDB-MUA interface" + :group 'ebdb) + (defcustom ebdb-mua-auto-update-p 'existing "Specify how EBDB handles addresses in mail messages. It can take one of the following values:
[elpa] externals/ebdb 8e8c2e1 07/15: Make gnus-message window config stuff customizable
branch: externals/ebdb commit 8e8c2e1ba0724c2a8c018765ec691183d397eb2a Author: Eric Abrahamsen Commit: Eric Abrahamsen Make gnus-message window config stuff customizable * ebdb-message.el (ebdb-message-reply-window-config, ebdb-message-reply-yank-window-config): New customization options, replacing the earlier hard-coded window configs. --- ebdb-message.el | 33 - 1 file changed, 24 insertions(+), 9 deletions(-) diff --git a/ebdb-message.el b/ebdb-message.el index 8bd304e..a29e093 100644 --- a/ebdb-message.el +++ b/ebdb-message.el @@ -35,6 +35,26 @@ :group 'ebdb-mua) (put 'ebdb-mua-message 'custom-loads '(ebdb-message)) +(defcustom ebdb-message-reply-window-config + '(reply +(horizontal 1.0 + (message 1.0 point) + (ebdb-message 0.4))) + "Message reply window configuration to show EBDB. +See Gnus' manual for details." + :group 'ebdb-mua-message + :type 'list) + +(defcustom ebdb-message-reply-yank-window-config + '(reply-yank + (horizontal 1.0 +(message 1.0 point) +(ebdb-message 0.4))) + "Message reply-yank window configuration to show EBDB. +See Gnus' manual for details." + :group 'ebdb-mua-message + :type 'list) + ;; Suggestions welcome: What are good keybindings for the following ;; commands that do not collide with existing bindings? ;; (define-key message-mode-map "'" 'ebdb-mua-display-recipients) @@ -102,20 +122,15 @@ ;; The gnus window configuration stanza makes sure it's displayed ;; after the message buffer is set up. (with-eval-after-load 'gnus-win - (add-to-list 'gnus-window-to-buffer `(ebdb . ,(ebdb-message-buffer-name))) + (add-to-list 'gnus-window-to-buffer + `(ebdb-message . ,(ebdb-message-buffer-name))) (add-hook 'message-header-setup-hook 'ebdb-mua-auto-update) (gnus-add-configuration - '(reply - (horizontal 1.0 -(message 1.0 point) -(ebdb 0.4 + ebdb-message-reply-window-config) (gnus-add-configuration - '(reply-yank - (horizontal 1.0 -(message 1.0 point) -(ebdb 0.4) + ebdb-message-reply-yank-window-config)) (provide 'ebdb-message) ;;; ebdb-message.el ends here
[elpa] externals/ebdb ff6e919 09/15: Add a basic language field
branch: externals/ebdb commit ff6e919e12491dc102f04a0ecf6aabdff3b2bca1 Author: Eric Abrahamsen Commit: Eric Abrahamsen Add a basic language field * ebdb.el (ebdb-field-language): New field. Has no particular behavior yet. Could possibly be used to switch input methods. --- ebdb.el | 24 1 file changed, 24 insertions(+) diff --git a/ebdb.el b/ebdb.el index 38a68b1..d3409fb 100644 --- a/ebdb.el +++ b/ebdb.el @@ -2118,6 +2118,30 @@ See `ebdb-url-valid-schemes' for a list of acceptable schemes." (cl-defmethod ebdb-string ((field ebdb-field-gender)) (symbol-name (slot-value field 'gender))) +;; Language field + +;; People should be able to put anything they want in here, but +;; ideally we'd do something special for the ISO 639-1 codes: + +;; https://en.wikipedia.org/wiki/List_of_ISO_639-1_codes + +(defclass ebdb-field-language (ebdb-field-user) + ((language +:initarg :language +:type string +:custom string)) + :human-readable "language" + :documentation "A field specifying a language that can be used + to communication with this contact.") + +(cl-defmethod ebdb-string ((field ebdb-field-language)) + (slot-value field 'language)) + +(cl-defmethod ebdb-read ((class (subclass ebdb-field-language)) &optional slots obj) + (let ((lang (ebdb-read-string + "Language: " (when obj (slot-value obj 'language)) nil nil))) +(cl-call-next-method class (plist-put slots :language lang) obj))) + ;;; Bank account field (defclass ebdb-field-bank-account (ebdb-field-user)
[elpa] externals/ebdb b228892 04/15: Change interactive behavior of ebdb-mail-aliases
branch: externals/ebdb commit b228892213b55202d54903cef85c4fae4bdb3ede Author: Eric Abrahamsen Commit: Eric Abrahamsen Change interactive behavior of ebdb-mail-aliases * ebdb-com.el (ebdb-mail-aliases): Remove optional "noisy" argument, nothing was using it. Instead use `called-interactively-p' to decide whether to add a message. --- ebdb-com.el | 8 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/ebdb-com.el b/ebdb-com.el index 4789817..1643ef9 100644 --- a/ebdb-com.el +++ b/ebdb-com.el @@ -2589,7 +2589,7 @@ If we are past `fill-column', wrap at the previous comma." ;;; interface to mail-abbrevs.el. ;;;###autoload -(defun ebdb-mail-aliases (&optional noisy) +(defun ebdb-mail-aliases () "Add aliases from the database to the global alias table. \\Give records a \"mail alias\" field to define an alias for that record. @@ -2600,8 +2600,7 @@ of all of these people. This function is automatically called each time an EBDB buffer is created. Alternately, use \\[ebdb-mail-aliases] in an *EBDB* -buffer to force an update. With optional argument NOISY, print a -message when updating is done." +buffer to force an update." (interactive) ;; Build `mail-aliases' if not yet done. @@ -2638,7 +2637,8 @@ message when updating is done." ',(mapcar (lambda (r) (ebdb-record-uuid (car r))) (cdr entry))) - (if noisy (message "EBDB mail alias: rebuilding done"))) + (when (called-interactively-p 'any) +(message "EBDB mail alias: rebuilding done"))) (defun ebdb-mail-abbrev-expand-hook (_alias records) "Function substituted for `mail-abbrev-expand-hook' when expanding RECORDS.
[elpa] externals/ebdb 925e0ea 14/15: Remove mail-citation-prefix-regexp from strings to snarf
branch: externals/ebdb commit 925e0ea3d005ce7ba16577029ffd051308d36f54 Author: Eric Abrahamsen Commit: Eric Abrahamsen Remove mail-citation-prefix-regexp from strings to snarf * ebdb-snarf.el (ebdb-snarf-collect): Work with common case of snarfing mail messages. --- ebdb-snarf.el | 6 +- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/ebdb-snarf.el b/ebdb-snarf.el index 6f85a0e..77c6984 100644 --- a/ebdb-snarf.el +++ b/ebdb-snarf.el @@ -176,7 +176,11 @@ list of other field instances. Any element can be nil." "\\)[-\n ,:]*"))) (with-temp-buffer - (insert str) + ;; Snarfing mail buffers is very common, try deleting citation + ;; prefixes from the buffer first. + (insert (replace-regexp-in-string + (concat "^" mail-citation-prefix-regexp "[:blank:]+") + "" str)) (goto-char (point-min)) (while (re-search-forward big-re nil t) (let* ((start (goto-char (match-beginning 0)))
[elpa] externals/ebdb b56bf29 12/15: Adjust snarfing regexp for names
branch: externals/ebdb
commit b56bf29dfe51e3310336dc39a27815e60d4353b3
Author: Eric Abrahamsen
Commit: Eric Abrahamsen
Adjust snarfing regexp for names
* ebdb-snarf.el (ebdb-snarf-name-re): The [:space:] class includes
newlines, which we don't want. Realistically, this regexp is going
to need a whole lot more adjustment to be useful.
---
ebdb-snarf.el | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/ebdb-snarf.el b/ebdb-snarf.el
index fa892fd..505fc10 100644
--- a/ebdb-snarf.el
+++ b/ebdb-snarf.el
@@ -65,7 +65,7 @@ expression should contain at least one parenthetical group:
the
:type 'list)
(defcustom ebdb-snarf-name-re
- (list "\\(?:[[:upper:]][[:lower:]'-]+[,.[:space:]]*\\)\\{2,\\}")
+ (list "\\(?:[[:upper:]][[:lower:]'-]+[,.[:blank:]]*\\)\\{2,\\}")
"A list of regular expressions matching names.
[elpa] externals/ebdb 5e42dff 03/15: Forgot to pop-to-buffer to after creating citation buffer
branch: externals/ebdb
commit 5e42dff0dfb4b207cbf7836107ec6adc979be661
Author: Eric Abrahamsen
Commit: Eric Abrahamsen
Forgot to pop-to-buffer to after creating citation buffer
* ebdb-com.el (ebdb-cite-records-ebdb): Not much use if you can't see
it.
---
ebdb-com.el | 14 --
1 file changed, 8 insertions(+), 6 deletions(-)
diff --git a/ebdb-com.el b/ebdb-com.el
index fb089c2..4789817 100644
--- a/ebdb-com.el
+++ b/ebdb-com.el
@@ -2171,12 +2171,14 @@ otherwise inline."
current-prefix-arg
(ebdb-do-records)
(completing-read "Style: " '("org" "html" "message") nil t)))
- (with-current-buffer (get-buffer-create "*EBDB Citation*")
-(pcase style
- ("org" (org-mode))
- ("html" (html-mode))
- (_ (message-mode)))
-(ebdb-cite-records records arg)))
+ (let ((buf (get-buffer-create "*EBDB Citation*")))
+(with-current-buffer buf
+ (pcase style
+ ("org" (org-mode))
+ ("html" (html-mode))
+ (_ (message-mode)))
+ (ebdb-cite-records records arg))
+(pop-to-buffer buf)))
;;; completion
[elpa] externals/ebdb bb01b5c 13/15: Mostly re-write ebdb-snarf-collect
branch: externals/ebdb
commit bb01b5c7ecd29b70797f76f83fbb5797818e26c6
Author: Eric Abrahamsen
Commit: Eric Abrahamsen
Mostly re-write ebdb-snarf-collect
* ebdb-snarf.el (ebdb-snarf-collect): Instead of searching for one
likely chunk of field data, and then progressively searching on
after that (which could skip field data depending on the order of
ebdb-snarf-routines), now find all contiguous field data in a single
search, then loop each search routine regexp over that whole block
of text. Seems to work a lot better, though there will be a million
edge cases to adjust for.
Addresses #58
---
ebdb-snarf.el | 131 +++---
1 file changed, 62 insertions(+), 69 deletions(-)
diff --git a/ebdb-snarf.el b/ebdb-snarf.el
index 505fc10..6f85a0e 100644
--- a/ebdb-snarf.el
+++ b/ebdb-snarf.el
@@ -149,17 +149,15 @@ list of other field instances. Any element can be nil."
;; (Also see the snarfing tests in ebdb-test.el.)
- ;; The tactic is: Make a big regexp that finds any probable
- ;; field data. Once there's a hit, search *backwards* for a
- ;; name, and *forwards* for more fields. All contiguous field
- ;; data is grouped into the same bundle. If the first field
- ;; found is at bol, assume "block" style data, as in the third
- ;; example above. If it is not at bol, assume "inline" style
- ;; data, as in the second example.
+ ;; The tactic is: Make a big regexp that finds a big blob of
+ ;; probable field data. Once there's a hit, search
+ ;; *backwards* for a name, and *forwards* for more fields.
+ ;; All contiguous field data is grouped into the same bundle.
;; Snarfing mail message data is very common, it would be nice
;; to somehow disregard left-hand quotation characters and
- ;; indendation. A problem for another day.
+ ;; indentation. See `mail-citation-prefix-regexp'. A problem
+ ;; for another day.
(big-re
(concat
"\\(?:"
@@ -169,73 +167,68 @@ list of other field instances. Any element can be nil."
(cadr r)
(mapconcat #'identity (cadr r) "\\|")))
ebdb-snarf-routines
- "\\|")
- "\\)"))
- bundle block name)
+ "\\|*")
+ "\\)+"))
+ (name-re (concat
+ "\\("
+ (mapconcat #'identity
+ebdb-snarf-name-re "\\|")
+ "\\)[-\n ,:]*")))
(with-temp-buffer
(insert str)
(goto-char (point-min))
(while (re-search-forward big-re nil t)
- (goto-char (match-beginning 0))
- (setq block (= (point) (point-at-bol)))
- (when (setq name
- (save-excursion
- (when (re-search-backward
-(concat
- "\\("
- (mapconcat #'identity
-ebdb-snarf-name-re "\\|")
- "\\)")
-(save-excursion
- (if block
- (progn (forward-line -1)
- (line-beginning-position))
-(point-at-bol)))
-t)
- ;; If something goes wrong with the
- ;; name, don't worry about it.
- (ignore-errors
- (ebdb-parse
- 'ebdb-field-name
- (string-trim (match-string-no-properties 0)))
- ;; If NAME matches one of the records that are already in
- ;; BUNDLES, then assume we should be working with that record.
- (dolist (b bundles)
- (when (and (aref b 0)
- (string-match-p (ebdb-string name)
- (ebdb-string (aref b 0
- (setq bundle b
-
- (unless bundle
- (setq bundle (make-vector 3 nil))
- (when name
- (push name (aref bundle 1
-
- (dolist (class ebdb-snarf-routines)
- (dolist (re (cdr class))
- (while (re-search-forward re (if block
-(save-excursion
- (forward-line)
- (line-end-position))
- (point-at-eol))
- t)
- (condition-case nil
- (push (ebdb-parse
-(car class)
-(match-str
[elpa] externals/ebdb 9e7a96f: Add experimental ebdb-completion-at-point-function
branch: externals/ebdb commit 9e7a96fdf8b5fb8ec14d173f3bb0383d461f5780 Author: Eric Abrahamsen Commit: Eric Abrahamsen Add experimental ebdb-completion-at-point-function * ebdb-complete.el (ebdb-completion-at-point-function): New function that could be used as a completion-at-point function. Not sure this is a good idea, though. --- ebdb-complete.el | 36 1 file changed, 36 insertions(+) diff --git a/ebdb-complete.el b/ebdb-complete.el index a892ddd..66c9a9b 100644 --- a/ebdb-complete.el +++ b/ebdb-complete.el @@ -56,6 +56,42 @@ (require 'message) (require 'sendmail) +;; Experimental completion-at-point function. I'm not sure this is a +;; good idea yet -- with a large enough EBDB database, nearly any +;; string is completable, meaning the other completion-at-point +;; functions will rarely get a chance. +(defun ebdb-completion-at-point-function () + "Try to find an EBDB completion for the text at point. +For use in `completion-at-point-functions'." + ;; Might consider restricting this to text-mode buffers -- would you + ;; ever want to complete contact names in prog-mode? + (let* ((start (point)) +(chunk (buffer-substring +(save-excursion + ;; First try going back two words. + (forward-word -2) + (setq start (point))) +(point))) +(completions (all-completions (downcase chunk) ebdb-hashtable))) +(unless completions + ;; If that didn't work, try just one word. + (setq chunk (buffer-substring + (save-excursion +(forward-word -1) +(setq start (point))) + (point)) + completions (all-completions (downcase chunk) ebdb-hashtable))) +(when completions + (list start (point) + (mapcar +(lambda (str) + ;; Gross. + (if (string-match-p "@" str) + str +(capitalize str))) +completions) + '(:exclusive no) + (defvar ebdb-complete-info (make-hash-table) "A hashtable, record buffer, buffer-window and window-point")
[elpa] externals/ebdb a25e1eb 06/15: Use values from "slots" in role field ebdb-read
branch: externals/ebdb commit a25e1eb35d45a6b3c8340cc04c0a2f2d150d2b5e Author: Eric Abrahamsen Commit: Eric Abrahamsen Use values from "slots" in role field ebdb-read * ebdb.el (ebdb-read): We should be allowing values in "slots" to override the read process. --- ebdb.el | 13 - 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/ebdb.el b/ebdb.el index eb0d396..cfb2e9f 100644 --- a/ebdb.el +++ b/ebdb.el @@ -1396,11 +1396,14 @@ first one." (cl-call-next-method)) (cl-defmethod ebdb-read ((role (subclass ebdb-field-role)) &optional slots obj) - (let ((org-id (if obj (slot-value obj 'org-uuid) - (ebdb-record-uuid (ebdb-prompt-for-record nil 'ebdb-record-organization - (mail (ebdb-with-exit - (ebdb-read ebdb-default-mail-class nil - (when obj (slot-value obj 'mail)) + (let ((org-id (or (plist-get slots 'org-uuid) + (if obj (slot-value obj 'org-uuid) + (ebdb-record-uuid (ebdb-prompt-for-record +nil 'ebdb-record-organization) + (mail (or (plist-get slots 'mail) + (ebdb-with-exit + (ebdb-read ebdb-default-mail-class nil + (when obj (slot-value obj 'mail))) (when mail (setq slots (plist-put slots :mail mail))) (setq slots (plist-put slots :org-uuid org-id))
[elpa] externals/ebdb 261454d 03/15: Return results of ebdb-loop-with-exit in correct order
branch: externals/ebdb commit 261454d490622abf1a4320ae277322083e3e8a87 Author: Eric Abrahamsen Commit: Eric Abrahamsen Return results of ebdb-loop-with-exit in correct order * ebdb.el (ebdb-loop-with-exit): Items should be in the order the user entered them. --- ebdb.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ebdb.el b/ebdb.el index 6f7a299..41b93da 100644 --- a/ebdb.el +++ b/ebdb.el @@ -788,7 +788,7 @@ if CHILD-P is non-nil, one of its subclasses." (while t (push ,@body acc)) ((quit ebdb-empty) - (throw '--ebdb-loop-exit-- acc)) + (throw '--ebdb-loop-exit-- (nreverse acc))) (defmacro ebdb-debug (&rest body) "Excecute BODY just like `progn' with debugging capability.
[elpa] externals/ebdb a7e88d4 14/15: Update copyright dates
branch: externals/ebdb commit a7e88d44368d315c4920a69654e5caf959d1 Author: Eric Abrahamsen Commit: Eric Abrahamsen Update copyright dates --- ebdb-com.el | 2 +- ebdb-format.el | 2 +- ebdb-gnus.el| 2 +- ebdb-i18n.el| 2 +- ebdb-ispell.el | 2 +- ebdb-message.el | 2 +- ebdb-mhe.el | 2 +- ebdb-migrate.el | 2 +- ebdb-mu4e.el| 2 +- ebdb-mua.el | 2 +- ebdb-org.el | 2 +- ebdb-pgp.el | 2 +- ebdb-rmail.el | 2 +- ebdb-snarf.el | 2 +- ebdb-vcard.el | 2 +- ebdb.el | 2 +- 16 files changed, 16 insertions(+), 16 deletions(-) diff --git a/ebdb-com.el b/ebdb-com.el index ac96ad2..1cb2f70 100644 --- a/ebdb-com.el +++ b/ebdb-com.el @@ -1,6 +1,6 @@ ;;; ebdb-com.el --- User-level commands of EBDB -*- lexical-binding: t; -*- -;; Copyright (C) 2016-2017 Free Software Foundation, Inc. +;; Copyright (C) 2016-2018 Free Software Foundation, Inc. ;; Author: Eric Abrahamsen ;; Keywords: convenience, mail diff --git a/ebdb-format.el b/ebdb-format.el index e17fa29..65e4dbd 100644 --- a/ebdb-format.el +++ b/ebdb-format.el @@ -1,6 +1,6 @@ ;;; ebdb-format.el --- Formatting/exporting EBDB records -*- lexical-binding: t; -*- -;; Copyright (C) 2016-2017 Free Software Foundation, Inc. +;; Copyright (C) 2016-2018 Free Software Foundation, Inc. ;; Author: Eric Abrahamsen diff --git a/ebdb-gnus.el b/ebdb-gnus.el index 88303cd..6938c8e 100644 --- a/ebdb-gnus.el +++ b/ebdb-gnus.el @@ -1,6 +1,6 @@ ;;; ebdb-gnus.el --- Gnus interface to EBDB -*- lexical-binding: t; -*- -;; Copyright (C) 2016-2017 Free Software Foundation, Inc. +;; Copyright (C) 2016-2018 Free Software Foundation, Inc. ;; Author: Eric Abrahamsen diff --git a/ebdb-i18n.el b/ebdb-i18n.el index 7d70baf..a311b19 100644 --- a/ebdb-i18n.el +++ b/ebdb-i18n.el @@ -1,6 +1,6 @@ ;;; ebdb-i18n.el --- Internationalization support for EBDB -*- lexical-binding: t; -*- -;; Copyright (C) 2016-2017 Free Software Foundation, Inc. +;; Copyright (C) 2016-2018 Free Software Foundation, Inc. ;; Author: Eric Abrahamsen diff --git a/ebdb-ispell.el b/ebdb-ispell.el index 5649076..bff51c4 100644 --- a/ebdb-ispell.el +++ b/ebdb-ispell.el @@ -1,6 +1,6 @@ ;;; ebdb-ispell.el --- Add EBDB contact names to personal dictionaries -*- lexical-binding: t; -*- -;; Copyright (C) 2016-2017 Free Software Foundation, Inc. +;; Copyright (C) 2016-2018 Free Software Foundation, Inc. ;; Author: Eric Abrahamsen diff --git a/ebdb-message.el b/ebdb-message.el index a29e093..bd42315 100644 --- a/ebdb-message.el +++ b/ebdb-message.el @@ -1,6 +1,6 @@ ;;; ebdb-message.el --- EBDB interface to mail composition packages -*- lexical-binding: t; -*- -;; Copyright (C) 2016-2017 Free Software Foundation, Inc. +;; Copyright (C) 2016-2018 Free Software Foundation, Inc. ;; Author: Eric Abrahamsen diff --git a/ebdb-mhe.el b/ebdb-mhe.el index 74464a4..127eb71 100644 --- a/ebdb-mhe.el +++ b/ebdb-mhe.el @@ -1,6 +1,6 @@ ;;; ebdb-mhe.el --- EBDB interface to mh-e -*- lexical-binding: t; -*- -;; Copyright (C) 2016-2017 Free Software Foundation, Inc. +;; Copyright (C) 2016-2018 Free Software Foundation, Inc. ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by diff --git a/ebdb-migrate.el b/ebdb-migrate.el index 8010c3d..dc31d11 100644 --- a/ebdb-migrate.el +++ b/ebdb-migrate.el @@ -1,6 +1,6 @@ ;;; ebdb-migrate.el --- Migration/upgrade functions for EBDB -*- lexical-binding: t; -*- -;; Copyright (C) 2016-2017 Free Software Foundation, Inc. +;; Copyright (C) 2016-2018 Free Software Foundation, Inc. ;; Author: Eric Abrahamsen diff --git a/ebdb-mu4e.el b/ebdb-mu4e.el index dc87fef..76baa92 100644 --- a/ebdb-mu4e.el +++ b/ebdb-mu4e.el @@ -1,6 +1,6 @@ ;;; ebdb-mu4e.el --- EBDB interface for mu4e -*- lexical-binding: t; -*- -;; Copyright (C) 2016-2017 Free Software Foundation, Inc. +;; Copyright (C) 2016-2018 Free Software Foundation, Inc. ;; Author: Eric Abrahamsen diff --git a/ebdb-mua.el b/ebdb-mua.el index 01a998f..bf52f5c 100644 --- a/ebdb-mua.el +++ b/ebdb-mua.el @@ -1,6 +1,6 @@ ;;; ebdb-mua.el --- Mail user agent interaction for EBDB -*- lexical-binding: t; -*- -;; Copyright (C) 2016-2017 Free Software Foundation, Inc. +;; Copyright (C) 2016-2018 Free Software Foundation, Inc. ;; Author: Eric Abrahamsen diff --git a/ebdb-org.el b/ebdb-org.el index 6a76b8b..162525f 100644 --- a/ebdb-org.el +++ b/ebdb-org.el @@ -1,6 +1,6 @@ ;;; ebdb-org.el --- Org mode integration for EBDB-*- lexical-binding: t; -*- -;; Copyright (C) 2016-2017 Free Software Foundation, Inc. +;; Copyright (C) 2016-2018 Free Software Foundation, Inc. ;; Author: Eric Abrahamsen ;; Keywords: diff --git a/ebdb-pgp.el b/ebdb-pgp.el index cad93a0..aed90a7 100644 --- a/ebdb-pgp.el +++ b/ebdb-pgp.el @@ -1,6 +1,6 @@ ;;; ebdb-pgp.el --- Interaction between EBDB and
[elpa] externals/ebdb 5b4d834 01/15: Organization/role delete method needs to be an :around
branch: externals/ebdb commit 5b4d8345ed93f7719b7ad4e9b0d1c1fb3bd6a86b Author: Eric Abrahamsen Commit: Eric Abrahamsen Organization/role delete method needs to be an :around * ebdb.el (ebdb-record-delete-field): Otherwise it hits the existing :around method, which first checks which slot on the organization record can accept the role field, and then raises an error. --- ebdb.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/ebdb.el b/ebdb.el index d3409fb..6f7a299 100644 --- a/ebdb.el +++ b/ebdb.el @@ -3423,9 +3423,9 @@ appropriate person record." (let ((record (ebdb-gethash (slot-value old-field 'record-uuid) 'uuid))) (cl-call-next-method record old-field new-field))) -(cl-defmethod ebdb-record-delete-field ((_record ebdb-record-organization) - (field ebdb-field-role) - &optional slot) +(cl-defmethod ebdb-record-delete-field :around ((_record ebdb-record-organization) + (field ebdb-field-role) + &optional slot) (let ((record (ebdb-gethash (slot-value field 'record-uuid) 'uuid))) (cl-call-next-method record field slot)))
[elpa] externals/ebdb bbfdc70 04/15: Set mail priority on record creation
branch: externals/ebdb commit bbfdc70297fabeaba060d1401bef92bdcd74cfa0 Author: Eric Abrahamsen Commit: Eric Abrahamsen Set mail priority on record creation * ebdb.el (ebdb-read): Make the first mail address entered the priority address. --- ebdb.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/ebdb.el b/ebdb.el index 41b93da..9977154 100644 --- a/ebdb.el +++ b/ebdb.el @@ -2956,6 +2956,8 @@ If FIELD doesn't specify a year, use the current year." (ebdb-read ebdb-default-phone-class))) (address (ebdb-loop-with-exit (ebdb-read ebdb-default-address-class +(when mail + (setf (slot-value (car mail) 'priority) 'primary)) (setq slots (plist-put slots :mail mail)) (setq slots (plist-put slots :phone phone)) (setq slots (plist-put slots :address address))
[elpa] externals/ebdb updated (9e7a96f -> d60338c)
girzel pushed a change to branch externals/ebdb. from 9e7a96f Add experimental ebdb-completion-at-point-function new 5b4d834 Organization/role delete method needs to be an :around new 9bd965b Simplify ebdb-with-record-edits new 261454d Return results of ebdb-loop-with-exit in correct order new bbfdc70 Set mail priority on record creation new 27a1fa5 Move field manipulation "convenience logic" into ebdb-com new a25e1eb Use values from "slots" in role field ebdb-read new 9ab7b56 Improvements to ebdb-edit-foo new 70754b8 Fix unnecessary code in ebdb-follow-related new b323307 Add a "follow related" action to role fields new dd2f73c Change behavior of mail insertion new 4bb77e3 Add mail deletion behavior new c3e06ee Use quoted field class new 7a5ce18 Handle mail priority after customization edits new a7e88d4 Update copyright dates new d60338c Bump version to 0.5 Summary of changes: ebdb-com.el | 343 ++-- ebdb-format.el | 2 +- ebdb-gnus.el| 2 +- ebdb-i18n.el| 2 +- ebdb-ispell.el | 2 +- ebdb-message.el | 2 +- ebdb-mhe.el | 2 +- ebdb-migrate.el | 2 +- ebdb-mu4e.el| 2 +- ebdb-mua.el | 2 +- ebdb-org.el | 2 +- ebdb-pgp.el | 2 +- ebdb-rmail.el | 2 +- ebdb-snarf.el | 2 +- ebdb-test.el| 10 +- ebdb-vcard.el | 2 +- ebdb.el | 85 ++ 17 files changed, 263 insertions(+), 203 deletions(-)
[elpa] externals/ebdb 9bd965b 02/15: Simplify ebdb-with-record-edits
branch: externals/ebdb commit 9bd965b62deb4ba75bdaf49e05fedbdcdffb5472 Author: Eric Abrahamsen Commit: Eric Abrahamsen Simplify ebdb-with-record-edits * ebdb-com.el (ebdb-with-record-edits): This macro was trying too hard. Instead of accepting a list of records, just operate on one record at a time. There's some inefficiency -- with multiple records belonging to the same database, there will be a duplicate database check for each record -- but it's not an issue, and this will give us a bit more freedom. (ebdb-insert-field, ebdb-edit-field, ebdb-edit-foo, ebdb-delete-field-or-record, ebdb-delete-records, ebdb-move-records, ebdb-copy-records): Adjust macro calls in these locations. * ebdb-test.el (ebdb-test-with-record-edits): Tweak test to match new definition. --- ebdb-com.el | 183 +-- ebdb-test.el | 10 ++-- 2 files changed, 82 insertions(+), 111 deletions(-) diff --git a/ebdb-com.el b/ebdb-com.el index b2301e9..452ff0f 100644 --- a/ebdb-com.el +++ b/ebdb-com.el @@ -1531,74 +1531,38 @@ Records are displayed using formatter FMT." (ebdb-compare-records (ebdb-record-field record 'timestamp) 'creation-date 'equal) fmt)) -(defmacro ebdb-with-record-edits (spec &rest body) - "Run BODY on all records listed in the cdr of SPEC. - -This macro checks that each record is editable; ie, that it +(defmacro ebdb-with-record-edits (record &rest body) + "Run BODY, containing operations on RECORD. +This macro checks that the record is editable; ie, that it doesn't belong to a read-only database. It also throws an error -and bails out if any of the database are unsynced. - -Then bind each editable record to the car of SPEC in turn, run -`ebdb-change-hook' on the record, excecute BODY, run -`ebdb-after-change-hook', and redisplay the record. - -SPEC should look like the first argument to `dolist'. This macro -should be called as: +and bails out if any of its databases are unsynced. -\(ebdb-with-record-edits (r record-list) - ...\) - -Note that RECORD-LIST will be replaced with the list of -actually-editable records." +Then it runs `ebdb-change-hook' on the record, executes BODY, +runs `ebdb-after-change-hook', and redisplays the record." (declare (indent 1) (debug ((symbolp form) body))) - (let ((editable-records (cl-gensym)) - (bad-dbs (cl-gensym)) - (good-dbs (cl-gensym))) -`(let (,editable-records ,bad-dbs ,good-dbs) - (dolist (r ,(nth 1 spec)) -(unless -;; "Unless the record has a bum database..." -(catch 'bad - ;; Return nil unless we throw a 'bad. - (condition-case err - (dolist (d (slot-value (ebdb-record-cache r) 'database) nil) -(cond ((object-assoc (slot-value d 'file) 'file ,good-dbs)) - ((object-assoc (slot-value d 'file) 'file ,bad-dbs) - (throw 'bad t)) - (t - (ebdb-db-editable d) - (push d ,good-dbs -(ebdb-unsynced-db - (let ((db (cadr err))) - (if (ebdb-db-dirty db) - (error "Database %s is out of sync and has unsaved changes" db) - (if (or ebdb-auto-revert - (yes-or-no-p - (format "Database %s is out of sync, reload?" - (ebdb-string db - (progn - (ebdb-reload-database db) - (push db ,good-dbs)) - (push db ,bad-dbs) - (message "Database %s is out of sync" db) - (sit-for 1) - (throw 'bad t) -(ebdb-readonly-db - (push (cadr err) ,bad-dbs) - (message "Database %s is read-only" (cadr err)) - (sit-for 1) - (throw 'bad t - ;; No bum database, it's okay. - (push r ,editable-records))) - (dolist (,(car spec) ,editable-records) -(run-hook-with-args 'ebdb-change-hook ,(car spec)) + ;; I'm expecting that none of the local variables in this macro + ;; (including the "err" arg to `condition-case'), will be exposed + ;; within "body". Hopefully that's not wrong. + `(condition-case err + (progn +(dolist (d (slot-value (ebdb-record-cache ,record) 'database) nil) + (ebdb-db-editable d)) +(run-hook-with-args 'ebdb-change-hook ,record) ,@body -
[elpa] externals/ebdb 4bb77e3 11/15: Add mail deletion behavior
branch: externals/ebdb commit 4bb77e377f04ac26ab0b743a9d0a46fd2d14ab1a Author: Eric Abrahamsen Commit: Eric Abrahamsen Add mail deletion behavior * ebdb.el (ebdb-record-delete-field): If deleting a record mail leaves no primary mail address, set the first of the remaining mails as primary. --- ebdb.el | 14 +- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/ebdb.el b/ebdb.el index 613660b..e23e294 100644 --- a/ebdb.el +++ b/ebdb.el @@ -3025,9 +3025,21 @@ If FIELD doesn't specify a year, use the current year." "Possibly set the priority of a newly-added mail address. If RECORD has no other primary mail, set MAIL's priority to primary." - (when (null (object-assoc 'primary 'priority (ebdb-record-mail record))) + (when (null (object-assoc 'primary 'priority (ebdb-record-mail record t))) (setf (slot-value mail 'priority) 'primary))) +(cl-defmethod ebdb-record-delete-field :after ((record ebdb-record-entity) + (mail ebdb-field-mail) + &optional _slot) + "Possibly alter the priority of RECORD's remaining mails. +If there aren't any other primary mails, make the first of the +remaining mails primary." + (let* ((mails (remove mail (ebdb-record-mail record))) +(clone (unless (object-assoc 'primary 'priority mails) + (clone (car mails) +(when clone + (ebdb-record-change-field record (car mails) clone + (defun ebdb-compose-mail (&rest args) "Start composing a mail message to send. ARGS is passed to `compose-mail'."
[elpa] externals/ebdb 9ab7b56 07/15: Improvements to ebdb-edit-foo
branch: externals/ebdb commit 9ab7b56115284f9d4ef7a9c9a75a47d5cf4f0986 Author: Eric Abrahamsen Commit: Eric Abrahamsen Improvements to ebdb-edit-foo * ebdb-com.el (eieio-done-customizing): Use the formatting functions to display field values. Don't offer the primary name for editing. --- ebdb-com.el | 18 +++--- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/ebdb-com.el b/ebdb-com.el index ac56c74..da14952 100644 --- a/ebdb-com.el +++ b/ebdb-com.el @@ -1751,14 +1751,18 @@ field to edit." (mapcar (lambda (f) (let ((field (cdr f))) - (cons (concat - (ebdb-field-readable-name field) - (when (slot-exists-p field 'object-name) -(format " (%s)" (slot-value field 'object-name))) - " " - (car (split-string (ebdb-string field) "\n"))) + (cons (substring-no-properties + (concat + (ebdb-fmt-field-label +ebdb-default-oneline-formatter +field 'oneline record) + ": " + (ebdb-fmt-field +ebdb-default-oneline-formatter +field 'oneline record))) (cdr f - (ebdb-record-current-fields record)) + (assq-delete-all +'name (ebdb-record-current-fields record))) field (cdr (assoc
[elpa] externals/ebdb dd2f73c 10/15: Change behavior of mail insertion
branch: externals/ebdb commit dd2f73cfb7e8c9b9fa5369c783e84530817c98ca Author: Eric Abrahamsen Commit: Eric Abrahamsen Change behavior of mail insertion * ebdb.el (ebdb-record-insert-field): Change what this method does. It previously sorted all the record's mails, which is a no-no because it was setting slot values directly, without going through the database-aware accessors. Don't do that (we still don't have a good way of doing that). Instead, do something else: set the priority the mail, if the record has no other primary mail. --- ebdb.el | 15 --- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/ebdb.el b/ebdb.el index e3042e1..613660b 100644 --- a/ebdb.el +++ b/ebdb.el @@ -3019,13 +3019,14 @@ If FIELD doesn't specify a year, use the current year." (cl-defmethod ebdb-record-organizations ((_record ebdb-record-entity)) nil) -(cl-defmethod ebdb-record-insert-field :after ((record ebdb-record-entity) - (_mail ebdb-field-mail) - &optional _slot) - "After giving RECORD a new mail field, sort RECORD's mails by -priority." - (let ((sorted (ebdb-sort-mails (slot-value record 'mail -(setf (slot-value record 'mail) sorted))) +(cl-defmethod ebdb-record-insert-field :before ((record ebdb-record-entity) + (mail ebdb-field-mail) + &optional _slot) + "Possibly set the priority of a newly-added mail address. +If RECORD has no other primary mail, set MAIL's priority to +primary." + (when (null (object-assoc 'primary 'priority (ebdb-record-mail record))) +(setf (slot-value mail 'priority) 'primary))) (defun ebdb-compose-mail (&rest args) "Start composing a mail message to send.
[elpa] externals/ebdb 70754b8 08/15: Fix unnecessary code in ebdb-follow-related
branch: externals/ebdb commit 70754b8acb9612cf8054de0b9c576cdf978e8b22 Author: Eric Abrahamsen Commit: Eric Abrahamsen Fix unnecessary code in ebdb-follow-related * ebdb-com.el (ebdb-follow-related): No need to mapcar ebdb-records, that's what the APPEND argument does. --- ebdb-com.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/ebdb-com.el b/ebdb-com.el index da14952..ff6d447 100644 --- a/ebdb-com.el +++ b/ebdb-com.el @@ -1293,8 +1293,7 @@ With prefix N move backwards N (sub)fields." (ebdb-current-field))) (condition-case nil (ebdb-display-records - (cons (ebdb-record-related record field) -(mapcar #'car ebdb-records)) + (list (ebdb-record-related record field)) ebdb-default-multiline-formatter t) (ebdb-related-unfound
[elpa] externals/ebdb c3e06ee 12/15: Use quoted field class
branch: externals/ebdb commit c3e06eefbd0239d3ae94ea2c5c64427a70d85369 Author: Eric Abrahamsen Commit: Eric Abrahamsen Use quoted field class * ebdb.el (ebdb-record-change-name): Compiler didn't like this. --- ebdb.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ebdb.el b/ebdb.el index e23e294..ff958ba 100644 --- a/ebdb.el +++ b/ebdb.el @@ -3364,7 +3364,7 @@ ARGS is passed to `compose-mail'." (cl-defmethod ebdb-record-change-name ((record ebdb-record-organization) (name-string string)) - (let ((name (ebdb-parse ebdb-field-name-simple name-string))) + (let ((name (ebdb-parse 'ebdb-field-name-simple name-string))) (ebdb-record-change-name record name))) (cl-defmethod ebdb-record-current-fields ((record ebdb-record-organization)
[elpa] externals/ebdb d60338c 15/15: Bump version to 0.5
branch: externals/ebdb commit d60338cb7fcfbc09fda1458a2fa4653dd2df3be2 Author: Eric Abrahamsen Commit: Eric Abrahamsen Bump version to 0.5 --- ebdb.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ebdb.el b/ebdb.el index 101427c..5d3d547 100644 --- a/ebdb.el +++ b/ebdb.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2016-2018 Free Software Foundation, Inc. -;; Version: 0.4.3 +;; Version: 0.5 ;; Package-Requires: ((emacs "25.1") (cl-lib "0.5") (seq "2.15")) ;; Maintainer: Eric Abrahamsen
[elpa] externals/ebdb b323307 09/15: Add a "follow related" action to role fields
branch: externals/ebdb
commit b32330782c7bc781b18b44ddaad9dd3fae10447a
Author: Eric Abrahamsen
Commit: Eric Abrahamsen
Add a "follow related" action to role fields
* ebdb.el (ebdb-field-role): Should be able to hit RET to add the
related record.
---
ebdb.el | 4 +++-
1 file changed, 3 insertions(+), 1 deletion(-)
diff --git a/ebdb.el b/ebdb.el
index cfb2e9f..e3042e1 100644
--- a/ebdb.el
+++ b/ebdb.el
@@ -1327,7 +1327,9 @@ first one."
:initform nil
:documentation "If t, this role is considered defunct (ie
the person left their job, etc). Fields in the \"fields\"
- slot will generally be ignored by the rest of EBDB."))
+ slot will generally be ignored by the rest of EBDB.")
+ (actions
+:initform '(("Display role relation" . ebdb-follow-related
:documentation "This class represents a relationship between
the record which owns this field, and the
`ebdb-record-organization' pointed to by the \"organization\"
[elpa] externals/ebdb 27a1fa5 05/15: Move field manipulation "convenience logic" into ebdb-com
branch: externals/ebdb commit 27a1fa5fcd33613bbfddf9466d4665cf990ad747 Author: Eric Abrahamsen Commit: Eric Abrahamsen Move field manipulation "convenience logic" into ebdb-com * ebdb-com.el (ebdb-com-delete-field, ebdb-com-insert-field, ebdb-com-edit-field): Three new generic methods that sit between the high-level interactive commands, and the low-level database editing functions. These methods are the right place for providing field/record-specific behavior. * ebdb.el: Remove the equivalent logic from here. This file should be as "dumb" as possible. --- ebdb-com.el | 162 ebdb.el | 33 - 2 files changed, 120 insertions(+), 75 deletions(-) diff --git a/ebdb-com.el b/ebdb-com.el index 452ff0f..ac56c74 100644 --- a/ebdb-com.el +++ b/ebdb-com.el @@ -1605,32 +1605,84 @@ for these values." ;;;###autoload (defun ebdb-insert-field (records) - "Prompt to create a field and insert it into RECORDS." + "Prompt to create a field and insert it into RECORDS. +If multiple records are marked, insert instances of the same +field class into each record, first asking whether each field +instance should be identical." (interactive (list (ebdb-do-records))) - (pcase-let + (pcase-let* ((`(,label (,_slot . ,class)) (ebdb-prompt-for-field-type -(ebdb-record-field-slot-query - (eieio-object-class (car records)) -(let - ((field (ebdb-read class - (when (equal class 'ebdb-field-user-simple) -`(:object-name ,label -clone) - (dolist (r records) - (ebdb-with-record-edits r -(setq clone (clone field)) -(condition-case err -(ebdb-record-insert-field r clone) - (ebdb-unacceptable-field - (message "Record %s cannot accept field %s" (ebdb-string r) (ebdb-string field)) - (sit-for 2)) - (error - (message "Error inserting field: %s, %s" (car err) (cdr err)) - (sit-for 2 - -;; TODO: Allow editing of multiple record fields simultaneously. +;; Currently special-case hacking so that role fields can be +;; inserted on organization records. Alternate approach +;; would be modifying `ebdb-record-field-slot-query' so that +;; it can return all defined fields. We shouldn't be +;; restricting field classes here. +(cons + '(organizations . ebdb-field-role) + (ebdb-record-field-slot-query + (eieio-object-class (car records)) + (slots (when (equal class 'ebdb-field-user-simple) + `(:object-name ,label))) + (field (when (or (= 1 (length records)) + (y-or-n-p +"Insert same field values in all records? ")) + (ebdb-read class slots +(dolist (r records) + (ebdb-with-record-edits r + (ebdb-com-insert-field +r (if field (clone field) class) slots) + +(cl-defgeneric ebdb-com-insert-field (record field &optional slots) + "Insert FIELD into RECORD. +For use between the `ebdb-insert-field' command, which is called +from an *EBDB* buffer and may operate on many records, and the +lower-level per-record `ebdb-record-insert-field' method. + +SLOTS, if present, is passed to any subsequent call to +`ebdb-read'." + (:method ((rec ebdb-record) (field ebdb-field) &optional _slots) + (condition-case err + (ebdb-record-insert-field rec field) +(ebdb-unacceptable-field + (message "Record %s cannot accept field %s" + (ebdb-string rec) (ebdb-string field)) + (sit-for 1)) +(error + (message "Error inserting field: %s, %s" (car err) (cdr err)) + (sit-for 1) + +(cl-defmethod ebdb-com-insert-field ((rec ebdb-record) +(field-class (subclass ebdb-field)) +&optional slots) + (let ((field (ebdb-read field-class slots))) +(ebdb-com-insert-field rec field))) + +(cl-defmethod ebdb-com-insert-field ((org ebdb-record-organization) +(role-class (subclass ebdb-field-role)) +&optional slots) + (let ((record (ebdb-prompt-for-record)) + (field (ebdb-read role-class + (plist-put slots :org-uuid (slot-value org 'uuid) +(ebdb-com-insert-field record field))) + +(cl-defmethod ebdb-com-insert-field :after ((record ebdb-record-person) + (field ebdb-field-role) + &optional _slots) + (let ((org (ebdb-ge
[elpa] externals/ebdb 7a5ce18 13/15: Handle mail priority after customization edits
branch: externals/ebdb commit 7a5ce181ccc3329a515875cabea5a2a0e7e39916 Author: Eric Abrahamsen Commit: Eric Abrahamsen Handle mail priority after customization edits * ebdb-com.el (eieio-done-customizing): New :after method to set record's mail priorities based on edits to this mail address. Split redisplay out into its own :after method, so it runs after this, as well. --- ebdb-com.el | 25 +++-- 1 file changed, 23 insertions(+), 2 deletions(-) diff --git a/ebdb-com.el b/ebdb-com.el index ff6d447..ac96ad2 100644 --- a/ebdb-com.el +++ b/ebdb-com.el @@ -1733,8 +1733,29 @@ commands, called from an *EBDB* buffer, and the lower-level (cl-defmethod eieio-done-customizing ((f ebdb-field)) (let ((rec ebdb-custom-field-record)) (when rec - (ebdb-record-insert-field rec f) - (ebdb-redisplay-records rec 'reformat t + (ebdb-record-insert-field rec f + +(cl-defmethod eieio-done-customizing :after ((f ebdb-field)) + (ebdb-redisplay-records rec 'reformat t)) + +(cl-defmethod eieio-done-customizing :after ((mail ebdb-field-mail)) + "Handle mail priority after customizing. +Check that some mail is marked as primary after MAIL is edited." + (let* ((rec ebdb-custom-field-record) +(all-mails (remove mail (ebdb-record-mail rec))) +(primaries (when rec (seq-filter + (lambda (m) +(eq (slot-value m 'priority) 'primary)) + all-mails))) +(prim (eq (slot-value mail 'priority) 'primary))) +(cond ((and prim primaries) + (dolist (p primaries) +(ebdb-record-change-field rec p (clone p :priority 'normal + ((and (null (or prim primaries)) + (car-safe all-mails)) + (ebdb-record-change-field + rec (car all-mails) + (clone (car all-mails) :priority 'primary)) ;;;###autoload (defun ebdb-edit-foo (record field)
[elpa] externals/ebdb 5c9893c 1/2: Fix debug declaration for ebdb-with-record-edits
branch: externals/ebdb commit 5c9893c87ccdf515cb4060e6e2c0593ecf87d386 Author: Eric Abrahamsen Commit: Eric Abrahamsen Fix debug declaration for ebdb-with-record-edits * ebdb-com.el (ebdb-with-record-edits): Forgot to change this. --- ebdb-com.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ebdb-com.el b/ebdb-com.el index 1cb2f70..89718f2 100644 --- a/ebdb-com.el +++ b/ebdb-com.el @@ -1538,7 +1538,7 @@ and bails out if any of its databases are unsynced. Then it runs `ebdb-change-hook' on the record, executes BODY, runs `ebdb-after-change-hook', and redisplays the record." - (declare (indent 1) (debug ((symbolp form) body))) + (declare (indent 1) (debug (symbolp body))) ;; I'm expecting that none of the local variables in this macro ;; (including the "err" arg to `condition-case'), will be exposed ;; within "body". Hopefully that's not wrong.
[elpa] externals/ebdb 022a18a 2/2: Fix erroneous quoting of option, bump to 0.5.1
branch: externals/ebdb commit 022a18a6a5f84ff7bc9d10bab030f4df2ba2a9ee Author: Eric Abrahamsen Commit: Eric Abrahamsen Fix erroneous quoting of option, bump to 0.5.1 * ebdb-com.el (ebdb-edit-foo): Shouldn't have been quoting this customization option. Also remove unnecessary let*. * ebdb.el: Bump to 0.5.1 --- ebdb-com.el | 6 +++--- ebdb.el | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/ebdb-com.el b/ebdb-com.el index 89718f2..977ff3b 100644 --- a/ebdb-com.el +++ b/ebdb-com.el @@ -1764,8 +1764,8 @@ Interactively, if called without a prefix, edit the notes field of RECORD. When called with a prefix, prompt the user for a field to edit." (interactive - (let* ((record (ebdb-current-record)) - field field-list) + (let ((record (ebdb-current-record)) + field field-list) (if current-prefix-arg (setq field-list (mapcar @@ -1795,7 +1795,7 @@ field to edit." (ebdb-with-record-edits record (if field (ebdb-com-edit-field record field) - (ebdb-com-insert-field record 'ebdb-default-notes-class + (ebdb-com-insert-field record ebdb-default-notes-class ;; (ebdb-list-transpose '(a b c d) 1 3) (defun ebdb-list-transpose (list i j) diff --git a/ebdb.el b/ebdb.el index 5d3d547..6a02dff 100644 --- a/ebdb.el +++ b/ebdb.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2016-2018 Free Software Foundation, Inc. -;; Version: 0.5 +;; Version: 0.5.1 ;; Package-Requires: ((emacs "25.1") (cl-lib "0.5") (seq "2.15")) ;; Maintainer: Eric Abrahamsen
[elpa] externals/ebdb updated (d60338c -> 022a18a)
girzel pushed a change to branch externals/ebdb. from d60338c Bump version to 0.5 new 5c9893c Fix debug declaration for ebdb-with-record-edits new 022a18a Fix erroneous quoting of option, bump to 0.5.1 Summary of changes: ebdb-com.el | 8 ebdb.el | 2 +- 2 files changed, 5 insertions(+), 5 deletions(-)
[elpa] externals/ebdb 01c30dd: Fix dumb mistake in eieio-done-customizing, bump to 0.5.2
branch: externals/ebdb commit 01c30dde9296f1ded0b893db81a097448d1cff90 Author: Eric Abrahamsen Commit: Eric Abrahamsen Fix dumb mistake in eieio-done-customizing, bump to 0.5.2 * ebdb-com.el (eieio-done-customizing): Was too hasty with this. --- ebdb-com.el | 4 +++- ebdb.el | 2 +- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/ebdb-com.el b/ebdb-com.el index 977ff3b..8945668 100644 --- a/ebdb-com.el +++ b/ebdb-com.el @@ -1736,7 +1736,9 @@ commands, called from an *EBDB* buffer, and the lower-level (ebdb-record-insert-field rec f (cl-defmethod eieio-done-customizing :after ((f ebdb-field)) - (ebdb-redisplay-records rec 'reformat t)) + (let ((rec ebdb-custom-field-record)) +(when rec + (ebdb-redisplay-records rec 'reformat t (cl-defmethod eieio-done-customizing :after ((mail ebdb-field-mail)) "Handle mail priority after customizing. diff --git a/ebdb.el b/ebdb.el index 6a02dff..0fcff72 100644 --- a/ebdb.el +++ b/ebdb.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2016-2018 Free Software Foundation, Inc. -;; Version: 0.5.1 +;; Version: 0.5.2 ;; Package-Requires: ((emacs "25.1") (cl-lib "0.5") (seq "2.15")) ;; Maintainer: Eric Abrahamsen
[elpa] externals/ebdb 6576148 4/5: Fix post-delete mail manipulation
branch: externals/ebdb commit 6576148ef3006a2b0ee6ea57faf2fa41d58bd3d8 Author: Eric Abrahamsen Commit: Eric Abrahamsen Fix post-delete mail manipulation * ebdb.el (ebdb-record-delete-field): This needed to check if there actually *is* a mail field to act on, and also wasn't actually setting the priority properly. --- ebdb.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/ebdb.el b/ebdb.el index 0fcff72..03f9a37 100644 --- a/ebdb.el +++ b/ebdb.el @@ -3036,9 +3036,10 @@ If there aren't any other primary mails, make the first of the remaining mails primary." (let* ((mails (remove mail (ebdb-record-mail record))) (clone (unless (object-assoc 'primary 'priority mails) - (clone (car mails) + (when (car mails) + (clone (car mails) :priority 'primary) (when clone - (ebdb-record-change-field record (car mails) clone + (ebdb-record-change-field record (car mails) clone (defun ebdb-compose-mail (&rest args) "Start composing a mail message to send.
[elpa] externals/ebdb ae40502 2/5: Use inhibit-read-only
branch: externals/ebdb commit ae4050260743304004f4481b56931663e44265a7 Author: Eric Abrahamsen Commit: Eric Abrahamsen Use inhibit-read-only * ebdb-com.el (ebdb-display-records, ebdb-redisplay-records): Instead of let-binding buffer-read-only. --- ebdb-com.el | 6 -- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/ebdb-com.el b/ebdb-com.el index 6f4941f..b543c85 100644 --- a/ebdb-com.el +++ b/ebdb-com.el @@ -789,7 +789,8 @@ name based on the current major mode." (unless (or ebdb-silent-internal ebdb-silent) (message "Formatting EBDB...")) (let ((record-number 0) - buffer-read-only start) + (inhibit-read-only t) + start) (erase-buffer) (insert (ebdb-fmt-header fmt records)) (dolist (record ebdb-records) @@ -927,7 +928,8 @@ displayed records." records))) (dolist (b bufs) (with-current-buffer b - (let (renumber buffer-read-only) + (let ((inhibit-read-only t) + renumber) (dolist (r records) (catch 'bail ;; Find the location of record in this buffer. The
[elpa] externals/ebdb updated (01c30dd -> 1a4870a)
girzel pushed a change to branch externals/ebdb. from 01c30dd Fix dumb mistake in eieio-done-customizing, bump to 0.5.2 new 7c6d15a Be smarter about displaying appended records new ae40502 Use inhibit-read-only new 2c42f1b Fix to snarfing collapse new 6576148 Fix post-delete mail manipulation new 1a4870a Make field customization more robust Summary of changes: ebdb-com.el | 77 ++- ebdb-snarf.el | 36 ++-- ebdb.el | 5 ++-- 3 files changed, 71 insertions(+), 47 deletions(-)
[elpa] externals/ebdb 1a4870a 5/5: Make field customization more robust
branch: externals/ebdb commit 1a4870aa225548eda80ae69f7dad6662000f55a2 Author: Eric Abrahamsen Commit: Eric Abrahamsen Make field customization more robust * ebdb-com.el (ebdb-customization-record): Rename variable from ebdb-custom-field-record. (ebdb-customization-field): New variable doing equivalent record-keeping. (ebdb-edit-field-customize): Have customization act on a field clone, rather than the field itself. (eieio-done-customizing): Once customization is complete (on the cloned field), then try to change the old field for the new field, in an atomic way. (eieio-done-customizing): Use ebdb-with-record-edits to both handle un-editable records, and record redisplay. (eieio-done-customizing): Use the new record-keeping variable. --- ebdb-com.el | 52 +++- 1 file changed, 31 insertions(+), 21 deletions(-) diff --git a/ebdb-com.el b/ebdb-com.el index b543c85..69d8f1e 100644 --- a/ebdb-com.el +++ b/ebdb-com.el @@ -42,12 +42,11 @@ map) "Keymap used for EBDB crm completions.") -(defvar-local ebdb-custom-field-record nil - "Variable local to EBDB field customization buffers, pointing -to the record that field belongs to. +(defvar-local ebdb-customization-record nil + "Variable holding the record whose field is being customized.") -A hacky bit of bookkeeping that lets us mark the record as dirty -and redisplay it after the field is edited.") +(defvar-local ebdb-customization-field nil + "Variable holding the field being customized.") ;; Customizations for display routines @@ -1736,27 +1735,34 @@ commands, called from an *EBDB* buffer, and the lower-level (interactive (list (ebdb-current-record) (ebdb-current-field))) - (ebdb-with-record-edits record -(ebdb-record-delete-field record field) -(condition-case nil - (eieio-customize-object field) - (error (ebdb-record-insert-field record field - (setq ebdb-custom-field-record record)) - -(cl-defmethod eieio-done-customizing ((f ebdb-field)) - (let ((rec ebdb-custom-field-record)) -(when rec - (ebdb-record-insert-field rec f - -(cl-defmethod eieio-done-customizing :after ((f ebdb-field)) - (let ((rec ebdb-custom-field-record)) + (let ((new-field (clone field))) +(eieio-customize-object new-field) +;; The following two variables are buffer-local, and we're hoping +;; this will make them local to the customization buffer: ie, an +;; arbitrary number of *Customize* buffers can be opened, and the +;; accept/apply options will all behave correctly. +(setq ebdb-customization-field field + ebdb-customization-record record))) + +(cl-defmethod eieio-done-customizing ((new-field ebdb-field)) + "Do the actual insertion of the newly-customized field." + (let ((rec ebdb-customization-record) + (old-field ebdb-customization-field)) +(when (and rec old-field) + (ebdb-record-change-field rec old-field new-field + +(cl-defmethod eieio-done-customizing :around ((_field ebdb-field)) + "Check that the record owning FIELD can be edited. +Also redisplays it after customization." + (let ((rec ebdb-customization-record)) (when rec - (ebdb-redisplay-records rec 'reformat t + (ebdb-with-record-edits rec + (cl-call-next-method) (cl-defmethod eieio-done-customizing :after ((mail ebdb-field-mail)) "Handle mail priority after customizing. Check that some mail is marked as primary after MAIL is edited." - (let* ((rec ebdb-custom-field-record) + (let* ((rec ebdb-customization-record) (all-mails (remove mail (ebdb-record-mail rec))) (primaries (when rec (seq-filter (lambda (m) @@ -1764,10 +1770,14 @@ Check that some mail is marked as primary after MAIL is edited." all-mails))) (prim (eq (slot-value mail 'priority) 'primary))) (cond ((and prim primaries) + ;; MAIL is primary, so set all other primary mails to + ;; normal. (dolist (p primaries) (ebdb-record-change-field rec p (clone p :priority 'normal ((and (null (or prim primaries)) (car-safe all-mails)) + ;; Nothing is primary, so try to set some other mail to + ;; primary. (ebdb-record-change-field rec (car all-mails) (clone (car all-mails) :priority 'primary))
[elpa] externals/ebdb 7c6d15a 1/5: Be smarter about displaying appended records
branch: externals/ebdb commit 7c6d15abd51299b81ba5fe389cfd9e1682154080 Author: Eric Abrahamsen Commit: Eric Abrahamsen Be smarter about displaying appended records * ebdb-com.el (ebdb-display-records): When records are appended to an existing buffer, we almost certainly want point to end up on them. Record the uuid of the first additional record, and try to move to its marker after redisplay. Additionally, use `recenter' instead of `set-window-start', as that's less likely to cause surprising scrolling behavior. --- ebdb-com.el | 19 +++ 1 file changed, 15 insertions(+), 4 deletions(-) diff --git a/ebdb-com.el b/ebdb-com.el index 8945668..6f4941f 100644 --- a/ebdb-com.el +++ b/ebdb-com.el @@ -756,7 +756,12 @@ name based on the current major mode." (setq fmt ebdb-default-multiline-formatter)) ;; `ebdb-make-buffer-name' is a generic function that ;; dispatches on the current major mode. - (let ((target-buffer (or buf (ebdb-make-buffer-name + (let ((target-buffer (or buf (ebdb-make-buffer-name))) + ;; When appending, we want point to end up on the first of the + ;; appended records. Save the uuid, and later point a marker + ;; at it. Mostly useful for `follow-related'. + (target-record-uuid (ebdb-record-uuid (car records))) + target-record-marker) (with-current-buffer (get-buffer-create target-buffer) ;; If we are appending RECORDS to the ones already displayed, @@ -772,7 +777,11 @@ name based on the current major mode." (setq ebdb-records (mapcar (lambda (r) - (list r fmt (make-marker) nil)) + (let ((m (make-marker))) + (when (string= target-record-uuid + (ebdb-record-uuid r)) + (setq target-record-marker m)) + (list r fmt m nil))) records)) (ebdb-pop-up-window target-buffer select pop) @@ -795,8 +804,10 @@ name based on the current major mode." (message "Formatting EBDB...done.")) (set-buffer-modified-p nil) - (goto-char (point-min)) - (set-window-start (get-buffer-window (current-buffer)) (point) + (goto-char (or target-record-marker (point-min))) + (when (window-live-p (get-buffer-window)) + (with-selected-window (get-buffer-window) + (recenter)) (defun ebdb-undisplay-records (&optional buffer) "Undisplay records in *EBDB* BUFFER, leaving the buffer empty.
[elpa] externals/ebdb 2c42f1b 3/5: Fix to snarfing collapse
branch: externals/ebdb commit 2c42f1b4d10a1dba28bdffdbb6daa8f4eab9c07e Author: Eric Abrahamsen Commit: Eric Abrahamsen Fix to snarfing collapse * ebdb-snarf.el (ebdb-snarf-collapse): The two clauses handling fields and names were meant to both be protected under the (when record... clause. --- ebdb-snarf.el | 36 ++-- 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/ebdb-snarf.el b/ebdb-snarf.el index 8936fd0..1d0ec23 100644 --- a/ebdb-snarf.el +++ b/ebdb-snarf.el @@ -261,27 +261,27 @@ vectors, usually to `ebdb-snarf-query'." (ebdb-string f))) (append fields names) (setq record rec))) - (if record - (dolist (f fields) - (condition-case nil - (progn - ;; Make sure that record can accept field, and doesn't - ;; already have it. - (when (and (car-safe (ebdb-record-field-slot-query - (eieio-object-class record) - `(nil . ,(eieio-object-class f - (null (ebdb-record-search - record - (eieio-object-class f) - (ebdb-string f - (push f out-fields))) - (ebdb-unacceptable-field nil))) + (when record + (dolist (f fields) + (condition-case nil + (progn + ;; Make sure that record can accept field, and doesn't + ;; already have it. + (when (and (car-safe (ebdb-record-field-slot-query + (eieio-object-class record) + `(nil . ,(eieio-object-class f +(null (ebdb-record-search + record + (eieio-object-class f) + (ebdb-string f + (push f out-fields))) + (ebdb-unacceptable-field nil))) (dolist (name names) (unless (ebdb-record-search record 'ebdb-field-name (ebdb-string name)) - (push name out-names))) - (setq out-names names - out-fields fields)) + (push name out-names + (setq out-names names + out-fields fields) (push (vector record out-names out-fields) output))) output))
[elpa] master e538c67 2/2: Allow short-circuiting the nnir search
branch: master commit e538c672a61b59bb6d4cff7c137f74732948f56b Author: Eric Abrahamsen Commit: Eric Abrahamsen Allow short-circuiting the nnir search * packages/gnorb/nngnorb.el (nnir-run-gnorb): If an 'articles key is already present in the query, assume the work has already been done, and simply return the articles. --- packages/gnorb/nngnorb.el | 161 +++--- 1 file changed, 82 insertions(+), 79 deletions(-) diff --git a/packages/gnorb/nngnorb.el b/packages/gnorb/nngnorb.el index dd6e23e..0985a87 100644 --- a/packages/gnorb/nngnorb.el +++ b/packages/gnorb/nngnorb.el @@ -75,85 +75,88 @@ are displayed in an ephemeral group. Otherwise, the query string can be a tags match string, a la the Org agenda tags search. All headings matched by this string will be scanned for gnus messages, and those messages displayed." - (save-window-excursion -(let ((q (cdr (assq 'query query))) - (buf (get-buffer-create nnir-tmp-buffer)) - msg-ids org-ids links vectors) - (with-current-buffer buf - (erase-buffer) - (setq nngnorb-attachment-file-list nil)) - (when (and (equal "5.13" gnus-version-number) (version< emacs-version "24.4")) - (setq q (car q))) - (cond ((string-match "id\\+\\([[:alnum:]-]+\\)$" q) -(with-demoted-errors "Error: %S" - (org-id-goto (match-string 1 q)) - (save-restriction -(org-narrow-to-subtree) -(append-to-buffer - buf - (point-min) - (point-max)) -(setq org-ids - (append - (gnorb-collect-ids) - org-ids)) -(when org-ids - (with-current-buffer buf -;; The file list var is buffer local, so set it -;; (local to the nnir-tmp-buffer) to a full list -;; of all files in the subtree. -(dolist (id org-ids) - (setq nngnorb-attachment-file-list -(append (gnorb-org-attachment-list id) -nngnorb-attachment-file-list - ((listp q) -;; be a little careful: this could be a list of links, or -;; it could be the full plist -(setq links (if (plist-member q :gnus) -(plist-get q :gnus) - q))) - (t (org-map-entries - (lambda () - (push (org-id-get) org-ids) - (append-to-buffer - buf - (point) - (save-excursion -(outline-next-heading) -(point - q - 'agenda))) - (with-current-buffer buf - (goto-char (point-min)) - (setq links (append -(alist-get 'gnus (gnorb-scan-links (point-max) 'gnus)) -links)) - - (goto-char (point-min))) - ;; First add all links to messages (elements of messages should - ;; look like (group-name message-id)). - (dolist (l links) - (push (org-link-unescape - (nth 1 (split-string l "#"))) - msg-ids)) - - (unless (gnus-alive-p) - (gnus)) - - ;; Then use the registry to turn list of org-ids into list of - ;; msg-ids. - (dolist (i (delq nil (delete-dups org-ids))) - (when-let ((rel-msg-id (gnorb-registry-org-id-search i))) - (setq msg-ids (append (delq nil rel-msg-id) msg-ids - - ;; Then find the group and article number for each msg-id, and - ;; push that onto our return value "vectors". - (when msg-ids - (dolist (id (delete-dups msg-ids) (when vectors - (nreverse vectors))) - (pcase-let ((`(,group . ,artno) (gnorb-msg-id-request-head id))) - (when (and artno (integerp artno) (> artno 0)) - (push (vector group artno 100) vectors + (if (cdr-safe (assq 'articles query)) + ;; The work has already been done elsewhere. + (cdr (assq 'articles query)) +(save-window-excursion + (let ((q (cdr (assq 'query query))) + (buf (get-buffer-create nnir-tmp-buffer)) + msg-ids org-ids links vectors) + (with-current-buffer buf + (erase-buffer) + (setq nngnorb-attachment-file-list nil)) + (when (and (equal "5.13" gnus-version-number) (version< emacs-version "24.4")) + (setq q (car q))) + (cond ((string-match "id\\+\\([[:alnum:]-]+\\)$" q) + (with-demoted-errors "Error: %S" +(org-id-goto (match-string 1 q)) +
[elpa] master updated (8d426df -> e538c67)
girzel pushed a change to branch master. from 8d426df externals-list: Add orgalist new 853ba9d Allow gnorb-msg-id-request-head to accept a "group" argument new e538c67 Allow short-circuiting the nnir search Summary of changes: packages/gnorb/gnorb-utils.el | 10 ++- packages/gnorb/nngnorb.el | 161 +- 2 files changed, 89 insertions(+), 82 deletions(-)
[elpa] master 853ba9d 1/2: Allow gnorb-msg-id-request-head to accept a "group" argument
branch: master commit 853ba9d74a9aaa9352d9f8cfdb7fbc30c6c6d266 Author: Eric Abrahamsen Commit: Eric Abrahamsen Allow gnorb-msg-id-request-head to accept a "group" argument * packages/gnorb/gnorb-utils.el (gnorb-msg-id-request-head): Sometimes we already know the group. --- packages/gnorb/gnorb-utils.el | 10 +++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/packages/gnorb/gnorb-utils.el b/packages/gnorb/gnorb-utils.el index 3db394d..1a9d094 100644 --- a/packages/gnorb/gnorb-utils.el +++ b/packages/gnorb/gnorb-utils.el @@ -500,8 +500,10 @@ If SERVER-GROUP isn't given, try to figure it out." (concat server-group "#" (gnorb-unbracket-message-id msg-id)) -(defun gnorb-msg-id-request-head (msg-id) +(defun gnorb-msg-id-request-head (msg-id &optional group) "Given a message id, try to find its group and article number. +If GROUP is given, assume that group and just try to find the +article number. So far we're checking the registry, then the groups in `gnorb-gnus-sent-groups'. Use search engines? Other clever @@ -510,8 +512,10 @@ methods?" (setq msg-id (gnorb-bracket-message-id msg-id)) (catch 'found (when gnorb-tracking-enabled - (setq candidates (append (gnus-registry-get-id-key msg-id 'group) -gnorb-gnus-sent-groups)) + (setq candidates (if group +(list group) + (append (gnus-registry-get-id-key msg-id 'group) + gnorb-gnus-sent-groups))) (while (setq server-group (pop candidates)) (when (and (stringp server-group) (string-match-p "+" server-group)
[elpa] master 7d3f43c 1/5: Factor out function for finding nngnorb server
branch: master commit 7d3f43cbe76663db52e7b6d9b19d1c497b43349c Author: Eric Abrahamsen Commit: Eric Abrahamsen Factor out function for finding nngnorb server * packages/gnorb/gnorb-gnus.el (gnorb-gnus-find-gnorb-server): New function, so this can be called from elsewhere. (gnorb-gnus-search-messages): Use this new function. --- packages/gnorb/gnorb-gnus.el | 34 -- 1 file changed, 20 insertions(+), 14 deletions(-) diff --git a/packages/gnorb/gnorb-gnus.el b/packages/gnorb/gnorb-gnus.el index 77e21ce..9029163 100644 --- a/packages/gnorb/gnorb-gnus.el +++ b/packages/gnorb/gnorb-gnus.el @@ -807,20 +807,7 @@ HEAD-TEXT, if present, as its name. Otherwise create an ephemeral one, with RET as the value of its quit-config." (interactive) (require 'nnir) - (let* ((nnir-address - (or (catch 'found - ;; Try very hard to find the server. - (when (assoc 'nngnorb gnus-secondary-select-methods) - (throw 'found -(format - "nngnorb:%s" - (nth 1 (assoc 'nngnorb - gnus-secondary-select-methods) - (dolist (s (append gnus-server-alist gnus-server-method-cache)) - (when (eq 'nngnorb (cadr s)) - (throw 'found (car s) - (user-error - "Please add a \"nngnorb\" backend to your gnus installation."))) + (let* ((nnir-address (gnorb-gnus-find-gnorb-server)) (name (if persist (read-string (format "Name for group (default %s): " head-text) @@ -840,6 +827,25 @@ ephemeral one, with RET as the value of its quit-config." (gnus-group-select-group)) (gnus-group-read-ephemeral-group name method nil ret nil nil spec +(defun gnorb-gnus-find-gnorb-server (&optional no-error) + "Try very hard to find a local nngnorb server. +If NO-ERROR is non-nil, return nil on failure, otherwise an +error." + (or (catch 'found + ;; Try very hard to find the server. + (when (assoc 'nngnorb gnus-secondary-select-methods) + (throw 'found +(format + "nngnorb:%s" + (nth 1 (assoc 'nngnorb + gnus-secondary-select-methods) + (dolist (s (append gnus-server-alist gnus-server-method-cache)) + (when (eq 'nngnorb (cadr s)) + (throw 'found (car s) + (unless no-error + (user-error +"Please add a \"nngnorb\" backend to your gnus installation." + (defun gnorb-gnus-summary-mode-hook () "Check if we've entered a Gnorb-generated group, and activate `gnorb-summary-minor-mode', if so."
[elpa] master 6f43089 3/5: New function gnorb-gnus-search-registry
branch: master commit 6f430895afdcb19c06e2bfa98c7992953b8eb3d5 Author: Eric Abrahamsen Commit: Eric Abrahamsen New function gnorb-gnus-search-registry * packages/gnorb/gnorb-gnus.el (gnorb-gnus-search-registry): For searching the registry and displaying messages. (gnorb-registry-search-history): History var. * packages/gnorb/gnorb.org: Document. --- packages/gnorb/gnorb-gnus.el | 61 ++ packages/gnorb/gnorb.info| 88 packages/gnorb/gnorb.org | 20 ++ packages/gnorb/gnorb.texi| 32 +++- 4 files changed, 168 insertions(+), 33 deletions(-) diff --git a/packages/gnorb/gnorb-gnus.el b/packages/gnorb/gnorb-gnus.el index 9029163..2c465d2 100644 --- a/packages/gnorb/gnorb-gnus.el +++ b/packages/gnorb/gnorb-gnus.el @@ -687,6 +687,67 @@ reply." (add-to-list 'gnus-registry-extra-entries-precious 'org-tags) (add-to-list 'gnus-registry-track-extra 'org-tags)) +(defvar gnorb-registry-search-history nil) + +;;;###autoload +(defun gnorb-gnus-search-registry (search-string) + "Search for and display messages using the registry. +Prompt for a registry-specific SEARCH-STRING, then create an +ephemeral group containing the resulting messages. All tracked +registry data keys are acceptable, see (slot-value +gnus-registry-db 'tracked). Unknown keys will be ignored. Keys +and search strings should be given as \"key:value\", with extra +quotes around multi-word search values. Eg: + +sender:google.com subject:\"your search results\"" + (interactive + (list (read-string "Registry search terms: " nil + gnorb-registry-search-history))) + (let (parsed found this-pass term) +(with-temp-buffer + (insert search-string) + (goto-char (point-min)) + (while (re-search-forward + "\\([[:alpha:]]+\\):\\(\\(?:\\w+\\|\"[[:alpha:] ]+\"\\)\\)" + (point-at-eol) t) + (push (cons (intern (match-string 1)) + (string-trim (match-string 2) "\"" "\"")) + parsed)) + (dolist (sym (slot-value gnus-registry-db 'tracked)) + (when (setq term (cdr-safe (assoc sym parsed))) + (maphash + (lambda (k v) +(when (string-match-p term k) + (setq this-pass (append v this-pass + (gethash sym (slot-value gnus-registry-db 'tracker))) + (setq found (if found + (seq-intersection found this-pass) + this-pass) + this-pass nil))) + (if found + (let* ((server (gnorb-gnus-find-gnorb-server)) +(artlist + (mapcar + (lambda (msg) +(pcase-let ((`(,group . ,artno) (gnorb-msg-id-request-head + msg))) + (when (and artno (integerp artno) (> artno 0)) +(vector group artno 100 + (delq nil (delete-dups found +(name (make-temp-name "registry messages")) +(spec (list + (cons 'nnir-specs (list (cons 'nnir-query-spec + `((query . "dummy") + (articles . ,artlist))) + (cons 'nnir-group-spec + `((,server ,(list name)) + (cons 'nnir-artlist nil + (switch-to-buffer gnus-group-buffer) + (gnus-group-read-ephemeral-group +name `(nnir ,server) nil `(switch-to-buffer ,gnus-group-buffer) +nil nil spec)) + (message "No results found")) + ;;;###autoload (defun gnorb-gnus-tag-message (arg &optional tags) "Tag message or messages with TAGS. diff --git a/packages/gnorb/gnorb.info b/packages/gnorb/gnorb.info index 414242e..0bb27fa 100644 --- a/packages/gnorb/gnorb.info +++ b/packages/gnorb/gnorb.info @@ -52,6 +52,7 @@ Misc Org Misc Gnus +* Searching With the Registry:: * User Options: User Options 2. @@ -673,12 +674,37 @@ File: gnorb.info, Node: Misc Gnus, Next: Default Keybindings, Prev: Misc Org, * Menu: +* Searching With the Registry:: * User Options: User Options 2. -File: gnorb.info, Node: User Options 2, Up: Misc Gnus +File: gnorb.info, Node: Searching With the Registry, Next: User Options 2, Up: Misc Gnus -11.1 User Options +11.1 Searching With the Registry + + +Gnorb can use the Gnus registry as a sort of limited search index: the +registry tracks information about sender, recipient, subject, and a few +other things, and while t
[elpa] master 620d210 2/5: Missing a require for seq package
branch: master commit 620d2109951e3a833bd7ca33d8dbbdb4599acd5c Author: Eric Abrahamsen Commit: Eric Abrahamsen Missing a require for seq package * packages/gnorb/gnorb-utils.el --- packages/gnorb/gnorb-utils.el | 1 + 1 file changed, 1 insertion(+) diff --git a/packages/gnorb/gnorb-utils.el b/packages/gnorb/gnorb-utils.el index 1a9d094..2b4b98d 100644 --- a/packages/gnorb/gnorb-utils.el +++ b/packages/gnorb/gnorb-utils.el @@ -28,6 +28,7 @@ (require 'cl-lib) (require 'nnheader)) (require 'pcase) +(require 'seq) (require 'org) (require 'org-agenda) (require 'org-element)
[elpa] master updated (e538c67 -> 7c12813)
girzel pushed a change to branch master. from e538c67 Allow short-circuiting the nnir search new 7d3f43c Factor out function for finding nngnorb server new 620d210 Missing a require for seq package new 6f43089 New function gnorb-gnus-search-registry new c7d86a3 New gnorb-helm file new 7c12813 Update copyright notices, bump to version 1.5 Summary of changes: packages/gnorb/gnorb-bbdb.el | 2 +- packages/gnorb/gnorb-gnus.el | 97 +--- packages/gnorb/gnorb-helm.el | 91 + packages/gnorb/gnorb-org.el | 2 +- packages/gnorb/gnorb-registry.el | 2 +- packages/gnorb/gnorb-utils.el| 3 +- packages/gnorb/gnorb.el | 4 +- packages/gnorb/gnorb.info| 93 +- packages/gnorb/gnorb.org | 24 ++ packages/gnorb/gnorb.texi| 37 ++- packages/gnorb/nngnorb.el| 2 +- 11 files changed, 302 insertions(+), 55 deletions(-) create mode 100644 packages/gnorb/gnorb-helm.el
[elpa] master 7c12813 5/5: Update copyright notices, bump to version 1.5
branch: master commit 7c12813970557d874403236b0c4b27b1521a9fd2 Author: Eric Abrahamsen Commit: Eric Abrahamsen Update copyright notices, bump to version 1.5 * packages/gnorb/gnorb.el: Version 1.5 --- packages/gnorb/gnorb-bbdb.el | 2 +- packages/gnorb/gnorb-gnus.el | 2 +- packages/gnorb/gnorb-org.el | 2 +- packages/gnorb/gnorb-registry.el | 2 +- packages/gnorb/gnorb-utils.el| 2 +- packages/gnorb/gnorb.el | 4 ++-- packages/gnorb/nngnorb.el| 2 +- 7 files changed, 8 insertions(+), 8 deletions(-) diff --git a/packages/gnorb/gnorb-bbdb.el b/packages/gnorb/gnorb-bbdb.el index 1c41848..ce83738 100644 --- a/packages/gnorb/gnorb-bbdb.el +++ b/packages/gnorb/gnorb-bbdb.el @@ -1,6 +1,6 @@ ;;; gnorb-bbdb.el --- The BBDB-centric functions of gnorb -*- lexical-binding: t -*- -;; Copyright (C) 2014 Free Software Foundation, Inc. +;; Copyright (C) 2018 Free Software Foundation, Inc. ;; Author: Eric Abrahamsen ;; Keywords: diff --git a/packages/gnorb/gnorb-gnus.el b/packages/gnorb/gnorb-gnus.el index 2c465d2..47b232e 100644 --- a/packages/gnorb/gnorb-gnus.el +++ b/packages/gnorb/gnorb-gnus.el @@ -1,6 +1,6 @@ ;;; gnorb-gnus.el --- The gnus-centric fuctions of gnorb -*- lexical-binding: t -*- -;; Copyright (C) 2014 Free Software Foundation, Inc. +;; Copyright (C) 2018 Free Software Foundation, Inc. ;; Author: Eric Abrahamsen ;; Keywords: diff --git a/packages/gnorb/gnorb-org.el b/packages/gnorb/gnorb-org.el index 485b988..98c7a35 100644 --- a/packages/gnorb/gnorb-org.el +++ b/packages/gnorb/gnorb-org.el @@ -1,6 +1,6 @@ ;;; gnorb-org.el --- The Org-centric functions of gnorb -*- lexical-binding: t -*- -;; Copyright (C) 2014 Free Software Foundation, Inc. +;; Copyright (C) 2018 Free Software Foundation, Inc. ;; Author: Eric Abrahamsen ;; Keywords: diff --git a/packages/gnorb/gnorb-registry.el b/packages/gnorb/gnorb-registry.el index e6dc7b9..d87892d 100644 --- a/packages/gnorb/gnorb-registry.el +++ b/packages/gnorb/gnorb-registry.el @@ -1,6 +1,6 @@ ;;; gnorb-registry.el --- Registry implementation for Gnorb -*- lexical-binding: t -*- -;; Copyright (C) 2014 Free Software Foundation, Inc. +;; Copyright (C) 2018 Free Software Foundation, Inc. ;; Author: Eric Abrahamsen diff --git a/packages/gnorb/gnorb-utils.el b/packages/gnorb/gnorb-utils.el index 2b4b98d..13e4933 100644 --- a/packages/gnorb/gnorb-utils.el +++ b/packages/gnorb/gnorb-utils.el @@ -1,6 +1,6 @@ ;;; gnorb-utils.el --- Common utilities for all gnorb stuff -*- lexical-binding: t -*- -;; Copyright (C) 2014 Free Software Foundation, Inc. +;; Copyright (C) 2018 Free Software Foundation, Inc. ;; Author: Eric Abrahamsen ;; Keywords: diff --git a/packages/gnorb/gnorb.el b/packages/gnorb/gnorb.el index efe72d6..36f63ba 100644 --- a/packages/gnorb/gnorb.el +++ b/packages/gnorb/gnorb.el @@ -1,8 +1,8 @@ ;;; gnorb.el --- Glue code between Gnus, Org, and BBDB -*- lexical-binding: t -*- -;; Copyright (C) 2014 Free Software Foundation, Inc. +;; Copyright (C) 2018 Free Software Foundation, Inc. -;; Version: 1.4.2 +;; Version: 1.5 ;; Package-Requires: ((cl-lib "0.5")) ;; Maintainer: Eric Abrahamsen diff --git a/packages/gnorb/nngnorb.el b/packages/gnorb/nngnorb.el index 0985a87..fd871e5 100644 --- a/packages/gnorb/nngnorb.el +++ b/packages/gnorb/nngnorb.el @@ -1,6 +1,6 @@ ;;; nngnorb.el --- Gnorb backend for Gnus -*- lexical-binding: t -*- -;; Copyright (C) 2014 Free Software Foundation, Inc. +;; Copyright (C) 2018 Free Software Foundation, Inc. ;; Author: Eric Abrahamsen
[elpa] master c7d86a3 4/5: New gnorb-helm file
branch: master commit c7d86a3f0080cc0c5ba07206cd9de95829338ff0 Author: Eric Abrahamsen Commit: Eric Abrahamsen New gnorb-helm file * packages/gnorb/gnorb-helm.el: New library, so far only one command. (gnorb-helm-search-registry): Command for searching the Gnus registry. (gnorb-helm-gnus-registry-candidates): Extract values from the registry. * packages/gnorb/gnorb.org: Document. --- packages/gnorb/gnorb-helm.el | 91 packages/gnorb/gnorb.info| 13 +-- packages/gnorb/gnorb.org | 8 +++- packages/gnorb/gnorb.texi| 9 - 4 files changed, 113 insertions(+), 8 deletions(-) diff --git a/packages/gnorb/gnorb-helm.el b/packages/gnorb/gnorb-helm.el new file mode 100644 index 000..bdf490d --- /dev/null +++ b/packages/gnorb/gnorb-helm.el @@ -0,0 +1,91 @@ +;;; gnorb-helm.el --- Interface between Helm and Gnorb -*- lexical-binding: t; -*- + +;; Copyright (C) 2018 Free Software Foundation, Inc. + +;; Author: Eric Abrahamsen + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Convenience functions relying on the helm package. + +;;; Code: + +(require 'gnorb-gnus) +(require 'nngnorb) +(require 'gnorb-utils) + +(declare-function 'helm-make-source "ext:helm-source") +(declare-function 'helm "ext:helm") +(declare-function 'helm-marked-candidates "ext:helm") + +(defun gnorb-helm-gnus-registry-candidates () + "Return a list of candidates from the Gnus registry." + (let (ret from recipient subject group) +(maphash + (lambda (msg-id data) + (when (setq group (car-safe (cdr (assoc 'group data))) + from (car-safe (cdr (assoc 'sender data))) + subject (car-safe (cdr (assoc 'subject data))) + recipient (car-safe (cdr (assoc 'recipient data +(push (cons (format "%s: %s" +(if (string-match-p from gnus-ignored-from-addresses) +recipient + from) +subject) ; display +(cons msg-id group)) ; real + ret))) + (slot-value gnus-registry-db 'data)) +ret)) + +;;;###autoload +(defun gnorb-helm-search-registry () + "Use helm and the Gnus registry to search messages." + (interactive) + (require 'helm) + (unless (gnus-alive-p) +(error "Gnus is not running")) + (unless gnus-registry-enabled +(error "The Gnus registry is not enabled")) + (let* ((msgs (helm :sources +(helm-make-source "Gnus Registry" 'helm-source-sync + :candidates #'gnorb-helm-gnus-registry-candidates + :action (lambda (&rest _ignored) (helm-marked-candidates))) +:buffer "*helm Gnus Registry*")) +(server (gnorb-gnus-find-gnorb-server)) +(artlist + (mapcar + (lambda (msg) +(pcase-let ((`(,group . ,artno) (gnorb-msg-id-request-head + (car msg) (cdr msg + (when (and artno (integerp artno) (> artno 0)) +(vector group artno 100 + msgs)) +(name (make-temp-name "registry messages")) +(spec (list + (cons 'nnir-specs (list (cons 'nnir-query-spec + `((query . "dummy") + (articles . ,artlist))) + (cons 'nnir-group-spec + `((,server ,(list name)) + (cons 'nnir-artlist nil +(when msgs + (switch-to-buffer gnus-group-buffer) + (gnus-group-read-ephemeral-group + name `(nnir ,server) nil `(switch-to-buffer ,gnus-group-buffer) + nil nil spec + +(provide 'gnorb-helm) +;;; gnorb-helm.el ends here diff --git a/packages/gnorb/gnorb.info b/packages/gnorb/gnorb.info index 0bb27fa..ee9a0df 100644 --- a/packages/gnorb/gnorb.info +++ b/packages/gnorb/gnorb.info @@ -695,11 +695,16 @@ set of groups beforehand. tracked in the regi
[elpa] master e57f1be: [gnorb] Fix immediate and inexplicable typos, bump to 1.5.1
branch: master commit e57f1be0c46463b75b91f47de707e368d080cb89 Author: Eric Abrahamsen Commit: Eric Abrahamsen [gnorb] Fix immediate and inexplicable typos, bump to 1.5.1 * packages/gnorb/gnorb-gnus.el (gnorb-gnus-search-registry): Cat walked on keyboard? * packages/gnorb/gnorb-helm.el (gnorb-helm-gnus-registry-candidates): Stupid. * packages/gnorb/gnorb.el: Bump to 1.5.1 --- packages/gnorb/gnorb-gnus.el | 2 +- packages/gnorb/gnorb-helm.el | 2 +- packages/gnorb/gnorb.el | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/packages/gnorb/gnorb-gnus.el b/packages/gnorb/gnorb-gnus.el index 47b232e..2bbe19f 100644 --- a/packages/gnorb/gnorb-gnus.el +++ b/packages/gnorb/gnorb-gnus.el @@ -746,7 +746,7 @@ sender:google.com subject:\"your search results\"" (gnus-group-read-ephemeral-group name `(nnir ,server) nil `(switch-to-buffer ,gnus-group-buffer) nil nil spec)) - (message "No results found")) + (message "No results found") ;;;###autoload (defun gnorb-gnus-tag-message (arg &optional tags) diff --git a/packages/gnorb/gnorb-helm.el b/packages/gnorb/gnorb-helm.el index bdf490d..e9eae46 100644 --- a/packages/gnorb/gnorb-helm.el +++ b/packages/gnorb/gnorb-helm.el @@ -41,7 +41,7 @@ subject (car-safe (cdr (assoc 'subject data))) recipient (car-safe (cdr (assoc 'recipient data (push (cons (format "%s: %s" -(if (string-match-p from gnus-ignored-from-addresses) +(if (string-match-p gnus-ignored-from-addresses from) recipient from) subject) ; display diff --git a/packages/gnorb/gnorb.el b/packages/gnorb/gnorb.el index 36f63ba..2253fb1 100644 --- a/packages/gnorb/gnorb.el +++ b/packages/gnorb/gnorb.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2018 Free Software Foundation, Inc. -;; Version: 1.5 +;; Version: 1.5.1 ;; Package-Requires: ((cl-lib "0.5")) ;; Maintainer: Eric Abrahamsen
[elpa] master 6c6b7a1: [gnorb] More little tweaks to registry searching, bump to 1.5.2
branch: master commit 6c6b7a18e9e3f8c215919fc1bef6f2c0af15e093 Author: Eric Abrahamsen Commit: Eric Abrahamsen [gnorb] More little tweaks to registry searching, bump to 1.5.2 * packages/gnorb/gnorb-gnus.el (gnorb-gnus-search-registry): Use case-fold-search, better parsing regexp, and be more careful about returning valid results. * packages/gnorb/gnorb-helm.el (gnorb-helm-gnus-registry-candidates): Be more careful about checking gnus-ignored-from-addresses. * packages/gnorb/gnorb.el: Bump to 1.5.2 --- packages/gnorb/gnorb-gnus.el | 79 +++- packages/gnorb/gnorb-helm.el | 24 ++ packages/gnorb/gnorb.el | 2 +- 3 files changed, 60 insertions(+), 45 deletions(-) diff --git a/packages/gnorb/gnorb-gnus.el b/packages/gnorb/gnorb-gnus.el index 2bbe19f..96d660e 100644 --- a/packages/gnorb/gnorb-gnus.el +++ b/packages/gnorb/gnorb-gnus.el @@ -703,50 +703,55 @@ sender:google.com subject:\"your search results\"" (interactive (list (read-string "Registry search terms: " nil gnorb-registry-search-history))) - (let (parsed found this-pass term) + (let ((case-fold-search t) + parsed found this-pass term) (with-temp-buffer (insert search-string) (goto-char (point-min)) (while (re-search-forward - "\\([[:alpha:]]+\\):\\(\\(?:\\w+\\|\"[[:alpha:] ]+\"\\)\\)" + "\\([[:alpha:]]+\\):\\(\\(?:[^\"[:blank:]]+\\|\"[^\"]+\"\\)\\)" (point-at-eol) t) (push (cons (intern (match-string 1)) (string-trim (match-string 2) "\"" "\"")) - parsed)) - (dolist (sym (slot-value gnus-registry-db 'tracked)) - (when (setq term (cdr-safe (assoc sym parsed))) - (maphash - (lambda (k v) -(when (string-match-p term k) - (setq this-pass (append v this-pass - (gethash sym (slot-value gnus-registry-db 'tracker))) - (setq found (if found - (seq-intersection found this-pass) - this-pass) - this-pass nil))) - (if found - (let* ((server (gnorb-gnus-find-gnorb-server)) -(artlist - (mapcar - (lambda (msg) -(pcase-let ((`(,group . ,artno) (gnorb-msg-id-request-head - msg))) - (when (and artno (integerp artno) (> artno 0)) -(vector group artno 100 - (delq nil (delete-dups found -(name (make-temp-name "registry messages")) -(spec (list - (cons 'nnir-specs (list (cons 'nnir-query-spec - `((query . "dummy") - (articles . ,artlist))) - (cons 'nnir-group-spec - `((,server ,(list name)) - (cons 'nnir-artlist nil - (switch-to-buffer gnus-group-buffer) - (gnus-group-read-ephemeral-group -name `(nnir ,server) nil `(switch-to-buffer ,gnus-group-buffer) -nil nil spec)) - (message "No results found") + parsed))) +(dolist (sym (slot-value gnus-registry-db 'tracked)) + (when (setq term (cdr-safe (assoc sym parsed))) + (maphash +(lambda (k v) + (when (string-match-p term k) +(setq this-pass (append v this-pass +(gethash sym (slot-value gnus-registry-db 'tracker))) + (setq found (if found + (seq-intersection found this-pass) + this-pass) + this-pass nil))) +(if found + (let* ((server (gnorb-gnus-find-gnorb-server)) + (artlist + (delq +nil +(mapcar + (lambda (msg) + (pcase-let ((`(,group . ,artno) +(gnorb-msg-id-request-head + msg (car-safe + (gnus-registry-get-id-key msg 'group) + (when (and group artno (integerp artno) (> artno 0)) + (vector group artno 100 + (delq nil (delete-dups found) + (name (make-temp-name "registry messages")) + (spec (list + (cons 'nnir-specs (list (cons 'nnir-query-spec + `((query . "dummy") +
[elpa] master 0786fbc 5/5: [gnorb] Bump version to 1.5.3
branch: master commit 0786fbc58af64e5232041941883258f258eea313 Author: Eric Abrahamsen Commit: Eric Abrahamsen [gnorb] Bump version to 1.5.3 --- packages/gnorb/gnorb.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/packages/gnorb/gnorb.el b/packages/gnorb/gnorb.el index fb10287..f30cda5 100644 --- a/packages/gnorb/gnorb.el +++ b/packages/gnorb/gnorb.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2018 Free Software Foundation, Inc. -;; Version: 1.5.2 +;; Version: 1.5.3 ;; Package-Requires: ((cl-lib "0.5")) ;; Maintainer: Eric Abrahamsen
[elpa] master dd8158e 4/5: [gnorb] Fix handling of region-bounds return value
branch: master commit dd8158e52ad0cde6fc3e5347ee5863447e7ad9f6 Author: Eric Abrahamsen Commit: Eric Abrahamsen [gnorb] Fix handling of region-bounds return value * packages/gnorb/gnorb-org.el (gnorb-org-handle-mail): It returns a list of cons cells. Did it always do that? Why? --- packages/gnorb/gnorb-org.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/packages/gnorb/gnorb-org.el b/packages/gnorb/gnorb-org.el index 98c7a35..287345d 100644 --- a/packages/gnorb/gnorb-org.el +++ b/packages/gnorb/gnorb-org.el @@ -443,7 +443,7 @@ composed. FILE is a file to attach to the message." (goto-char pos))) (let ((region (when (use-region-p) - (region-bounds + (car (region-bounds) (deactivate-mark) (save-excursion (unless (org-back-to-heading t)
[elpa] master b4cc360 2/5: [gnorb] Don't use make-temp-name for registry searches
branch: master commit b4cc360c96d24421f3cd01da93ae27d0e1093d02 Author: Eric Abrahamsen Commit: Eric Abrahamsen [gnorb] Don't use make-temp-name for registry searches * packages/gnorb/gnorb-gnus.el (gnorb-gnus-search-registry): This was a red herring left over from earlier confusion. --- packages/gnorb/gnorb-gnus.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/packages/gnorb/gnorb-gnus.el b/packages/gnorb/gnorb-gnus.el index 398cc0b..32410a5 100644 --- a/packages/gnorb/gnorb-gnus.el +++ b/packages/gnorb/gnorb-gnus.el @@ -740,7 +740,7 @@ sender:google.com subject:\"your search results\"" (when (and group artno (integerp artno) (> artno 0)) (vector group artno 100 (delq nil (delete-dups found) - (name (make-temp-name "registry messages")) + (name "registry messages") (spec (list (cons 'nnir-specs (list (cons 'nnir-query-spec `((query . "dummy")
[elpa] master updated (6c6b7a1 -> 0786fbc)
girzel pushed a change to branch master. from 6c6b7a1 [gnorb] More little tweaks to registry searching, bump to 1.5.2 new a69320f [gnorb] Don't use string-trim with optional args new b4cc360 [gnorb] Don't use make-temp-name for registry searches new dafd985 [gnorb] Check message-alternative-emails in helm registry search new dd8158e [gnorb] Fix handling of region-bounds return value new 0786fbc [gnorb] Bump version to 1.5.3 Summary of changes: packages/gnorb/gnorb-gnus.el | 5 +++-- packages/gnorb/gnorb-helm.el | 14 +++--- packages/gnorb/gnorb-org.el | 2 +- packages/gnorb/gnorb.el | 2 +- 4 files changed, 16 insertions(+), 7 deletions(-)
[elpa] master a69320f 1/5: [gnorb] Don't use string-trim with optional args
branch: master commit a69320f900d9f7c5e1fe472a7cdcab9a47213903 Author: Eric Abrahamsen Commit: Eric Abrahamsen [gnorb] Don't use string-trim with optional args * packages/gnorb/gnorb-gnus.el (gnorb-gnus-search-registry): Apparently these args aren't accepted in Emacs 25. --- packages/gnorb/gnorb-gnus.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/packages/gnorb/gnorb-gnus.el b/packages/gnorb/gnorb-gnus.el index 96d660e..398cc0b 100644 --- a/packages/gnorb/gnorb-gnus.el +++ b/packages/gnorb/gnorb-gnus.el @@ -712,7 +712,8 @@ sender:google.com subject:\"your search results\"" "\\([[:alpha:]]+\\):\\(\\(?:[^\"[:blank:]]+\\|\"[^\"]+\"\\)\\)" (point-at-eol) t) (push (cons (intern (match-string 1)) - (string-trim (match-string 2) "\"" "\"")) + (replace-regexp-in-string "\\`\"\\|\"\\'" "" + (match-string 2))) parsed))) (dolist (sym (slot-value gnus-registry-db 'tracked)) (when (setq term (cdr-safe (assoc sym parsed)))
[elpa] master dafd985 3/5: [gnorb] Check message-alternative-emails in helm registry search
branch: master commit dafd985dc0f6c8294fa550051e20423af767fbf5 Author: Eric Abrahamsen Commit: Eric Abrahamsen [gnorb] Check message-alternative-emails in helm registry search * packages/gnorb/gnorb-helm.el (gnorb-helm-gnus-registry-candidates): In addition to gnus-ignored-from-addresses. --- packages/gnorb/gnorb-helm.el | 14 +++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/packages/gnorb/gnorb-helm.el b/packages/gnorb/gnorb-helm.el index bcae4f9..8fa6309 100644 --- a/packages/gnorb/gnorb-helm.el +++ b/packages/gnorb/gnorb-helm.el @@ -34,13 +34,20 @@ (defun gnorb-helm-gnus-registry-candidates () "Return a list of candidates from the Gnus registry." (let ((check -(when gnus-ignored-from-addresses +(when (or gnus-ignored-from-addresses + message-alternative-emails) (cond ((functionp gnus-ignored-from-addresses) (lambda (adr) (funcall gnus-ignored-from-addresses adr))) ((stringp gnus-ignored-from-addresses) (lambda (adr) (string-match-p -gnus-ignored-from-addresses adr)) +gnus-ignored-from-addresses adr))) +((functionp message-alternative-emails) + (lambda (adr) (funcall message-alternative-emails adr))) +((stringp message-alternative-emails) + (lambda (adr) + (string-match-p +message-alternative-emails adr)) ret from recipient subject group) (maphash (lambda (msg-id data) @@ -52,7 +59,8 @@ "%s: %s" ; display (if (and check (funcall check from)) - (mapconcat #'identity recipient " ") + (concat + "To: " (mapconcat #'identity recipient " ")) from) subject) (cons msg-id group)) ; real
[elpa] master 04889dc: [gnorb] Require gnorb-org within gnorb-trigger-todo-action
branch: master commit 04889dc0c720a24fcd59e48677a1b9c4c0666485 Author: Eric Abrahamsen Commit: Eric Abrahamsen [gnorb] Require gnorb-org within gnorb-trigger-todo-action * packages/gnorb/gnorb-utils.el (gnorb-trigger-todo-action): This is another entry point where the user might not have hit anything to load gnorb-org yet. --- packages/gnorb/gnorb-utils.el | 1 + 1 file changed, 1 insertion(+) diff --git a/packages/gnorb/gnorb-utils.el b/packages/gnorb/gnorb-utils.el index 13e4933..63469cc 100644 --- a/packages/gnorb/gnorb-utils.el +++ b/packages/gnorb/gnorb-utils.el @@ -326,6 +326,7 @@ numbers (no upper bound)." 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 `gnorb-org-trigger-actions'." + (require 'gnorb-org) (let* ((agenda-p (eq major-mode 'org-agenda-mode)) (root-marker (cond (agenda-p
[elpa] externals/ebdb 1090a26 6/7: Display message when reformatting a single record
branch: externals/ebdb commit 1090a26b70d5fb36992c7d6917cb59d958331bbc Author: Eric Abrahamsen Commit: Eric Abrahamsen Display message when reformatting a single record * ebdb-com.el (ebdb-reformat-records): Say that we're doing it. --- ebdb-com.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/ebdb-com.el b/ebdb-com.el index 469f6c1..a91e7bb 100644 --- a/ebdb-com.el +++ b/ebdb-com.el @@ -1337,7 +1337,9 @@ Use the symbol `mark', or the mark provided by MARK." ;; This function ideally wouldn't be necessary, but obviously there ;; will be times... (interactive (list (ebdb-do-records))) - (ebdb-redisplay-records records 'reformat)) + (message "Redisplaying record") + (ebdb-redisplay-records records 'reformat) + (message "Redisplaying record... done")) ;; Buffer manipulation
[elpa] externals/ebdb b240223 4/7: Rework field sorting
branch: externals/ebdb commit b240223aba0f7e92e355178026a03c7ce24956ae Author: Eric Abrahamsen Commit: Eric Abrahamsen Rework field sorting * ebdb.el (ebdb-field-compare): New method for comparing/sorting fields. By default, don't change order. (ebdb-field-compare): Remove old (unused) function `ebdb-sort-mails', and replace with new method for mail fields. * ebdb-format.el (ebdb-fmt-sort-fields): Instead of fretting about how to correctly sort mails when editing the database, just do the sorting at display time. Fields are now sorted first using `ebdb-field-compare', then the formatter sort order. Use seq.el sorting functions, instead of my homemade bird's nest. (ebdb-fmt-process-fields): Make sure combined field instances maintain sort order. --- ebdb-format.el | 46 -- ebdb.el| 27 --- 2 files changed, 36 insertions(+), 37 deletions(-) diff --git a/ebdb-format.el b/ebdb-format.el index 65e4dbd..3dd7257 100644 --- a/ebdb-format.el +++ b/ebdb-format.el @@ -277,35 +277,28 @@ FIELD-STRING1 FIELD-STRING2 ..)." (cl-defmethod ebdb-fmt-sort-fields ((fmt ebdb-formatter) (_record ebdb-record) field-list) - (let ((sort (slot-value fmt 'sort)) - f acc outlist class) -(when sort - (dolist (s sort) - (if (symbolp s) - (progn - (setq class (cl--find-class s)) - (while (setq f (pop field-list)) - (if (same-class-p f class) - (push f outlist) - (push f acc))) - (setq field-list acc - acc nil)) - ;; We assume this is the "_" value. Actually, anything - ;; would do as a catchall placeholder. - (dolist (fld field-list) - (setq class (eieio-object-class-name fld)) - (unless (memq class sort) - ;; This isn't enough -- field still need to be grouped - ;; by field class. - (push fld outlist) - (setq field-list (nreverse outlist))) -field-list)) + "Sort FIELD-LIST using sort order from FMT. +First sorts all fields with `ebdb-field-compare', then sorts +again by the order of each field's class symbol in the 'sort +slot of FMT." + (let* ((sort-order (slot-value fmt 'sort)) +(catchall (or (seq-position sort-order "_") + (length sort-order))) +(sorted (seq-sort #'ebdb-field-compare field-list))) + +(when sort-order + (setq sorted + (seq-sort-by +(lambda (f) + (or (seq-position sort-order (eieio-object-class-name f)) + catchall)) +#'< sorted))) +sorted)) (cl-defmethod ebdb-fmt-process-fields ((fmt ebdb-formatter) (_record ebdb-record) field-list) "Process FIELD-LIST for FMT. - At present that means handling the combine and collapse slots of FMT. @@ -319,9 +312,10 @@ grouped by field class." (if (null (ebdb-class-in-list-p cls combine)) (push f outlist) (push f acc) - (while (and field-list (same-class-p (car field-list) (eieio-object-class f))) + (while (and field-list (same-class-p (car field-list) +(eieio-object-class f))) (push (setq f (pop field-list)) acc)) - (push `(:class ,cls :style compact :inst ,acc) outlist) + (push `(:class ,cls :style compact :inst ,(nreverse acc)) outlist) (setq acc nil))) (setq field-list (nreverse outlist) outlist nil)) diff --git a/ebdb.el b/ebdb.el index 03f9a37..1b5683e 100644 --- a/ebdb.el +++ b/ebdb.el @@ -958,6 +958,13 @@ chance to react somehow. TYPE is one of the symbols 'sender or in." nil) +(cl-defgeneric ebdb-field-compare (field1 field2) + "Return non-nil if FIELD1 should be sorted before FIELD2.") + +(cl-defmethod ebdb-field-compare (_field1 _field2) + "By default, leave order unchanged." + nil) + ;;; The UUID field. ;; This was originally just a string-value slot, but it was such a @@ -1515,18 +1522,16 @@ first one." (setq slots (plist-put slots :aka name))) (cl-call-next-method class str slots))) -(defun ebdb-sort-mails (mails) - "Sort MAILS by their priority slot. +(cl-defmethod ebdb-field-compare ((m-left ebdb-field-mail) + (m-right ebdb-field-mail)) + "Sort M-LEFT and M-RIGHT by their priority slot. Primary sorts before normal sorts before defunct." - (sort - mails - (lambda (l r) - (let ((l-p (slot-value l 'priority)) - (r-p (
