]> git.notmuchmail.org Git - notmuch/blobdiff - emacs/notmuch.el
Merge branch '0.3.x' immediately after the 0.3.1 release
[notmuch] / emacs / notmuch.el
index 6e73a2b904ab3d53a1bccf01f629829b83c546c5..57e11400a526cf4b81433430d1ce0f65245f989d 100644 (file)
 
 (require 'notmuch-lib)
 (require 'notmuch-show)
+(require 'notmuch-mua)
+(require 'notmuch-hello)
+(require 'notmuch-maildir-fcc)
+(require 'notmuch-message)
+
+(defcustom notmuch-search-result-format
+  `(("date" . "%s ")
+    ("count" . "%-7s ")
+    ("authors" . "%-20s ")
+    ("subject" . "%s ")
+    ("tags" . "(%s)"))
+  "Search result formating. Supported fields are:
+       date, count, authors, subject, tags
+For example:
+       (setq notmuch-search-result-format \(\(\"authors\" . \"%-40s\"\)
+                                            \(\"subject\" . \"%s\"\)\)\)"
+  :type '(alist :key-type (string) :value-type (string))
+  :group 'notmuch)
 
 (defun notmuch-select-tag-with-completion (prompt &rest search-terms)
   (let ((tag-list
             (mm-save-part p))))
    mm-handle))
 
-(defun notmuch-reply (query-string)
-  (switch-to-buffer (generate-new-buffer "notmuch-draft"))
-  (call-process notmuch-command nil t nil "reply" query-string)
-  (message-insert-signature)
-  (goto-char (point-min))
-  (if (re-search-forward "^$" nil t)
-      (progn
-       (insert "--text follows this line--")
-       (forward-line)))
-  (message-mode))
-
 (defun notmuch-documentation-first-line (symbol)
   "Return the first line of the documentation string for SYMBOL."
   (let ((doc (documentation symbol)))
@@ -178,24 +185,17 @@ For a mouse binding, return nil."
       (set-buffer-modified-p nil)
       (view-buffer (current-buffer) 'kill-buffer-if-not-modified))))
 
-(defgroup notmuch nil
-  "Notmuch mail reader for Emacs."
-  :group 'mail)
-
 (defcustom notmuch-search-hook '(hl-line-mode)
   "List of functions to call when notmuch displays the search results."
   :type 'hook
   :options '(hl-line-mode)
   :group 'notmuch)
 
-(defvar notmuch-search-authors-width 20
-  "Number of columns to use to display authors in a notmuch-search buffer.")
-
 (defvar notmuch-search-mode-map
   (let ((map (make-sparse-keymap)))
     (define-key map "?" 'notmuch-help)
-    (define-key map "q" 'kill-this-buffer)
-    (define-key map "x" 'kill-this-buffer)
+    (define-key map "q" 'notmuch-search-quit)
+    (define-key map "x" 'notmuch-search-quit)
     (define-key map (kbd "<DEL>") 'notmuch-search-scroll-down)
     (define-key map "b" 'notmuch-search-scroll-down)
     (define-key map " " 'notmuch-search-scroll-up)
@@ -204,10 +204,11 @@ For a mouse binding, return nil."
     (define-key map "p" 'notmuch-search-previous-thread)
     (define-key map "n" 'notmuch-search-next-thread)
     (define-key map "r" 'notmuch-search-reply-to-thread)
-    (define-key map "m" 'message-mail)
+    (define-key map "m" 'notmuch-mua-mail)
     (define-key map "s" 'notmuch-search)
     (define-key map "o" 'notmuch-search-toggle-order)
     (define-key map "=" 'notmuch-search-refresh-view)
+    (define-key map "G" 'notmuch-search-poll-and-refresh-view)
     (define-key map "t" 'notmuch-search-filter-by-tag)
     (define-key map "f" 'notmuch-search-filter)
     (define-key map [mouse-1] 'notmuch-search-show-thread)
@@ -223,11 +224,18 @@ For a mouse binding, return nil."
 (defvar notmuch-search-query-string)
 (defvar notmuch-search-target-thread)
 (defvar notmuch-search-target-line)
-(defvar notmuch-search-oldest-first t
-  "Show the oldest mail first in the search-mode")
+(defvar notmuch-search-continuation)
 
 (defvar notmuch-search-disjunctive-regexp      "\\<[oO][rR]\\>")
 
+(defun notmuch-search-quit ()
+  "Exit the search buffer, calling any defined continuation function."
+  (interactive)
+  (let ((continuation notmuch-search-continuation))
+    (kill-this-buffer)
+    (when continuation
+      (funcall continuation))))
+
 (defun notmuch-search-scroll-up ()
   "Move forward through search results by one window's worth."
   (interactive)
@@ -289,11 +297,6 @@ For a mouse binding, return nil."
   "Notmuch search mode face used to highligh tags."
   :group 'notmuch)
 
-(defvar notmuch-tag-face-alist nil
-  "List containing the tag list that need to be highlighed")
-
-(defvar notmuch-search-font-lock-keywords  nil)
-
 ;;;###autoload
 (defun notmuch-search-mode ()
   "Major mode displaying results of a notmuch search.
@@ -325,23 +328,14 @@ Complete list of currently available key bindings:
   (make-local-variable 'notmuch-search-oldest-first)
   (make-local-variable 'notmuch-search-target-thread)
   (make-local-variable 'notmuch-search-target-line)
+  (set (make-local-variable 'notmuch-search-continuation) nil)
   (set (make-local-variable 'scroll-preserve-screen-position) t)
   (add-to-invisibility-spec 'notmuch-search)
   (use-local-map notmuch-search-mode-map)
   (setq truncate-lines t)
   (setq major-mode 'notmuch-search-mode
        mode-name "notmuch-search")
-  (setq buffer-read-only t)
-  (if (not notmuch-tag-face-alist)
-      (add-to-list 'notmuch-search-font-lock-keywords (list
-               "(\\([^()]*\\))$" '(1  'notmuch-tag-face)))
-    (let ((notmuch-search-tags (mapcar 'car notmuch-tag-face-alist)))
-      (loop for notmuch-search-tag  in notmuch-search-tags
-           do (add-to-list 'notmuch-search-font-lock-keywords (list
-                       (concat "([^)]*\\(" notmuch-search-tag "\\)[^)]*)$")
-                       `(1  ,(cdr (assoc notmuch-search-tag notmuch-tag-face-alist))))))))
-  (set (make-local-variable 'font-lock-defaults)
-         '(notmuch-search-font-lock-keywords t)))
+  (setq buffer-read-only t))
 
 (defun notmuch-search-properties-in-region (property beg end)
   (save-excursion
@@ -402,7 +396,7 @@ Complete list of currently available key bindings:
   "Begin composing a reply to the entire current thread in a new buffer."
   (interactive)
   (let ((message-id (notmuch-search-find-thread-id)))
-    (notmuch-reply message-id)))
+    (notmuch-mua-reply message-id)))
 
 (defun notmuch-call-notmuch-process (&rest args)
   "Synchronously invoke \"notmuch\" with the given list of arguments.
@@ -432,7 +426,8 @@ and will also appear in a buffer named \"*Notmuch errors*\"."
       (backward-char)
       (let ((end (point)))
        (delete-region beg end)
-       (insert (mapconcat  'identity tags " "))))))
+       (insert (propertize (mapconcat  'identity tags " ")
+                           'font-lock-face 'notmuch-tag-face))))))
 
 (defun notmuch-search-get-tags ()
   (save-excursion
@@ -581,6 +576,32 @@ matching will be applied."
                  (t
                   (setq tags-faces (cdr tags-faces)))))))))
 
+(defun notmuch-search-insert-field (field date count authors subject tags)
+  (cond
+   ((string-equal field "date")
+    (insert (format (cdr (assoc field notmuch-search-result-format)) date)))
+   ((string-equal field "count")
+    (insert (format (cdr (assoc field notmuch-search-result-format)) count)))
+   ((string-equal field "authors")
+    (insert (let* ((format-string (cdr (assoc field notmuch-search-result-format)))
+                  (formatted-sample (format format-string ""))
+                  (formatted-authors (format format-string authors)))
+             (if (> (length formatted-authors)
+                    (length formatted-sample))
+                 (concat (substring authors 0 (- (length formatted-sample) 4)) "... ")
+               formatted-authors))))
+   ((string-equal field "subject")
+    (insert (format (cdr (assoc field notmuch-search-result-format)) subject)))
+   ((string-equal field "tags")
+    (insert (concat "(" (propertize tags 'font-lock-face 'notmuch-tag-face) ")")))))
+
+(defun notmuch-search-show-result (date count authors subject tags)
+  (let ((fields) (field))
+    (setq fields (mapcar 'car notmuch-search-result-format))
+    (loop for field in fields
+         do (notmuch-search-insert-field field date count authors subject tags)))
+  (insert "\n"))
+
 (defun notmuch-search-process-filter (proc string)
   "Process and filter the output of \"notmuch search\""
   (let ((buffer (process-buffer proc))
@@ -597,16 +618,12 @@ matching will be applied."
                           (date (match-string 2 string))
                           (count (match-string 3 string))
                           (authors (match-string 4 string))
-                          (authors-length (length authors))
                           (subject (match-string 5 string))
                           (tags (match-string 6 string))
                           (tag-list (if tags (save-match-data (split-string tags)))))
-                     (if (> authors-length notmuch-search-authors-width)
-                         (set 'authors (concat (substring authors 0 (- notmuch-search-authors-width 3)) "...")))
                      (goto-char (point-max))
-                     (let ((beg (point-marker))
-                           (format-string (format "%%s %%-7s %%-%ds %%s (%%s)\n" notmuch-search-authors-width)))
-                       (insert (format format-string date count authors subject tags))
+                     (let ((beg (point-marker)))
+                       (notmuch-search-show-result date count authors subject tags)
                        (notmuch-search-color-line beg (point-marker) tag-list)
                        (put-text-property beg (point-marker) 'notmuch-search-thread-id thread-id)
                        (put-text-property beg (point-marker) 'notmuch-search-authors authors)
@@ -644,8 +661,29 @@ characters as well as `_.+-'.
     (apply 'notmuch-call-notmuch-process "tag"
           (append action-split (list notmuch-search-query-string) nil))))
 
+(defun notmuch-search-buffer-title (query)
+  "Returns the title for a buffer with notmuch search results."
+  (let* ((saved-search (rassoc-if (lambda (key)
+                                   (string-match (concat "^" (regexp-quote key))
+                                                 query))
+                                 (reverse (notmuch-saved-searches))))
+        (saved-search-name (car saved-search))
+        (saved-search-query (cdr saved-search)))
+    (cond ((and saved-search (equal saved-search-query query))
+          ;; Query is the same as saved search (ignoring case)
+          (concat "*notmuch-saved-search-" saved-search-name "*"))
+         (saved-search
+          (concat "*notmuch-search-"
+                  (replace-regexp-in-string (concat "^" (regexp-quote saved-search-query))
+                                            (concat "[ " saved-search-name " ]")
+                                            query)
+                  "*"))
+         (t
+          (concat "*notmuch-search-" query "*"))
+         )))
+
 ;;;###autoload
-(defun notmuch-search (query &optional oldest-first target-thread target-line)
+(defun notmuch-search (query &optional oldest-first target-thread target-line continuation)
   "Run \"notmuch search\" with the given query string and display results.
 
 The optional parameters are used as follows:
@@ -656,13 +694,14 @@ The optional parameters are used as follows:
   target-line: The line number to move to if the target thread does not
                appear in the search results."
   (interactive "sNotmuch search: ")
-  (let ((buffer (get-buffer-create (concat "*notmuch-search-" query "*"))))
+  (let ((buffer (get-buffer-create (notmuch-search-buffer-title query))))
     (switch-to-buffer buffer)
     (notmuch-search-mode)
     (set 'notmuch-search-query-string query)
     (set 'notmuch-search-oldest-first oldest-first)
     (set 'notmuch-search-target-thread target-thread)
     (set 'notmuch-search-target-line target-line)
+    (set 'notmuch-search-continuation continuation)
     (let ((proc (get-buffer-process (current-buffer)))
          (inhibit-read-only t))
       (if proc
@@ -691,11 +730,40 @@ same relative position within the new buffer."
   (let ((target-line (line-number-at-pos))
        (oldest-first notmuch-search-oldest-first)
        (target-thread (notmuch-search-find-thread-id))
-       (query notmuch-search-query-string))
+       (query notmuch-search-query-string)
+       (continuation notmuch-search-continuation))
     (kill-this-buffer)
-    (notmuch-search query oldest-first target-thread target-line)
-    (goto-char (point-min))
-    ))
+    (notmuch-search query oldest-first target-thread target-line continuation)
+    (goto-char (point-min))))
+
+(defcustom notmuch-poll-script ""
+  "An external script to incorporate new mail into the notmuch database.
+
+If this variable is non empty, then it should name a script to be
+invoked by `notmuch-search-poll-and-refresh-view' and
+`notmuch-hello-poll-and-update' (each have a default keybinding
+of 'G'). The script could do any of the following depending on
+the user's needs:
+
+1. Invoke a program to transfer mail to the local mail store
+2. Invoke \"notmuch new\" to incorporate the new mail
+3. Invoke one or more \"notmuch tag\" commands to classify the mail"
+  :type 'string
+  :group 'notmuch)
+
+(defun notmuch-poll ()
+  "Run external script to import mail.
+
+Invokes `notmuch-poll-script' if it is not set to an empty string."
+  (interactive)
+  (if (not (string= notmuch-poll-script ""))
+      (call-process notmuch-poll-script nil nil)))
+
+(defun notmuch-search-poll-and-refresh-view ()
+  "Invoke `notmuch-poll' to import mail, then refresh the current view."
+  (interactive)
+  (notmuch-poll)
+  (notmuch-search-refresh-view))
 
 (defun notmuch-search-toggle-order ()
   "Toggle the current search order.
@@ -739,152 +807,10 @@ current search results AND that are tagged with the given tag."
 
 ;;;###autoload
 (defun notmuch ()
-  "Run notmuch to display all mail with tag of 'inbox'"
+  "Run notmuch and display saved searches, known tags, etc."
   (interactive)
-  (notmuch-search "tag:inbox" notmuch-search-oldest-first))
-
-(setq mail-user-agent 'message-user-agent)
-
-(defvar notmuch-folder-mode-map
-  (let ((map (make-sparse-keymap)))
-    (define-key map "?" 'notmuch-help)
-    (define-key map "x" 'kill-this-buffer)
-    (define-key map "q" 'kill-this-buffer)
-    (define-key map "m" 'message-mail)
-    (define-key map "e" 'notmuch-folder-show-empty-toggle)
-    (define-key map ">" 'notmuch-folder-last)
-    (define-key map "<" 'notmuch-folder-first)
-    (define-key map "=" 'notmuch-folder)
-    (define-key map "s" 'notmuch-search)
-    (define-key map [mouse-1] 'notmuch-folder-show-search)
-    (define-key map (kbd "RET") 'notmuch-folder-show-search)
-    (define-key map " " 'notmuch-folder-show-search)
-    (define-key map "p" 'notmuch-folder-previous)
-    (define-key map "n" 'notmuch-folder-next)
-    map)
-  "Keymap for \"notmuch folder\" buffers.")
-
-(fset 'notmuch-folder-mode-map notmuch-folder-mode-map)
-
-(defcustom notmuch-folders (quote (("inbox" . "tag:inbox") ("unread" . "tag:unread")))
-  "List of searches for the notmuch folder view"
-  :type '(alist :key-type (string) :value-type (string))
-  :group 'notmuch)
-
-(defun notmuch-folder-mode ()
-  "Major mode for showing notmuch 'folders'.
-
-This buffer contains a list of message counts returned by a
-customizable set of searches of your email archives. Each line in
-the buffer shows the name of a saved search and the resulting
-message count.
-
-Pressing RET on any line opens a search window containing the
-results for the saved search on that line.
+  (notmuch-hello))
 
-Here is an example of how the search list could be
-customized, (the following text would be placed in your ~/.emacs
-file):
-
-(setq notmuch-folders '((\"inbox\" . \"tag:inbox\")
-                        (\"unread\" . \"tag:inbox AND tag:unread\")
-                        (\"notmuch\" . \"tag:inbox AND to:notmuchmail.org\")))
-
-Of course, you can have any number of folders, each configured
-with any supported search terms (see \"notmuch help search-terms\").
-
-Currently available key bindings:
-
-\\{notmuch-folder-mode-map}"
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map 'notmuch-folder-mode-map)
-  (setq truncate-lines t)
-  (hl-line-mode 1)
-  (setq major-mode 'notmuch-folder-mode
-       mode-name "notmuch-folder")
-  (setq buffer-read-only t))
-
-(defun notmuch-folder-next ()
-  "Select the next folder in the list."
-  (interactive)
-  (forward-line 1)
-  (if (eobp)
-      (forward-line -1)))
-
-(defun notmuch-folder-previous ()
-  "Select the previous folder in the list."
-  (interactive)
-  (forward-line -1))
-
-(defun notmuch-folder-first ()
-  "Select the first folder in the list."
-  (interactive)
-  (goto-char (point-min)))
-
-(defun notmuch-folder-last ()
-  "Select the last folder in the list."
-  (interactive)
-  (goto-char (point-max))
-  (forward-line -1))
-
-(defun notmuch-folder-count (search)
-  (car (process-lines notmuch-command "count" search)))
-
-(defvar notmuch-folder-show-empty t
-  "Whether `notmuch-folder-mode' should display empty folders.")
-
-(defun notmuch-folder-show-empty-toggle ()
-  "Toggle the listing of empty folders"
-  (interactive)
-  (setq notmuch-folder-show-empty (not notmuch-folder-show-empty))
-  (notmuch-folder))
-
-(defun notmuch-folder-add (folders)
-  (if folders
-      (let* ((name (car (car folders)))
-           (inhibit-read-only t)
-           (search (cdr (car folders)))
-           (count (notmuch-folder-count search)))
-       (if (or notmuch-folder-show-empty
-               (not (equal count "0")))
-           (progn
-             (insert name)
-             (indent-to 16 1)
-             (insert count)
-             (insert "\n")
-             )
-         )
-       (notmuch-folder-add (cdr folders)))))
-
-(defun notmuch-folder-find-name ()
-  (save-excursion
-    (beginning-of-line)
-    (let ((beg (point)))
-      (re-search-forward "\\([ \t]*[^ \t]+\\)")
-      (filter-buffer-substring (match-beginning 1) (match-end 1)))))
-
-(defun notmuch-folder-show-search (&optional folder)
-  "Show a search window for the search related to the specified folder."
-  (interactive)
-  (if (null folder)
-      (setq folder (notmuch-folder-find-name)))
-  (let ((search (assoc folder notmuch-folders)))
-    (if search
-       (notmuch-search (cdr search) notmuch-search-oldest-first))))
-
-;;;###autoload
-(defun notmuch-folder ()
-  "Show the notmuch folder view and update the displayed counts."
-  (interactive)
-  (let ((buffer (get-buffer-create "*notmuch-folders*")))
-    (switch-to-buffer buffer)
-    (let ((inhibit-read-only t)
-         (n (line-number-at-pos)))
-      (erase-buffer)
-      (notmuch-folder-mode)
-      (notmuch-folder-add notmuch-folders)
-      (goto-char (point-min))
-      (goto-line n))))
+(setq mail-user-agent 'notmuch-user-agent)
 
 (provide 'notmuch)