66/d08c8ac9ab8319881b395191352a8cca0ae91a

   1 Return-Path: <daniel@schoepe.org>\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 723CF429E31\r
   6         for <notmuch@notmuchmail.org>; Fri, 16 Dec 2011 16:32:18 -0800 (PST)\r
   7 X-Virus-Scanned: Debian amavisd-new at olra.theworths.org\r
   8 X-Spam-Flag: NO\r
   9 X-Spam-Score: -0.8\r
  10 X-Spam-Level: \r
  11 X-Spam-Status: No, score=-0.8 tagged_above=-999 required=5\r
  12         tests=[DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1,\r
  13         RCVD_IN_DNSWL_LOW=-0.7] autolearn=disabled\r
  14 Received: from olra.theworths.org ([127.0.0.1])\r
  15         by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024)\r
  16         with ESMTP id CLgW0jZ2i8V9 for <notmuch@notmuchmail.org>;\r
  17         Fri, 16 Dec 2011 16:32:17 -0800 (PST)\r
  18 Received: from mail-ee0-f53.google.com (mail-ee0-f53.google.com\r
  19  [74.125.83.53])        (using TLSv1 with cipher RC4-SHA (128/128 bits))        (No client\r
  20  certificate requested) by olra.theworths.org (Postfix) with ESMTPS id\r
  21  049CD429E30    for <notmuch@notmuchmail.org>; Fri, 16 Dec 2011 16:32:16 -0800\r
  22  (PST)\r
  23 Received: by mail-ee0-f53.google.com with SMTP id d41so4346943eek.26\r
  24         for <notmuch@notmuchmail.org>; Fri, 16 Dec 2011 16:32:16 -0800 (PST)\r
  25 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=schoepe.org; s=google;\r
  26         h=from:to:cc:subject:date:message-id:x-mailer:in-reply-to:references;\r
  27         bh=6WLk3lB0KgzEPW/HdNJ7zzRC/n8KncJo6WJZbcWxzRQ=;\r
  28         b=AJATkQiiT+sCHgo9R+Vz0HZSHN/Hhsi9TVus/uvzmzeHxDGHMw7RYiW8CcVGzngYTq\r
  29         3ssrBGea0VUV169c+pH2M8TdV3bAX1bF66sLP9UL7Ws4brLRtLV+kBWTjLjjwzWpP22Y\r
  30         iB7XE+kWWU3g+7oiwETHOR7E50k2+XarTISrs=\r
  31 Received: by 10.213.26.77 with SMTP id d13mr738786ebc.132.1324081936547;\r
  32         Fri, 16 Dec 2011 16:32:16 -0800 (PST)\r
  33 Received: from localhost (dslb-088-069-153-158.pools.arcor-ip.net.\r
  34         [88.69.153.158])\r
  35         by mx.google.com with ESMTPS id 39sm222289eei.1.2011.12.16.16.32.14\r
  36         (version=TLSv1/SSLv3 cipher=OTHER);\r
  37         Fri, 16 Dec 2011 16:32:15 -0800 (PST)\r
  38 From: Daniel Schoepe <daniel@schoepe.org>\r
  39 To: notmuch@notmuchmail.org\r
  40 Subject: [PATCH v3 1/2] emacs: Add thread-outline functionality\r
  41 Date: Sat, 17 Dec 2011 01:32:08 +0100\r
  42 Message-Id: <1324081929-23025-2-git-send-email-daniel@schoepe.org>\r
  43 X-Mailer: git-send-email 1.7.7.3\r
  44 In-Reply-To: <1324081929-23025-1-git-send-email-daniel@schoepe.org>\r
  45 References: <1307921480-17130-1-git-send-email-daniel.schoepe@googlemail.com>\r
  46         <1324081929-23025-1-git-send-email-daniel@schoepe.org>\r
  47 Cc: Daniel Schoepe <daniel.schoepe@googlemail.com>\r
  48 X-BeenThere: notmuch@notmuchmail.org\r
  49 X-Mailman-Version: 2.1.13\r
  50 Precedence: list\r
  51 List-Id: "Use and development of the notmuch mail system."\r
  52         <notmuch.notmuchmail.org>\r
  53 List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,\r
  54         <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
  55 List-Archive: <http://notmuchmail.org/pipermail/notmuch>\r
  56 List-Post: <mailto:notmuch@notmuchmail.org>\r
  57 List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
  58 List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,\r
  59         <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
  60 X-List-Received-Date: Sat, 17 Dec 2011 00:32:18 -0000\r
  61 \r
  62 From: Daniel Schoepe <daniel.schoepe@googlemail.com>\r
  63 \r
  64 This patch adds some functionality to display the outline for threads\r
  65 displayed by notmuch-show.  The entries in the outline buffer are\r
  66 links to the corresponding message in the notmuch-show buffer.\r
  67 ---\r
  68  emacs/notmuch-lib.el  |   12 +++\r
  69  emacs/notmuch-show.el |  195 ++++++++++++++++++++++++++++++++++++++++++++++++-\r
  70  2 files changed, 206 insertions(+), 1 deletions(-)\r
  71 \r
  72 diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el\r
  73 index 0f856bf..a8be8b1 100644\r
  74 --- a/emacs/notmuch-lib.el\r
  75 +++ b/emacs/notmuch-lib.el\r
  76 @@ -43,6 +43,10 @@\r
  77  (defvar notmuch-folders nil\r
  78    "Deprecated name for what is now known as `notmuch-saved-searches'.")\r
  79  \r
  80 +(defvar notmuch-show-outline-buffer nil\r
  81 +  "Outline buffer associated with a notmuch-show buffer.")\r
  82 +(make-variable-buffer-local 'notmuch-show-outline-buffer)\r
  83 +\r
  84  (defun notmuch-saved-searches ()\r
  85    "Common function for querying the notmuch-saved-searches variable.\r
  86  \r
  87 @@ -91,9 +95,17 @@ the user hasn't set this variable with the old or new value."\r
  88    "Return the user.other_email value (as a list) from the notmuch configuration."\r
  89    (split-string (notmuch-config-get "user.other_email") "\n"))\r
  90  \r
  91 +(declare-function notmuch-show-outline-buffer-name  "notmuch-show" (&optional buf))\r
  92 +\r
  93  (defun notmuch-kill-this-buffer ()\r
  94    "Kill the current buffer."\r
  95    (interactive)\r
  96 +  ;; if we are in a notmuch-show buffer, kill the associated outline buffer, if any\r
  97 +  (when (eq major-mode 'notmuch-show-mode)\r
  98 +    (let ((outline-buf notmuch-show-outline-buffer))\r
  99 +      (when outline-buf\r
 100 +       (mapc #'delete-window (get-buffer-window-list outline-buf))\r
 101 +       (kill-buffer outline-buf))))\r
 102    (kill-buffer (current-buffer)))\r
 103  \r
 104  ;;\r
 105 diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el\r
 106 index 63b01e5..e7ce811 100644\r
 107 --- a/emacs/notmuch-show.el\r
 108 +++ b/emacs/notmuch-show.el\r
 109 @@ -107,6 +107,57 @@ indentation."\r
 110    :group 'notmuch\r
 111    :type 'boolean)\r
 112  \r
 113 +(defcustom notmuch-always-show-outline nil\r
 114 +  "Always open an outline buffer when viewing a thread?"\r
 115 +  :group 'notmuch\r
 116 +  :type 'boolean)\r
 117 +\r
 118 +(defcustom notmuch-outline-format\r
 119 +  (list "%a - %r")\r
 120 +  "Format used for thread-outline lines.\r
 121 +\r
 122 +This is a list supporting the following types of elements:\r
 123 +For a symbol, its value is used if non-nil.\r
 124 +A string is inserted verbatim with the exception\r
 125 + of the following %-constructs:\r
 126 + %a - Author\r
 127 + %d - Date\r
 128 + %s - Subject\r
 129 + %r - Relative date\r
 130 +For a list of the form `(:eval FORM)', form is evaluated\r
 131 + and its result displayed.\r
 132 +\r
 133 +The variables author, subject, date and reldate will be bound to\r
 134 +their respective values when this is interpreted, and can be\r
 135 +used in (:eval ..)-elements or directly as symbols."\r
 136 +  :group 'notmuch\r
 137 +  :type\r
 138 +  '(repeat (choice (const :tag "Author" author)\r
 139 +                  (const :tag "Date" date)\r
 140 +                  (const :tag "Relative date" reldate)\r
 141 +                  (string :tag "Format string")\r
 142 +                  (list :tag "Custom expression (will be evaluated when rendering)"\r
 143 +                        (const :tag "" :eval)\r
 144 +                        sexp))))\r
 145 +\r
 146 +(defface notmuch-outline '((t :inherit default))\r
 147 +  "Face used to display (unhighlighted) lines in thread outlines"\r
 148 +  :group 'notmuch)\r
 149 +\r
 150 +(defface notmuch-outline-highlighted\r
 151 +  '((((class color) (background light)) (:background "#f0f0f0"))\r
 152 +    (((class color) (background dark)) (:background "#303030")))\r
 153 +  "Face used to display highlight the current message in the outline buffer"\r
 154 +  :group 'notmuch)\r
 155 +\r
 156 +(defvar notmuch-outline-mode-map\r
 157 +  (let ((map (make-sparse-keymap)))\r
 158 +    (define-key map "n" 'next-line)\r
 159 +    (define-key map "p" 'previous-line)\r
 160 +    (define-key map "q" 'kill-buffer-and-window)\r
 161 +    (define-key map "x" 'kill-buffer-and-window)\r
 162 +    map))\r
 163 +\r
 164  (defmacro with-current-notmuch-show-message (&rest body)\r
 165    "Evaluate body with current buffer set to the text of current message"\r
 166    `(save-excursion\r
 167 @@ -747,12 +798,27 @@ current buffer, if possible."\r
 168      ;; message.\r
 169      (put-text-property message-start message-end :notmuch-message-extent (cons message-start message-end))\r
 170  \r
 171 +    ;; Save the indentation depth, used by `notmuch-show-outline'\r
 172 +    (put-text-property message-start message-end :notmuch-depth depth)\r
 173 +\r
 174      (let ((headers-overlay (make-overlay headers-start headers-end))\r
 175            (invis-specs (list headers-invis-spec message-invis-spec)))\r
 176        (overlay-put headers-overlay 'invisible invis-specs)\r
 177        (overlay-put headers-overlay 'priority 10))\r
 178      (overlay-put (make-overlay body-start body-end) 'invisible message-invis-spec)\r
 179  \r
 180 +    ;; Add callbacks that update the outline buffer when moving between messages.\r
 181 +    ;; Due to the mindbogglingly absurd semantics of point-entered and point-left\r
 182 +    ;; this function will will be run up to _four_ times when moving between messages:\r
 183 +    (let ((goto-msg-func\r
 184 +          `(lambda (before after)\r
 185 +             (if (and (>= after (marker-position ,message-start))\r
 186 +                      (< after (marker-position ,message-end)))\r
 187 +                 (notmuch-outline-highlight-message ,message-start)))))\r
 188 +      (add-text-properties message-start message-end\r
 189 +                          (list 'point-entered goto-msg-func\r
 190 +                                'point-left goto-msg-func)))\r
 191 +\r
 192      ;; Save the properties for this message. Currently this saves the\r
 193      ;; entire message (augmented it with other stuff), which seems\r
 194      ;; like overkill. We might save a reduced subset (for example, not\r
 195 @@ -808,6 +874,130 @@ a corresponding notmuch search."\r
 196                         'help-echo "Mouse-1, RET: search for this message"\r
 197                         'face goto-address-mail-face))))\r
 198  \r
 199 +(defun notmuch-show-message-is-visible ()\r
 200 +  "Return t if current message is visible."\r
 201 +  (plist-get (notmuch-show-get-message-properties) :message-visible))\r
 202 +\r
 203 +(defun notmuch-outline-render-format (format)\r
 204 +  "Render FORMAT, as described in `notmuch-outline-format'"\r
 205 +  (let ((author (notmuch-show-get-from))\r
 206 +       (date (notmuch-show-get-date))\r
 207 +       (subject (notmuch-show-get-subject))\r
 208 +       (reldate (plist-get (notmuch-show-get-message-properties)\r
 209 +                           :date_relative)))\r
 210 +    (mapconcat (lambda (elem)\r
 211 +                (cond\r
 212 +                 ((symbolp elem) (or (symbol-value elem) ""))\r
 213 +                 ((stringp elem)\r
 214 +                  (let ((str elem))\r
 215 +                    (mapc (lambda (subst)\r
 216 +                            (setq str\r
 217 +                                  (replace-regexp-in-string (car subst)\r
 218 +                                                            (cdr subst)\r
 219 +                                                            str)))\r
 220 +                          `(("%a" . ,author)\r
 221 +                            ("%s" . ,subject)\r
 222 +                            ("%d" . ,date)\r
 223 +                            ("%r" . ,reldate)))\r
 224 +                    str))\r
 225 +                 ((and (listp elem) (eq (car elem) :eval))\r
 226 +                  (eval (second elem)))\r
 227 +                 (t (error "Unknown element in `notmuch-outline-format': %S" elem))))\r
 228 +              format\r
 229 +              "")))\r
 230 +\r
 231 +(defun notmuch-outline-highlight-message (msg-start)\r
 232 +  "Highlight message starting at MSG-START.\r
 233 +\r
 234 +The highlighting will take place in the outline buffer, while\r
 235 +MSG-START refers to a position in the corresponding notmuch-show buffer."\r
 236 +  (when (buffer-live-p notmuch-show-outline-buffer)\r
 237 +    (with-current-buffer notmuch-show-outline-buffer\r
 238 +      (remove-overlays nil nil 'current-message t)\r
 239 +      (save-excursion\r
 240 +       (goto-char (point-min))\r
 241 +       (while (and (not (equal (get-text-property (point) :message-start)\r
 242 +                           msg-start))\r
 243 +                 (not (eobp)))\r
 244 +         (forward-line))\r
 245 +       (unless (eobp)\r
 246 +         (let ((ovl\r
 247 +                (make-overlay (line-beginning-position)\r
 248 +                              (line-end-position))))\r
 249 +         (overlay-put ovl 'face 'notmuch-outline-highlighted)\r
 250 +         (overlay-put ovl 'current-message t)))))))\r
 251 +\r
 252 +(defun notmuch-show-create-outline-buffer (&optional buf)\r
 253 +  "Create an outline buffer for show-buffer BUF.\r
 254 +\r
 255 +Returns the created buffer."\r
 256 +\r
 257 +  (generate-new-buffer (concat (buffer-name buf) " - outline")))\r
 258 +\r
 259 +(defun notmuch-outline-message ()\r
 260 +  "Outline the message under the point.\r
 261 +\r
 262 +Expects the point to be on the beginning of the first line of the message."\r
 263 +  (lexical-let*\r
 264 +      ((msg-start (car (notmuch-show-message-extent)))\r
 265 +       (outline-buf notmuch-show-outline-buffer)\r
 266 +       (goto-message\r
 267 +       (lambda (btn)\r
 268 +         (let ((win (get-buffer-window outline-buf)))\r
 269 +           (when win\r
 270 +             (select-window (get-buffer-window outline-buf))\r
 271 +             (when (marker-buffer msg-start)\r
 272 +               (switch-to-buffer-other-window (marker-buffer msg-start))\r
 273 +               (notmuch-outline-highlight-message msg-start)\r
 274 +               (goto-char (marker-position msg-start))\r
 275 +               (when (not (notmuch-show-message-is-visible))\r
 276 +                 (notmuch-show-toggle-message))))))))\r
 277 +    (let ((indentation (or (get-text-property (point) :notmuch-depth) 0))\r
 278 +         (button-label (notmuch-outline-render-format\r
 279 +                        notmuch-outline-format)))\r
 280 +      (with-current-buffer outline-buf\r
 281 +       (indent-to indentation)\r
 282 +       (insert button-label)\r
 283 +       (make-text-button (line-beginning-position) (line-end-position)\r
 284 +                         'action goto-message\r
 285 +                         'follow-link t\r
 286 +                         'help-echo "mouse-1, RET: show this message"\r
 287 +                         'face 'notmuch-outline)\r
 288 +       (put-text-property (line-beginning-position) (line-end-position)\r
 289 +                          :message-start msg-start)\r
 290 +       (insert "\n")))))\r
 291 +\r
 292 +(defun notmuch-show-outline ()\r
 293 +  "Generate an outline for the current buffer.\r
 294 +\r
 295 +This function must only be called in a notmuch-show buffer."\r
 296 +  (interactive)\r
 297 +  (if (buffer-live-p notmuch-show-outline-buffer)\r
 298 +      (switch-to-buffer-other-window notmuch-show-outline-buffer)\r
 299 +    (let ((outline-buf (notmuch-show-create-outline-buffer))\r
 300 +         (inhibit-point-motion-hooks t))\r
 301 +      (setq notmuch-show-outline-buffer outline-buf)\r
 302 +      (save-excursion\r
 303 +       (with-current-buffer outline-buf\r
 304 +         (notmuch-outline-mode))\r
 305 +       (goto-char (point-min))\r
 306 +       (while (not (eobp))\r
 307 +         (notmuch-outline-message)\r
 308 +         (goto-char (marker-position (cdr (notmuch-show-message-extent)))))\r
 309 +       (with-current-buffer outline-buf\r
 310 +         (setq buffer-read-only t)))\r
 311 +      (notmuch-outline-highlight-message (car (notmuch-show-message-extent)))\r
 312 +      (let ((win (selected-window)))\r
 313 +       (switch-to-buffer-other-window outline-buf)\r
 314 +       (select-window win)))))\r
 315 +\r
 316 +(defun notmuch-outline-mode ()\r
 317 +  (interactive)\r
 318 +  (kill-all-local-variables)\r
 319 +  (use-local-map notmuch-outline-mode-map)\r
 320 +  (setq major-mode 'notmuch-show-outline-mode\r
 321 +       mode-name "notmuch-show-outline"))\r
 322 +\r
 323  ;;;###autoload\r
 324  (defun notmuch-show (thread-id &optional parent-buffer query-context buffer-name crypto-switch)\r
 325    "Run \"notmuch show\" with the given thread ID and display results.\r
 326 @@ -881,7 +1071,9 @@ buffer."\r
 327      ;; Set the header line to the subject of the first open message.\r
 328      (setq header-line-format (notmuch-show-strip-re (notmuch-show-get-subject)))\r
 329  \r
 330 -    (notmuch-show-mark-read)))\r
 331 +    (notmuch-show-mark-read)\r
 332 +    (when notmuch-always-show-outline\r
 333 +      (notmuch-show-outline))))\r
 334  \r
 335  (defun notmuch-show-refresh-view (&optional crypto-switch)\r
 336    "Refresh the current view (with crypto switch if prefix given).\r
 337 @@ -941,6 +1133,7 @@ thread id.  If a prefix is given, crypto processing is toggled."\r
 338         (define-key map "P" 'notmuch-show-previous-message)\r
 339         (define-key map "n" 'notmuch-show-next-open-message)\r
 340         (define-key map "p" 'notmuch-show-previous-open-message)\r
 341 +       (define-key map "o" 'notmuch-show-outline)\r
 342         (define-key map (kbd "DEL") 'notmuch-show-rewind)\r
 343         (define-key map " " 'notmuch-show-advance-and-archive)\r
 344         (define-key map (kbd "M-RET") 'notmuch-show-open-or-close-all)\r
 345 -- \r
 346 1.7.7.3\r
 347 \r