From: Daniel Schoepe Date: Sat, 17 Dec 2011 00:16:33 +0000 (+0100) Subject: [PATCH v2 1/2] emacs: Add thread-outline functionality X-Git-Url: http://git.tremily.us/?a=commitdiff_plain;h=7447df6d69d5e816a14fa0051e2fa657328cc50e;p=notmuch-archives.git [PATCH v2 1/2] emacs: Add thread-outline functionality --- diff --git a/d5/bfadb6045f7446b71bc7b7e2635c6f78e933b4 b/d5/bfadb6045f7446b71bc7b7e2635c6f78e933b4 new file mode 100644 index 000000000..b4b51c249 --- /dev/null +++ b/d5/bfadb6045f7446b71bc7b7e2635c6f78e933b4 @@ -0,0 +1,347 @@ +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 AC827429E21 + for ; Fri, 16 Dec 2011 16:16:44 -0800 (PST) +X-Virus-Scanned: Debian amavisd-new at olra.theworths.org +X-Spam-Flag: NO +X-Spam-Score: -0.8 +X-Spam-Level: +X-Spam-Status: No, score=-0.8 tagged_above=-999 required=5 + tests=[DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, + 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 ZMjumJamEOYQ for ; + Fri, 16 Dec 2011 16:16:43 -0800 (PST) +Received: from mail-ee0-f53.google.com (mail-ee0-f53.google.com + [74.125.83.53]) (using TLSv1 with cipher RC4-SHA (128/128 bits)) (No client + certificate requested) by olra.theworths.org (Postfix) with ESMTPS id + 42355431FB6 for ; Fri, 16 Dec 2011 16:16:43 -0800 + (PST) +Received: by mail-ee0-f53.google.com with SMTP id d41so4339652eek.26 + for ; Fri, 16 Dec 2011 16:16:42 -0800 (PST) +DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=schoepe.org; s=google; + h=from:to:cc:subject:date:message-id:x-mailer:in-reply-to:references; + bh=6WLk3lB0KgzEPW/HdNJ7zzRC/n8KncJo6WJZbcWxzRQ=; + b=GtL22qpiG1RlOUXZWmz3pHFNp55phNifwqjcwmS2HRNCQKTNB59fVjIfor5UO/30X9 + uQNUOY5tDF54D3wXWwCKqoCH53MFfDmw32Pgz8PvpYcHOJvsUK2tIgodYSqr4SLG2Wey + lyg0lVkLxAs4xZG/py0tBlSWotEmdli8qGcNQ= +Received: by 10.14.3.167 with SMTP id 39mr328477eeh.6.1324081002702; + Fri, 16 Dec 2011 16:16:42 -0800 (PST) +Received: from localhost (dslb-088-069-153-158.pools.arcor-ip.net. + [88.69.153.158]) + by mx.google.com with ESMTPS id z54sm3932898eeh.5.2011.12.16.16.16.40 + (version=TLSv1/SSLv3 cipher=OTHER); + Fri, 16 Dec 2011 16:16:41 -0800 (PST) +From: Daniel Schoepe +To: notmuch@notmuchmail.org +Subject: [PATCH v2 1/2] emacs: Add thread-outline functionality +Date: Sat, 17 Dec 2011 01:16:33 +0100 +Message-Id: <1324080994-18146-2-git-send-email-daniel@schoepe.org> +X-Mailer: git-send-email 1.7.7.3 +In-Reply-To: <1324080994-18146-1-git-send-email-daniel@schoepe.org> +References: <1307921480-17130-1-git-send-email-daniel.schoepe@googlemail.com> + <1324080994-18146-1-git-send-email-daniel@schoepe.org> +Cc: Daniel Schoepe +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: Sat, 17 Dec 2011 00:16:44 -0000 + +From: Daniel Schoepe + +This patch adds some functionality to display the outline for threads +displayed by notmuch-show. The entries in the outline buffer are +links to the corresponding message in the notmuch-show buffer. +--- + emacs/notmuch-lib.el | 12 +++ + emacs/notmuch-show.el | 195 ++++++++++++++++++++++++++++++++++++++++++++++++- + 2 files changed, 206 insertions(+), 1 deletions(-) + +diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el +index 0f856bf..a8be8b1 100644 +--- a/emacs/notmuch-lib.el ++++ b/emacs/notmuch-lib.el +@@ -43,6 +43,10 @@ + (defvar notmuch-folders nil + "Deprecated name for what is now known as `notmuch-saved-searches'.") + ++(defvar notmuch-show-outline-buffer nil ++ "Outline buffer associated with a notmuch-show buffer.") ++(make-variable-buffer-local 'notmuch-show-outline-buffer) ++ + (defun notmuch-saved-searches () + "Common function for querying the notmuch-saved-searches variable. + +@@ -91,9 +95,17 @@ the user hasn't set this variable with the old or new value." + "Return the user.other_email value (as a list) from the notmuch configuration." + (split-string (notmuch-config-get "user.other_email") "\n")) + ++(declare-function notmuch-show-outline-buffer-name "notmuch-show" (&optional buf)) ++ + (defun notmuch-kill-this-buffer () + "Kill the current buffer." + (interactive) ++ ;; if we are in a notmuch-show buffer, kill the associated outline buffer, if any ++ (when (eq major-mode 'notmuch-show-mode) ++ (let ((outline-buf notmuch-show-outline-buffer)) ++ (when outline-buf ++ (mapc #'delete-window (get-buffer-window-list outline-buf)) ++ (kill-buffer outline-buf)))) + (kill-buffer (current-buffer))) + + ;; +diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el +index 63b01e5..e7ce811 100644 +--- a/emacs/notmuch-show.el ++++ b/emacs/notmuch-show.el +@@ -107,6 +107,57 @@ indentation." + :group 'notmuch + :type 'boolean) + ++(defcustom notmuch-always-show-outline nil ++ "Always open an outline buffer when viewing a thread?" ++ :group 'notmuch ++ :type 'boolean) ++ ++(defcustom notmuch-outline-format ++ (list "%a - %r") ++ "Format used for thread-outline lines. ++ ++This is a list supporting the following types of elements: ++For a symbol, its value is used if non-nil. ++A string is inserted verbatim with the exception ++ of the following %-constructs: ++ %a - Author ++ %d - Date ++ %s - Subject ++ %r - Relative date ++For a list of the form `(:eval FORM)', form is evaluated ++ and its result displayed. ++ ++The variables author, subject, date and reldate will be bound to ++their respective values when this is interpreted, and can be ++used in (:eval ..)-elements or directly as symbols." ++ :group 'notmuch ++ :type ++ '(repeat (choice (const :tag "Author" author) ++ (const :tag "Date" date) ++ (const :tag "Relative date" reldate) ++ (string :tag "Format string") ++ (list :tag "Custom expression (will be evaluated when rendering)" ++ (const :tag "" :eval) ++ sexp)))) ++ ++(defface notmuch-outline '((t :inherit default)) ++ "Face used to display (unhighlighted) lines in thread outlines" ++ :group 'notmuch) ++ ++(defface notmuch-outline-highlighted ++ '((((class color) (background light)) (:background "#f0f0f0")) ++ (((class color) (background dark)) (:background "#303030"))) ++ "Face used to display highlight the current message in the outline buffer" ++ :group 'notmuch) ++ ++(defvar notmuch-outline-mode-map ++ (let ((map (make-sparse-keymap))) ++ (define-key map "n" 'next-line) ++ (define-key map "p" 'previous-line) ++ (define-key map "q" 'kill-buffer-and-window) ++ (define-key map "x" 'kill-buffer-and-window) ++ map)) ++ + (defmacro with-current-notmuch-show-message (&rest body) + "Evaluate body with current buffer set to the text of current message" + `(save-excursion +@@ -747,12 +798,27 @@ current buffer, if possible." + ;; message. + (put-text-property message-start message-end :notmuch-message-extent (cons message-start message-end)) + ++ ;; Save the indentation depth, used by `notmuch-show-outline' ++ (put-text-property message-start message-end :notmuch-depth depth) ++ + (let ((headers-overlay (make-overlay headers-start headers-end)) + (invis-specs (list headers-invis-spec message-invis-spec))) + (overlay-put headers-overlay 'invisible invis-specs) + (overlay-put headers-overlay 'priority 10)) + (overlay-put (make-overlay body-start body-end) 'invisible message-invis-spec) + ++ ;; Add callbacks that update the outline buffer when moving between messages. ++ ;; Due to the mindbogglingly absurd semantics of point-entered and point-left ++ ;; this function will will be run up to _four_ times when moving between messages: ++ (let ((goto-msg-func ++ `(lambda (before after) ++ (if (and (>= after (marker-position ,message-start)) ++ (< after (marker-position ,message-end))) ++ (notmuch-outline-highlight-message ,message-start))))) ++ (add-text-properties message-start message-end ++ (list 'point-entered goto-msg-func ++ 'point-left goto-msg-func))) ++ + ;; 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 +@@ -808,6 +874,130 @@ a corresponding notmuch search." + 'help-echo "Mouse-1, RET: search for this message" + 'face goto-address-mail-face)))) + ++(defun notmuch-show-message-is-visible () ++ "Return t if current message is visible." ++ (plist-get (notmuch-show-get-message-properties) :message-visible)) ++ ++(defun notmuch-outline-render-format (format) ++ "Render FORMAT, as described in `notmuch-outline-format'" ++ (let ((author (notmuch-show-get-from)) ++ (date (notmuch-show-get-date)) ++ (subject (notmuch-show-get-subject)) ++ (reldate (plist-get (notmuch-show-get-message-properties) ++ :date_relative))) ++ (mapconcat (lambda (elem) ++ (cond ++ ((symbolp elem) (or (symbol-value elem) "")) ++ ((stringp elem) ++ (let ((str elem)) ++ (mapc (lambda (subst) ++ (setq str ++ (replace-regexp-in-string (car subst) ++ (cdr subst) ++ str))) ++ `(("%a" . ,author) ++ ("%s" . ,subject) ++ ("%d" . ,date) ++ ("%r" . ,reldate))) ++ str)) ++ ((and (listp elem) (eq (car elem) :eval)) ++ (eval (second elem))) ++ (t (error "Unknown element in `notmuch-outline-format': %S" elem)))) ++ format ++ ""))) ++ ++(defun notmuch-outline-highlight-message (msg-start) ++ "Highlight message starting at MSG-START. ++ ++The highlighting will take place in the outline buffer, while ++MSG-START refers to a position in the corresponding notmuch-show buffer." ++ (when (buffer-live-p notmuch-show-outline-buffer) ++ (with-current-buffer notmuch-show-outline-buffer ++ (remove-overlays nil nil 'current-message t) ++ (save-excursion ++ (goto-char (point-min)) ++ (while (and (not (equal (get-text-property (point) :message-start) ++ msg-start)) ++ (not (eobp))) ++ (forward-line)) ++ (unless (eobp) ++ (let ((ovl ++ (make-overlay (line-beginning-position) ++ (line-end-position)))) ++ (overlay-put ovl 'face 'notmuch-outline-highlighted) ++ (overlay-put ovl 'current-message t))))))) ++ ++(defun notmuch-show-create-outline-buffer (&optional buf) ++ "Create an outline buffer for show-buffer BUF. ++ ++Returns the created buffer." ++ ++ (generate-new-buffer (concat (buffer-name buf) " - outline"))) ++ ++(defun notmuch-outline-message () ++ "Outline the message under the point. ++ ++Expects the point to be on the beginning of the first line of the message." ++ (lexical-let* ++ ((msg-start (car (notmuch-show-message-extent))) ++ (outline-buf notmuch-show-outline-buffer) ++ (goto-message ++ (lambda (btn) ++ (let ((win (get-buffer-window outline-buf))) ++ (when win ++ (select-window (get-buffer-window outline-buf)) ++ (when (marker-buffer msg-start) ++ (switch-to-buffer-other-window (marker-buffer msg-start)) ++ (notmuch-outline-highlight-message msg-start) ++ (goto-char (marker-position msg-start)) ++ (when (not (notmuch-show-message-is-visible)) ++ (notmuch-show-toggle-message)))))))) ++ (let ((indentation (or (get-text-property (point) :notmuch-depth) 0)) ++ (button-label (notmuch-outline-render-format ++ notmuch-outline-format))) ++ (with-current-buffer outline-buf ++ (indent-to indentation) ++ (insert button-label) ++ (make-text-button (line-beginning-position) (line-end-position) ++ 'action goto-message ++ 'follow-link t ++ 'help-echo "mouse-1, RET: show this message" ++ 'face 'notmuch-outline) ++ (put-text-property (line-beginning-position) (line-end-position) ++ :message-start msg-start) ++ (insert "\n"))))) ++ ++(defun notmuch-show-outline () ++ "Generate an outline for the current buffer. ++ ++This function must only be called in a notmuch-show buffer." ++ (interactive) ++ (if (buffer-live-p notmuch-show-outline-buffer) ++ (switch-to-buffer-other-window notmuch-show-outline-buffer) ++ (let ((outline-buf (notmuch-show-create-outline-buffer)) ++ (inhibit-point-motion-hooks t)) ++ (setq notmuch-show-outline-buffer outline-buf) ++ (save-excursion ++ (with-current-buffer outline-buf ++ (notmuch-outline-mode)) ++ (goto-char (point-min)) ++ (while (not (eobp)) ++ (notmuch-outline-message) ++ (goto-char (marker-position (cdr (notmuch-show-message-extent))))) ++ (with-current-buffer outline-buf ++ (setq buffer-read-only t))) ++ (notmuch-outline-highlight-message (car (notmuch-show-message-extent))) ++ (let ((win (selected-window))) ++ (switch-to-buffer-other-window outline-buf) ++ (select-window win))))) ++ ++(defun notmuch-outline-mode () ++ (interactive) ++ (kill-all-local-variables) ++ (use-local-map notmuch-outline-mode-map) ++ (setq major-mode 'notmuch-show-outline-mode ++ mode-name "notmuch-show-outline")) ++ + ;;;###autoload + (defun notmuch-show (thread-id &optional parent-buffer query-context buffer-name crypto-switch) + "Run \"notmuch show\" with the given thread ID and display results. +@@ -881,7 +1071,9 @@ buffer." + ;; Set the header line to the subject of the first open message. + (setq header-line-format (notmuch-show-strip-re (notmuch-show-get-subject))) + +- (notmuch-show-mark-read))) ++ (notmuch-show-mark-read) ++ (when notmuch-always-show-outline ++ (notmuch-show-outline)))) + + (defun notmuch-show-refresh-view (&optional crypto-switch) + "Refresh the current view (with crypto switch if prefix given). +@@ -941,6 +1133,7 @@ thread id. If a prefix is given, crypto processing is toggled." + (define-key map "P" 'notmuch-show-previous-message) + (define-key map "n" 'notmuch-show-next-open-message) + (define-key map "p" 'notmuch-show-previous-open-message) ++ (define-key map "o" 'notmuch-show-outline) + (define-key map (kbd "DEL") 'notmuch-show-rewind) + (define-key map " " 'notmuch-show-advance-and-archive) + (define-key map (kbd "M-RET") 'notmuch-show-open-or-close-all) +-- +1.7.7.3 +