Notmuch support (work in progress)

contrib/notmuch/README.md

@@ -0,0 +1,12 @@
+This is a module that adds some notmuch modes for reading email with notmuch.
+
+
+** Installation
+
+To use:
+`M-x site-init-add-dependency`
+then type `notmuch`
+
+this will it to your lem-site-init.asd
+
+

contrib/notmuch/backend.lisp

@@ -0,0 +1,41 @@
+(in-package :lem-notmuch)
+
+(defvar *notmuch-executable* "notmuch")
+
+(defun run-notmuch (query)
+  (multiple-value-bind (str err retval)
+      (uiop:run-program (format nil "~A ~A" *notmuch-executable* query)
+			:output :string
+			:error-output :string
+			:ignore-error-status t)
+
+    (if (= retval 0)
+	str
+	(editor-error "`notmuch ~A` returned ~A ~A ~A" query retval str err))))
+
+(defun notmuch-search (query &key oldest-first)
+  (yason:parse
+      (run-notmuch (format nil "search --format=json --format-version=5 --sort=~A ~S"
+				(if oldest-first "oldest-first" "newest-first")
+				query))))
+
+(defun notmuch-show (query &key entire-thread decrypt)
+  (yason:parse
+      (run-notmuch (format nil "show --format=json --format-version=5 --entire-thread=~A --decrypt=auto ~S"
+				(if entire-thread "true" "false")
+				query))))
+
+
+(defun notmuch-count (query)
+  (parse-integer
+   (run-notmuch (format nil "count ~S" query))))
+
+(defmacro with-notmuch-props (obj props &body body)
+  (let ((sym (gensym)))
+    `(let ((,sym ,obj))
+       (let ,(loop for i in props
+		    collect (list (first i) (list 'gethash (second i) sym))) ,@body))
+    ))
+
+; (with-notmuch-props ((a "hi") (b "bye")) (list 'x) (princ 5))
+

contrib/notmuch/lem-notmuch.asd

@@ -0,0 +1,10 @@
+(defsystem "lem-notmuch"
+  :depends-on ("lem" "yason" "alexandria")
+  :serial t
+  :components (
+	       (:file "package")
+	       (:file "backend")
+	       (:file "notmuch-show")
+	       (:file "notmuch-search")
+	       (:file "notmuch-hello")
+	       (:file "notmuch")))

contrib/notmuch/notmuch-hello.lisp

@@ -0,0 +1,49 @@
+
+(in-package :lem-notmuch)
+
+(define-major-mode notmuch-hello-mode ()
+    (:name "notmuch-hello"
+     :keymap *notmuch-hello-mode-keymap*))
+
+;; fixme/unused: deprecate for button
+(defun find-saved-search (name-to-find)
+  (dolist (item *notmuch-saved-searches*)
+    (destructuring-bind (&key name query &allow-other-keys)
+	item
+      (when (string-equal name-to-find name)
+	(return-from find-saved-search query)))))
+
+(defun notmuch-hello (buffer)
+  (let ((point (current-point)))
+    (insert-string point (format nil "Saved searches:~%~%"))
+    (dolist (saved-search *notmuch-saved-searches*)
+      (destructuring-bind (&key name query &allow-other-keys)
+	  saved-search
+	(let ((count (notmuch-count query)))
+
+	  (lem/button:insert-button point
+				    name
+				    (lambda ()  (notmuch-run-saved-query name query))
+				    :attribute 'notmuch-saved-search-attribute)
+
+	  (insert-string point (format nil ": ~A" count))
+	  (insert-character point #\newline 1)
+	  )
+
+
+	))
+    (setf (buffer-read-only-p buffer) t)
+    ))
+
+
+;; fixme/unused don't use symbol-string-at-point, deprecate for button
+(define-command notmuch-open-saved-query (&optional (point (current-point))) ()
+  (let* ((name (string (symbol-string-at-point point)))
+	 (query (find-saved-search name)))
+    (notmuch-run-saved-query name (or query (editor-error "Could not find query for ~S" name)))))
+
+
+;(define-key *notmuch-hello-mode-keymap* "Return" 'lem-notmuch:notmuch-open-saved-query)
+
+(define-key *notmuch-hello-mode-keymap* "q" 'quit-active-window)
+

contrib/notmuch/notmuch-search.lisp

@@ -0,0 +1,51 @@
+
+(in-package :lem-notmuch)
+
+(define-major-mode notmuch-search-mode ()
+    (:name "notmuch-search"
+     :keymap *notmuch-search-mode-keymap*))
+
+
+(defun truncate-field (len str)
+  (if (< len (length str))
+      (concatenate 'string (subseq str 0 (- len 3)) "...")
+      str))
+
+(defun notmuch-run-saved-query (name query)
+  (let ((buffer (make-buffer (format nil "*notmuch-saved-query-~A%" name)))
+	(results (notmuch-search query :oldest-first t)))
+    (switch-to-buffer buffer)
+    (notmuch-search-mode)
+    (erase-buffer buffer)
+    (let ((point (current-point)))
+      (dolist (item results)
+	(when item
+	  (with-notmuch-props item
+	      ((thread "thread")
+	       (date_relative "date_relative")
+	       (matched "matched")
+	       (total "total")
+	       (authors "authors")
+	       (query "query")
+	       (subject "subject")
+	       (tags "tags"))
+	    (lem/button:insert-button
+	     point
+	     (format nil "~12@A ~8@A ~25@A ~A"
+		     (truncate-field 12 date_relative)
+		     (format nil "[~A/~A]" matched total)
+		     (truncate-field 20 authors)
+		     (truncate-field 60 subject))
+	     (lambda () (notmuch-show-message subject query)))
+	    (insert-character point #\newline 1)
+	    ))
+      )
+    (setf (buffer-read-only-p buffer) t)
+      )))
+
+
+; todo
+;(define-key *notmuch-search-mode-keymap* "Return" 'lem-notmuch:notmuch-search-show-thread)
+
+(define-key *notmuch-search-mode-keymap* "q" 'quit-active-window)
+

contrib/notmuch/notmuch-show.lisp

@@ -0,0 +1,65 @@
+
+(in-package :lem-notmuch)
+
+(define-major-mode notmuch-message-mode ()
+    (:name "notmuch-message"
+     :keymap *notmuch-message-mode-keymap*))
+
+(defun print-message-body (point body)
+  (dolist (item (alexandria:flatten body))
+    (with-notmuch-props item
+	((id "id")
+	 (content-type "content-type")
+	 (content "content"))
+      (if (equal content-type "text/plain")
+	  (progn
+	    ;; fixme insert link to part
+	    (insert-string point (format nil "~A~%" content)))
+	  (progn
+	    (insert-string point (format nil "[id: ~S, content type ~S]~%" id content-type))
+	    )
+	  )
+      )
+    )
+  )
+
+(defun notmuch-print-message (email)
+  (with-notmuch-props email
+      ((id "id")
+       (content-type "content-type")
+       (content "content")
+       (filename "filename")
+       (body "body")
+       (headers "headers"))
+    (with-notmuch-props headers
+	((to "To")
+	 (from "From")
+	 (subject "Subject")
+	 (date "Date"))
+      (let ((point (current-point)))
+	(insert-string point (format nil "From: ~A~%Subject: ~A~%To: ~A~%Date: ~A~%~%"
+				     from
+				     subject
+				     to
+				     date))
+	(print-message-body point body)
+	(insert-character point #\newline 1)
+	)
+      )))
+
+(defun notmuch-show-message (subject query)
+  (let ((buffer (make-buffer (format nil "*~A%*" subject)))
+	;; (first query) is the query that matches the message
+	(results (car (car (notmuch-show (first query) :decrypt t :entire-thread nil)))))
+    (switch-to-buffer buffer)
+    (notmuch-message-mode)
+    (erase-buffer buffer)
+    (dolist (email-message (alexandria:flatten results))
+      (when email-message
+	(notmuch-print-message email-message)))
+    (setf (buffer-read-only-p buffer) t)
+    ))
+
+
+  (define-key *notmuch-message-mode-keymap* "q" 'quit-active-window)
+

contrib/notmuch/notmuch.lisp

@@ -0,0 +1,18 @@
+(in-package :lem-notmuch)
+
+(defvar *notmuch-saved-searches*
+  '((:name "inbox" :query "tag:inbox")
+    (:name "unread" :query "tag:inbox and tag:unread")))
+
+
+(define-attribute notmuch-saved-search-attribute
+  (t :bold t))
+
+
+(define-command notmuch () ()
+  (let ((buffer (make-buffer "*notmuch-hello*")))
+    (switch-to-buffer buffer)
+    (notmuch-hello-mode)
+    (erase-buffer buffer)
+    (notmuch-hello buffer)))
+

contrib/notmuch/package.lisp

@@ -0,0 +1,16 @@
+
+(defpackage :lem-notmuch
+  (:use :cl
+        :lem)
+  (:export
+   :*notmuch-executable*
+   :*notmuch-saved-searches*
+   :notmuch-hello-mode
+   :notmuch-open-saved-query
+   ; todo: for testing
+   :notmuch-search
+   :notmuch-count
+   :run-notmuch
+   ; main entrypoint
+   :notmuch))
+