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

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

[elpa] externals/gnorb f5d451e 092/449: New nngnorb mail backend


From: Stefan Monnier
Subject: [elpa] externals/gnorb f5d451e 092/449: New nngnorb mail backend
Date: Fri, 27 Nov 2020 23:15:15 -0500 (EST)

branch: externals/gnorb
commit f5d451ed0f17ff8417ff1e6375dbd049c0628550
Author: Eric Abrahamsen <eric@ericabrahamsen.net>
Commit: Eric Abrahamsen <eric@ericabrahamsen.net>

    New nngnorb mail backend
    
    lisp/nngnorb.el: Define a "nngnorb" mail backend, mostly copy and pasted
                 from nnnil.
    
    lisp/gnorb.el: Require the above file.
    
    lisp/gnorb-org.el: New function `gnorb-org-view'. Call this on a subtree
                 to open an ephemeral gnus group containing all the
                 messages linked to from within the subtree's text. This
                 calls directly to `gnorb-gnus-search-messages'.
    
    lisp/gnorb-gnus.el: New function `gnorb-gnus-search-messages', initiates
                 the actual search. Analogous to
                 `gnus-group-make-nnir-group'. Works in the *Server*
                 buffer, on the nngnorb server line, but can't be used
                 from the *Group* buffer, as the nngnorb backend has no
                 groups.
    
    Once the search is initiated, the ephemeral group construction process
    eventually calls `nnir-run-gnorb', with the search query string. This
    string can be one of two things. The first is an Org id value, which is
    what happens when you start out using `gnorb-org-view'. The heading with
    that value is scanned for links to gnus messages. The second is an
    agenda search string, with tags/todo matching and all that. In that case
    all the headings which match the search are scanned for message links.
    It might be nice to make those groups persistent at some point.
---
 lisp/gnorb-gnus.el |  31 ++++++++++
 lisp/gnorb-org.el  |  19 ++++++
 lisp/gnorb.el      |   1 +
 lisp/nngnorb.el    | 171 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 222 insertions(+)

diff --git a/lisp/gnorb-gnus.el b/lisp/gnorb-gnus.el
index c60e6b2..5bef51f 100644
--- a/lisp/gnorb-gnus.el
+++ b/lisp/gnorb-gnus.el
@@ -387,5 +387,36 @@ if any of the IDs there match the value of the
         (mapconcat 'key-description
                    (where-is-internal 'org-insert-link) ", "))))))
 
+(defun gnorb-gnus-search-messages (str &optional 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 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."
+  (interactive)
+  (let ((server
+        (or (catch 'found
+              (dolist (s gnus-server-alist)
+                (when (eq (nth 1 s) 'nngnorb)
+                  (throw 'found (car s)))))
+            (user-error
+             "Please add a \"nngnorb\" backend to your gnus installation."))))
+    (gnus-group-read-ephemeral-group
+     (concat "gnorb-" str)
+     (list 'nnir "nnir") nil
+     ret ;; it's possible you can't just put an arbitrary form in here.
+     nil nil
+     (list (cons 'nnir-specs (list (cons 'nnir-query-spec `((query . ,str)))
+                                  (cons 'nnir-group-spec `((,server)))))
+          (cons 'nnir-artlist nil)))))
+
+
+
 (provide 'gnorb-gnus)
 ;;; gnorb-gnus.el ends here
diff --git a/lisp/gnorb-org.el b/lisp/gnorb-org.el
index 890d185..6cc5354 100644
--- a/lisp/gnorb-org.el
+++ b/lisp/gnorb-org.el
@@ -671,5 +671,24 @@ search."
 
 (add-hook 'org-agenda-finalize-hook 'gnorb-org-popup-bbdb)
 
+;;; Groups from the gnorb gnus server backend
+
+(defun gnorb-org-view ()
+  "Search the subtree at point for links to gnus messages, and
+then show them in an ephemeral group, in gnus.
+
+This won't work unless you've added a \"nngnorb\" server to
+your gnus select methods."
+  (interactive)
+  (setq gnorb-org-window-conf (current-window-configuration))
+  (let (id)
+    (save-excursion
+      (org-back-to-heading)
+      (setq id (concat "id+" (org-id-get-create t))))
+    (gnorb-gnus-search-messages
+     id
+     `(when (window-configuration-p gnorb-org-window-conf)
+       (set-window-configuration gnorb-org-window-conf)))))
+
 (provide 'gnorb-org)
 ;;; gnorb-org.el ends here
diff --git a/lisp/gnorb.el b/lisp/gnorb.el
index c798198..6304ec6 100644
--- a/lisp/gnorb.el
+++ b/lisp/gnorb.el
@@ -25,6 +25,7 @@
 ;;; Code:
 
 (require 'gnorb-utils)
+(require 'nngnorb)
 (require 'gnorb-gnus)
 (require 'gnorb-org)
 (require 'gnorb-bbdb)
diff --git a/lisp/nngnorb.el b/lisp/nngnorb.el
new file mode 100644
index 0000000..4f78a90
--- /dev/null
+++ b/lisp/nngnorb.el
@@ -0,0 +1,171 @@
+;;; nngnorb.el --- Gnorb backend for Gnus
+
+;; This file is in the public domain.
+
+;; Author: Eric Abrahamsen <eric@ericabrahamsen.net.>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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 GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This is a backend for supporting Gnorb-related stuff. I'm going to
+;; regret this, I know.
+
+;; It started off just with wanting to collect all the gnus links in a
+;; subtree, and display all the messages in an ephemeral group. But it
+;; doesn't seem possible to create ephemeral groups without
+;; associating them with a server, and which server would that be?
+;; Nnir also provides a nice interface to creating ephemeral groups,
+;; but again, it relies on a server parameter to know which nnir
+;; engine to use, and if you try to fake it it still craps out.
+
+;; So this file is a copy-pasta from nnnil.el -- I'm trying to keep
+;; this as simple as possible. Right now it does nothing but serving
+;; as a place to hang ephemeral groups made with nnir searches of
+;; message from the rest of your gnus installation. Enjoy.
+
+;;; Code:
+
+(eval-and-compile
+  (require 'nnheader)
+  (require 'nnir))
+
+(defvar nngnorb-status-string "")
+
+(gnus-declare-backend "nngnorb" 'none)
+
+(add-to-list 'nnir-method-default-engines '(nngnorb . gnorb))
+
+(add-to-list 'nnir-engines
+            '(gnorb nnir-run-gnorb
+                    ((gnorb-nnir-string . "Org Agenda tags search string: "))))
+
+(defun nnir-run-gnorb (query server &optional group)
+  "Run the actual search for messages to display. See nnir.el for
+some details of how this gets called.
+
+As things stand, the query string can be given as one of two
+different things. First is the ID string of an Org heading,
+prefixed with \"id+\". This was probably a bad choice as it could
+conceivably look like an org tags search string. Fix that later.
+If it's an ID, then the entire subtree text of that heading is
+scanned for gnus links, and all the linked messages 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-excursion
+    (let ((q-string (cdr (assq 'query query)))
+         subtrees subtree-text vectors)
+      (if (string-match "id\\+\\([[:alnum:]-]+\\)$" q-string)
+         (with-demoted-errors "Error: %S"
+           (org-id-goto (match-string 1 q-string))
+           (push (move-marker
+                  (make-marker)
+                  (org-element-property :begin (org-element-at-point)))
+                 subtrees))
+       (org-map-entries
+        (lambda ()
+          (push
+           (move-marker (make-marker)
+                        (org-element-property :begin
+                                              (org-element-at-point)))
+           subtrees))
+        q-string
+        'agenda))
+      (when subtrees
+       (with-current-buffer (get-buffer-create nnir-tmp-buffer)
+         (erase-buffer)
+         (dolist (m subtrees)
+           (save-excursion
+             (org-pop-to-buffer-same-window (marker-buffer m))
+             (goto-char m)
+             (move-marker m nil)
+             (setq subtree-text
+                   (buffer-substring-no-properties
+                    (point)
+                    (org-element-property
+                     :end
+                     (org-element-at-point)))))
+           (insert subtree-text)
+           (insert "\n"))
+         (goto-char (point-min))
+         (setq links (delete-dups (gnorb-scan-links
+                                   (point-max) 'gnus))))
+       (dolist (m (plist-get links :gnus) (nreverse vectors))
+         (let (server-group msg-id artno)
+           (setq m (org-link-unescape m))
+           (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" m))
+               (error "Error in Gnus link"))
+           (setq server-group (match-string 1 m)
+                 msg-id (match-string 3 m))
+           ;; I swear just finding the `gnus-request-head' function
+           ;; was a trial in itself. But I've only tried it with
+           ;; nnimap -- does it work for other backends?
+           (setq artno (cdr (gnus-request-head msg-id server-group)))
+           (when (> artno 0)
+             (push (vector server-group artno 100) vectors))))))))
+
+(defvar nngnorb-status-string "")
+
+(defun nngnorb-retrieve-headers (articles &optional group server fetch-old)
+  (with-current-buffer nntp-server-buffer
+    (erase-buffer))
+  'nov)
+
+(defun nngnorb-open-server (server &optional definitions)
+  t)
+
+(defun nngnorb-close-server (&optional server)
+  t)
+
+(defun nngnorb-request-close ()
+  t)
+
+(defun nngnorb-server-opened (&optional server)
+  t)
+
+(defun nngnorb-status-message (&optional server)
+  nnnil-status-string)
+
+(defun nngnorb-request-article (article &optional group server to-buffer)
+  (setq nnnil-status-string "No such group")
+  nil)
+
+(defun nngnorb-request-group (group &optional server fast info)
+  (let (deactivate-mark)
+    (with-current-buffer nntp-server-buffer
+      (erase-buffer)
+      (insert "411 no such news group\n")))
+  (setq nnnil-status-string "No such group")
+  nil)
+
+(defun nngnorb-close-group (group &optional server)
+  t)
+
+(defun nngnorb-request-list (&optional server)
+  (with-current-buffer nntp-server-buffer
+    (erase-buffer))
+  t)
+
+(defun nngnorb-request-post (&optional server)
+  (setq nngnorb-status-string "Read-only server")
+  nil)
+
+(provide 'nngnorb)
+
+;;; nnnil.el ends here



reply via email to

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