emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] master 2111d3f 1/2: Gnorb: New command for inserting tracked mess


From: Eric Abrahamsen
Subject: [elpa] master 2111d3f 1/2: Gnorb: New command for inserting tracked messages; bump to 1.4.1
Date: Mon, 11 Dec 2017 12:21:00 -0500 (EST)

branch: master
commit 2111d3f3df06eeb5eb13c42148ff5f9ef43a0bf3
Author: Eric Abrahamsen <address@hidden>
Commit: Eric Abrahamsen <address@hidden>

    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-registry-db 'gnorb-ids)))
+   (registry-lookup-secondary gnus-registry-db 'gnorb-ids t)))
 
 (defun gnorb-registry-tracked-tags ()
   "Return all tags that have been used on tracked messages."
   (hash-table-keys
-   (registry-lookup-secondary gnus-registry-db 'org-tags)))
+   (registry-lookup-secondary gnus-registry-db 'org-tags t)))
 
 (defun gnorb-report-tracking-usage ()
   "Pop up a temporary window reporting on Gnorb usage of the Gnus
 registry to track message/heading associations.  Reports the
-number of tracked messages, the number of tracked headings, and how much of 
the registry is occupied."
+number of tracked messages, the number of tracked headings, any
+tagged messages, and how much of the registry is occupied."
   (interactive)
   (pop-to-buffer
    (get-buffer-create "*Gnorb Usage*")
@@ -228,28 +229,40 @@ number of tracked messages, the number of tracked 
headings, and how much of the
 
 (defun gnorb-refresh-usage-status (&optional _ignore-auto _noconfirm)
   "Clear and re-format the *Gnorb Usage* buffer."
-  (let ((messages (length (gnorb-registry-tracked-messages)))
-       (headings (length (gnorb-registry-tracked-headings)))
-       (reg-size (registry-size gnus-registry-db))
-       (reg-max-size (if (slot-exists-p gnus-registry-db 'max-size)
-                         (oref gnus-registry-db max-size)
-                       (oref gnus-registry-db max-hard))))
+  (let* ((messages (gnorb-registry-tracked-messages))
+        (message-num (length messages))
+        (headings (gnorb-registry-tracked-headings))
+        (heading-num (length headings))
+        (tagged (gnorb-registry-tagged-messages))
+        (tags (gnorb-registry-tracked-tags))
+        (total-occupied (length (delete-dups (append messages tagged))))
+        (reg-size (registry-size gnus-registry-db))
+        (reg-max-size (if (slot-exists-p gnus-registry-db 'max-size)
+                          (oref gnus-registry-db max-size)
+                        (oref gnus-registry-db max-hard))))
     (with-current-buffer "*Gnorb Usage*"
       (let ((inhibit-read-only t))
-       (erase-buffer)
-       (insert
-       (format
-        "Tracking %d Gnus messages associated with %d Org headings."
-        messages headings))
-       (insert "\n\n")
-       (insert
-       (format
-        "Occupying %.2f%% (%d/%d) of the registry (max %d)."
-        (* 100 (/ (float messages) reg-size))
-        messages reg-size reg-max-size))
-       (insert "\n\n")
-       (insert "Press 'd' to delete associations for non-existent Org 
headings.\n")
-       (insert "Press 'D' to delete associations for both non-existent and 
archived Org headings.")))))
+       (erase-buffer)
+       (insert
+        (format
+         "Tracking %d Gnus messages associated with %d Org headings."
+         message-num heading-num))
+       (when tagged
+         (insert (format "\n%d tagged messages, with %d tag%s:\n"
+                         (length tagged)
+                         (length tags)
+                         (if (= 1 (length tags)) "" "s")))
+         (dolist (tag tags)
+           (insert (format "%s\n" tag))))
+       (insert "\n\n")
+       (insert
+        (format
+         "Occupying %.2f%% (%d/%d) of the registry (max %d)."
+         (* 100 (/ (float total-occupied) reg-size))
+         total-occupied reg-size reg-max-size))
+       (insert "\n\n")
+       (insert "Press 'd' to delete associations for non-existent Org 
headings.\n")
+       (insert "Press 'D' to delete associations for both non-existent and 
archived Org headings.")))))
 
 (defun gnorb-registry-transition-from-props (arg)
   "Helper function for transitioning the old tracking system to the new.
diff --git a/packages/gnorb/gnorb-utils.el b/packages/gnorb/gnorb-utils.el
index 30dec58..791c671 100644
--- a/packages/gnorb/gnorb-utils.el
+++ b/packages/gnorb/gnorb-utils.el
@@ -648,6 +648,7 @@ registry be in use, and should be called after the call to
        (define-key gnus-summary-mode-map (kbd "C-c v") #'gnorb-gnus-view)
        (define-key gnus-summary-mode-map (kbd "C-c C-t") 
#'gnorb-gnus-tag-message)
        (define-key gnus-summary-limit-map (kbd "g") 
#'gnorb-gnus-insert-tagged-messages)
+       (define-key gnus-summary-limit-map (kbd "G") 
#'gnorb-gnus-insert-tracked-messages)
        (setq gnorb-gnus-capture-always-attach t)
        (push '("attach to org heading" . gnorb-gnus-mime-org-attach)
              gnus-mime-action-alist)
diff --git a/packages/gnorb/gnorb.el b/packages/gnorb/gnorb.el
index 9b79722..e44eb46 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.5
+;; Version: 1.4.1
 ;; Package-Requires: ((cl-lib "0.5"))
 
 ;; Maintainer: Eric Abrahamsen <address@hidden>
diff --git a/packages/gnorb/gnorb.info b/packages/gnorb/gnorb.info
index f83d046..414242e 100644
--- a/packages/gnorb/gnorb.info
+++ b/packages/gnorb/gnorb.info
@@ -360,6 +360,13 @@ and update the group contents by hitting “M-g” on the 
group in the Gnus
    Calling ‘gnorb-gnus-view’ (“C-c v”) on a tracked message will take
 you to the tracked Org heading.
 
+   From a Gnus *Summary* buffer, you can insert all tracked messages in
+the current group into the buffer with
+‘gnorb-gnus-insert-tracked-messages’, bound to “/ G” in the default
+keybindings.  By default this will only insert messages associated with
+headings that are not in a DONE state; call with a prefix arg to insert
+all messages.
+
    As a bonus, it’s possible to go into Gnus’ *Server* buffer, find the
 line specifying your nngnorb server, and hit “G” (aka
 ‘gnus-group-make-nnir-group’).  At the query prompt, enter an Org-style
@@ -733,8 +740,6 @@ File: gnorb.info,  Node: Default Keybindings,  Prev: Misc 
Gnus,  Up: Top
 12 Default Keybindings
 **********************
 
-Using the bundled function ‘gnorb-install-defaults’ runs the code below.
-If you don’t like these defaults, you can always do your own setup.
      (global-set-key (kbd "C-c A") 'gnorb-restore-layout)
      (eval-after-load "gnorb-bbdb"
        '(progn
@@ -757,6 +762,9 @@ If you don’t like these defaults, you can always do your 
own setup.
           (define-key gnus-summary-mime-map "a" 
#'gnorb-gnus-article-org-attach)
           (define-key gnus-summary-mode-map (kbd "C-c t") 
#'gnorb-gnus-incoming-do-todo)
           (define-key gnus-summary-mode-map (kbd "C-c v") #'gnorb-gnus-view)
+          (define-key gnus-summary-mode-map (kbd "C-c C-t") 
#'gnorb-gnus-tag-message)
+          (define-key gnus-summary-limit-map (kbd "g") 
#'gnorb-gnus-insert-tagged-messages)
+          (define-key gnus-summary-limit-map (kbd "G") 
#'gnorb-gnus-insert-tracked-messages)
           (setq gnorb-gnus-capture-always-attach t)
           (push '("attach to org heading" . gnorb-gnus-mime-org-attach)
                 gnus-mime-action-alist)
@@ -770,6 +778,9 @@ If you don’t like these defaults, you can always do your 
own setup.
      (eval-after-load "message"
        '(progn
           (define-key message-mode-map (kbd "C-c t") 
#'gnorb-gnus-outgoing-do-todo)))
+   Using the bundled function ‘gnorb-install-defaults’ runs the code
+below.  If you don’t like these defaults, you can always do your own
+setup.
 
 
 
@@ -784,23 +795,23 @@ Node: Tracking Setup7132
 Node: Beginning and Continuing the Tracking Process8412
 Node: Trigger Actions12604
 Node: Viewing Things13678
-Node: Hinting in Gnus15448
-Node: Message Attachments16513
-Node: Registry Usage17752
-Node: Restoring Window Layout18179
-Node: Recent Mails From BBDB Contacts18576
-Node: Tagging Messages and Contacts19582
-Node: BBDB posting styles21233
-Node: Misc BBDB22140
-Node: Searching for messages from BBDB contacts22356
-Node: Citing BBDB contacts22802
-Node: User Options23123
-Node: Misc Org24646
-Node: Inserting BBDB links24821
-Node: User Options 125077
-Node: Misc Gnus27975
-Node: User Options 228137
-Node: Default Keybindings31279
+Node: Hinting in Gnus15794
+Node: Message Attachments16859
+Node: Registry Usage18098
+Node: Restoring Window Layout18525
+Node: Recent Mails From BBDB Contacts18922
+Node: Tagging Messages and Contacts19928
+Node: BBDB posting styles21579
+Node: Misc BBDB22486
+Node: Searching for messages from BBDB contacts22702
+Node: Citing BBDB contacts23148
+Node: User Options23469
+Node: Misc Org24992
+Node: Inserting BBDB links25167
+Node: User Options 125423
+Node: Misc Gnus28321
+Node: User Options 228483
+Node: Default Keybindings31625
 
 End Tag Table
 
diff --git a/packages/gnorb/gnorb.org b/packages/gnorb/gnorb.org
index 016b08e..c298c1b 100644
--- a/packages/gnorb/gnorb.org
+++ b/packages/gnorb/gnorb.org
@@ -261,6 +261,13 @@ the Gnus *Group* buffer.
 Calling `gnorb-gnus-view' ("C-c v") on a tracked message will take you
 to the tracked Org heading.
 
+From a Gnus *Summary* buffer, you can insert all tracked messages in
+the current group into the buffer with
+`gnorb-gnus-insert-tracked-messages', bound to "/ G" in the default
+keybindings. By default this will only insert messages associated with
+headings that are not in a DONE state; call with a prefix arg to
+insert all messages.
+
 As a bonus, it's possible to go into Gnus' *Server* buffer, find the
 line specifying your nngnorb server, and hit "G" (aka
 `gnus-group-make-nnir-group'). At the query prompt, enter an Org-style
@@ -553,6 +560,9 @@ below. If you don't like these defaults, you can always do 
your own setup.
        (define-key gnus-summary-mime-map "a" #'gnorb-gnus-article-org-attach)
        (define-key gnus-summary-mode-map (kbd "C-c t") 
#'gnorb-gnus-incoming-do-todo)
        (define-key gnus-summary-mode-map (kbd "C-c v") #'gnorb-gnus-view)
+       (define-key gnus-summary-mode-map (kbd "C-c C-t") 
#'gnorb-gnus-tag-message)
+       (define-key gnus-summary-limit-map (kbd "g") 
#'gnorb-gnus-insert-tagged-messages)
+       (define-key gnus-summary-limit-map (kbd "G") 
#'gnorb-gnus-insert-tracked-messages)
        (setq gnorb-gnus-capture-always-attach t)
        (push '("attach to org heading" . gnorb-gnus-mime-org-attach)
              gnus-mime-action-alist)
diff --git a/packages/gnorb/gnorb.texi b/packages/gnorb/gnorb.texi
index 3d09c89..eeab2b7 100644
--- a/packages/gnorb/gnorb.texi
+++ b/packages/gnorb/gnorb.texi
@@ -379,6 +379,13 @@ the Gnus *Group* buffer.
 Calling `gnorb-gnus-view' (``C-c v'') on a tracked message will take you
 to the tracked Org heading.
 
+From a Gnus *Summary* buffer, you can insert all tracked messages in
+the current group into the buffer with
+`gnorb-gnus-insert-tracked-messages', bound to ``/ G'' in the default
+keybindings. By default this will only insert messages associated with
+headings that are not in a DONE state; call with a prefix arg to
+insert all messages.
+
 As a bonus, it's possible to go into Gnus' *Server* buffer, find the
 line specifying your nngnorb server, and hit ``G'' (aka
 `gnus-group-make-nnir-group'). At the query prompt, enter an Org-style
@@ -726,8 +733,6 @@ line. Defaults to ``&''.
 @node Default Keybindings
 @chapter Default Keybindings
 
-Using the bundled function `gnorb-install-defaults' runs the code
-below. If you don't like these defaults, you can always do your own setup.
 @lisp
 (global-set-key (kbd "C-c A") 'gnorb-restore-layout)
 (eval-after-load "gnorb-bbdb"
@@ -751,6 +756,9 @@ below. If you don't like these defaults, you can always do 
your own setup.
      (define-key gnus-summary-mime-map "a" #'gnorb-gnus-article-org-attach)
      (define-key gnus-summary-mode-map (kbd "C-c t") 
#'gnorb-gnus-incoming-do-todo)
      (define-key gnus-summary-mode-map (kbd "C-c v") #'gnorb-gnus-view)
+     (define-key gnus-summary-mode-map (kbd "C-c C-t") 
#'gnorb-gnus-tag-message)
+     (define-key gnus-summary-limit-map (kbd "g") 
#'gnorb-gnus-insert-tagged-messages)
+     (define-key gnus-summary-limit-map (kbd "G") 
#'gnorb-gnus-insert-tracked-messages)
      (setq gnorb-gnus-capture-always-attach t)
      (push '("attach to org heading" . gnorb-gnus-mime-org-attach)
            gnus-mime-action-alist)
@@ -765,5 +773,7 @@ below. If you don't like these defaults, you can always do 
your own setup.
   '(progn
      (define-key message-mode-map (kbd "C-c t") 
#'gnorb-gnus-outgoing-do-todo)))
 @end lisp
+Using the bundled function `gnorb-install-defaults' runs the code
+below. If you don't like these defaults, you can always do your own setup.
 
 @bye
\ No newline at end of file



reply via email to

[Prev in Thread] Current Thread [Next in Thread]