f5/87838279888a381c4f6771bce34dd1450a5a4f

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