1 Return-Path: <markwalters1009@gmail.com>
\r
2 X-Original-To: notmuch@notmuchmail.org
\r
3 Delivered-To: notmuch@notmuchmail.org
\r
4 Received: from localhost (localhost [127.0.0.1])
\r
5 by olra.theworths.org (Postfix) with ESMTP id 0B1CB431FD8
\r
6 for <notmuch@notmuchmail.org>; Wed, 5 Jun 2013 09:24:13 -0700 (PDT)
\r
7 X-Virus-Scanned: Debian amavisd-new at olra.theworths.org
\r
11 X-Spam-Status: No, score=0.224 tagged_above=-999 required=5
\r
12 tests=[DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1,
\r
13 FREEMAIL_ENVFROM_END_DIGIT=1, FREEMAIL_FROM=0.001,
\r
14 HS_INDEX_PARAM=0.023, RCVD_IN_DNSWL_LOW=-0.7] autolearn=disabled
\r
15 Received: from olra.theworths.org ([127.0.0.1])
\r
16 by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024)
\r
17 with ESMTP id xujJgItUg2nQ for <notmuch@notmuchmail.org>;
\r
18 Wed, 5 Jun 2013 09:24:00 -0700 (PDT)
\r
19 Received: from mail-wi0-f175.google.com (mail-wi0-f175.google.com
\r
20 [209.85.212.175]) (using TLSv1 with cipher RC4-SHA (128/128 bits))
\r
21 (No client certificate requested)
\r
22 by olra.theworths.org (Postfix) with ESMTPS id 51A04431FB6
\r
23 for <notmuch@notmuchmail.org>; Wed, 5 Jun 2013 09:23:57 -0700 (PDT)
\r
24 Received: by mail-wi0-f175.google.com with SMTP id hn14so4994170wib.8
\r
25 for <notmuch@notmuchmail.org>; Wed, 05 Jun 2013 09:23:56 -0700 (PDT)
\r
26 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113;
\r
27 h=from:to:cc:subject:date:message-id:x-mailer:in-reply-to:references;
\r
28 bh=hKWwxBUR1hAlUagUlVrOWYvy1g8/CJe4Q7fzDgvJOS0=;
\r
29 b=bekF8Pc2Ud/R5lvIhohatvlrgLbwS7yzmMjDt51rUaAsvtu2ZNmqcqvak45dESdJji
\r
30 VcRQ3TNKGy9FltXkOjN4ebvG+7vl9Fvs6zyQmzIFVuo2UykuXtF4vhlqTEM0HvXQEDvG
\r
31 dVfqezByfjdApWAwfL8z0gol5esui1m1+26J338hecmrtQb8eNXdKvyixVNHtqYFgcPO
\r
32 15lTtB6QZCmbbCeCNXSyDLKPr1eS0B8hStohYyvWLN4+n4bn+YAu65bFjAPU0+RY55ir
\r
33 jaWb79/KN/6/LGWuujBQ1zZ6HD9dFZzhO4tkrIHxxtJBFP/Y14nwBiwfk5G7br/xC4fr
\r
35 X-Received: by 10.180.184.101 with SMTP id et5mr7366942wic.45.1370449436197;
\r
36 Wed, 05 Jun 2013 09:23:56 -0700 (PDT)
\r
37 Received: from localhost (93-97-24-31.zone5.bethere.co.uk. [93.97.24.31])
\r
38 by mx.google.com with ESMTPSA id
\r
39 fu14sm11487953wic.0.2013.06.05.09.23.54 for <multiple recipients>
\r
40 (version=TLSv1.2 cipher=RC4-SHA bits=128/128);
\r
41 Wed, 05 Jun 2013 09:23:55 -0700 (PDT)
\r
42 From: Mark Walters <markwalters1009@gmail.com>
\r
43 To: notmuch@notmuchmail.org
\r
44 Subject: [PATCH 2/2] insert forest moved
\r
45 Date: Wed, 5 Jun 2013 17:23:46 +0100
\r
46 Message-Id: <1370449426-2325-3-git-send-email-markwalters1009@gmail.com>
\r
47 X-Mailer: git-send-email 1.7.9.1
\r
48 In-Reply-To: <1370449426-2325-1-git-send-email-markwalters1009@gmail.com>
\r
49 References: <1370449426-2325-1-git-send-email-markwalters1009@gmail.com>
\r
50 X-BeenThere: notmuch@notmuchmail.org
\r
51 X-Mailman-Version: 2.1.13
\r
53 List-Id: "Use and development of the notmuch mail system."
\r
54 <notmuch.notmuchmail.org>
\r
55 List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,
\r
56 <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>
\r
57 List-Archive: <http://notmuchmail.org/pipermail/notmuch>
\r
58 List-Post: <mailto:notmuch@notmuchmail.org>
\r
59 List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>
\r
60 List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,
\r
61 <mailto:notmuch-request@notmuchmail.org?subject=subscribe>
\r
62 X-List-Received-Date: Wed, 05 Jun 2013 16:24:13 -0000
\r
65 emacs/notmuch-show-display.el | 704 ++++++++++++++++++++++++++++++++++++++++-
\r
66 emacs/notmuch-show.el | 692 ----------------------------------------
\r
67 2 files changed, 703 insertions(+), 693 deletions(-)
\r
69 diff --git a/emacs/notmuch-show-display.el b/emacs/notmuch-show-display.el
\r
70 index 50d83ad..82678c2 100644
\r
71 --- a/emacs/notmuch-show-display.el
\r
72 +++ b/emacs/notmuch-show-display.el
\r
74 ;; Authors: Carl Worth <cworth@cworth.org>
\r
75 ;; David Edmondson <dme@dme.org>
\r
79 +(require 'mm-decode)
\r
82 -(provide 'notmuch-show-display)
\r
83 \ No newline at end of file
\r
84 +(require 'notmuch-lib)
\r
85 +(require 'notmuch-tag)
\r
86 +(require 'notmuch-wash)
\r
87 +(require 'notmuch-crypto)
\r
89 +(declare-function notmuch-show-get-header "notmuch-show" (header &optional props))
\r
90 +(declare-function notmuch-show-set-message-properties "notmuch-show" (props))
\r
91 +(declare-function notmuch-show-set-prop "notmuch-show" (prop val &optional props))
\r
93 +(defcustom notmuch-message-headers '("Subject" "To" "Cc" "Date")
\r
94 + "Headers that should be shown in a message, in this order.
\r
96 +For an open message, all of these headers will be made visible
\r
97 +according to `notmuch-message-headers-visible' or can be toggled
\r
98 +with `notmuch-show-toggle-visibility-headers'. For a closed message,
\r
99 +only the first header in the list will be visible."
\r
100 + :type '(repeat string)
\r
101 + :group 'notmuch-show)
\r
103 +(defcustom notmuch-message-headers-visible t
\r
104 + "Should the headers be visible by default?
\r
106 +If this value is non-nil, then all of the headers defined in
\r
107 +`notmuch-message-headers' will be visible by default in the display
\r
108 +of each message. Otherwise, these headers will be hidden and
\r
109 +`notmuch-show-toggle-visibility-headers' can be used to make them
\r
110 +visible for any given message."
\r
112 + :group 'notmuch-show)
\r
114 +(defcustom notmuch-show-relative-dates t
\r
115 + "Display relative dates in the message summary line."
\r
117 + :group 'notmuch-show)
\r
119 +(defvar notmuch-show-markup-headers-hook '(notmuch-show-colour-headers)
\r
120 + "A list of functions called to decorate the headers listed in
\r
121 +`notmuch-message-headers'.")
\r
123 +(defcustom notmuch-show-insert-text/plain-hook '(notmuch-wash-wrap-long-lines
\r
124 + notmuch-wash-tidy-citations
\r
125 + notmuch-wash-elide-blank-lines
\r
126 + notmuch-wash-excerpt-citations)
\r
127 + "Functions used to improve the display of text/plain parts."
\r
129 + :options '(notmuch-wash-convert-inline-patch-to-part
\r
130 + notmuch-wash-wrap-long-lines
\r
131 + notmuch-wash-tidy-citations
\r
132 + notmuch-wash-elide-blank-lines
\r
133 + notmuch-wash-excerpt-citations)
\r
134 + :group 'notmuch-show
\r
135 + :group 'notmuch-hooks)
\r
137 +;; Mostly useful for debugging.
\r
138 +(defcustom notmuch-show-all-multipart/alternative-parts nil
\r
139 + "Should all parts of multipart/alternative parts be shown?"
\r
141 + :group 'notmuch-show)
\r
143 +(defcustom notmuch-show-indent-messages-width 1
\r
144 + "Width of message indentation in threads.
\r
146 +Messages are shown indented according to their depth in a thread.
\r
147 +This variable determines the width of this indentation measured
\r
148 +in number of blanks. Defaults to `1', choose `0' to disable
\r
151 + :group 'notmuch-show)
\r
153 +(defcustom notmuch-show-indent-multipart nil
\r
154 + "Should the sub-parts of a multipart/* part be indented?"
\r
155 + ;; dme: Not sure which is a good default.
\r
157 + :group 'notmuch-show)
\r
159 +(defvar notmuch-show-process-crypto nil)
\r
160 +(make-variable-buffer-local 'notmuch-show-process-crypto)
\r
161 +(put 'notmuch-show-process-crypto 'permanent-local t)
\r
163 +(defvar notmuch-show-indent-content t)
\r
164 +(make-variable-buffer-local 'notmuch-show-indent-content)
\r
165 +(put 'notmuch-show-indent-content 'permanent-local t)
\r
167 +(defun notmuch-show-fontify-header ()
\r
168 + (let ((face (cond
\r
169 + ((looking-at "[Tt]o:")
\r
170 + 'message-header-to)
\r
171 + ((looking-at "[Bb]?[Cc][Cc]:")
\r
172 + 'message-header-cc)
\r
173 + ((looking-at "[Ss]ubject:")
\r
174 + 'message-header-subject)
\r
175 + ((looking-at "[Ff]rom:")
\r
176 + 'message-header-from)
\r
178 + 'message-header-other))))
\r
180 + (overlay-put (make-overlay (point) (re-search-forward ":"))
\r
181 + 'face 'message-header-name)
\r
182 + (overlay-put (make-overlay (point) (re-search-forward ".*$"))
\r
185 +(defun notmuch-show-colour-headers ()
\r
186 + "Apply some colouring to the current headers."
\r
187 + (goto-char (point-min))
\r
188 + (while (looking-at "^[A-Za-z][-A-Za-z0-9]*:")
\r
189 + (notmuch-show-fontify-header)
\r
192 +(defun notmuch-show-spaces-n (n)
\r
193 + "Return a string comprised of `n' spaces."
\r
194 + (make-string n ? ))
\r
196 +(defun notmuch-clean-address (address)
\r
197 + "Try to clean a single email ADDRESS for display. Return a cons
\r
198 +cell of (AUTHOR_EMAIL AUTHOR_NAME). Return (ADDRESS nil) if
\r
200 + (condition-case nil
\r
201 + (let (p-name p-address)
\r
202 + ;; It would be convenient to use `mail-header-parse-address',
\r
203 + ;; but that expects un-decoded mailbox parts, whereas our
\r
204 + ;; mailbox parts are already decoded (and hence may contain
\r
205 + ;; UTF-8). Given that notmuch should handle most of the awkward
\r
206 + ;; cases, some simple string deconstruction should be sufficient
\r
209 + ;; "User <user@dom.ain>" style.
\r
210 + ((string-match "\\(.*\\) <\\(.*\\)>" address)
\r
211 + (setq p-name (match-string 1 address)
\r
212 + p-address (match-string 2 address)))
\r
214 + ;; "<user@dom.ain>" style.
\r
215 + ((string-match "<\\(.*\\)>" address)
\r
216 + (setq p-address (match-string 1 address)))
\r
218 + ;; Everything else.
\r
220 + (setq p-address address)))
\r
223 + ;; Remove elements of the mailbox part that are not relevant for
\r
224 + ;; display, even if they are required during transport:
\r
227 + (setq p-name (replace-regexp-in-string "\\\\" "" p-name))
\r
229 + ;; Outer single and double quotes, which might be nested.
\r
231 + with start-of-loop
\r
232 + do (setq start-of-loop p-name)
\r
234 + when (string-match "^\"\\(.*\\)\"$" p-name)
\r
235 + do (setq p-name (match-string 1 p-name))
\r
237 + when (string-match "^'\\(.*\\)'$" p-name)
\r
238 + do (setq p-name (match-string 1 p-name))
\r
240 + until (string= start-of-loop p-name)))
\r
242 + ;; If the address is 'foo@bar.com <foo@bar.com>' then show just
\r
243 + ;; 'foo@bar.com'.
\r
244 + (when (string= p-name p-address)
\r
245 + (setq p-name nil))
\r
247 + (cons p-address p-name))
\r
248 + (error (cons address nil))))
\r
250 +(defun notmuch-show-clean-address (address)
\r
251 + "Try to clean a single email ADDRESS for display. Return
\r
252 +unchanged ADDRESS if parsing fails."
\r
253 + (let* ((clean-address (notmuch-clean-address address))
\r
254 + (p-address (car clean-address))
\r
255 + (p-name (cdr clean-address)))
\r
256 + ;; If no name, return just the address.
\r
259 + ;; Otherwise format the name and address together.
\r
260 + (concat p-name " <" p-address ">"))))
\r
262 +(defun notmuch-show-insert-headerline (headers date tags depth)
\r
263 + "Insert a notmuch style headerline based on HEADERS for a
\r
264 +message at DEPTH in the current thread."
\r
265 + (let ((start (point)))
\r
266 + (insert (notmuch-show-spaces-n (* notmuch-show-indent-messages-width depth))
\r
267 + (notmuch-show-clean-address (plist-get headers :From))
\r
271 + (notmuch-tag-format-tags tags)
\r
273 + (overlay-put (make-overlay start (point)) 'face 'notmuch-message-summary-face)))
\r
275 +(defun notmuch-show-insert-header (header header-value)
\r
276 + "Insert a single header."
\r
277 + (insert header ": " header-value "\n"))
\r
279 +(defun notmuch-show-insert-headers (headers)
\r
280 + "Insert the headers of the current message."
\r
281 + (let ((start (point)))
\r
282 + (mapc (lambda (header)
\r
283 + (let* ((header-symbol (intern (concat ":" header)))
\r
284 + (header-value (plist-get headers header-symbol)))
\r
285 + (if (and header-value
\r
286 + (not (string-equal "" header-value)))
\r
287 + (notmuch-show-insert-header header header-value))))
\r
288 + notmuch-message-headers)
\r
290 + (save-restriction
\r
291 + (narrow-to-region start (point-max))
\r
292 + (run-hooks 'notmuch-show-markup-headers-hook)))))
\r
294 +(defun notmuch-show-insert-part-header (nth content-type declared-type &optional name comment)
\r
296 + (base-label (concat (when name (concat name ": "))
\r
298 + (unless (string-equal declared-type content-type)
\r
299 + (concat " (as " content-type ")"))
\r
304 + (concat "[ " base-label " ]")
\r
305 + :base-label base-label
\r
306 + :type 'notmuch-show-part-button-type
\r
307 + :notmuch-part nth
\r
308 + :notmuch-filename name
\r
309 + :notmuch-content-type content-type))
\r
314 +;; This is taken from notmuch-wash: maybe it should be unified?
\r
315 +(defun notmuch-show-toggle-part-invisibility (&optional button)
\r
317 + (let* ((button (or button (button-at (point))))
\r
318 + (overlay (button-get button 'overlay)))
\r
320 + (let* ((show (overlay-get overlay 'invisible))
\r
321 + (new-start (button-start button))
\r
322 + (button-label (button-get button :base-label))
\r
323 + (old-point (point))
\r
324 + (inhibit-read-only t))
\r
325 + (overlay-put overlay 'invisible (not show))
\r
326 + (goto-char new-start)
\r
327 + (insert "[ " button-label (if show " ]" " (hidden) ]"))
\r
328 + (let ((old-end (button-end button)))
\r
329 + (move-overlay button new-start (point))
\r
330 + (delete-region (point) old-end))
\r
331 + (goto-char (min old-point (1- (button-end button))))))))
\r
333 +(defun notmuch-show-multipart/*-to-list (part)
\r
334 + (mapcar (lambda (inner-part) (plist-get inner-part :content-type))
\r
335 + (plist-get part :content)))
\r
337 +(defun notmuch-show-insert-part-multipart/alternative (msg part content-type nth depth declared-type)
\r
338 + (notmuch-show-insert-part-header nth declared-type content-type nil)
\r
339 + (let ((chosen-type (car (notmuch-multipart/alternative-choose (notmuch-show-multipart/*-to-list part))))
\r
340 + (inner-parts (plist-get part :content))
\r
342 + ;; This inserts all parts of the chosen type rather than just one,
\r
343 + ;; but it's not clear that this is the wrong thing to do - which
\r
344 + ;; should be chosen if there are more than one that match?
\r
345 + (mapc (lambda (inner-part)
\r
346 + (let* ((inner-type (plist-get inner-part :content-type))
\r
347 + (hide (not (or notmuch-show-all-multipart/alternative-parts
\r
348 + (string= chosen-type inner-type)))))
\r
349 + (notmuch-show-insert-bodypart msg inner-part depth hide)))
\r
352 + (when notmuch-show-indent-multipart
\r
353 + (indent-rigidly start (point) 1)))
\r
356 +(defun notmuch-show-setup-w3m ()
\r
357 + "Instruct w3m how to retrieve content from a \"related\" part of a message."
\r
359 + (if (boundp 'w3m-cid-retrieve-function-alist)
\r
360 + (unless (assq 'notmuch-show-mode w3m-cid-retrieve-function-alist)
\r
361 + (push (cons 'notmuch-show-mode 'notmuch-show-w3m-cid-retrieve)
\r
362 + w3m-cid-retrieve-function-alist)))
\r
363 + (setq mm-inline-text-html-with-images t))
\r
365 +(defvar w3m-current-buffer) ;; From `w3m.el'.
\r
366 +(defvar notmuch-show-w3m-cid-store nil)
\r
367 +(make-variable-buffer-local 'notmuch-show-w3m-cid-store)
\r
369 +(defun notmuch-show-w3m-cid-store-internal (content-id
\r
374 + (push (list content-id
\r
379 + notmuch-show-w3m-cid-store))
\r
381 +(defun notmuch-show-w3m-cid-store (msg part)
\r
382 + (let ((content-id (plist-get part :content-id)))
\r
384 + (notmuch-show-w3m-cid-store-internal (concat "cid:" content-id)
\r
385 + (plist-get msg :id)
\r
386 + (plist-get part :id)
\r
387 + (plist-get part :content-type)
\r
390 +(defun notmuch-show-w3m-cid-retrieve (url &rest args)
\r
391 + (let ((matching-part (with-current-buffer w3m-current-buffer
\r
392 + (assoc url notmuch-show-w3m-cid-store))))
\r
393 + (if matching-part
\r
394 + (let ((message-id (nth 1 matching-part))
\r
395 + (part-number (nth 2 matching-part))
\r
396 + (content-type (nth 3 matching-part))
\r
397 + (content (nth 4 matching-part)))
\r
398 + ;; If we don't already have the content, get it and cache
\r
399 + ;; it, as some messages reference the same cid: part many
\r
400 + ;; times (hundreds!), which results in many calls to
\r
401 + ;; `notmuch part'.
\r
403 + (setq content (notmuch-get-bodypart-internal (notmuch-id-to-query message-id)
\r
404 + part-number notmuch-show-process-crypto))
\r
405 + (with-current-buffer w3m-current-buffer
\r
406 + (notmuch-show-w3m-cid-store-internal url
\r
415 +(defun notmuch-show-insert-part-multipart/related (msg part content-type nth depth declared-type)
\r
416 + (notmuch-show-insert-part-header nth declared-type content-type nil)
\r
417 + (let ((inner-parts (plist-get part :content))
\r
420 + ;; We assume that the first part is text/html and the remainder
\r
421 + ;; things that it references.
\r
423 + ;; Stash the non-primary parts.
\r
424 + (mapc (lambda (part)
\r
425 + (notmuch-show-w3m-cid-store msg part))
\r
426 + (cdr inner-parts))
\r
428 + ;; Render the primary part.
\r
429 + (notmuch-show-insert-bodypart msg (car inner-parts) depth)
\r
431 + (when notmuch-show-indent-multipart
\r
432 + (indent-rigidly start (point) 1)))
\r
435 +(defun notmuch-show-insert-part-multipart/signed (msg part content-type nth depth declared-type)
\r
436 + (let ((button (notmuch-show-insert-part-header nth declared-type content-type nil)))
\r
437 + (button-put button 'face 'notmuch-crypto-part-header)
\r
438 + ;; add signature status button if sigstatus provided
\r
439 + (if (plist-member part :sigstatus)
\r
440 + (let* ((from (notmuch-show-get-header :From msg))
\r
441 + (sigstatus (car (plist-get part :sigstatus))))
\r
442 + (notmuch-crypto-insert-sigstatus-button sigstatus from))
\r
443 + ;; if we're not adding sigstatus, tell the user how they can get it
\r
444 + (button-put button 'help-echo "Set notmuch-crypto-process-mime to process cryptographic MIME parts.")))
\r
446 + (let ((inner-parts (plist-get part :content))
\r
448 + ;; Show all of the parts.
\r
449 + (mapc (lambda (inner-part)
\r
450 + (notmuch-show-insert-bodypart msg inner-part depth))
\r
453 + (when notmuch-show-indent-multipart
\r
454 + (indent-rigidly start (point) 1)))
\r
457 +(defun notmuch-show-insert-part-multipart/encrypted (msg part content-type nth depth declared-type)
\r
458 + (let ((button (notmuch-show-insert-part-header nth declared-type content-type nil)))
\r
459 + (button-put button 'face 'notmuch-crypto-part-header)
\r
460 + ;; add encryption status button if encstatus specified
\r
461 + (if (plist-member part :encstatus)
\r
462 + (let ((encstatus (car (plist-get part :encstatus))))
\r
463 + (notmuch-crypto-insert-encstatus-button encstatus)
\r
464 + ;; add signature status button if sigstatus specified
\r
465 + (if (plist-member part :sigstatus)
\r
466 + (let* ((from (notmuch-show-get-header :From msg))
\r
467 + (sigstatus (car (plist-get part :sigstatus))))
\r
468 + (notmuch-crypto-insert-sigstatus-button sigstatus from))))
\r
469 + ;; if we're not adding encstatus, tell the user how they can get it
\r
470 + (button-put button 'help-echo "Set notmuch-crypto-process-mime to process cryptographic MIME parts.")))
\r
472 + (let ((inner-parts (plist-get part :content))
\r
474 + ;; Show all of the parts.
\r
475 + (mapc (lambda (inner-part)
\r
476 + (notmuch-show-insert-bodypart msg inner-part depth))
\r
479 + (when notmuch-show-indent-multipart
\r
480 + (indent-rigidly start (point) 1)))
\r
483 +(defun notmuch-show-insert-part-multipart/* (msg part content-type nth depth declared-type)
\r
484 + (notmuch-show-insert-part-header nth declared-type content-type nil)
\r
485 + (let ((inner-parts (plist-get part :content))
\r
487 + ;; Show all of the parts.
\r
488 + (mapc (lambda (inner-part)
\r
489 + (notmuch-show-insert-bodypart msg inner-part depth))
\r
492 + (when notmuch-show-indent-multipart
\r
493 + (indent-rigidly start (point) 1)))
\r
496 +(defun notmuch-show-insert-part-message/rfc822 (msg part content-type nth depth declared-type)
\r
497 + (notmuch-show-insert-part-header nth declared-type content-type nil)
\r
498 + (let* ((message (car (plist-get part :content)))
\r
499 + (body (car (plist-get message :body)))
\r
502 + ;; Override `notmuch-message-headers' to force `From' to be
\r
504 + (let ((notmuch-message-headers '("From" "Subject" "To" "Cc" "Date")))
\r
505 + (notmuch-show-insert-headers (plist-get message :headers)))
\r
507 + ;; Blank line after headers to be compatible with the normal
\r
508 + ;; message display.
\r
512 + (notmuch-show-insert-bodypart msg body depth)
\r
514 + (when notmuch-show-indent-multipart
\r
515 + (indent-rigidly start (point) 1)))
\r
518 +(defun notmuch-show-insert-part-text/plain (msg part content-type nth depth declared-type)
\r
519 + (let ((start (point)))
\r
520 + ;; If this text/plain part is not the first part in the message,
\r
521 + ;; insert a header to make this clear.
\r
523 + (notmuch-show-insert-part-header nth declared-type content-type (plist-get part :filename)))
\r
524 + (insert (notmuch-get-bodypart-content msg part nth notmuch-show-process-crypto))
\r
526 + (save-restriction
\r
527 + (narrow-to-region start (point-max))
\r
528 + (run-hook-with-args 'notmuch-show-insert-text/plain-hook msg depth))))
\r
531 +(defun notmuch-show-insert-part-text/calendar (msg part content-type nth depth declared-type)
\r
532 + (notmuch-show-insert-part-header nth declared-type content-type (plist-get part :filename))
\r
533 + (insert (with-temp-buffer
\r
534 + (insert (notmuch-get-bodypart-content msg part nth notmuch-show-process-crypto))
\r
535 + ;; notmuch-get-bodypart-content provides "raw", non-converted
\r
536 + ;; data. Replace CRLF with LF before icalendar can use it.
\r
537 + (goto-char (point-min))
\r
538 + (while (re-search-forward "\r\n" nil t)
\r
539 + (replace-match "\n" nil nil))
\r
540 + (let ((file (make-temp-file "notmuch-ical"))
\r
544 + (unless (icalendar-import-buffer file t)
\r
545 + (error "Icalendar import error. See *icalendar-errors* for more information"))
\r
546 + (set-buffer (get-file-buffer file))
\r
547 + (setq result (buffer-substring (point-min) (point-max)))
\r
548 + (set-buffer-modified-p nil)
\r
549 + (kill-buffer (current-buffer)))
\r
550 + (delete-file file))
\r
554 +;; For backwards compatibility.
\r
555 +(defun notmuch-show-insert-part-text/x-vcalendar (msg part content-type nth depth declared-type)
\r
556 + (notmuch-show-insert-part-text/calendar msg part content-type nth depth declared-type))
\r
558 +(defun notmuch-show-get-mime-type-of-application/octet-stream (part)
\r
559 + ;; If we can deduce a MIME type from the filename of the attachment,
\r
560 + ;; we return that.
\r
561 + (if (plist-get part :filename)
\r
562 + (let ((extension (file-name-extension (plist-get part :filename)))
\r
566 + (mailcap-parse-mimetypes)
\r
567 + (setq mime-type (mailcap-extension-to-mime extension))
\r
568 + (if (and mime-type
\r
569 + (not (string-equal mime-type "application/octet-stream")))
\r
574 +;; Handler for wash generated inline patch fake parts.
\r
575 +(defun notmuch-show-insert-part-inline-patch-fake-part (msg part content-type nth depth declared-type)
\r
576 + (notmuch-show-insert-part-*/* msg part content-type nth depth declared-type))
\r
578 +(defun notmuch-show-insert-part-text/html (msg part content-type nth depth declared-type)
\r
579 + ;; text/html handler to work around bugs in renderers and our
\r
580 + ;; invisibile parts code. In particular w3m sets up a keymap which
\r
581 + ;; "leaks" outside the invisible region and causes strange effects
\r
582 + ;; in notmuch. We set mm-inline-text-html-with-w3m-keymap to nil to
\r
583 + ;; tell w3m not to set a keymap (so the normal notmuch-show-mode-map
\r
585 + (let ((mm-inline-text-html-with-w3m-keymap nil))
\r
586 + (notmuch-show-insert-part-*/* msg part content-type nth depth declared-type)))
\r
588 +(defun notmuch-show-insert-part-*/* (msg part content-type nth depth declared-type)
\r
589 + ;; This handler _must_ succeed - it is the handler of last resort.
\r
590 + (notmuch-show-insert-part-header nth content-type declared-type (plist-get part :filename))
\r
591 + (notmuch-mm-display-part-inline msg part nth content-type notmuch-show-process-crypto)
\r
594 +;; Functions for determining how to handle MIME parts.
\r
596 +(defun notmuch-show-handlers-for (content-type)
\r
597 + "Return a list of content handlers for a part of type CONTENT-TYPE."
\r
599 + (mapc (lambda (func)
\r
600 + (if (functionp func)
\r
601 + (push func result)))
\r
602 + ;; Reverse order of prefrence.
\r
603 + (list (intern (concat "notmuch-show-insert-part-*/*"))
\r
605 + "notmuch-show-insert-part-"
\r
606 + (car (notmuch-split-content-type content-type))
\r
608 + (intern (concat "notmuch-show-insert-part-" content-type))))
\r
614 +(defun notmuch-show-insert-bodypart-internal (msg part content-type nth depth declared-type)
\r
615 + (let ((handlers (notmuch-show-handlers-for content-type)))
\r
616 + ;; Run the content handlers until one of them returns a non-nil
\r
618 + (while (and handlers
\r
619 + (not (condition-case err
\r
620 + (funcall (car handlers) msg part content-type nth depth declared-type)
\r
622 + (insert "!!! Bodypart insert error: ")
\r
623 + (insert (error-message-string err))
\r
624 + (insert " !!!\n") nil)))))
\r
625 + (setq handlers (cdr handlers))))
\r
628 +(defun notmuch-show-create-part-overlays (msg beg end hide)
\r
629 + "Add an overlay to the part between BEG and END"
\r
630 + (let* ((button (button-at beg))
\r
631 + (part-beg (and button (1+ (button-end button)))))
\r
633 + ;; If the part contains no text we do not make it toggleable. We
\r
634 + ;; also need to check that the button is a genuine part button not
\r
635 + ;; a notmuch-wash button.
\r
636 + (when (and button (/= part-beg end) (button-get button :base-label))
\r
637 + (button-put button 'overlay (make-overlay part-beg end))
\r
638 + ;; We toggle the button for hidden parts as that gets the
\r
639 + ;; button label right.
\r
642 + (notmuch-show-toggle-part-invisibility button))))))
\r
644 +(defun notmuch-show-insert-bodypart (msg part depth &optional hide)
\r
645 + "Insert the body part PART at depth DEPTH in the current thread.
\r
647 +If HIDE is non-nil then initially hide this part."
\r
648 + (let* ((content-type (downcase (plist-get part :content-type)))
\r
649 + (mime-type (or (and (string= content-type "application/octet-stream")
\r
650 + (notmuch-show-get-mime-type-of-application/octet-stream part))
\r
651 + (and (string= content-type "inline patch")
\r
654 + (nth (plist-get part :id))
\r
657 + (notmuch-show-insert-bodypart-internal msg part mime-type nth depth content-type)
\r
658 + ;; Some of the body part handlers leave point somewhere up in the
\r
659 + ;; part, so we make sure that we're down at the end.
\r
660 + (goto-char (point-max))
\r
661 + ;; Ensure that the part ends with a carriage return.
\r
664 + (notmuch-show-create-part-overlays msg beg (point) hide)))
\r
666 +(defun notmuch-show-insert-body (msg body depth)
\r
667 + "Insert the body BODY at depth DEPTH in the current thread."
\r
668 + (mapc (lambda (part) (notmuch-show-insert-bodypart msg part depth)) body))
\r
670 +(defun notmuch-show-strip-re (string)
\r
671 + (replace-regexp-in-string "^\\([Rr]e: *\\)+" "" string))
\r
673 +(defvar notmuch-show-previous-subject "")
\r
674 +(make-variable-buffer-local 'notmuch-show-previous-subject)
\r
676 +(defun notmuch-show-insert-msg (msg depth)
\r
677 + "Insert the message MSG at depth DEPTH in the current thread."
\r
678 + (let* ((headers (plist-get msg :headers))
\r
679 + ;; Indentation causes the buffer offset of the start/end
\r
680 + ;; points to move, so we must use markers.
\r
681 + message-start message-end
\r
682 + content-start content-end
\r
683 + headers-start headers-end
\r
684 + (bare-subject (notmuch-show-strip-re (plist-get headers :Subject))))
\r
686 + (setq message-start (point-marker))
\r
688 + (notmuch-show-insert-headerline headers
\r
689 + (or (if notmuch-show-relative-dates
\r
690 + (plist-get msg :date_relative)
\r
692 + (plist-get headers :Date))
\r
693 + (plist-get msg :tags) depth)
\r
695 + (setq content-start (point-marker))
\r
697 + ;; Set `headers-start' to point after the 'Subject:' header to be
\r
698 + ;; compatible with the existing implementation. This just sets it
\r
699 + ;; to after the first header.
\r
700 + (notmuch-show-insert-headers headers)
\r
702 + (goto-char content-start)
\r
703 + ;; If the subject of this message is the same as that of the
\r
704 + ;; previous message, don't display it when this message is
\r
706 + (when (not (string= notmuch-show-previous-subject
\r
708 + (forward-line 1))
\r
709 + (setq headers-start (point-marker)))
\r
710 + (setq headers-end (point-marker))
\r
712 + (setq notmuch-show-previous-subject bare-subject)
\r
714 + ;; A blank line between the headers and the body.
\r
716 + (notmuch-show-insert-body msg (plist-get msg :body)
\r
717 + (if notmuch-show-indent-content depth 0))
\r
718 + ;; Ensure that the body ends with a newline.
\r
721 + (setq content-end (point-marker))
\r
723 + ;; Indent according to the depth in the thread.
\r
724 + (if notmuch-show-indent-content
\r
725 + (indent-rigidly content-start content-end (* notmuch-show-indent-messages-width depth)))
\r
727 + (setq message-end (point-max-marker))
\r
729 + ;; Save the extents of this message over the whole text of the
\r
731 + (put-text-property message-start message-end :notmuch-message-extent (cons message-start message-end))
\r
733 + ;; Create overlays used to control visibility
\r
734 + (plist-put msg :headers-overlay (make-overlay headers-start headers-end))
\r
735 + (plist-put msg :message-overlay (make-overlay headers-start content-end))
\r
737 + (plist-put msg :depth depth)
\r
739 + ;; Save the properties for this message. Currently this saves the
\r
740 + ;; entire message (augmented it with other stuff), which seems
\r
741 + ;; like overkill. We might save a reduced subset (for example, not
\r
743 + (notmuch-show-set-message-properties msg)
\r
745 + ;; Set header visibility.
\r
746 + (notmuch-show-headers-visible msg notmuch-message-headers-visible)
\r
748 + ;; Message visibility depends on whether it matched the search
\r
750 + (notmuch-show-message-visible msg (and (plist-get msg :match)
\r
751 + (not (plist-get msg :excluded))))))
\r
753 +(defun notmuch-show-insert-tree (tree depth)
\r
754 + "Insert the message tree TREE at depth DEPTH in the current thread."
\r
755 + (let ((msg (car tree))
\r
756 + (replies (cadr tree)))
\r
757 + ;; We test whether there is a message or just some replies.
\r
759 + (notmuch-show-insert-msg msg depth))
\r
760 + (notmuch-show-insert-thread replies (1+ depth))))
\r
762 +(defun notmuch-show-insert-thread (thread depth)
\r
763 + "Insert the thread THREAD at depth DEPTH in the current forest."
\r
764 + (mapc (lambda (tree) (notmuch-show-insert-tree tree depth)) thread))
\r
766 +(defun notmuch-show-insert-forest (forest)
\r
767 + "Insert the forest of threads FOREST."
\r
768 + (mapc (lambda (thread) (notmuch-show-insert-thread thread 0)) forest))
\r
770 +;; Functions relating to the visibility of messages and their
\r
773 +(defun notmuch-show-message-visible (props visible-p)
\r
774 + (overlay-put (plist-get props :message-overlay) 'invisible (not visible-p))
\r
775 + (notmuch-show-set-prop :message-visible visible-p props))
\r
777 +(defun notmuch-show-headers-visible (props visible-p)
\r
778 + (overlay-put (plist-get props :headers-overlay) 'invisible (not visible-p))
\r
779 + (notmuch-show-set-prop :headers-visible visible-p props))
\r
783 +(provide 'notmuch-show-display)
\r
784 diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
\r
785 index 37ba911..9e3401d 100644
\r
786 --- a/emacs/notmuch-show.el
\r
787 +++ b/emacs/notmuch-show.el
\r
788 @@ -22,17 +22,12 @@
\r
789 ;; David Edmondson <dme@dme.org>
\r
791 (eval-when-compile (require 'cl))
\r
792 -(require 'mm-view)
\r
793 -(require 'message)
\r
794 -(require 'mm-decode)
\r
795 -(require 'mailcap)
\r
796 (require 'icalendar)
\r
797 (require 'goto-addr)
\r
799 (require 'notmuch-lib)
\r
800 (require 'notmuch-tag)
\r
801 (require 'notmuch-query)
\r
802 -(require 'notmuch-wash)
\r
803 (require 'notmuch-mua)
\r
804 (require 'notmuch-crypto)
\r
805 (require 'notmuch-print)
\r
807 (declare-function notmuch-search-previous-thread "notmuch" nil)
\r
808 (declare-function notmuch-search-show-thread "notmuch" nil)
\r
810 -(defcustom notmuch-message-headers '("Subject" "To" "Cc" "Date")
\r
811 - "Headers that should be shown in a message, in this order.
\r
813 -For an open message, all of these headers will be made visible
\r
814 -according to `notmuch-message-headers-visible' or can be toggled
\r
815 -with `notmuch-show-toggle-visibility-headers'. For a closed message,
\r
816 -only the first header in the list will be visible."
\r
817 - :type '(repeat string)
\r
818 - :group 'notmuch-show)
\r
820 -(defcustom notmuch-message-headers-visible t
\r
821 - "Should the headers be visible by default?
\r
823 -If this value is non-nil, then all of the headers defined in
\r
824 -`notmuch-message-headers' will be visible by default in the display
\r
825 -of each message. Otherwise, these headers will be hidden and
\r
826 -`notmuch-show-toggle-visibility-headers' can be used to make them
\r
827 -visible for any given message."
\r
829 - :group 'notmuch-show)
\r
831 -(defcustom notmuch-show-relative-dates t
\r
832 - "Display relative dates in the message summary line."
\r
834 - :group 'notmuch-show)
\r
836 -(defvar notmuch-show-markup-headers-hook '(notmuch-show-colour-headers)
\r
837 - "A list of functions called to decorate the headers listed in
\r
838 -`notmuch-message-headers'.")
\r
840 (defcustom notmuch-show-hook '(notmuch-show-turn-on-visual-line-mode)
\r
841 "Functions called after populating a `notmuch-show' buffer."
\r
843 @@ -80,42 +45,6 @@ visible for any given message."
\r
844 :group 'notmuch-show
\r
845 :group 'notmuch-hooks)
\r
847 -(defcustom notmuch-show-insert-text/plain-hook '(notmuch-wash-wrap-long-lines
\r
848 - notmuch-wash-tidy-citations
\r
849 - notmuch-wash-elide-blank-lines
\r
850 - notmuch-wash-excerpt-citations)
\r
851 - "Functions used to improve the display of text/plain parts."
\r
853 - :options '(notmuch-wash-convert-inline-patch-to-part
\r
854 - notmuch-wash-wrap-long-lines
\r
855 - notmuch-wash-tidy-citations
\r
856 - notmuch-wash-elide-blank-lines
\r
857 - notmuch-wash-excerpt-citations)
\r
858 - :group 'notmuch-show
\r
859 - :group 'notmuch-hooks)
\r
861 -;; Mostly useful for debugging.
\r
862 -(defcustom notmuch-show-all-multipart/alternative-parts nil
\r
863 - "Should all parts of multipart/alternative parts be shown?"
\r
865 - :group 'notmuch-show)
\r
867 -(defcustom notmuch-show-indent-messages-width 1
\r
868 - "Width of message indentation in threads.
\r
870 -Messages are shown indented according to their depth in a thread.
\r
871 -This variable determines the width of this indentation measured
\r
872 -in number of blanks. Defaults to `1', choose `0' to disable
\r
875 - :group 'notmuch-show)
\r
877 -(defcustom notmuch-show-indent-multipart nil
\r
878 - "Should the sub-parts of a multipart/* part be indented?"
\r
879 - ;; dme: Not sure which is a good default.
\r
881 - :group 'notmuch-show)
\r
883 (defcustom notmuch-show-part-button-default-action 'notmuch-show-save-part
\r
884 "Default part header button action (on ENTER or mouse click)."
\r
885 :group 'notmuch-show
\r
886 @@ -143,18 +72,10 @@ indentation."
\r
887 (make-variable-buffer-local 'notmuch-show-query-context)
\r
888 (put 'notmuch-show-query-context 'permanent-local t)
\r
890 -(defvar notmuch-show-process-crypto nil)
\r
891 -(make-variable-buffer-local 'notmuch-show-process-crypto)
\r
892 -(put 'notmuch-show-process-crypto 'permanent-local t)
\r
894 (defvar notmuch-show-elide-non-matching-messages nil)
\r
895 (make-variable-buffer-local 'notmuch-show-elide-non-matching-messages)
\r
896 (put 'notmuch-show-elide-non-matching-messages 'permanent-local t)
\r
898 -(defvar notmuch-show-indent-content t)
\r
899 -(make-variable-buffer-local 'notmuch-show-indent-content)
\r
900 -(put 'notmuch-show-indent-content 'permanent-local t)
\r
902 (defcustom notmuch-show-stash-mlarchive-link-alist
\r
903 '(("Gmane" . "http://mid.gmane.org/")
\r
904 ("MARC" . "http://marc.info/?i=")
\r
905 @@ -328,35 +249,6 @@ operation on the contents of the current buffer."
\r
907 (notmuch-show-with-message-as-text 'notmuch-print-message))
\r
909 -(defun notmuch-show-fontify-header ()
\r
910 - (let ((face (cond
\r
911 - ((looking-at "[Tt]o:")
\r
912 - 'message-header-to)
\r
913 - ((looking-at "[Bb]?[Cc][Cc]:")
\r
914 - 'message-header-cc)
\r
915 - ((looking-at "[Ss]ubject:")
\r
916 - 'message-header-subject)
\r
917 - ((looking-at "[Ff]rom:")
\r
918 - 'message-header-from)
\r
920 - 'message-header-other))))
\r
922 - (overlay-put (make-overlay (point) (re-search-forward ":"))
\r
923 - 'face 'message-header-name)
\r
924 - (overlay-put (make-overlay (point) (re-search-forward ".*$"))
\r
927 -(defun notmuch-show-colour-headers ()
\r
928 - "Apply some colouring to the current headers."
\r
929 - (goto-char (point-min))
\r
930 - (while (looking-at "^[A-Za-z][-A-Za-z0-9]*:")
\r
931 - (notmuch-show-fontify-header)
\r
934 -(defun notmuch-show-spaces-n (n)
\r
935 - "Return a string comprised of `n' spaces."
\r
936 - (make-string n ? ))
\r
938 (defun notmuch-show-update-tags (tags)
\r
939 "Update the displayed tags of the current message."
\r
941 @@ -367,104 +259,6 @@ operation on the contents of the current buffer."
\r
942 (notmuch-tag-format-tags tags)
\r
945 -(defun notmuch-clean-address (address)
\r
946 - "Try to clean a single email ADDRESS for display. Return a cons
\r
947 -cell of (AUTHOR_EMAIL AUTHOR_NAME). Return (ADDRESS nil) if
\r
949 - (condition-case nil
\r
950 - (let (p-name p-address)
\r
951 - ;; It would be convenient to use `mail-header-parse-address',
\r
952 - ;; but that expects un-decoded mailbox parts, whereas our
\r
953 - ;; mailbox parts are already decoded (and hence may contain
\r
954 - ;; UTF-8). Given that notmuch should handle most of the awkward
\r
955 - ;; cases, some simple string deconstruction should be sufficient
\r
958 - ;; "User <user@dom.ain>" style.
\r
959 - ((string-match "\\(.*\\) <\\(.*\\)>" address)
\r
960 - (setq p-name (match-string 1 address)
\r
961 - p-address (match-string 2 address)))
\r
963 - ;; "<user@dom.ain>" style.
\r
964 - ((string-match "<\\(.*\\)>" address)
\r
965 - (setq p-address (match-string 1 address)))
\r
967 - ;; Everything else.
\r
969 - (setq p-address address)))
\r
972 - ;; Remove elements of the mailbox part that are not relevant for
\r
973 - ;; display, even if they are required during transport:
\r
976 - (setq p-name (replace-regexp-in-string "\\\\" "" p-name))
\r
978 - ;; Outer single and double quotes, which might be nested.
\r
980 - with start-of-loop
\r
981 - do (setq start-of-loop p-name)
\r
983 - when (string-match "^\"\\(.*\\)\"$" p-name)
\r
984 - do (setq p-name (match-string 1 p-name))
\r
986 - when (string-match "^'\\(.*\\)'$" p-name)
\r
987 - do (setq p-name (match-string 1 p-name))
\r
989 - until (string= start-of-loop p-name)))
\r
991 - ;; If the address is 'foo@bar.com <foo@bar.com>' then show just
\r
992 - ;; 'foo@bar.com'.
\r
993 - (when (string= p-name p-address)
\r
994 - (setq p-name nil))
\r
996 - (cons p-address p-name))
\r
997 - (error (cons address nil))))
\r
999 -(defun notmuch-show-clean-address (address)
\r
1000 - "Try to clean a single email ADDRESS for display. Return
\r
1001 -unchanged ADDRESS if parsing fails."
\r
1002 - (let* ((clean-address (notmuch-clean-address address))
\r
1003 - (p-address (car clean-address))
\r
1004 - (p-name (cdr clean-address)))
\r
1005 - ;; If no name, return just the address.
\r
1006 - (if (not p-name)
\r
1008 - ;; Otherwise format the name and address together.
\r
1009 - (concat p-name " <" p-address ">"))))
\r
1011 -(defun notmuch-show-insert-headerline (headers date tags depth)
\r
1012 - "Insert a notmuch style headerline based on HEADERS for a
\r
1013 -message at DEPTH in the current thread."
\r
1014 - (let ((start (point)))
\r
1015 - (insert (notmuch-show-spaces-n (* notmuch-show-indent-messages-width depth))
\r
1016 - (notmuch-show-clean-address (plist-get headers :From))
\r
1020 - (notmuch-tag-format-tags tags)
\r
1022 - (overlay-put (make-overlay start (point)) 'face 'notmuch-message-summary-face)))
\r
1024 -(defun notmuch-show-insert-header (header header-value)
\r
1025 - "Insert a single header."
\r
1026 - (insert header ": " header-value "\n"))
\r
1028 -(defun notmuch-show-insert-headers (headers)
\r
1029 - "Insert the headers of the current message."
\r
1030 - (let ((start (point)))
\r
1031 - (mapc (lambda (header)
\r
1032 - (let* ((header-symbol (intern (concat ":" header)))
\r
1033 - (header-value (plist-get headers header-symbol)))
\r
1034 - (if (and header-value
\r
1035 - (not (string-equal "" header-value)))
\r
1036 - (notmuch-show-insert-header header header-value))))
\r
1037 - notmuch-message-headers)
\r
1039 - (save-restriction
\r
1040 - (narrow-to-region start (point-max))
\r
1041 - (run-hooks 'notmuch-show-markup-headers-hook)))))
\r
1043 (define-button-type 'notmuch-show-part-button-type
\r
1044 'action 'notmuch-show-part-button-default
\r
1045 'keymap 'notmuch-show-part-button-map
\r
1046 @@ -483,26 +277,6 @@ message at DEPTH in the current thread."
\r
1047 "Submap for button commands")
\r
1048 (fset 'notmuch-show-part-button-map notmuch-show-part-button-map)
\r
1050 -(defun notmuch-show-insert-part-header (nth content-type declared-type &optional name comment)
\r
1052 - (base-label (concat (when name (concat name ": "))
\r
1054 - (unless (string-equal declared-type content-type)
\r
1055 - (concat " (as " content-type ")"))
\r
1060 - (concat "[ " base-label " ]")
\r
1061 - :base-label base-label
\r
1062 - :type 'notmuch-show-part-button-type
\r
1063 - :notmuch-part nth
\r
1064 - :notmuch-filename name
\r
1065 - :notmuch-content-type content-type))
\r
1067 - ;; return button
\r
1070 ;; Functions handling particular MIME parts.
\r
1072 (defmacro notmuch-with-temp-part-buffer (message-id nth &rest body)
\r
1073 @@ -550,447 +324,9 @@ message at DEPTH in the current thread."
\r
1074 (let ((handle (mm-make-handle (current-buffer) (list content-type))))
\r
1075 (mm-pipe-part handle))))
\r
1077 -;; This is taken from notmuch-wash: maybe it should be unified?
\r
1078 -(defun notmuch-show-toggle-part-invisibility (&optional button)
\r
1080 - (let* ((button (or button (button-at (point))))
\r
1081 - (overlay (button-get button 'overlay)))
\r
1083 - (let* ((show (overlay-get overlay 'invisible))
\r
1084 - (new-start (button-start button))
\r
1085 - (button-label (button-get button :base-label))
\r
1086 - (old-point (point))
\r
1087 - (inhibit-read-only t))
\r
1088 - (overlay-put overlay 'invisible (not show))
\r
1089 - (goto-char new-start)
\r
1090 - (insert "[ " button-label (if show " ]" " (hidden) ]"))
\r
1091 - (let ((old-end (button-end button)))
\r
1092 - (move-overlay button new-start (point))
\r
1093 - (delete-region (point) old-end))
\r
1094 - (goto-char (min old-point (1- (button-end button))))))))
\r
1096 -(defun notmuch-show-multipart/*-to-list (part)
\r
1097 - (mapcar (lambda (inner-part) (plist-get inner-part :content-type))
\r
1098 - (plist-get part :content)))
\r
1100 -(defun notmuch-show-insert-part-multipart/alternative (msg part content-type nth depth declared-type)
\r
1101 - (notmuch-show-insert-part-header nth declared-type content-type nil)
\r
1102 - (let ((chosen-type (car (notmuch-multipart/alternative-choose (notmuch-show-multipart/*-to-list part))))
\r
1103 - (inner-parts (plist-get part :content))
\r
1104 - (start (point)))
\r
1105 - ;; This inserts all parts of the chosen type rather than just one,
\r
1106 - ;; but it's not clear that this is the wrong thing to do - which
\r
1107 - ;; should be chosen if there are more than one that match?
\r
1108 - (mapc (lambda (inner-part)
\r
1109 - (let* ((inner-type (plist-get inner-part :content-type))
\r
1110 - (hide (not (or notmuch-show-all-multipart/alternative-parts
\r
1111 - (string= chosen-type inner-type)))))
\r
1112 - (notmuch-show-insert-bodypart msg inner-part depth hide)))
\r
1115 - (when notmuch-show-indent-multipart
\r
1116 - (indent-rigidly start (point) 1)))
\r
1119 -(defun notmuch-show-setup-w3m ()
\r
1120 - "Instruct w3m how to retrieve content from a \"related\" part of a message."
\r
1122 - (if (boundp 'w3m-cid-retrieve-function-alist)
\r
1123 - (unless (assq 'notmuch-show-mode w3m-cid-retrieve-function-alist)
\r
1124 - (push (cons 'notmuch-show-mode 'notmuch-show-w3m-cid-retrieve)
\r
1125 - w3m-cid-retrieve-function-alist)))
\r
1126 - (setq mm-inline-text-html-with-images t))
\r
1128 -(defvar w3m-current-buffer) ;; From `w3m.el'.
\r
1129 -(defvar notmuch-show-w3m-cid-store nil)
\r
1130 -(make-variable-buffer-local 'notmuch-show-w3m-cid-store)
\r
1132 -(defun notmuch-show-w3m-cid-store-internal (content-id
\r
1137 - (push (list content-id
\r
1142 - notmuch-show-w3m-cid-store))
\r
1144 -(defun notmuch-show-w3m-cid-store (msg part)
\r
1145 - (let ((content-id (plist-get part :content-id)))
\r
1146 - (when content-id
\r
1147 - (notmuch-show-w3m-cid-store-internal (concat "cid:" content-id)
\r
1148 - (plist-get msg :id)
\r
1149 - (plist-get part :id)
\r
1150 - (plist-get part :content-type)
\r
1153 -(defun notmuch-show-w3m-cid-retrieve (url &rest args)
\r
1154 - (let ((matching-part (with-current-buffer w3m-current-buffer
\r
1155 - (assoc url notmuch-show-w3m-cid-store))))
\r
1156 - (if matching-part
\r
1157 - (let ((message-id (nth 1 matching-part))
\r
1158 - (part-number (nth 2 matching-part))
\r
1159 - (content-type (nth 3 matching-part))
\r
1160 - (content (nth 4 matching-part)))
\r
1161 - ;; If we don't already have the content, get it and cache
\r
1162 - ;; it, as some messages reference the same cid: part many
\r
1163 - ;; times (hundreds!), which results in many calls to
\r
1164 - ;; `notmuch part'.
\r
1166 - (setq content (notmuch-get-bodypart-internal (notmuch-id-to-query message-id)
\r
1167 - part-number notmuch-show-process-crypto))
\r
1168 - (with-current-buffer w3m-current-buffer
\r
1169 - (notmuch-show-w3m-cid-store-internal url
\r
1174 - (insert content)
\r
1178 -(defun notmuch-show-insert-part-multipart/related (msg part content-type nth depth declared-type)
\r
1179 - (notmuch-show-insert-part-header nth declared-type content-type nil)
\r
1180 - (let ((inner-parts (plist-get part :content))
\r
1181 - (start (point)))
\r
1183 - ;; We assume that the first part is text/html and the remainder
\r
1184 - ;; things that it references.
\r
1186 - ;; Stash the non-primary parts.
\r
1187 - (mapc (lambda (part)
\r
1188 - (notmuch-show-w3m-cid-store msg part))
\r
1189 - (cdr inner-parts))
\r
1191 - ;; Render the primary part.
\r
1192 - (notmuch-show-insert-bodypart msg (car inner-parts) depth)
\r
1194 - (when notmuch-show-indent-multipart
\r
1195 - (indent-rigidly start (point) 1)))
\r
1198 -(defun notmuch-show-insert-part-multipart/signed (msg part content-type nth depth declared-type)
\r
1199 - (let ((button (notmuch-show-insert-part-header nth declared-type content-type nil)))
\r
1200 - (button-put button 'face 'notmuch-crypto-part-header)
\r
1201 - ;; add signature status button if sigstatus provided
\r
1202 - (if (plist-member part :sigstatus)
\r
1203 - (let* ((from (notmuch-show-get-header :From msg))
\r
1204 - (sigstatus (car (plist-get part :sigstatus))))
\r
1205 - (notmuch-crypto-insert-sigstatus-button sigstatus from))
\r
1206 - ;; if we're not adding sigstatus, tell the user how they can get it
\r
1207 - (button-put button 'help-echo "Set notmuch-crypto-process-mime to process cryptographic MIME parts.")))
\r
1209 - (let ((inner-parts (plist-get part :content))
\r
1210 - (start (point)))
\r
1211 - ;; Show all of the parts.
\r
1212 - (mapc (lambda (inner-part)
\r
1213 - (notmuch-show-insert-bodypart msg inner-part depth))
\r
1216 - (when notmuch-show-indent-multipart
\r
1217 - (indent-rigidly start (point) 1)))
\r
1220 -(defun notmuch-show-insert-part-multipart/encrypted (msg part content-type nth depth declared-type)
\r
1221 - (let ((button (notmuch-show-insert-part-header nth declared-type content-type nil)))
\r
1222 - (button-put button 'face 'notmuch-crypto-part-header)
\r
1223 - ;; add encryption status button if encstatus specified
\r
1224 - (if (plist-member part :encstatus)
\r
1225 - (let ((encstatus (car (plist-get part :encstatus))))
\r
1226 - (notmuch-crypto-insert-encstatus-button encstatus)
\r
1227 - ;; add signature status button if sigstatus specified
\r
1228 - (if (plist-member part :sigstatus)
\r
1229 - (let* ((from (notmuch-show-get-header :From msg))
\r
1230 - (sigstatus (car (plist-get part :sigstatus))))
\r
1231 - (notmuch-crypto-insert-sigstatus-button sigstatus from))))
\r
1232 - ;; if we're not adding encstatus, tell the user how they can get it
\r
1233 - (button-put button 'help-echo "Set notmuch-crypto-process-mime to process cryptographic MIME parts.")))
\r
1235 - (let ((inner-parts (plist-get part :content))
\r
1236 - (start (point)))
\r
1237 - ;; Show all of the parts.
\r
1238 - (mapc (lambda (inner-part)
\r
1239 - (notmuch-show-insert-bodypart msg inner-part depth))
\r
1242 - (when notmuch-show-indent-multipart
\r
1243 - (indent-rigidly start (point) 1)))
\r
1246 -(defun notmuch-show-insert-part-multipart/* (msg part content-type nth depth declared-type)
\r
1247 - (notmuch-show-insert-part-header nth declared-type content-type nil)
\r
1248 - (let ((inner-parts (plist-get part :content))
\r
1249 - (start (point)))
\r
1250 - ;; Show all of the parts.
\r
1251 - (mapc (lambda (inner-part)
\r
1252 - (notmuch-show-insert-bodypart msg inner-part depth))
\r
1255 - (when notmuch-show-indent-multipart
\r
1256 - (indent-rigidly start (point) 1)))
\r
1259 -(defun notmuch-show-insert-part-message/rfc822 (msg part content-type nth depth declared-type)
\r
1260 - (notmuch-show-insert-part-header nth declared-type content-type nil)
\r
1261 - (let* ((message (car (plist-get part :content)))
\r
1262 - (body (car (plist-get message :body)))
\r
1263 - (start (point)))
\r
1265 - ;; Override `notmuch-message-headers' to force `From' to be
\r
1267 - (let ((notmuch-message-headers '("From" "Subject" "To" "Cc" "Date")))
\r
1268 - (notmuch-show-insert-headers (plist-get message :headers)))
\r
1270 - ;; Blank line after headers to be compatible with the normal
\r
1271 - ;; message display.
\r
1274 - ;; Show the body
\r
1275 - (notmuch-show-insert-bodypart msg body depth)
\r
1277 - (when notmuch-show-indent-multipart
\r
1278 - (indent-rigidly start (point) 1)))
\r
1281 -(defun notmuch-show-insert-part-text/plain (msg part content-type nth depth declared-type)
\r
1282 - (let ((start (point)))
\r
1283 - ;; If this text/plain part is not the first part in the message,
\r
1284 - ;; insert a header to make this clear.
\r
1286 - (notmuch-show-insert-part-header nth declared-type content-type (plist-get part :filename)))
\r
1287 - (insert (notmuch-get-bodypart-content msg part nth notmuch-show-process-crypto))
\r
1289 - (save-restriction
\r
1290 - (narrow-to-region start (point-max))
\r
1291 - (run-hook-with-args 'notmuch-show-insert-text/plain-hook msg depth))))
\r
1294 -(defun notmuch-show-insert-part-text/calendar (msg part content-type nth depth declared-type)
\r
1295 - (notmuch-show-insert-part-header nth declared-type content-type (plist-get part :filename))
\r
1296 - (insert (with-temp-buffer
\r
1297 - (insert (notmuch-get-bodypart-content msg part nth notmuch-show-process-crypto))
\r
1298 - ;; notmuch-get-bodypart-content provides "raw", non-converted
\r
1299 - ;; data. Replace CRLF with LF before icalendar can use it.
\r
1300 - (goto-char (point-min))
\r
1301 - (while (re-search-forward "\r\n" nil t)
\r
1302 - (replace-match "\n" nil nil))
\r
1303 - (let ((file (make-temp-file "notmuch-ical"))
\r
1307 - (unless (icalendar-import-buffer file t)
\r
1308 - (error "Icalendar import error. See *icalendar-errors* for more information"))
\r
1309 - (set-buffer (get-file-buffer file))
\r
1310 - (setq result (buffer-substring (point-min) (point-max)))
\r
1311 - (set-buffer-modified-p nil)
\r
1312 - (kill-buffer (current-buffer)))
\r
1313 - (delete-file file))
\r
1317 -;; For backwards compatibility.
\r
1318 -(defun notmuch-show-insert-part-text/x-vcalendar (msg part content-type nth depth declared-type)
\r
1319 - (notmuch-show-insert-part-text/calendar msg part content-type nth depth declared-type))
\r
1321 -(defun notmuch-show-get-mime-type-of-application/octet-stream (part)
\r
1322 - ;; If we can deduce a MIME type from the filename of the attachment,
\r
1323 - ;; we return that.
\r
1324 - (if (plist-get part :filename)
\r
1325 - (let ((extension (file-name-extension (plist-get part :filename)))
\r
1329 - (mailcap-parse-mimetypes)
\r
1330 - (setq mime-type (mailcap-extension-to-mime extension))
\r
1331 - (if (and mime-type
\r
1332 - (not (string-equal mime-type "application/octet-stream")))
\r
1337 -;; Handler for wash generated inline patch fake parts.
\r
1338 -(defun notmuch-show-insert-part-inline-patch-fake-part (msg part content-type nth depth declared-type)
\r
1339 - (notmuch-show-insert-part-*/* msg part content-type nth depth declared-type))
\r
1341 -(defun notmuch-show-insert-part-text/html (msg part content-type nth depth declared-type)
\r
1342 - ;; text/html handler to work around bugs in renderers and our
\r
1343 - ;; invisibile parts code. In particular w3m sets up a keymap which
\r
1344 - ;; "leaks" outside the invisible region and causes strange effects
\r
1345 - ;; in notmuch. We set mm-inline-text-html-with-w3m-keymap to nil to
\r
1346 - ;; tell w3m not to set a keymap (so the normal notmuch-show-mode-map
\r
1348 - (let ((mm-inline-text-html-with-w3m-keymap nil))
\r
1349 - (notmuch-show-insert-part-*/* msg part content-type nth depth declared-type)))
\r
1351 -(defun notmuch-show-insert-part-*/* (msg part content-type nth depth declared-type)
\r
1352 - ;; This handler _must_ succeed - it is the handler of last resort.
\r
1353 - (notmuch-show-insert-part-header nth content-type declared-type (plist-get part :filename))
\r
1354 - (notmuch-mm-display-part-inline msg part nth content-type notmuch-show-process-crypto)
\r
1357 -;; Functions for determining how to handle MIME parts.
\r
1359 -(defun notmuch-show-handlers-for (content-type)
\r
1360 - "Return a list of content handlers for a part of type CONTENT-TYPE."
\r
1362 - (mapc (lambda (func)
\r
1363 - (if (functionp func)
\r
1364 - (push func result)))
\r
1365 - ;; Reverse order of prefrence.
\r
1366 - (list (intern (concat "notmuch-show-insert-part-*/*"))
\r
1368 - "notmuch-show-insert-part-"
\r
1369 - (car (notmuch-split-content-type content-type))
\r
1371 - (intern (concat "notmuch-show-insert-part-" content-type))))
\r
1377 -(defun notmuch-show-insert-bodypart-internal (msg part content-type nth depth declared-type)
\r
1378 - (let ((handlers (notmuch-show-handlers-for content-type)))
\r
1379 - ;; Run the content handlers until one of them returns a non-nil
\r
1381 - (while (and handlers
\r
1382 - (not (condition-case err
\r
1383 - (funcall (car handlers) msg part content-type nth depth declared-type)
\r
1385 - (insert "!!! Bodypart insert error: ")
\r
1386 - (insert (error-message-string err))
\r
1387 - (insert " !!!\n") nil)))))
\r
1388 - (setq handlers (cdr handlers))))
\r
1391 -(defun notmuch-show-create-part-overlays (msg beg end hide)
\r
1392 - "Add an overlay to the part between BEG and END"
\r
1393 - (let* ((button (button-at beg))
\r
1394 - (part-beg (and button (1+ (button-end button)))))
\r
1396 - ;; If the part contains no text we do not make it toggleable. We
\r
1397 - ;; also need to check that the button is a genuine part button not
\r
1398 - ;; a notmuch-wash button.
\r
1399 - (when (and button (/= part-beg end) (button-get button :base-label))
\r
1400 - (button-put button 'overlay (make-overlay part-beg end))
\r
1401 - ;; We toggle the button for hidden parts as that gets the
\r
1402 - ;; button label right.
\r
1405 - (notmuch-show-toggle-part-invisibility button))))))
\r
1407 -(defun notmuch-show-insert-bodypart (msg part depth &optional hide)
\r
1408 - "Insert the body part PART at depth DEPTH in the current thread.
\r
1410 -If HIDE is non-nil then initially hide this part."
\r
1411 - (let* ((content-type (downcase (plist-get part :content-type)))
\r
1412 - (mime-type (or (and (string= content-type "application/octet-stream")
\r
1413 - (notmuch-show-get-mime-type-of-application/octet-stream part))
\r
1414 - (and (string= content-type "inline patch")
\r
1417 - (nth (plist-get part :id))
\r
1420 - (notmuch-show-insert-bodypart-internal msg part mime-type nth depth content-type)
\r
1421 - ;; Some of the body part handlers leave point somewhere up in the
\r
1422 - ;; part, so we make sure that we're down at the end.
\r
1423 - (goto-char (point-max))
\r
1424 - ;; Ensure that the part ends with a carriage return.
\r
1427 - (notmuch-show-create-part-overlays msg beg (point) hide)))
\r
1429 -(defun notmuch-show-insert-body (msg body depth)
\r
1430 - "Insert the body BODY at depth DEPTH in the current thread."
\r
1431 - (mapc (lambda (part) (notmuch-show-insert-bodypart msg part depth)) body))
\r
1433 (defun notmuch-show-make-symbol (type)
\r
1434 (make-symbol (concat "notmuch-show-" type)))
\r
1436 -(defun notmuch-show-strip-re (string)
\r
1437 - (replace-regexp-in-string "^\\([Rr]e: *\\)+" "" string))
\r
1439 -(defvar notmuch-show-previous-subject "")
\r
1440 -(make-variable-buffer-local 'notmuch-show-previous-subject)
\r
1442 -(defun notmuch-show-insert-msg (msg depth)
\r
1443 - "Insert the message MSG at depth DEPTH in the current thread."
\r
1444 - (let* ((headers (plist-get msg :headers))
\r
1445 - ;; Indentation causes the buffer offset of the start/end
\r
1446 - ;; points to move, so we must use markers.
\r
1447 - message-start message-end
\r
1448 - content-start content-end
\r
1449 - headers-start headers-end
\r
1450 - (bare-subject (notmuch-show-strip-re (plist-get headers :Subject))))
\r
1452 - (setq message-start (point-marker))
\r
1454 - (notmuch-show-insert-headerline headers
\r
1455 - (or (if notmuch-show-relative-dates
\r
1456 - (plist-get msg :date_relative)
\r
1458 - (plist-get headers :Date))
\r
1459 - (plist-get msg :tags) depth)
\r
1461 - (setq content-start (point-marker))
\r
1463 - ;; Set `headers-start' to point after the 'Subject:' header to be
\r
1464 - ;; compatible with the existing implementation. This just sets it
\r
1465 - ;; to after the first header.
\r
1466 - (notmuch-show-insert-headers headers)
\r
1468 - (goto-char content-start)
\r
1469 - ;; If the subject of this message is the same as that of the
\r
1470 - ;; previous message, don't display it when this message is
\r
1472 - (when (not (string= notmuch-show-previous-subject
\r
1474 - (forward-line 1))
\r
1475 - (setq headers-start (point-marker)))
\r
1476 - (setq headers-end (point-marker))
\r
1478 - (setq notmuch-show-previous-subject bare-subject)
\r
1480 - ;; A blank line between the headers and the body.
\r
1482 - (notmuch-show-insert-body msg (plist-get msg :body)
\r
1483 - (if notmuch-show-indent-content depth 0))
\r
1484 - ;; Ensure that the body ends with a newline.
\r
1487 - (setq content-end (point-marker))
\r
1489 - ;; Indent according to the depth in the thread.
\r
1490 - (if notmuch-show-indent-content
\r
1491 - (indent-rigidly content-start content-end (* notmuch-show-indent-messages-width depth)))
\r
1493 - (setq message-end (point-max-marker))
\r
1495 - ;; Save the extents of this message over the whole text of the
\r
1497 - (put-text-property message-start message-end :notmuch-message-extent (cons message-start message-end))
\r
1499 - ;; Create overlays used to control visibility
\r
1500 - (plist-put msg :headers-overlay (make-overlay headers-start headers-end))
\r
1501 - (plist-put msg :message-overlay (make-overlay headers-start content-end))
\r
1503 - (plist-put msg :depth depth)
\r
1505 - ;; Save the properties for this message. Currently this saves the
\r
1506 - ;; entire message (augmented it with other stuff), which seems
\r
1507 - ;; like overkill. We might save a reduced subset (for example, not
\r
1508 - ;; the content).
\r
1509 - (notmuch-show-set-message-properties msg)
\r
1511 - ;; Set header visibility.
\r
1512 - (notmuch-show-headers-visible msg notmuch-message-headers-visible)
\r
1514 - ;; Message visibility depends on whether it matched the search
\r
1516 - (notmuch-show-message-visible msg (and (plist-get msg :match)
\r
1517 - (not (plist-get msg :excluded))))))
\r
1519 (defun notmuch-show-toggle-process-crypto ()
\r
1520 "Toggle the processing of cryptographic MIME parts."
\r
1522 @@ -1018,23 +354,6 @@ If HIDE is non-nil then initially hide this part."
\r
1523 "Content is not indented."))
\r
1524 (notmuch-show-refresh-view))
\r
1526 -(defun notmuch-show-insert-tree (tree depth)
\r
1527 - "Insert the message tree TREE at depth DEPTH in the current thread."
\r
1528 - (let ((msg (car tree))
\r
1529 - (replies (cadr tree)))
\r
1530 - ;; We test whether there is a message or just some replies.
\r
1532 - (notmuch-show-insert-msg msg depth))
\r
1533 - (notmuch-show-insert-thread replies (1+ depth))))
\r
1535 -(defun notmuch-show-insert-thread (thread depth)
\r
1536 - "Insert the thread THREAD at depth DEPTH in the current forest."
\r
1537 - (mapc (lambda (tree) (notmuch-show-insert-tree tree depth)) thread))
\r
1539 -(defun notmuch-show-insert-forest (forest)
\r
1540 - "Insert the forest of threads FOREST."
\r
1541 - (mapc (lambda (thread) (notmuch-show-insert-thread thread 0)) forest))
\r
1543 (defvar notmuch-id-regexp
\r
1545 ;; Match the id: prefix only if it begins a word (to disallow, for
\r
1546 @@ -1373,17 +692,6 @@ effects."
\r
1547 (loop do (funcall function)
\r
1548 while (notmuch-show-goto-message-next))))
\r
1550 -;; Functions relating to the visibility of messages and their
\r
1553 -(defun notmuch-show-message-visible (props visible-p)
\r
1554 - (overlay-put (plist-get props :message-overlay) 'invisible (not visible-p))
\r
1555 - (notmuch-show-set-prop :message-visible visible-p props))
\r
1557 -(defun notmuch-show-headers-visible (props visible-p)
\r
1558 - (overlay-put (plist-get props :headers-overlay) 'invisible (not visible-p))
\r
1559 - (notmuch-show-set-prop :headers-visible visible-p props))
\r
1561 ;; Functions for setting and getting attributes of the current
\r
projects / notmuch-archives.git / blob