X-Git-Url: https://git.notmuchmail.org/git?a=blobdiff_plain;f=emacs%2Fnotmuch-show.el;h=20f89970a00a7008fadf818e5873662c12c48c06;hb=9ff72a83bda69e6c064bd8be9f201a4626bff54e;hp=1c1cf9c7de02f6e651ec6f0090f29dd209e6e72d;hpb=8a22e2875049b47ebf7058e93bd2d12747838519;p=notmuch

diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index 1c1cf9c7..20f89970 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -47,8 +47,8 @@
 
 For an open message, all of these headers will be made visible
 according to `notmuch-message-headers-visible' or can be toggled
-with `notmuch-show-toggle-headers'. For a closed message, only
-the first header in the list will be visible."
+with `notmuch-show-toggle-visibility-headers'. For a closed message,
+only the first header in the list will be visible."
   :type '(repeat string)
   :group 'notmuch-show)
 
@@ -58,8 +58,8 @@ the first header in the list will be visible."
 If this value is non-nil, then all of the headers defined in
 `notmuch-message-headers' will be visible by default in the display
 of each message. Otherwise, these headers will be hidden and
-`notmuch-show-toggle-headers' can be used to make the visible for
-any given message."
+`notmuch-show-toggle-visibility-headers' can be used to make them
+visible for any given message."
   :type 'boolean
   :group 'notmuch-show)
 
@@ -203,9 +203,10 @@ For example, if you wanted to remove an \"unread\" tag and add a
      (let ((id (notmuch-show-get-message-id)))
        (let ((buf (generate-new-buffer (concat "*notmuch-msg-" id "*"))))
          (with-current-buffer buf
-	    (call-process notmuch-command nil t nil "show" "--format=raw" id)
-           ,@body)
-	 (kill-buffer buf)))))
+	   (let ((coding-system-for-read 'no-conversion))
+	     (call-process notmuch-command nil t nil "show" "--format=raw" id)
+	     ,@body)
+	   (kill-buffer buf))))))
 
 (defun notmuch-show-turn-on-visual-line-mode ()
   "Enable Visual Line mode."
@@ -365,9 +366,10 @@ operation on the contents of the current buffer."
 					     'face 'notmuch-tag-face)
 				 ")"))))))
 
-(defun notmuch-show-clean-address (address)
-  "Try to clean a single email ADDRESS for display.  Return
-unchanged ADDRESS if parsing fails."
+(defun notmuch-clean-address (address)
+  "Try to clean a single email ADDRESS for display. Return a cons
+cell of (AUTHOR_EMAIL AUTHOR_NAME). Return (ADDRESS nil) if
+parsing fails."
   (condition-case nil
     (let (p-name p-address)
       ;; It would be convenient to use `mail-header-parse-address',
@@ -415,12 +417,20 @@ unchanged ADDRESS if parsing fails."
       (when (string= p-name p-address)
 	(setq p-name nil))
 
-      ;; If no name results, return just the address.
-      (if (not p-name)
-	  p-address
-	;; Otherwise format the name and address together.
-	(concat p-name " <" p-address ">")))
-    (error address)))
+      (cons p-address p-name))
+    (error (cons address nil))))
+
+(defun notmuch-show-clean-address (address)
+  "Try to clean a single email ADDRESS for display.  Return
+unchanged ADDRESS if parsing fails."
+  (let* ((clean-address (notmuch-clean-address address))
+	 (p-address (car clean-address))
+	 (p-name (cdr clean-address)))
+    ;; If no name, return just the address.
+    (if (not p-name)
+	p-address
+      ;; Otherwise format the name and address together.
+      (concat p-name " <" p-address ">"))))
 
 (defun notmuch-show-insert-headerline (headers date tags depth)
   "Insert a notmuch style headerline based on HEADERS for a
@@ -747,17 +757,22 @@ message at DEPTH in the current thread."
   (notmuch-show-insert-part-header nth declared-type content-type (plist-get part :filename))
   (insert (with-temp-buffer
 	    (insert (notmuch-get-bodypart-content msg part nth notmuch-show-process-crypto))
+	    ;; notmuch-get-bodypart-content provides "raw", non-converted
+	    ;; data. Replace CRLF with LF before icalendar can use it.
 	    (goto-char (point-min))
+	    (while (re-search-forward "\r\n" nil t)
+	      (replace-match "\n" nil nil))
 	    (let ((file (make-temp-file "notmuch-ical"))
 		  result)
-	      (icalendar--convert-ical-to-diary
-	       (icalendar--read-element nil nil)
-	       file t)
-	      (set-buffer (get-file-buffer file))
-	      (setq result (buffer-substring (point-min) (point-max)))
-	      (set-buffer-modified-p nil)
-	      (kill-buffer (current-buffer))
-	      (delete-file file)
+	      (unwind-protect
+		  (progn
+		    (unless (icalendar-import-buffer file t)
+		      (error "Icalendar import error. See *icalendar-errors* for more information"))
+		    (set-buffer (get-file-buffer file))
+		    (setq result (buffer-substring (point-min) (point-max)))
+		    (set-buffer-modified-p nil)
+		    (kill-buffer (current-buffer)))
+		(delete-file file))
 	      result)))
   t)
 
@@ -815,7 +830,12 @@ message at DEPTH in the current thread."
     ;; Run the content handlers until one of them returns a non-nil
     ;; value.
     (while (and handlers
-		(not (funcall (car handlers) msg part content-type nth depth declared-type)))
+		(not (condition-case err
+			 (funcall (car handlers) msg part content-type nth depth declared-type)
+		       (error (progn
+				(insert "!!! Bodypart insert error: ")
+				(insert (error-message-string err))
+				(insert " !!!\n") nil)))))
       (setq handlers (cdr handlers))))
   t)
 
@@ -991,23 +1011,62 @@ message at DEPTH in the current thread."
   "Insert the forest of threads FOREST."
   (mapc (lambda (thread) (notmuch-show-insert-thread thread 0)) forest))
 
+(defvar notmuch-id-regexp
+  (concat
+   ;; Match the id: prefix only if it begins a word (to disallow, for
+   ;; example, matching cid:).
+   "\\<id:\\("
+   ;; If the term starts with a ", then parse Xapian's quoted boolean
+   ;; term syntax, which allows for anything as long as embedded
+   ;; double quotes escaped by doubling them.  We also disallow
+   ;; newlines (which Xapian allows) to prevent runaway terms.
+   "\"\\([^\"\n]\\|\"\"\\)*\""
+   ;; Otherwise, parse Xapian's unquoted syntax, which goes up to the
+   ;; next space or ).  We disallow [.,;] as the last character
+   ;; because these are probably part of the surrounding text, and not
+   ;; part of the id.  This doesn't match single character ids; meh.
+   "\\|[^\"[:space:])][^[:space:])]*[^])[:space:].,:;?!]"
+   "\\)")
+  "The regexp used to match id: links in messages.")
+
+(defvar notmuch-mid-regexp
+  ;; goto-address-url-regexp matched cid: links, which have the same
+  ;; grammar as the message ID part of a mid: link.  Construct the
+  ;; regexp using the same technique as goto-address-url-regexp.
+  (concat "\\<mid:\\(" thing-at-point-url-path-regexp "\\)")
+  "The regexp used to match mid: links in messages.
+
+See RFC 2392.")
+
 (defun notmuch-show-buttonise-links (start end)
   "Buttonise URLs and mail addresses between START and END.
 
-This also turns id:\"<message id>\"-parts into buttons for
-a corresponding notmuch search."
+This also turns id:\"<message id>\"-parts and mid: links into
+buttons for a corresponding notmuch search."
   (goto-address-fontify-region start end)
   (save-excursion
-    (goto-char start)
-    (while (re-search-forward "id:\\(\"?\\)[^[:space:]\"]+\\1" end t)
-      ;; remove the overlay created by goto-address-mode
-      (remove-overlays (match-beginning 0) (match-end 0) 'goto-address t)
-      (make-text-button (match-beginning 0) (match-end 0)
-			'action `(lambda (arg)
-				   (notmuch-show ,(match-string-no-properties 0)))
-			'follow-link t
-			'help-echo "Mouse-1, RET: search for this message"
-			'face goto-address-mail-face))))
+    (let (links)
+      (goto-char start)
+      (while (re-search-forward notmuch-id-regexp end t)
+	(push (list (match-beginning 0) (match-end 0)
+		    (match-string-no-properties 0)) links))
+      (goto-char start)
+      (while (re-search-forward notmuch-mid-regexp end t)
+	(let* ((mid-cid (match-string-no-properties 1))
+	       (mid (save-match-data
+		      (string-match "^[^/]*" mid-cid)
+		      (url-unhex-string (match-string 0 mid-cid)))))
+	  (push (list (match-beginning 0) (match-end 0)
+		      (notmuch-id-to-query mid)) links)))
+      (dolist (link links)
+	;; Remove the overlay created by goto-address-mode
+	(remove-overlays (first link) (second link) 'goto-address t)
+	(make-text-button (first link) (second link)
+			  'action `(lambda (arg)
+				     (notmuch-show ,(third link)))
+			  'follow-link t
+			  'help-echo "Mouse-1, RET: search for this message"
+			  'face goto-address-mail-face)))))
 
 ;;;###autoload
 (defun notmuch-show (thread-id &optional parent-buffer query-context buffer-name)
@@ -1077,10 +1136,10 @@ function is used."
 
       (jit-lock-register #'notmuch-show-buttonise-links)
 
-      (run-hooks 'notmuch-show-hook))
+      ;; Set the header line to the subject of the first message.
+      (setq header-line-format (notmuch-show-strip-re (notmuch-show-get-subject)))
 
-    ;; Set the header line to the subject of the first message.
-    (setq header-line-format (notmuch-show-strip-re (notmuch-show-get-subject)))))
+      (run-hooks 'notmuch-show-hook))))
 
 (defun notmuch-show-capture-state ()
   "Capture the state of the current buffer.
@@ -1126,6 +1185,10 @@ reset based on the original query."
   (let ((inhibit-read-only t)
 	(state (unless reset-state
 		 (notmuch-show-capture-state))))
+    ;; erase-buffer does not seem to remove overlays, which can lead
+    ;; to weird effects such as remaining images, so remove them
+    ;; manually.
+    (remove-overlays)
     (erase-buffer)
     (notmuch-show-build-buffer)
     (if state
@@ -1170,7 +1233,7 @@ reset based on the original query."
 	(define-key map "v" 'notmuch-show-view-all-mime-parts)
 	(define-key map "c" 'notmuch-show-stash-map)
 	(define-key map "=" 'notmuch-show-refresh-view)
-	(define-key map "h" 'notmuch-show-toggle-headers)
+	(define-key map "h" 'notmuch-show-toggle-visibility-headers)
 	(define-key map "*" 'notmuch-show-tag-all)
 	(define-key map "-" 'notmuch-show-remove-tag)
 	(define-key map "+" 'notmuch-show-add-tag)
@@ -1709,7 +1772,7 @@ See `notmuch-tag' for information on the format of TAG-CHANGES."
   (interactive)
   (notmuch-show-tag "-"))
 
-(defun notmuch-show-toggle-headers ()
+(defun notmuch-show-toggle-visibility-headers ()
   "Toggle the visibility of the current message headers."
   (interactive)
   (let ((props (notmuch-show-get-message-properties)))