From: Mark Walters Date: Wed, 5 Jun 2013 16:23:46 +0000 (+0100) Subject: [PATCH 2/2] insert forest moved X-Git-Url: http://git.tremily.us/?a=commitdiff_plain;h=89b546134d4eaebbf49f2f59b2b226f575d17bcb;p=notmuch-archives.git [PATCH 2/2] insert forest moved --- diff --git a/38/66dd400ada0f8da57d25cc55604328e1bd1f1f b/38/66dd400ada0f8da57d25cc55604328e1bd1f1f new file mode 100644 index 000000000..e724ffe39 --- /dev/null +++ b/38/66dd400ada0f8da57d25cc55604328e1bd1f1f @@ -0,0 +1,1566 @@ +Return-Path: +X-Original-To: notmuch@notmuchmail.org +Delivered-To: notmuch@notmuchmail.org +Received: from localhost (localhost [127.0.0.1]) + by olra.theworths.org (Postfix) with ESMTP id 0B1CB431FD8 + for ; Wed, 5 Jun 2013 09:24:13 -0700 (PDT) +X-Virus-Scanned: Debian amavisd-new at olra.theworths.org +X-Spam-Flag: NO +X-Spam-Score: 0.224 +X-Spam-Level: +X-Spam-Status: No, score=0.224 tagged_above=-999 required=5 + tests=[DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, + FREEMAIL_ENVFROM_END_DIGIT=1, FREEMAIL_FROM=0.001, + HS_INDEX_PARAM=0.023, RCVD_IN_DNSWL_LOW=-0.7] autolearn=disabled +Received: from olra.theworths.org ([127.0.0.1]) + by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024) + with ESMTP id xujJgItUg2nQ for ; + Wed, 5 Jun 2013 09:24:00 -0700 (PDT) +Received: from mail-wi0-f175.google.com (mail-wi0-f175.google.com + [209.85.212.175]) (using TLSv1 with cipher RC4-SHA (128/128 bits)) + (No client certificate requested) + by olra.theworths.org (Postfix) with ESMTPS id 51A04431FB6 + for ; Wed, 5 Jun 2013 09:23:57 -0700 (PDT) +Received: by mail-wi0-f175.google.com with SMTP id hn14so4994170wib.8 + for ; Wed, 05 Jun 2013 09:23:56 -0700 (PDT) +DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; + h=from:to:cc:subject:date:message-id:x-mailer:in-reply-to:references; + bh=hKWwxBUR1hAlUagUlVrOWYvy1g8/CJe4Q7fzDgvJOS0=; + b=bekF8Pc2Ud/R5lvIhohatvlrgLbwS7yzmMjDt51rUaAsvtu2ZNmqcqvak45dESdJji + VcRQ3TNKGy9FltXkOjN4ebvG+7vl9Fvs6zyQmzIFVuo2UykuXtF4vhlqTEM0HvXQEDvG + dVfqezByfjdApWAwfL8z0gol5esui1m1+26J338hecmrtQb8eNXdKvyixVNHtqYFgcPO + 15lTtB6QZCmbbCeCNXSyDLKPr1eS0B8hStohYyvWLN4+n4bn+YAu65bFjAPU0+RY55ir + jaWb79/KN/6/LGWuujBQ1zZ6HD9dFZzhO4tkrIHxxtJBFP/Y14nwBiwfk5G7br/xC4fr + u1qA== +X-Received: by 10.180.184.101 with SMTP id et5mr7366942wic.45.1370449436197; + Wed, 05 Jun 2013 09:23:56 -0700 (PDT) +Received: from localhost (93-97-24-31.zone5.bethere.co.uk. [93.97.24.31]) + by mx.google.com with ESMTPSA id + fu14sm11487953wic.0.2013.06.05.09.23.54 for + (version=TLSv1.2 cipher=RC4-SHA bits=128/128); + Wed, 05 Jun 2013 09:23:55 -0700 (PDT) +From: Mark Walters +To: notmuch@notmuchmail.org +Subject: [PATCH 2/2] insert forest moved +Date: Wed, 5 Jun 2013 17:23:46 +0100 +Message-Id: <1370449426-2325-3-git-send-email-markwalters1009@gmail.com> +X-Mailer: git-send-email 1.7.9.1 +In-Reply-To: <1370449426-2325-1-git-send-email-markwalters1009@gmail.com> +References: <1370449426-2325-1-git-send-email-markwalters1009@gmail.com> +X-BeenThere: notmuch@notmuchmail.org +X-Mailman-Version: 2.1.13 +Precedence: list +List-Id: "Use and development of the notmuch mail system." + +List-Unsubscribe: , + +List-Archive: +List-Post: +List-Help: +List-Subscribe: , + +X-List-Received-Date: Wed, 05 Jun 2013 16:24:13 -0000 + +--- + emacs/notmuch-show-display.el | 704 ++++++++++++++++++++++++++++++++++++++++- + emacs/notmuch-show.el | 692 ---------------------------------------- + 2 files changed, 703 insertions(+), 693 deletions(-) + +diff --git a/emacs/notmuch-show-display.el b/emacs/notmuch-show-display.el +index 50d83ad..82678c2 100644 +--- a/emacs/notmuch-show-display.el ++++ b/emacs/notmuch-show-display.el +@@ -21,5 +21,707 @@ + ;; Authors: Carl Worth + ;; David Edmondson + ++(require 'mm-view) ++(require 'message) ++(require 'mm-decode) ++(require 'mailcap) + +-(provide 'notmuch-show-display) +\ No newline at end of file ++(require 'notmuch-lib) ++(require 'notmuch-tag) ++(require 'notmuch-wash) ++(require 'notmuch-crypto) ++ ++(declare-function notmuch-show-get-header "notmuch-show" (header &optional props)) ++(declare-function notmuch-show-set-message-properties "notmuch-show" (props)) ++(declare-function notmuch-show-set-prop "notmuch-show" (prop val &optional props)) ++ ++(defcustom notmuch-message-headers '("Subject" "To" "Cc" "Date") ++ "Headers that should be shown in a message, in this order. ++ ++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-visibility-headers'. For a closed message, ++only the first header in the list will be visible." ++ :type '(repeat string) ++ :group 'notmuch-show) ++ ++(defcustom notmuch-message-headers-visible t ++ "Should the headers be visible by default? ++ ++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-visibility-headers' can be used to make them ++visible for any given message." ++ :type 'boolean ++ :group 'notmuch-show) ++ ++(defcustom notmuch-show-relative-dates t ++ "Display relative dates in the message summary line." ++ :type 'boolean ++ :group 'notmuch-show) ++ ++(defvar notmuch-show-markup-headers-hook '(notmuch-show-colour-headers) ++ "A list of functions called to decorate the headers listed in ++`notmuch-message-headers'.") ++ ++(defcustom notmuch-show-insert-text/plain-hook '(notmuch-wash-wrap-long-lines ++ notmuch-wash-tidy-citations ++ notmuch-wash-elide-blank-lines ++ notmuch-wash-excerpt-citations) ++ "Functions used to improve the display of text/plain parts." ++ :type 'hook ++ :options '(notmuch-wash-convert-inline-patch-to-part ++ notmuch-wash-wrap-long-lines ++ notmuch-wash-tidy-citations ++ notmuch-wash-elide-blank-lines ++ notmuch-wash-excerpt-citations) ++ :group 'notmuch-show ++ :group 'notmuch-hooks) ++ ++;; Mostly useful for debugging. ++(defcustom notmuch-show-all-multipart/alternative-parts nil ++ "Should all parts of multipart/alternative parts be shown?" ++ :type 'boolean ++ :group 'notmuch-show) ++ ++(defcustom notmuch-show-indent-messages-width 1 ++ "Width of message indentation in threads. ++ ++Messages are shown indented according to their depth in a thread. ++This variable determines the width of this indentation measured ++in number of blanks. Defaults to `1', choose `0' to disable ++indentation." ++ :type 'integer ++ :group 'notmuch-show) ++ ++(defcustom notmuch-show-indent-multipart nil ++ "Should the sub-parts of a multipart/* part be indented?" ++ ;; dme: Not sure which is a good default. ++ :type 'boolean ++ :group 'notmuch-show) ++ ++(defvar notmuch-show-process-crypto nil) ++(make-variable-buffer-local 'notmuch-show-process-crypto) ++(put 'notmuch-show-process-crypto 'permanent-local t) ++ ++(defvar notmuch-show-indent-content t) ++(make-variable-buffer-local 'notmuch-show-indent-content) ++(put 'notmuch-show-indent-content 'permanent-local t) ++ ++(defun notmuch-show-fontify-header () ++ (let ((face (cond ++ ((looking-at "[Tt]o:") ++ 'message-header-to) ++ ((looking-at "[Bb]?[Cc][Cc]:") ++ 'message-header-cc) ++ ((looking-at "[Ss]ubject:") ++ 'message-header-subject) ++ ((looking-at "[Ff]rom:") ++ 'message-header-from) ++ (t ++ 'message-header-other)))) ++ ++ (overlay-put (make-overlay (point) (re-search-forward ":")) ++ 'face 'message-header-name) ++ (overlay-put (make-overlay (point) (re-search-forward ".*$")) ++ 'face face))) ++ ++(defun notmuch-show-colour-headers () ++ "Apply some colouring to the current headers." ++ (goto-char (point-min)) ++ (while (looking-at "^[A-Za-z][-A-Za-z0-9]*:") ++ (notmuch-show-fontify-header) ++ (forward-line))) ++ ++(defun notmuch-show-spaces-n (n) ++ "Return a string comprised of `n' spaces." ++ (make-string n ? )) ++ ++(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', ++ ;; but that expects un-decoded mailbox parts, whereas our ++ ;; mailbox parts are already decoded (and hence may contain ++ ;; UTF-8). Given that notmuch should handle most of the awkward ++ ;; cases, some simple string deconstruction should be sufficient ++ ;; here. ++ (cond ++ ;; "User " style. ++ ((string-match "\\(.*\\) <\\(.*\\)>" address) ++ (setq p-name (match-string 1 address) ++ p-address (match-string 2 address))) ++ ++ ;; "" style. ++ ((string-match "<\\(.*\\)>" address) ++ (setq p-address (match-string 1 address))) ++ ++ ;; Everything else. ++ (t ++ (setq p-address address))) ++ ++ (when p-name ++ ;; Remove elements of the mailbox part that are not relevant for ++ ;; display, even if they are required during transport: ++ ;; ++ ;; Backslashes. ++ (setq p-name (replace-regexp-in-string "\\\\" "" p-name)) ++ ++ ;; Outer single and double quotes, which might be nested. ++ (loop ++ with start-of-loop ++ do (setq start-of-loop p-name) ++ ++ when (string-match "^\"\\(.*\\)\"$" p-name) ++ do (setq p-name (match-string 1 p-name)) ++ ++ when (string-match "^'\\(.*\\)'$" p-name) ++ do (setq p-name (match-string 1 p-name)) ++ ++ until (string= start-of-loop p-name))) ++ ++ ;; If the address is 'foo@bar.com ' then show just ++ ;; 'foo@bar.com'. ++ (when (string= p-name p-address) ++ (setq p-name nil)) ++ ++ (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 ++message at DEPTH in the current thread." ++ (let ((start (point))) ++ (insert (notmuch-show-spaces-n (* notmuch-show-indent-messages-width depth)) ++ (notmuch-show-clean-address (plist-get headers :From)) ++ " (" ++ date ++ ") (" ++ (notmuch-tag-format-tags tags) ++ ")\n") ++ (overlay-put (make-overlay start (point)) 'face 'notmuch-message-summary-face))) ++ ++(defun notmuch-show-insert-header (header header-value) ++ "Insert a single header." ++ (insert header ": " header-value "\n")) ++ ++(defun notmuch-show-insert-headers (headers) ++ "Insert the headers of the current message." ++ (let ((start (point))) ++ (mapc (lambda (header) ++ (let* ((header-symbol (intern (concat ":" header))) ++ (header-value (plist-get headers header-symbol))) ++ (if (and header-value ++ (not (string-equal "" header-value))) ++ (notmuch-show-insert-header header header-value)))) ++ notmuch-message-headers) ++ (save-excursion ++ (save-restriction ++ (narrow-to-region start (point-max)) ++ (run-hooks 'notmuch-show-markup-headers-hook))))) ++ ++(defun notmuch-show-insert-part-header (nth content-type declared-type &optional name comment) ++ (let ((button) ++ (base-label (concat (when name (concat name ": ")) ++ declared-type ++ (unless (string-equal declared-type content-type) ++ (concat " (as " content-type ")")) ++ comment))) ++ ++ (setq button ++ (insert-button ++ (concat "[ " base-label " ]") ++ :base-label base-label ++ :type 'notmuch-show-part-button-type ++ :notmuch-part nth ++ :notmuch-filename name ++ :notmuch-content-type content-type)) ++ (insert "\n") ++ ;; return button ++ button)) ++ ++;; This is taken from notmuch-wash: maybe it should be unified? ++(defun notmuch-show-toggle-part-invisibility (&optional button) ++ (interactive) ++ (let* ((button (or button (button-at (point)))) ++ (overlay (button-get button 'overlay))) ++ (when overlay ++ (let* ((show (overlay-get overlay 'invisible)) ++ (new-start (button-start button)) ++ (button-label (button-get button :base-label)) ++ (old-point (point)) ++ (inhibit-read-only t)) ++ (overlay-put overlay 'invisible (not show)) ++ (goto-char new-start) ++ (insert "[ " button-label (if show " ]" " (hidden) ]")) ++ (let ((old-end (button-end button))) ++ (move-overlay button new-start (point)) ++ (delete-region (point) old-end)) ++ (goto-char (min old-point (1- (button-end button)))))))) ++ ++(defun notmuch-show-multipart/*-to-list (part) ++ (mapcar (lambda (inner-part) (plist-get inner-part :content-type)) ++ (plist-get part :content))) ++ ++(defun notmuch-show-insert-part-multipart/alternative (msg part content-type nth depth declared-type) ++ (notmuch-show-insert-part-header nth declared-type content-type nil) ++ (let ((chosen-type (car (notmuch-multipart/alternative-choose (notmuch-show-multipart/*-to-list part)))) ++ (inner-parts (plist-get part :content)) ++ (start (point))) ++ ;; This inserts all parts of the chosen type rather than just one, ++ ;; but it's not clear that this is the wrong thing to do - which ++ ;; should be chosen if there are more than one that match? ++ (mapc (lambda (inner-part) ++ (let* ((inner-type (plist-get inner-part :content-type)) ++ (hide (not (or notmuch-show-all-multipart/alternative-parts ++ (string= chosen-type inner-type))))) ++ (notmuch-show-insert-bodypart msg inner-part depth hide))) ++ inner-parts) ++ ++ (when notmuch-show-indent-multipart ++ (indent-rigidly start (point) 1))) ++ t) ++ ++(defun notmuch-show-setup-w3m () ++ "Instruct w3m how to retrieve content from a \"related\" part of a message." ++ (interactive) ++ (if (boundp 'w3m-cid-retrieve-function-alist) ++ (unless (assq 'notmuch-show-mode w3m-cid-retrieve-function-alist) ++ (push (cons 'notmuch-show-mode 'notmuch-show-w3m-cid-retrieve) ++ w3m-cid-retrieve-function-alist))) ++ (setq mm-inline-text-html-with-images t)) ++ ++(defvar w3m-current-buffer) ;; From `w3m.el'. ++(defvar notmuch-show-w3m-cid-store nil) ++(make-variable-buffer-local 'notmuch-show-w3m-cid-store) ++ ++(defun notmuch-show-w3m-cid-store-internal (content-id ++ message-id ++ part-number ++ content-type ++ content) ++ (push (list content-id ++ message-id ++ part-number ++ content-type ++ content) ++ notmuch-show-w3m-cid-store)) ++ ++(defun notmuch-show-w3m-cid-store (msg part) ++ (let ((content-id (plist-get part :content-id))) ++ (when content-id ++ (notmuch-show-w3m-cid-store-internal (concat "cid:" content-id) ++ (plist-get msg :id) ++ (plist-get part :id) ++ (plist-get part :content-type) ++ nil)))) ++ ++(defun notmuch-show-w3m-cid-retrieve (url &rest args) ++ (let ((matching-part (with-current-buffer w3m-current-buffer ++ (assoc url notmuch-show-w3m-cid-store)))) ++ (if matching-part ++ (let ((message-id (nth 1 matching-part)) ++ (part-number (nth 2 matching-part)) ++ (content-type (nth 3 matching-part)) ++ (content (nth 4 matching-part))) ++ ;; If we don't already have the content, get it and cache ++ ;; it, as some messages reference the same cid: part many ++ ;; times (hundreds!), which results in many calls to ++ ;; `notmuch part'. ++ (unless content ++ (setq content (notmuch-get-bodypart-internal (notmuch-id-to-query message-id) ++ part-number notmuch-show-process-crypto)) ++ (with-current-buffer w3m-current-buffer ++ (notmuch-show-w3m-cid-store-internal url ++ message-id ++ part-number ++ content-type ++ content))) ++ (insert content) ++ content-type) ++ nil))) ++ ++(defun notmuch-show-insert-part-multipart/related (msg part content-type nth depth declared-type) ++ (notmuch-show-insert-part-header nth declared-type content-type nil) ++ (let ((inner-parts (plist-get part :content)) ++ (start (point))) ++ ++ ;; We assume that the first part is text/html and the remainder ++ ;; things that it references. ++ ++ ;; Stash the non-primary parts. ++ (mapc (lambda (part) ++ (notmuch-show-w3m-cid-store msg part)) ++ (cdr inner-parts)) ++ ++ ;; Render the primary part. ++ (notmuch-show-insert-bodypart msg (car inner-parts) depth) ++ ++ (when notmuch-show-indent-multipart ++ (indent-rigidly start (point) 1))) ++ t) ++ ++(defun notmuch-show-insert-part-multipart/signed (msg part content-type nth depth declared-type) ++ (let ((button (notmuch-show-insert-part-header nth declared-type content-type nil))) ++ (button-put button 'face 'notmuch-crypto-part-header) ++ ;; add signature status button if sigstatus provided ++ (if (plist-member part :sigstatus) ++ (let* ((from (notmuch-show-get-header :From msg)) ++ (sigstatus (car (plist-get part :sigstatus)))) ++ (notmuch-crypto-insert-sigstatus-button sigstatus from)) ++ ;; if we're not adding sigstatus, tell the user how they can get it ++ (button-put button 'help-echo "Set notmuch-crypto-process-mime to process cryptographic MIME parts."))) ++ ++ (let ((inner-parts (plist-get part :content)) ++ (start (point))) ++ ;; Show all of the parts. ++ (mapc (lambda (inner-part) ++ (notmuch-show-insert-bodypart msg inner-part depth)) ++ inner-parts) ++ ++ (when notmuch-show-indent-multipart ++ (indent-rigidly start (point) 1))) ++ t) ++ ++(defun notmuch-show-insert-part-multipart/encrypted (msg part content-type nth depth declared-type) ++ (let ((button (notmuch-show-insert-part-header nth declared-type content-type nil))) ++ (button-put button 'face 'notmuch-crypto-part-header) ++ ;; add encryption status button if encstatus specified ++ (if (plist-member part :encstatus) ++ (let ((encstatus (car (plist-get part :encstatus)))) ++ (notmuch-crypto-insert-encstatus-button encstatus) ++ ;; add signature status button if sigstatus specified ++ (if (plist-member part :sigstatus) ++ (let* ((from (notmuch-show-get-header :From msg)) ++ (sigstatus (car (plist-get part :sigstatus)))) ++ (notmuch-crypto-insert-sigstatus-button sigstatus from)))) ++ ;; if we're not adding encstatus, tell the user how they can get it ++ (button-put button 'help-echo "Set notmuch-crypto-process-mime to process cryptographic MIME parts."))) ++ ++ (let ((inner-parts (plist-get part :content)) ++ (start (point))) ++ ;; Show all of the parts. ++ (mapc (lambda (inner-part) ++ (notmuch-show-insert-bodypart msg inner-part depth)) ++ inner-parts) ++ ++ (when notmuch-show-indent-multipart ++ (indent-rigidly start (point) 1))) ++ t) ++ ++(defun notmuch-show-insert-part-multipart/* (msg part content-type nth depth declared-type) ++ (notmuch-show-insert-part-header nth declared-type content-type nil) ++ (let ((inner-parts (plist-get part :content)) ++ (start (point))) ++ ;; Show all of the parts. ++ (mapc (lambda (inner-part) ++ (notmuch-show-insert-bodypart msg inner-part depth)) ++ inner-parts) ++ ++ (when notmuch-show-indent-multipart ++ (indent-rigidly start (point) 1))) ++ t) ++ ++(defun notmuch-show-insert-part-message/rfc822 (msg part content-type nth depth declared-type) ++ (notmuch-show-insert-part-header nth declared-type content-type nil) ++ (let* ((message (car (plist-get part :content))) ++ (body (car (plist-get message :body))) ++ (start (point))) ++ ++ ;; Override `notmuch-message-headers' to force `From' to be ++ ;; displayed. ++ (let ((notmuch-message-headers '("From" "Subject" "To" "Cc" "Date"))) ++ (notmuch-show-insert-headers (plist-get message :headers))) ++ ++ ;; Blank line after headers to be compatible with the normal ++ ;; message display. ++ (insert "\n") ++ ++ ;; Show the body ++ (notmuch-show-insert-bodypart msg body depth) ++ ++ (when notmuch-show-indent-multipart ++ (indent-rigidly start (point) 1))) ++ t) ++ ++(defun notmuch-show-insert-part-text/plain (msg part content-type nth depth declared-type) ++ (let ((start (point))) ++ ;; If this text/plain part is not the first part in the message, ++ ;; insert a header to make this clear. ++ (if (> nth 1) ++ (notmuch-show-insert-part-header nth declared-type content-type (plist-get part :filename))) ++ (insert (notmuch-get-bodypart-content msg part nth notmuch-show-process-crypto)) ++ (save-excursion ++ (save-restriction ++ (narrow-to-region start (point-max)) ++ (run-hook-with-args 'notmuch-show-insert-text/plain-hook msg depth)))) ++ t) ++ ++(defun notmuch-show-insert-part-text/calendar (msg part content-type nth depth declared-type) ++ (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) ++ (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) ++ ++;; For backwards compatibility. ++(defun notmuch-show-insert-part-text/x-vcalendar (msg part content-type nth depth declared-type) ++ (notmuch-show-insert-part-text/calendar msg part content-type nth depth declared-type)) ++ ++(defun notmuch-show-get-mime-type-of-application/octet-stream (part) ++ ;; If we can deduce a MIME type from the filename of the attachment, ++ ;; we return that. ++ (if (plist-get part :filename) ++ (let ((extension (file-name-extension (plist-get part :filename))) ++ mime-type) ++ (if extension ++ (progn ++ (mailcap-parse-mimetypes) ++ (setq mime-type (mailcap-extension-to-mime extension)) ++ (if (and mime-type ++ (not (string-equal mime-type "application/octet-stream"))) ++ mime-type ++ nil)) ++ nil)))) ++ ++;; Handler for wash generated inline patch fake parts. ++(defun notmuch-show-insert-part-inline-patch-fake-part (msg part content-type nth depth declared-type) ++ (notmuch-show-insert-part-*/* msg part content-type nth depth declared-type)) ++ ++(defun notmuch-show-insert-part-text/html (msg part content-type nth depth declared-type) ++ ;; text/html handler to work around bugs in renderers and our ++ ;; invisibile parts code. In particular w3m sets up a keymap which ++ ;; "leaks" outside the invisible region and causes strange effects ++ ;; in notmuch. We set mm-inline-text-html-with-w3m-keymap to nil to ++ ;; tell w3m not to set a keymap (so the normal notmuch-show-mode-map ++ ;; remains). ++ (let ((mm-inline-text-html-with-w3m-keymap nil)) ++ (notmuch-show-insert-part-*/* msg part content-type nth depth declared-type))) ++ ++(defun notmuch-show-insert-part-*/* (msg part content-type nth depth declared-type) ++ ;; This handler _must_ succeed - it is the handler of last resort. ++ (notmuch-show-insert-part-header nth content-type declared-type (plist-get part :filename)) ++ (notmuch-mm-display-part-inline msg part nth content-type notmuch-show-process-crypto) ++ t) ++ ++;; Functions for determining how to handle MIME parts. ++ ++(defun notmuch-show-handlers-for (content-type) ++ "Return a list of content handlers for a part of type CONTENT-TYPE." ++ (let (result) ++ (mapc (lambda (func) ++ (if (functionp func) ++ (push func result))) ++ ;; Reverse order of prefrence. ++ (list (intern (concat "notmuch-show-insert-part-*/*")) ++ (intern (concat ++ "notmuch-show-insert-part-" ++ (car (notmuch-split-content-type content-type)) ++ "/*")) ++ (intern (concat "notmuch-show-insert-part-" content-type)))) ++ result)) ++ ++;; + ++ ++(defun notmuch-show-insert-bodypart-internal (msg part content-type nth depth declared-type) ++ (let ((handlers (notmuch-show-handlers-for content-type))) ++ ;; Run the content handlers until one of them returns a non-nil ++ ;; value. ++ (while (and handlers ++ (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) ++ ++(defun notmuch-show-create-part-overlays (msg beg end hide) ++ "Add an overlay to the part between BEG and END" ++ (let* ((button (button-at beg)) ++ (part-beg (and button (1+ (button-end button))))) ++ ++ ;; If the part contains no text we do not make it toggleable. We ++ ;; also need to check that the button is a genuine part button not ++ ;; a notmuch-wash button. ++ (when (and button (/= part-beg end) (button-get button :base-label)) ++ (button-put button 'overlay (make-overlay part-beg end)) ++ ;; We toggle the button for hidden parts as that gets the ++ ;; button label right. ++ (save-excursion ++ (when hide ++ (notmuch-show-toggle-part-invisibility button)))))) ++ ++(defun notmuch-show-insert-bodypart (msg part depth &optional hide) ++ "Insert the body part PART at depth DEPTH in the current thread. ++ ++If HIDE is non-nil then initially hide this part." ++ (let* ((content-type (downcase (plist-get part :content-type))) ++ (mime-type (or (and (string= content-type "application/octet-stream") ++ (notmuch-show-get-mime-type-of-application/octet-stream part)) ++ (and (string= content-type "inline patch") ++ "text/x-diff") ++ content-type)) ++ (nth (plist-get part :id)) ++ (beg (point))) ++ ++ (notmuch-show-insert-bodypart-internal msg part mime-type nth depth content-type) ++ ;; Some of the body part handlers leave point somewhere up in the ++ ;; part, so we make sure that we're down at the end. ++ (goto-char (point-max)) ++ ;; Ensure that the part ends with a carriage return. ++ (unless (bolp) ++ (insert "\n")) ++ (notmuch-show-create-part-overlays msg beg (point) hide))) ++ ++(defun notmuch-show-insert-body (msg body depth) ++ "Insert the body BODY at depth DEPTH in the current thread." ++ (mapc (lambda (part) (notmuch-show-insert-bodypart msg part depth)) body)) ++ ++(defun notmuch-show-strip-re (string) ++ (replace-regexp-in-string "^\\([Rr]e: *\\)+" "" string)) ++ ++(defvar notmuch-show-previous-subject "") ++(make-variable-buffer-local 'notmuch-show-previous-subject) ++ ++(defun notmuch-show-insert-msg (msg depth) ++ "Insert the message MSG at depth DEPTH in the current thread." ++ (let* ((headers (plist-get msg :headers)) ++ ;; Indentation causes the buffer offset of the start/end ++ ;; points to move, so we must use markers. ++ message-start message-end ++ content-start content-end ++ headers-start headers-end ++ (bare-subject (notmuch-show-strip-re (plist-get headers :Subject)))) ++ ++ (setq message-start (point-marker)) ++ ++ (notmuch-show-insert-headerline headers ++ (or (if notmuch-show-relative-dates ++ (plist-get msg :date_relative) ++ nil) ++ (plist-get headers :Date)) ++ (plist-get msg :tags) depth) ++ ++ (setq content-start (point-marker)) ++ ++ ;; Set `headers-start' to point after the 'Subject:' header to be ++ ;; compatible with the existing implementation. This just sets it ++ ;; to after the first header. ++ (notmuch-show-insert-headers headers) ++ (save-excursion ++ (goto-char content-start) ++ ;; If the subject of this message is the same as that of the ++ ;; previous message, don't display it when this message is ++ ;; collapsed. ++ (when (not (string= notmuch-show-previous-subject ++ bare-subject)) ++ (forward-line 1)) ++ (setq headers-start (point-marker))) ++ (setq headers-end (point-marker)) ++ ++ (setq notmuch-show-previous-subject bare-subject) ++ ++ ;; A blank line between the headers and the body. ++ (insert "\n") ++ (notmuch-show-insert-body msg (plist-get msg :body) ++ (if notmuch-show-indent-content depth 0)) ++ ;; Ensure that the body ends with a newline. ++ (unless (bolp) ++ (insert "\n")) ++ (setq content-end (point-marker)) ++ ++ ;; Indent according to the depth in the thread. ++ (if notmuch-show-indent-content ++ (indent-rigidly content-start content-end (* notmuch-show-indent-messages-width depth))) ++ ++ (setq message-end (point-max-marker)) ++ ++ ;; Save the extents of this message over the whole text of the ++ ;; message. ++ (put-text-property message-start message-end :notmuch-message-extent (cons message-start message-end)) ++ ++ ;; Create overlays used to control visibility ++ (plist-put msg :headers-overlay (make-overlay headers-start headers-end)) ++ (plist-put msg :message-overlay (make-overlay headers-start content-end)) ++ ++ (plist-put msg :depth depth) ++ ++ ;; Save the properties for this message. Currently this saves the ++ ;; entire message (augmented it with other stuff), which seems ++ ;; like overkill. We might save a reduced subset (for example, not ++ ;; the content). ++ (notmuch-show-set-message-properties msg) ++ ++ ;; Set header visibility. ++ (notmuch-show-headers-visible msg notmuch-message-headers-visible) ++ ++ ;; Message visibility depends on whether it matched the search ++ ;; criteria. ++ (notmuch-show-message-visible msg (and (plist-get msg :match) ++ (not (plist-get msg :excluded)))))) ++ ++(defun notmuch-show-insert-tree (tree depth) ++ "Insert the message tree TREE at depth DEPTH in the current thread." ++ (let ((msg (car tree)) ++ (replies (cadr tree))) ++ ;; We test whether there is a message or just some replies. ++ (when msg ++ (notmuch-show-insert-msg msg depth)) ++ (notmuch-show-insert-thread replies (1+ depth)))) ++ ++(defun notmuch-show-insert-thread (thread depth) ++ "Insert the thread THREAD at depth DEPTH in the current forest." ++ (mapc (lambda (tree) (notmuch-show-insert-tree tree depth)) thread)) ++ ++(defun notmuch-show-insert-forest (forest) ++ "Insert the forest of threads FOREST." ++ (mapc (lambda (thread) (notmuch-show-insert-thread thread 0)) forest)) ++ ++;; Functions relating to the visibility of messages and their ++;; components. ++ ++(defun notmuch-show-message-visible (props visible-p) ++ (overlay-put (plist-get props :message-overlay) 'invisible (not visible-p)) ++ (notmuch-show-set-prop :message-visible visible-p props)) ++ ++(defun notmuch-show-headers-visible (props visible-p) ++ (overlay-put (plist-get props :headers-overlay) 'invisible (not visible-p)) ++ (notmuch-show-set-prop :headers-visible visible-p props)) ++ ++;; ++ ++(provide 'notmuch-show-display) +diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el +index 37ba911..9e3401d 100644 +--- a/emacs/notmuch-show.el ++++ b/emacs/notmuch-show.el +@@ -22,17 +22,12 @@ + ;; David Edmondson + + (eval-when-compile (require 'cl)) +-(require 'mm-view) +-(require 'message) +-(require 'mm-decode) +-(require 'mailcap) + (require 'icalendar) + (require 'goto-addr) + + (require 'notmuch-lib) + (require 'notmuch-tag) + (require 'notmuch-query) +-(require 'notmuch-wash) + (require 'notmuch-mua) + (require 'notmuch-crypto) + (require 'notmuch-print) +@@ -43,36 +38,6 @@ + (declare-function notmuch-search-previous-thread "notmuch" nil) + (declare-function notmuch-search-show-thread "notmuch" nil) + +-(defcustom notmuch-message-headers '("Subject" "To" "Cc" "Date") +- "Headers that should be shown in a message, in this order. +- +-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-visibility-headers'. For a closed message, +-only the first header in the list will be visible." +- :type '(repeat string) +- :group 'notmuch-show) +- +-(defcustom notmuch-message-headers-visible t +- "Should the headers be visible by default? +- +-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-visibility-headers' can be used to make them +-visible for any given message." +- :type 'boolean +- :group 'notmuch-show) +- +-(defcustom notmuch-show-relative-dates t +- "Display relative dates in the message summary line." +- :type 'boolean +- :group 'notmuch-show) +- +-(defvar notmuch-show-markup-headers-hook '(notmuch-show-colour-headers) +- "A list of functions called to decorate the headers listed in +-`notmuch-message-headers'.") +- + (defcustom notmuch-show-hook '(notmuch-show-turn-on-visual-line-mode) + "Functions called after populating a `notmuch-show' buffer." + :type 'hook +@@ -80,42 +45,6 @@ visible for any given message." + :group 'notmuch-show + :group 'notmuch-hooks) + +-(defcustom notmuch-show-insert-text/plain-hook '(notmuch-wash-wrap-long-lines +- notmuch-wash-tidy-citations +- notmuch-wash-elide-blank-lines +- notmuch-wash-excerpt-citations) +- "Functions used to improve the display of text/plain parts." +- :type 'hook +- :options '(notmuch-wash-convert-inline-patch-to-part +- notmuch-wash-wrap-long-lines +- notmuch-wash-tidy-citations +- notmuch-wash-elide-blank-lines +- notmuch-wash-excerpt-citations) +- :group 'notmuch-show +- :group 'notmuch-hooks) +- +-;; Mostly useful for debugging. +-(defcustom notmuch-show-all-multipart/alternative-parts nil +- "Should all parts of multipart/alternative parts be shown?" +- :type 'boolean +- :group 'notmuch-show) +- +-(defcustom notmuch-show-indent-messages-width 1 +- "Width of message indentation in threads. +- +-Messages are shown indented according to their depth in a thread. +-This variable determines the width of this indentation measured +-in number of blanks. Defaults to `1', choose `0' to disable +-indentation." +- :type 'integer +- :group 'notmuch-show) +- +-(defcustom notmuch-show-indent-multipart nil +- "Should the sub-parts of a multipart/* part be indented?" +- ;; dme: Not sure which is a good default. +- :type 'boolean +- :group 'notmuch-show) +- + (defcustom notmuch-show-part-button-default-action 'notmuch-show-save-part + "Default part header button action (on ENTER or mouse click)." + :group 'notmuch-show +@@ -143,18 +72,10 @@ indentation." + (make-variable-buffer-local 'notmuch-show-query-context) + (put 'notmuch-show-query-context 'permanent-local t) + +-(defvar notmuch-show-process-crypto nil) +-(make-variable-buffer-local 'notmuch-show-process-crypto) +-(put 'notmuch-show-process-crypto 'permanent-local t) +- + (defvar notmuch-show-elide-non-matching-messages nil) + (make-variable-buffer-local 'notmuch-show-elide-non-matching-messages) + (put 'notmuch-show-elide-non-matching-messages 'permanent-local t) + +-(defvar notmuch-show-indent-content t) +-(make-variable-buffer-local 'notmuch-show-indent-content) +-(put 'notmuch-show-indent-content 'permanent-local t) +- + (defcustom notmuch-show-stash-mlarchive-link-alist + '(("Gmane" . "http://mid.gmane.org/") + ("MARC" . "http://marc.info/?i=") +@@ -328,35 +249,6 @@ operation on the contents of the current buffer." + (interactive) + (notmuch-show-with-message-as-text 'notmuch-print-message)) + +-(defun notmuch-show-fontify-header () +- (let ((face (cond +- ((looking-at "[Tt]o:") +- 'message-header-to) +- ((looking-at "[Bb]?[Cc][Cc]:") +- 'message-header-cc) +- ((looking-at "[Ss]ubject:") +- 'message-header-subject) +- ((looking-at "[Ff]rom:") +- 'message-header-from) +- (t +- 'message-header-other)))) +- +- (overlay-put (make-overlay (point) (re-search-forward ":")) +- 'face 'message-header-name) +- (overlay-put (make-overlay (point) (re-search-forward ".*$")) +- 'face face))) +- +-(defun notmuch-show-colour-headers () +- "Apply some colouring to the current headers." +- (goto-char (point-min)) +- (while (looking-at "^[A-Za-z][-A-Za-z0-9]*:") +- (notmuch-show-fontify-header) +- (forward-line))) +- +-(defun notmuch-show-spaces-n (n) +- "Return a string comprised of `n' spaces." +- (make-string n ? )) +- + (defun notmuch-show-update-tags (tags) + "Update the displayed tags of the current message." + (save-excursion +@@ -367,104 +259,6 @@ operation on the contents of the current buffer." + (notmuch-tag-format-tags tags) + ")")))))) + +-(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', +- ;; but that expects un-decoded mailbox parts, whereas our +- ;; mailbox parts are already decoded (and hence may contain +- ;; UTF-8). Given that notmuch should handle most of the awkward +- ;; cases, some simple string deconstruction should be sufficient +- ;; here. +- (cond +- ;; "User " style. +- ((string-match "\\(.*\\) <\\(.*\\)>" address) +- (setq p-name (match-string 1 address) +- p-address (match-string 2 address))) +- +- ;; "" style. +- ((string-match "<\\(.*\\)>" address) +- (setq p-address (match-string 1 address))) +- +- ;; Everything else. +- (t +- (setq p-address address))) +- +- (when p-name +- ;; Remove elements of the mailbox part that are not relevant for +- ;; display, even if they are required during transport: +- ;; +- ;; Backslashes. +- (setq p-name (replace-regexp-in-string "\\\\" "" p-name)) +- +- ;; Outer single and double quotes, which might be nested. +- (loop +- with start-of-loop +- do (setq start-of-loop p-name) +- +- when (string-match "^\"\\(.*\\)\"$" p-name) +- do (setq p-name (match-string 1 p-name)) +- +- when (string-match "^'\\(.*\\)'$" p-name) +- do (setq p-name (match-string 1 p-name)) +- +- until (string= start-of-loop p-name))) +- +- ;; If the address is 'foo@bar.com ' then show just +- ;; 'foo@bar.com'. +- (when (string= p-name p-address) +- (setq p-name nil)) +- +- (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 +-message at DEPTH in the current thread." +- (let ((start (point))) +- (insert (notmuch-show-spaces-n (* notmuch-show-indent-messages-width depth)) +- (notmuch-show-clean-address (plist-get headers :From)) +- " (" +- date +- ") (" +- (notmuch-tag-format-tags tags) +- ")\n") +- (overlay-put (make-overlay start (point)) 'face 'notmuch-message-summary-face))) +- +-(defun notmuch-show-insert-header (header header-value) +- "Insert a single header." +- (insert header ": " header-value "\n")) +- +-(defun notmuch-show-insert-headers (headers) +- "Insert the headers of the current message." +- (let ((start (point))) +- (mapc (lambda (header) +- (let* ((header-symbol (intern (concat ":" header))) +- (header-value (plist-get headers header-symbol))) +- (if (and header-value +- (not (string-equal "" header-value))) +- (notmuch-show-insert-header header header-value)))) +- notmuch-message-headers) +- (save-excursion +- (save-restriction +- (narrow-to-region start (point-max)) +- (run-hooks 'notmuch-show-markup-headers-hook))))) +- + (define-button-type 'notmuch-show-part-button-type + 'action 'notmuch-show-part-button-default + 'keymap 'notmuch-show-part-button-map +@@ -483,26 +277,6 @@ message at DEPTH in the current thread." + "Submap for button commands") + (fset 'notmuch-show-part-button-map notmuch-show-part-button-map) + +-(defun notmuch-show-insert-part-header (nth content-type declared-type &optional name comment) +- (let ((button) +- (base-label (concat (when name (concat name ": ")) +- declared-type +- (unless (string-equal declared-type content-type) +- (concat " (as " content-type ")")) +- comment))) +- +- (setq button +- (insert-button +- (concat "[ " base-label " ]") +- :base-label base-label +- :type 'notmuch-show-part-button-type +- :notmuch-part nth +- :notmuch-filename name +- :notmuch-content-type content-type)) +- (insert "\n") +- ;; return button +- button)) +- + ;; Functions handling particular MIME parts. + + (defmacro notmuch-with-temp-part-buffer (message-id nth &rest body) +@@ -550,447 +324,9 @@ message at DEPTH in the current thread." + (let ((handle (mm-make-handle (current-buffer) (list content-type)))) + (mm-pipe-part handle)))) + +-;; This is taken from notmuch-wash: maybe it should be unified? +-(defun notmuch-show-toggle-part-invisibility (&optional button) +- (interactive) +- (let* ((button (or button (button-at (point)))) +- (overlay (button-get button 'overlay))) +- (when overlay +- (let* ((show (overlay-get overlay 'invisible)) +- (new-start (button-start button)) +- (button-label (button-get button :base-label)) +- (old-point (point)) +- (inhibit-read-only t)) +- (overlay-put overlay 'invisible (not show)) +- (goto-char new-start) +- (insert "[ " button-label (if show " ]" " (hidden) ]")) +- (let ((old-end (button-end button))) +- (move-overlay button new-start (point)) +- (delete-region (point) old-end)) +- (goto-char (min old-point (1- (button-end button)))))))) +- +-(defun notmuch-show-multipart/*-to-list (part) +- (mapcar (lambda (inner-part) (plist-get inner-part :content-type)) +- (plist-get part :content))) +- +-(defun notmuch-show-insert-part-multipart/alternative (msg part content-type nth depth declared-type) +- (notmuch-show-insert-part-header nth declared-type content-type nil) +- (let ((chosen-type (car (notmuch-multipart/alternative-choose (notmuch-show-multipart/*-to-list part)))) +- (inner-parts (plist-get part :content)) +- (start (point))) +- ;; This inserts all parts of the chosen type rather than just one, +- ;; but it's not clear that this is the wrong thing to do - which +- ;; should be chosen if there are more than one that match? +- (mapc (lambda (inner-part) +- (let* ((inner-type (plist-get inner-part :content-type)) +- (hide (not (or notmuch-show-all-multipart/alternative-parts +- (string= chosen-type inner-type))))) +- (notmuch-show-insert-bodypart msg inner-part depth hide))) +- inner-parts) +- +- (when notmuch-show-indent-multipart +- (indent-rigidly start (point) 1))) +- t) +- +-(defun notmuch-show-setup-w3m () +- "Instruct w3m how to retrieve content from a \"related\" part of a message." +- (interactive) +- (if (boundp 'w3m-cid-retrieve-function-alist) +- (unless (assq 'notmuch-show-mode w3m-cid-retrieve-function-alist) +- (push (cons 'notmuch-show-mode 'notmuch-show-w3m-cid-retrieve) +- w3m-cid-retrieve-function-alist))) +- (setq mm-inline-text-html-with-images t)) +- +-(defvar w3m-current-buffer) ;; From `w3m.el'. +-(defvar notmuch-show-w3m-cid-store nil) +-(make-variable-buffer-local 'notmuch-show-w3m-cid-store) +- +-(defun notmuch-show-w3m-cid-store-internal (content-id +- message-id +- part-number +- content-type +- content) +- (push (list content-id +- message-id +- part-number +- content-type +- content) +- notmuch-show-w3m-cid-store)) +- +-(defun notmuch-show-w3m-cid-store (msg part) +- (let ((content-id (plist-get part :content-id))) +- (when content-id +- (notmuch-show-w3m-cid-store-internal (concat "cid:" content-id) +- (plist-get msg :id) +- (plist-get part :id) +- (plist-get part :content-type) +- nil)))) +- +-(defun notmuch-show-w3m-cid-retrieve (url &rest args) +- (let ((matching-part (with-current-buffer w3m-current-buffer +- (assoc url notmuch-show-w3m-cid-store)))) +- (if matching-part +- (let ((message-id (nth 1 matching-part)) +- (part-number (nth 2 matching-part)) +- (content-type (nth 3 matching-part)) +- (content (nth 4 matching-part))) +- ;; If we don't already have the content, get it and cache +- ;; it, as some messages reference the same cid: part many +- ;; times (hundreds!), which results in many calls to +- ;; `notmuch part'. +- (unless content +- (setq content (notmuch-get-bodypart-internal (notmuch-id-to-query message-id) +- part-number notmuch-show-process-crypto)) +- (with-current-buffer w3m-current-buffer +- (notmuch-show-w3m-cid-store-internal url +- message-id +- part-number +- content-type +- content))) +- (insert content) +- content-type) +- nil))) +- +-(defun notmuch-show-insert-part-multipart/related (msg part content-type nth depth declared-type) +- (notmuch-show-insert-part-header nth declared-type content-type nil) +- (let ((inner-parts (plist-get part :content)) +- (start (point))) +- +- ;; We assume that the first part is text/html and the remainder +- ;; things that it references. +- +- ;; Stash the non-primary parts. +- (mapc (lambda (part) +- (notmuch-show-w3m-cid-store msg part)) +- (cdr inner-parts)) +- +- ;; Render the primary part. +- (notmuch-show-insert-bodypart msg (car inner-parts) depth) +- +- (when notmuch-show-indent-multipart +- (indent-rigidly start (point) 1))) +- t) +- +-(defun notmuch-show-insert-part-multipart/signed (msg part content-type nth depth declared-type) +- (let ((button (notmuch-show-insert-part-header nth declared-type content-type nil))) +- (button-put button 'face 'notmuch-crypto-part-header) +- ;; add signature status button if sigstatus provided +- (if (plist-member part :sigstatus) +- (let* ((from (notmuch-show-get-header :From msg)) +- (sigstatus (car (plist-get part :sigstatus)))) +- (notmuch-crypto-insert-sigstatus-button sigstatus from)) +- ;; if we're not adding sigstatus, tell the user how they can get it +- (button-put button 'help-echo "Set notmuch-crypto-process-mime to process cryptographic MIME parts."))) +- +- (let ((inner-parts (plist-get part :content)) +- (start (point))) +- ;; Show all of the parts. +- (mapc (lambda (inner-part) +- (notmuch-show-insert-bodypart msg inner-part depth)) +- inner-parts) +- +- (when notmuch-show-indent-multipart +- (indent-rigidly start (point) 1))) +- t) +- +-(defun notmuch-show-insert-part-multipart/encrypted (msg part content-type nth depth declared-type) +- (let ((button (notmuch-show-insert-part-header nth declared-type content-type nil))) +- (button-put button 'face 'notmuch-crypto-part-header) +- ;; add encryption status button if encstatus specified +- (if (plist-member part :encstatus) +- (let ((encstatus (car (plist-get part :encstatus)))) +- (notmuch-crypto-insert-encstatus-button encstatus) +- ;; add signature status button if sigstatus specified +- (if (plist-member part :sigstatus) +- (let* ((from (notmuch-show-get-header :From msg)) +- (sigstatus (car (plist-get part :sigstatus)))) +- (notmuch-crypto-insert-sigstatus-button sigstatus from)))) +- ;; if we're not adding encstatus, tell the user how they can get it +- (button-put button 'help-echo "Set notmuch-crypto-process-mime to process cryptographic MIME parts."))) +- +- (let ((inner-parts (plist-get part :content)) +- (start (point))) +- ;; Show all of the parts. +- (mapc (lambda (inner-part) +- (notmuch-show-insert-bodypart msg inner-part depth)) +- inner-parts) +- +- (when notmuch-show-indent-multipart +- (indent-rigidly start (point) 1))) +- t) +- +-(defun notmuch-show-insert-part-multipart/* (msg part content-type nth depth declared-type) +- (notmuch-show-insert-part-header nth declared-type content-type nil) +- (let ((inner-parts (plist-get part :content)) +- (start (point))) +- ;; Show all of the parts. +- (mapc (lambda (inner-part) +- (notmuch-show-insert-bodypart msg inner-part depth)) +- inner-parts) +- +- (when notmuch-show-indent-multipart +- (indent-rigidly start (point) 1))) +- t) +- +-(defun notmuch-show-insert-part-message/rfc822 (msg part content-type nth depth declared-type) +- (notmuch-show-insert-part-header nth declared-type content-type nil) +- (let* ((message (car (plist-get part :content))) +- (body (car (plist-get message :body))) +- (start (point))) +- +- ;; Override `notmuch-message-headers' to force `From' to be +- ;; displayed. +- (let ((notmuch-message-headers '("From" "Subject" "To" "Cc" "Date"))) +- (notmuch-show-insert-headers (plist-get message :headers))) +- +- ;; Blank line after headers to be compatible with the normal +- ;; message display. +- (insert "\n") +- +- ;; Show the body +- (notmuch-show-insert-bodypart msg body depth) +- +- (when notmuch-show-indent-multipart +- (indent-rigidly start (point) 1))) +- t) +- +-(defun notmuch-show-insert-part-text/plain (msg part content-type nth depth declared-type) +- (let ((start (point))) +- ;; If this text/plain part is not the first part in the message, +- ;; insert a header to make this clear. +- (if (> nth 1) +- (notmuch-show-insert-part-header nth declared-type content-type (plist-get part :filename))) +- (insert (notmuch-get-bodypart-content msg part nth notmuch-show-process-crypto)) +- (save-excursion +- (save-restriction +- (narrow-to-region start (point-max)) +- (run-hook-with-args 'notmuch-show-insert-text/plain-hook msg depth)))) +- t) +- +-(defun notmuch-show-insert-part-text/calendar (msg part content-type nth depth declared-type) +- (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) +- (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) +- +-;; For backwards compatibility. +-(defun notmuch-show-insert-part-text/x-vcalendar (msg part content-type nth depth declared-type) +- (notmuch-show-insert-part-text/calendar msg part content-type nth depth declared-type)) +- +-(defun notmuch-show-get-mime-type-of-application/octet-stream (part) +- ;; If we can deduce a MIME type from the filename of the attachment, +- ;; we return that. +- (if (plist-get part :filename) +- (let ((extension (file-name-extension (plist-get part :filename))) +- mime-type) +- (if extension +- (progn +- (mailcap-parse-mimetypes) +- (setq mime-type (mailcap-extension-to-mime extension)) +- (if (and mime-type +- (not (string-equal mime-type "application/octet-stream"))) +- mime-type +- nil)) +- nil)))) +- +-;; Handler for wash generated inline patch fake parts. +-(defun notmuch-show-insert-part-inline-patch-fake-part (msg part content-type nth depth declared-type) +- (notmuch-show-insert-part-*/* msg part content-type nth depth declared-type)) +- +-(defun notmuch-show-insert-part-text/html (msg part content-type nth depth declared-type) +- ;; text/html handler to work around bugs in renderers and our +- ;; invisibile parts code. In particular w3m sets up a keymap which +- ;; "leaks" outside the invisible region and causes strange effects +- ;; in notmuch. We set mm-inline-text-html-with-w3m-keymap to nil to +- ;; tell w3m not to set a keymap (so the normal notmuch-show-mode-map +- ;; remains). +- (let ((mm-inline-text-html-with-w3m-keymap nil)) +- (notmuch-show-insert-part-*/* msg part content-type nth depth declared-type))) +- +-(defun notmuch-show-insert-part-*/* (msg part content-type nth depth declared-type) +- ;; This handler _must_ succeed - it is the handler of last resort. +- (notmuch-show-insert-part-header nth content-type declared-type (plist-get part :filename)) +- (notmuch-mm-display-part-inline msg part nth content-type notmuch-show-process-crypto) +- t) +- +-;; Functions for determining how to handle MIME parts. +- +-(defun notmuch-show-handlers-for (content-type) +- "Return a list of content handlers for a part of type CONTENT-TYPE." +- (let (result) +- (mapc (lambda (func) +- (if (functionp func) +- (push func result))) +- ;; Reverse order of prefrence. +- (list (intern (concat "notmuch-show-insert-part-*/*")) +- (intern (concat +- "notmuch-show-insert-part-" +- (car (notmuch-split-content-type content-type)) +- "/*")) +- (intern (concat "notmuch-show-insert-part-" content-type)))) +- result)) +- +-;; + +- +-(defun notmuch-show-insert-bodypart-internal (msg part content-type nth depth declared-type) +- (let ((handlers (notmuch-show-handlers-for content-type))) +- ;; Run the content handlers until one of them returns a non-nil +- ;; value. +- (while (and handlers +- (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) +- +-(defun notmuch-show-create-part-overlays (msg beg end hide) +- "Add an overlay to the part between BEG and END" +- (let* ((button (button-at beg)) +- (part-beg (and button (1+ (button-end button))))) +- +- ;; If the part contains no text we do not make it toggleable. We +- ;; also need to check that the button is a genuine part button not +- ;; a notmuch-wash button. +- (when (and button (/= part-beg end) (button-get button :base-label)) +- (button-put button 'overlay (make-overlay part-beg end)) +- ;; We toggle the button for hidden parts as that gets the +- ;; button label right. +- (save-excursion +- (when hide +- (notmuch-show-toggle-part-invisibility button)))))) +- +-(defun notmuch-show-insert-bodypart (msg part depth &optional hide) +- "Insert the body part PART at depth DEPTH in the current thread. +- +-If HIDE is non-nil then initially hide this part." +- (let* ((content-type (downcase (plist-get part :content-type))) +- (mime-type (or (and (string= content-type "application/octet-stream") +- (notmuch-show-get-mime-type-of-application/octet-stream part)) +- (and (string= content-type "inline patch") +- "text/x-diff") +- content-type)) +- (nth (plist-get part :id)) +- (beg (point))) +- +- (notmuch-show-insert-bodypart-internal msg part mime-type nth depth content-type) +- ;; Some of the body part handlers leave point somewhere up in the +- ;; part, so we make sure that we're down at the end. +- (goto-char (point-max)) +- ;; Ensure that the part ends with a carriage return. +- (unless (bolp) +- (insert "\n")) +- (notmuch-show-create-part-overlays msg beg (point) hide))) +- +-(defun notmuch-show-insert-body (msg body depth) +- "Insert the body BODY at depth DEPTH in the current thread." +- (mapc (lambda (part) (notmuch-show-insert-bodypart msg part depth)) body)) +- + (defun notmuch-show-make-symbol (type) + (make-symbol (concat "notmuch-show-" type))) + +-(defun notmuch-show-strip-re (string) +- (replace-regexp-in-string "^\\([Rr]e: *\\)+" "" string)) +- +-(defvar notmuch-show-previous-subject "") +-(make-variable-buffer-local 'notmuch-show-previous-subject) +- +-(defun notmuch-show-insert-msg (msg depth) +- "Insert the message MSG at depth DEPTH in the current thread." +- (let* ((headers (plist-get msg :headers)) +- ;; Indentation causes the buffer offset of the start/end +- ;; points to move, so we must use markers. +- message-start message-end +- content-start content-end +- headers-start headers-end +- (bare-subject (notmuch-show-strip-re (plist-get headers :Subject)))) +- +- (setq message-start (point-marker)) +- +- (notmuch-show-insert-headerline headers +- (or (if notmuch-show-relative-dates +- (plist-get msg :date_relative) +- nil) +- (plist-get headers :Date)) +- (plist-get msg :tags) depth) +- +- (setq content-start (point-marker)) +- +- ;; Set `headers-start' to point after the 'Subject:' header to be +- ;; compatible with the existing implementation. This just sets it +- ;; to after the first header. +- (notmuch-show-insert-headers headers) +- (save-excursion +- (goto-char content-start) +- ;; If the subject of this message is the same as that of the +- ;; previous message, don't display it when this message is +- ;; collapsed. +- (when (not (string= notmuch-show-previous-subject +- bare-subject)) +- (forward-line 1)) +- (setq headers-start (point-marker))) +- (setq headers-end (point-marker)) +- +- (setq notmuch-show-previous-subject bare-subject) +- +- ;; A blank line between the headers and the body. +- (insert "\n") +- (notmuch-show-insert-body msg (plist-get msg :body) +- (if notmuch-show-indent-content depth 0)) +- ;; Ensure that the body ends with a newline. +- (unless (bolp) +- (insert "\n")) +- (setq content-end (point-marker)) +- +- ;; Indent according to the depth in the thread. +- (if notmuch-show-indent-content +- (indent-rigidly content-start content-end (* notmuch-show-indent-messages-width depth))) +- +- (setq message-end (point-max-marker)) +- +- ;; Save the extents of this message over the whole text of the +- ;; message. +- (put-text-property message-start message-end :notmuch-message-extent (cons message-start message-end)) +- +- ;; Create overlays used to control visibility +- (plist-put msg :headers-overlay (make-overlay headers-start headers-end)) +- (plist-put msg :message-overlay (make-overlay headers-start content-end)) +- +- (plist-put msg :depth depth) +- +- ;; Save the properties for this message. Currently this saves the +- ;; entire message (augmented it with other stuff), which seems +- ;; like overkill. We might save a reduced subset (for example, not +- ;; the content). +- (notmuch-show-set-message-properties msg) +- +- ;; Set header visibility. +- (notmuch-show-headers-visible msg notmuch-message-headers-visible) +- +- ;; Message visibility depends on whether it matched the search +- ;; criteria. +- (notmuch-show-message-visible msg (and (plist-get msg :match) +- (not (plist-get msg :excluded)))))) +- + (defun notmuch-show-toggle-process-crypto () + "Toggle the processing of cryptographic MIME parts." + (interactive) +@@ -1018,23 +354,6 @@ If HIDE is non-nil then initially hide this part." + "Content is not indented.")) + (notmuch-show-refresh-view)) + +-(defun notmuch-show-insert-tree (tree depth) +- "Insert the message tree TREE at depth DEPTH in the current thread." +- (let ((msg (car tree)) +- (replies (cadr tree))) +- ;; We test whether there is a message or just some replies. +- (when msg +- (notmuch-show-insert-msg msg depth)) +- (notmuch-show-insert-thread replies (1+ depth)))) +- +-(defun notmuch-show-insert-thread (thread depth) +- "Insert the thread THREAD at depth DEPTH in the current forest." +- (mapc (lambda (tree) (notmuch-show-insert-tree tree depth)) thread)) +- +-(defun notmuch-show-insert-forest (forest) +- "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 +@@ -1373,17 +692,6 @@ effects." + (loop do (funcall function) + while (notmuch-show-goto-message-next)))) + +-;; Functions relating to the visibility of messages and their +-;; components. +- +-(defun notmuch-show-message-visible (props visible-p) +- (overlay-put (plist-get props :message-overlay) 'invisible (not visible-p)) +- (notmuch-show-set-prop :message-visible visible-p props)) +- +-(defun notmuch-show-headers-visible (props visible-p) +- (overlay-put (plist-get props :headers-overlay) 'invisible (not visible-p)) +- (notmuch-show-set-prop :headers-visible visible-p props)) +- + ;; Functions for setting and getting attributes of the current + ;; message. + +-- +1.7.9.1 +