X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=emacs%2Fnotmuch-hello.el;h=97db90e51a24875c17184363f0d2cfc03c2f0c92;hp=aefa350f8282e237ae24dc9ef40ac56460db33e9;hb=f8e372ebeccff4e2cba323d75ac1278cb22828b9;hpb=4b0994dd25c97282701041e50a4916b149213dec

diff --git a/emacs/notmuch-hello.el b/emacs/notmuch-hello.el
index aefa350f..97db90e5 100644
--- a/emacs/notmuch-hello.el
+++ b/emacs/notmuch-hello.el
@@ -24,45 +24,50 @@
 (require 'cl)
 
 (require 'notmuch-lib)
-(require 'notmuch)
+(require 'notmuch-mua)
 
 (declare-function notmuch-search "notmuch" (query &optional oldest-first target-thread target-line continuation))
 (declare-function notmuch-folder-count "notmuch" (search))
 
-(defcustom notmuch-hello-recent-searches-max 10
+(defvar notmuch-hello-search-bar-marker nil
+  "The position of the search bar within the notmuch-hello buffer.")
+
+(defcustom notmuch-recent-searches-max 10
   "The number of recent searches to store and display."
   :type 'integer
   :group 'notmuch)
 
-(defcustom notmuch-hello-show-empty-saved-searches nil
+(defcustom notmuch-show-empty-saved-searches nil
   "Should saved searches with no messages be listed?"
   :type 'boolean
   :group 'notmuch)
 
-(defcustom notmuch-hello-indent 4
-  "How much to indent non-headers."
-  :type 'integer
-  :group 'notmuch)
+(defvar notmuch-hello-indent 4
+  "How much to indent non-headers.")
 
-(defcustom notmuch-hello-saved-searches notmuch-folders
+(defcustom notmuch-saved-searches nil
   "A list of saved searches to display."
   :type '(alist :key-type string :value-type string)
   :group 'notmuch)
 
-(defcustom notmuch-hello-show-logo t
+(defcustom notmuch-show-logo t
   "Should the notmuch logo be shown?"
   :type 'boolean
   :group 'notmuch)
 
-(defcustom notmuch-hello-logo-background "#5f5f5f"
-  "Background colour for the notmuch logo."
-  :type 'color
+(defcustom notmuch-show-all-tags-list nil
+  "Should all tags be shown in the notmuch-hello view?"
+  :type 'boolean
   :group 'notmuch)
 
-(defcustom notmuch-hello-jump-to-search nil
-  "Whether `notmuch-hello' should always jump to the search
-field."
-  :type 'boolean
+(defface notmuch-hello-logo-background
+  '((((class color)
+      (background dark))
+     (:background "#5f5f5f"))
+    (((class color)
+      (background light))
+     (:background "white")))
+  "Background colour for the notmuch logo."
   :group 'notmuch)
 
 (defvar notmuch-hello-url "http://notmuchmail.org"
@@ -71,10 +76,10 @@ field."
 (defvar notmuch-hello-recent-searches nil)
 
 (defun notmuch-hello-remember-search (search)
-  (if (not (memq search notmuch-hello-recent-searches))
+  (if (not (member search notmuch-hello-recent-searches))
       (push search notmuch-hello-recent-searches))
   (if (> (length notmuch-hello-recent-searches)
-	 notmuch-hello-recent-searches-max)
+	 notmuch-recent-searches-max)
       (setq notmuch-hello-recent-searches (butlast notmuch-hello-recent-searches))))
 
 (defun notmuch-hello-trim (search)
@@ -94,17 +99,17 @@ field."
 		 (symbol-value
 		  (widget-get widget :notmuch-saved-search-widget))))
 	(name (completing-read "Name for saved search: "
-			       notmuch-hello-saved-searches)))
+			       notmuch-saved-searches)))
     ;; If an existing saved search with this name exists, remove it.
-    (setq notmuch-hello-saved-searches
-	  (loop for elem in notmuch-hello-saved-searches
+    (setq notmuch-saved-searches
+	  (loop for elem in notmuch-saved-searches
 		if (not (equal name
 			       (car elem)))
 		collect elem))
     ;; Add the new one.
-    (customize-save-variable 'notmuch-hello-saved-searches
+    (customize-save-variable 'notmuch-saved-searches
 			     (push (cons name search)
-				   notmuch-hello-saved-searches))
+				   notmuch-saved-searches))
     (message "Saved '%s' as '%s'." search name)
     (notmuch-hello-update)))
 
@@ -142,9 +147,8 @@ diagonal."
 		  notmuch-search-oldest-first
 		  nil nil #'notmuch-hello-search-continuation))
 
-(defun notmuch-hello-insert-tags (tag-alist widest)
-  (let* ((tag-format-string (format "%%-%ds " widest))
-	 (tags-per-line (max 1
+(defun notmuch-hello-insert-tags (tag-alist widest target)
+  (let* ((tags-per-line (max 1
 			     (/ (- (window-width) notmuch-hello-indent)
 				;; Count is 7 wide, 1 for the space
 				;; after the name.
@@ -153,7 +157,8 @@ diagonal."
 	 (reordered-list (notmuch-hello-reflect tag-alist tags-per-line))
 	 ;; Hack the display of the buttons used.
 	 (widget-push-button-prefix "")
-	 (widget-push-button-suffix ""))
+	 (widget-push-button-suffix "")
+	 (found-target-pos nil))
     ;; dme: It feels as though there should be a better way to
     ;; implement this loop than using an incrementing counter.
     (loop for elem in reordered-list
@@ -161,10 +166,13 @@ diagonal."
 	       ;; (not elem) indicates an empty slot in the matrix.
 	       (when elem
 		 (widget-insert (format "%6s " (notmuch-folder-count (cdr elem))))
+		 (if (string= (format "%s " (car elem)) target)
+		     (setq found-target-pos (point-marker)))
 		 (widget-create 'push-button
 				:notify #'notmuch-hello-widget-search
 				:notmuch-search-terms (cdr elem)
-				(format tag-format-string (car elem))))
+				(format "%s " (car elem)))
+		 (insert (make-string (1+ (- widest (length (car elem)))) ? )))
 	       (setq count (1+ count))
 	       (if (eq (% count tags-per-line) 0)
 		   (widget-insert "\n"))))
@@ -172,187 +180,230 @@ diagonal."
     ;; If the last line was not full (and hence did not include a
     ;; carriage return), insert one now.
     (if (not (eq (% count tags-per-line) 0))
-	(widget-insert "\n"))))
+	(widget-insert "\n"))
+    found-target-pos))
 
 (defun notmuch-hello-goto-search ()
-  "Put point inside the `search' widget, which we know is first."
+  "Put point inside the `search' widget."
   (interactive)
-  (goto-char (point-min))
-  (widget-forward 3))
+  (goto-char notmuch-hello-search-bar-marker))
 
 (defimage notmuch-hello-logo ((:type png :file "notmuch-logo.png")))
 
 (defun notmuch-hello-search-continuation()
-  (notmuch-hello t))
+  (notmuch-hello-update t))
 
 (defun notmuch-hello-update (&optional no-display)
   ;; Lazy - rebuild everything.
   (interactive)
   (notmuch-hello no-display))
 
+(defun notmuch-hello-poll-and-update ()
+  "Invoke `notmuch-poll' to import mail, then refresh the current view."
+  (interactive)
+  (notmuch-poll)
+  (notmuch-hello-update))
+
 (defun notmuch-hello (&optional no-display)
   (interactive)
 
+  ;; Provide support for the deprecated name of this variable
+  (if (not notmuch-saved-searches)
+      (setq notmuch-saved-searches notmuch-folders))
+
+  ;; And set a default if neither has been set by the user
+  (if (not notmuch-saved-searches)
+      (setq notmuch-saved-searches '(("inbox" . "tag:inbox")
+				     ("unread" . "tag:unread"))))
+
   (if no-display
       (set-buffer "*notmuch-hello*")
     (switch-to-buffer "*notmuch-hello*"))
 
-  (kill-all-local-variables)
-  (let ((inhibit-read-only t))
-    (erase-buffer))
-
-  (let ((all (overlay-lists)))
-    ;; Delete all the overlays.
-    (mapc 'delete-overlay (car all))
-    (mapc 'delete-overlay (cdr all)))
-
-  (when notmuch-hello-show-logo
-    (let ((image notmuch-hello-logo))
-      ;; dme: Sorry, I don't know any other way to achieve this :-( The
-      ;; notmuch logo uses transparency. That works out badly when
-      ;; inserting the image into an emacs buffer, so force the
-      ;; background colour of the image.
-      (setq image (cons 'image (append (cdr image)
-				       `(:background ,notmuch-hello-logo-background))))
-      (insert-image image))
-    (widget-insert "  "))
-
-  (widget-insert "Welcome to ")
-  ;; Hack the display of the links used.
-  (let ((widget-link-prefix "")
-	(widget-link-suffix ""))
-    (widget-create 'link
-		   :notify (lambda (&rest ignore)
-			     (browse-url notmuch-hello-url))
-		   :help-echo "Visit the notmuch website."
-		   "notmuch")
-    (widget-insert ". ")
-    (widget-insert "You have ")
-    (widget-create 'link
-		   :notify (lambda (&rest ignore)
-			     (notmuch-hello-update))
-		   :help-echo "Refresh"
-		   (car (process-lines notmuch-command "count")))
-    (widget-insert " messages (that's not much mail).\n\n"))
-
-  (let ((start (point)))
-    (widget-insert "Search: ")
-    (widget-create 'editable-field
-		   ;; Leave some space at the start and end of the
-		   ;; search boxes.
-		   :size (max 8 (- (window-width) (* 2 notmuch-hello-indent)
-				   (length "Search: ")))
-		   :action (lambda (widget &rest ignore)
-			     (notmuch-hello-search (widget-value widget))))
-    (widget-insert "\n")
-    (indent-rigidly start (point) notmuch-hello-indent))
-
-  (when notmuch-hello-recent-searches
-    (widget-insert "\nRecent searches: ")
-    (widget-create 'push-button
-		   :notify (lambda (&rest ignore)
-			     (setq notmuch-hello-recent-searches nil)
-			     (notmuch-hello-update))
-		   "clear")
-    (widget-insert "\n\n")
-    (let ((start (point))
-	  (key 0))
-      (mapc '(lambda (search)
-	       (widget-insert (format "%2d: " key))
-	       (let ((widget-symbol (intern (format "notmuch-hello-search-%d" key))))
-		 (set widget-symbol
-		      (widget-create 'editable-field
-				     ;; Leave some space at the start
-				     ;; and end of the search boxes. 4
-				     ;; for the accelerator key. 1 for
-				     ;; the space before the `save'
-				     ;; button. 6 for the `save'
-				     ;; button.
-				     :size (max 8 (- (window-width) (* 2 notmuch-hello-indent)
-						     4 1 6))
-				     :action (lambda (widget &rest ignore)
-					       (notmuch-hello-search (widget-value widget)))
-				     search))
-		 (widget-insert " ")
-		 (widget-create 'push-button
-				:notify (lambda (widget &rest ignore)
-					  (notmuch-hello-add-saved-search widget))
-				:notmuch-saved-search-widget widget-symbol
-				"save"))
-	       (widget-insert "\n")
-	       (setq key (1+ key)))
-	    notmuch-hello-recent-searches)
-      (indent-rigidly start (point) notmuch-hello-indent)))
-
-  (let* ((saved-alist
-	  ;; Filter out empty saved seaches if required.
-	  (if notmuch-hello-show-empty-saved-searches
-	      notmuch-hello-saved-searches
-	    (loop for elem in notmuch-hello-saved-searches
-		  if (> (string-to-number (notmuch-folder-count (cdr elem))) 0)
-		  collect elem)))
-	 (saved-widest (notmuch-hello-longest-label saved-alist))
-	 (alltags-alist (mapcar '(lambda (tag) (cons tag (concat "tag:" tag)))
-				(process-lines notmuch-command "search-tags")))
-	 (alltags-widest (notmuch-hello-longest-label alltags-alist))
-	 (widest (max saved-widest alltags-widest)))
-
-    (when saved-alist
-      (widget-insert "\nSaved searches: ")
-      (widget-create 'push-button
+  (let ((target (if (widget-at)
+		   (widget-value (widget-at))
+		 (condition-case nil
+		     (progn
+		       (widget-forward 1)
+		       (widget-value (widget-at)))
+		   (error nil)))))
+
+    (kill-all-local-variables)
+    (let ((inhibit-read-only t))
+      (erase-buffer))
+
+    (let ((all (overlay-lists)))
+      ;; Delete all the overlays.
+      (mapc 'delete-overlay (car all))
+      (mapc 'delete-overlay (cdr all)))
+
+    (when notmuch-show-logo
+      (let ((image notmuch-hello-logo))
+	;; The notmuch logo uses transparency. That can display poorly
+	;; when inserting the image into an emacs buffer (black logo on
+	;; a black background), so force the background colour of the
+	;; image. We use a face to represent the colour so that
+	;; `defface' can be used to declare the different possible
+	;; colours, which depend on whether the frame has a light or
+	;; dark background.
+	(setq image (cons 'image
+			  (append (cdr image)
+				  (list :background (face-background 'notmuch-hello-logo-background)))))
+	(insert-image image))
+      (widget-insert "  "))
+
+    (widget-insert "Welcome to ")
+    ;; Hack the display of the links used.
+    (let ((widget-link-prefix "")
+	  (widget-link-suffix ""))
+      (widget-create 'link
 		     :notify (lambda (&rest ignore)
-			       (customize-variable 'notmuch-hello-saved-searches))
-		     "edit")
-      (widget-insert "\n\n")
-      (let ((start (point)))
-	(notmuch-hello-insert-tags saved-alist widest)
-	(indent-rigidly start (point) notmuch-hello-indent)))
+			       (browse-url notmuch-hello-url))
+		     :help-echo "Visit the notmuch website."
+		     "notmuch")
+      (widget-insert ". ")
+      (widget-insert "You have ")
+      (widget-create 'link
+		     :notify (lambda (&rest ignore)
+			       (notmuch-hello-update))
+		     :help-echo "Refresh"
+		     (car (process-lines notmuch-command "count")))
+      (widget-insert " messages (that's not much mail).\n\n"))
+
+    (let ((found-target-pos nil)
+	  (final-target-pos nil))
+      (let* ((saved-alist
+	      ;; Filter out empty saved seaches if required.
+	      (if notmuch-show-empty-saved-searches
+		  notmuch-saved-searches
+		(loop for elem in notmuch-saved-searches
+		      if (> (string-to-number (notmuch-folder-count (cdr elem))) 0)
+		      collect elem)))
+	     (saved-widest (notmuch-hello-longest-label saved-alist))
+	     (alltags-alist (mapcar '(lambda (tag) (cons tag (concat "tag:" tag)))
+				    (process-lines notmuch-command "search-tags")))
+	     (alltags-widest (notmuch-hello-longest-label alltags-alist))
+	     (widest (max saved-widest alltags-widest)))
+
+	(when saved-alist
+	  (widget-insert "Saved searches: ")
+	  (widget-create 'push-button
+			 :notify (lambda (&rest ignore)
+				   (customize-variable 'notmuch-saved-searches))
+			 "edit")
+	  (widget-insert "\n\n")
+	  (setq final-target-pos (point-marker))
+	  (let ((start (point)))
+	    (setq found-target-pos (notmuch-hello-insert-tags saved-alist widest target))
+	    (if found-target-pos
+		(setq final-target-pos found-target-pos))
+	    (indent-rigidly start (point) notmuch-hello-indent)))
+
+	(let ((start (point)))
+	  (widget-insert "\nSearch: ")
+	  (setq notmuch-hello-search-bar-marker (point-marker))
+	  (widget-create 'editable-field
+			 ;; Leave some space at the start and end of the
+			 ;; search boxes.
+			 :size (max 8 (- (window-width) (* 2 notmuch-hello-indent)
+					 (length "Search: ")))
+			 :action (lambda (widget &rest ignore)
+				   (notmuch-hello-search (widget-value widget))))
+	  (widget-insert "\n")
+	  (indent-rigidly start (point) notmuch-hello-indent))
+
+	(when notmuch-hello-recent-searches
+	  (widget-insert "\nRecent searches: ")
+	  (widget-create 'push-button
+			 :notify (lambda (&rest ignore)
+				   (setq notmuch-hello-recent-searches nil)
+				   (notmuch-hello-update))
+			 "clear")
+	  (widget-insert "\n\n")
+	  (let ((start (point))
+		(nth 0))
+	    (mapc '(lambda (search)
+		     (let ((widget-symbol (intern (format "notmuch-hello-search-%d" nth))))
+		       (set widget-symbol
+			    (widget-create 'editable-field
+				       ;; Don't let the search boxes be
+				       ;; less than 8 characters wide.
+				       :size (max 8
+						  (- (window-width)
+						     ;; Leave some space
+						     ;; at the start and
+						     ;; end of the
+						     ;; boxes.
+						     (* 2 notmuch-hello-indent)
+						     ;; 1 for the space
+						     ;; before the
+						     ;; `[save]' button. 6
+						     ;; for the `[save]'
+						     ;; button.
+						     1 6))
+				       :action (lambda (widget &rest ignore)
+						 (notmuch-hello-search (widget-value widget)))
+				       search))
+		       (widget-insert " ")
+		       (widget-create 'push-button
+				      :notify (lambda (widget &rest ignore)
+						(notmuch-hello-add-saved-search widget))
+				      :notmuch-saved-search-widget widget-symbol
+				      "save"))
+		     (widget-insert "\n")
+		     (setq nth (1+ nth)))
+		  notmuch-hello-recent-searches)
+	    (indent-rigidly start (point) notmuch-hello-indent)))
+
+	(when alltags-alist
+	  (if notmuch-show-all-tags-list
+	      (progn
+		(widget-insert "\nAll tags: ")
+		(widget-create 'push-button
+			       :notify (lambda (widget &rest ignore)
+					 (setq notmuch-show-all-tags-list nil)
+					 (notmuch-hello-update))
+			       "hide")
+		(widget-insert "\n\n")
+		(let ((start (point)))
+		  (setq found-target-pos (notmuch-hello-insert-tags alltags-alist widest target))
+		  (if (not final-target-pos)
+		      (setq final-target-pos found-target-pos))
+		  (indent-rigidly start (point) notmuch-hello-indent)))
+	    (widget-insert "\n")
+	    (widget-create 'push-button
+			   :notify (lambda (widget &rest ignore)
+				     (setq notmuch-show-all-tags-list t)
+				     (notmuch-hello-update))
+			   "Show all tags"))))
 
-    (when alltags-alist
-      (widget-insert "\nAll tags:\n\n")
       (let ((start (point)))
-	(notmuch-hello-insert-tags alltags-alist widest)
-	(indent-rigidly start (point) notmuch-hello-indent))))
-
-  (let ((start (point)))
-    (widget-insert "\n\n")
-    (widget-insert "Type a search query and hit RET to view matching threads.\n")
-    (when notmuch-hello-recent-searches
-      (widget-insert "Hit RET to re-submit a previous search. Edit it first if you like.\n")
-      (let ((searches (length notmuch-hello-recent-searches)))
-	(widget-insert
-	 (if (eq 1 searches)
-	     "Key 0 acts as an accelerator for the previous query.\n"
-	   (format "Keys 0-%d act as accelerators for the previous queries.\n"
-		   (- searches 1)))))
-      (widget-insert "Save recent searches with the `save' button.\n"))
-    (when notmuch-hello-saved-searches
-      (widget-insert "Edit saved searches with the `edit' button.\n"))
-    (widget-insert "Hit RET or click on a saved search or tag name to view matching threads.\n")
-    (widget-insert "`=' refreshes this screen. `s' jumps to the search box. `q' to quit.\n")
-    (let ((fill-column (- (window-width) notmuch-hello-indent)))
-      (center-region start (point))))
-
-  (use-local-map widget-keymap)
-  (local-set-key "=" 'notmuch-hello-update)
-  (local-set-key "q" '(lambda () (interactive) (kill-buffer (current-buffer))))
-  (local-set-key "s" 'notmuch-hello-goto-search)
-  (local-set-key "v" '(lambda () (interactive)
-			(message "notmuch version %s" (notmuch-version))))
-
-  (loop for key from 0 to (- (length notmuch-hello-recent-searches) 1)
-	do (let ((widget-symbol (intern (format "notmuch-hello-search-%d" key))))
-	     (local-set-key (number-to-string key)
-			    `(lambda ()
-			       (interactive)
-			       (notmuch-search (widget-value ,widget-symbol)
-					       notmuch-search-oldest-first
-					       nil nil #'notmuch-hello-search-continuation)))))
-  (widget-setup)
-
-  (if notmuch-hello-jump-to-search
-      (notmuch-hello-goto-search)
-    (goto-char (point-min))))
+	(widget-insert "\n\n")
+	(widget-insert "Type a search query and hit RET to view matching threads.\n")
+	(when notmuch-hello-recent-searches
+	  (widget-insert "Hit RET to re-submit a previous search. Edit it first if you like.\n")
+	  (widget-insert "Save recent searches with the `save' button.\n"))
+	(when notmuch-saved-searches
+	  (widget-insert "Edit saved searches with the `edit' button.\n"))
+	(widget-insert "Hit RET or click on a saved search or tag name to view matching threads.\n")
+	(widget-insert "`=' refreshes this screen. `s' jumps to the search box. `q' to quit.\n")
+	(let ((fill-column (- (window-width) notmuch-hello-indent)))
+	  (center-region start (point))))
+
+      (use-local-map widget-keymap)
+      (local-set-key "=" 'notmuch-hello-update)
+      (local-set-key "G" 'notmuch-hello-poll-and-update)
+      (local-set-key "m" 'notmuch-mua-mail)
+      (local-set-key "q" '(lambda () (interactive) (kill-buffer (current-buffer))))
+      (local-set-key "s" 'notmuch-hello-goto-search)
+      (local-set-key "v" '(lambda () (interactive)
+			    (message "notmuch version %s" (notmuch-version))))
+
+      (widget-setup)
+
+      (goto-char final-target-pos)
+      (if (not (widget-at))
+	  (widget-forward 1)))))
 
 ;;