From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp12.migadu.com ([2001:41d0:8:6d80::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms5.migadu.com with LMTPS id ECvxMucaLmOQ+AAAbAwnHQ (envelope-from ) for ; Fri, 23 Sep 2022 22:45:27 +0200 Received: from aspmx1.migadu.com ([2001:41d0:8:6d80::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp12.migadu.com with LMTPS id mArQMucaLmNCTwEAauVa8A (envelope-from ) for ; Fri, 23 Sep 2022 22:45:27 +0200 Received: from mail.notmuchmail.org (yantan.tethera.net [135.181.149.255]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (2048 bits) server-digest SHA256) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id 5EF0F1D6DC for ; Fri, 23 Sep 2022 22:45:27 +0200 (CEST) Received: from yantan.tethera.net (localhost [127.0.0.1]) by mail.notmuchmail.org (Postfix) with ESMTP id 0C89B5F3E5; Fri, 23 Sep 2022 20:35:37 +0000 (UTC) Received: from eggs.gnu.org (eggs.gnu.org [IPv6:2001:470:142:3::10]) by mail.notmuchmail.org (Postfix) with ESMTPS id 8C38A5F368 for ; Fri, 23 Sep 2022 20:35:34 +0000 (UTC) Received: from fencepost.gnu.org ([2001:470:142:3::e]:35630) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1obpOV-0007hM-FW; Fri, 23 Sep 2022 16:35:32 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:Date:Subject:To:From:in-reply-to: references; bh=3Igpegvwl9blw4iNLoYoHr0n7cfYd5p9tPw/tlE+uHQ=; b=jVvnt5drZJY7Nc E0BbEC0LCNKzHSHwJm2buTG4K/MjEosqZw53v29njnfY2MxPGHdWLt2Uf9Ot4c2tobt5UIV9HS6uS HRVtHpD7bqXhwHA+h0P6Q8IM0Yrx4iwMkH8BdFVcuI4wW8V1VzJzZM7LZBVKBacUCqWG6zeIyzHYY eeBu282vfW9P4cJaWUYVsfMy1DwUa0xUIIen/5asJVAuZlf4lMbNvXnOZ+rTNLIKLZ3O2eQAlswJq hTwLm/ytjzGT4KDHYzuwQGqwZ45RQSWnagdGIsRVJATGTNHTNSxuvmJgXHpokyHQKQ3JAFmSKrNvA xhXQ45qbyNxx1VhV4VCw==; Received: from cpc103048-sgyl39-2-0-cust502.18-2.cable.virginm.net ([92.233.85.247]:55254 helo=rivendell.localdomain) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1obpOT-0006X9-Tw; Fri, 23 Sep 2022 16:35:30 -0400 From: jao To: notmuch@notmuchmail.org Subject: [PATCH v4] emacs: notmuch-tree-outline-mode Date: Fri, 23 Sep 2022 21:34:50 +0100 Message-Id: <20220923203449.3747562-1-jao@gnu.org> X-Mailer: git-send-email 2.37.2 MIME-Version: 1.0 Message-ID-Hash: GETG3BJD77STBM7IEDMRNXEDVNH7MCWL X-Message-ID-Hash: GETG3BJD77STBM7IEDMRNXEDVNH7MCWL X-MailFrom: jao@gnu.org X-Mailman-Rule-Misses: dmarc-mitigation; no-senders; approved; emergency; loop; banned-address; member-moderation; header-match-notmuch.notmuchmail.org-0; nonmember-moderation; administrivia; implicit-dest; max-recipients; max-size; news-moderation; no-subject; digests; suspicious-header CC: jao X-Mailman-Version: 3.3.3 Precedence: list List-Id: "Use and development of the notmuch mail system." List-Help: List-Owner: List-Post: List-Subscribe: List-Unsubscribe: Content-Type: text/plain; charset="us-ascii" Content-Transfer-Encoding: 7bit X-Migadu-Flow: FLOW_IN X-Migadu-To: larch@yhetil.org X-Migadu-Country: DE ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1663965927; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:cc:mime-version:mime-version:content-type:content-type: content-transfer-encoding:content-transfer-encoding:list-id:list-help: list-owner:list-unsubscribe:list-subscribe:list-post:dkim-signature; bh=utc4ps8IypwaxDHw13b1XL8DrSmmrWdjmd0Y32g3ZkQ=; b=UnQzwzjGK2XOLhVkCvN34P1ihHqMEdzo3KyAzhnFtuoGuM1R8DMXN05WvJApA/DbKoi/bI 1la6i/bLwKBVISFPvt/F+2dis98QJOZ8AxJcAbjrqsWr39Y+0GWfDQRdZpBj5Pa6JfwMYg 6LS/LA4Oifk4MLmbKqUcvvvEQQmPyCWngZP66R6XOSxNmE4Z4eGedaTNgfXlkfp4ojC0vl dztwr1oIg2ozd4pXG5nhk3+Au8Yb4+Z3c8rkBhj+fSfaZg87z/olOo0HVD6WJKf8DsbRB/ +XTZfikMLwwUy3zWdd0Rq2kxLzffgClUwb7fd8YfZW1+aM9kJuvDqhgyPNG3rg== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1663965927; a=rsa-sha256; cv=none; b=TuOo/R1llZg5VAD1slrapT7ELbcnEV8pDxSO54PGa7OMPDJrf3+MkOu+dWvhtTOuE/da7v 6cQgOo2PaRKGmWhCfEq1FeyxiE9Nnn6Z7GJUvoJBcw2csGuGftozT6a++3zdvtwgnOVikg fPxBY2EyGlmKnXptWU8lV3hCvB2GI2IrSzZq1ahnUvVJYva7V0E6Hpa01FJkGYPgOvAkrI 8fs1uWnVfokMZug4m648OZ0Ghq4aK4/thPKsPvXWErrNNbM4F9pwiZtH/OM365K9PAWfZM +8sCn0GgXLG20AFqEExiBo+/Uuyjv4WTOVE3UGCV7i3dOGLJ1tszl3MKn/KdjA== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=fail ("body hash did not verify") header.d=gnu.org header.s=fencepost-gnu-org header.b=jVvnt5dr; dmarc=fail reason="SPF not aligned (relaxed)" header.from=gnu.org (policy=none); spf=pass (aspmx1.migadu.com: domain of notmuch-bounces@notmuchmail.org designates 135.181.149.255 as permitted sender) smtp.mailfrom=notmuch-bounces@notmuchmail.org X-Migadu-Spam-Score: 7.59 Authentication-Results: aspmx1.migadu.com; dkim=fail ("body hash did not verify") header.d=gnu.org header.s=fencepost-gnu-org header.b=jVvnt5dr; dmarc=fail reason="SPF not aligned (relaxed)" header.from=gnu.org (policy=none); spf=pass (aspmx1.migadu.com: domain of notmuch-bounces@notmuchmail.org designates 135.181.149.255 as permitted sender) smtp.mailfrom=notmuch-bounces@notmuchmail.org X-Migadu-Queue-Id: 5EF0F1D6DC X-Spam-Score: 7.59 X-Migadu-Scanner: scn1.migadu.com X-TUID: /aFXMGLkI5Qp With this mode, one can fold trees in the notmuch-tree buffer as if they were outlines, using all the commands provided by outline-minor-mode. We also define a couple of movement commands that, optional, will ensure that only the thread around point is unfolded. The implementation is based on the trick of inserting an invisible prefix before each thread head that is then used as the regexp used by outline-minor-mode to recognise headers. The message plist is also augmented with a :level property that provides a fast outline-level function. --- This version supesedes v3 (id:20220921225510.3159023-1-jao@gnu.org) by allowing notmuch-tree-ouline-mode to be enabled manually, not only automatically via notmuch-tree-outline-enabled, which was misnamed in the defcustom, by the way: we use now that name, as documented). Signed-off-by: jao --- doc/notmuch-emacs.rst | 20 +++++ emacs/notmuch-tree.el | 176 ++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 196 insertions(+) diff --git a/doc/notmuch-emacs.rst b/doc/notmuch-emacs.rst index 846f5e67..53e68c4d 100644 --- a/doc/notmuch-emacs.rst +++ b/doc/notmuch-emacs.rst @@ -606,6 +606,26 @@ can be controlled by the variable ``notmuch-search-oldest-first``. See also :el:defcustom:`notmuch-search-result-format` and :el:defcustom:`notmuch-unthreaded-result-format`. +It is also possible to enable outlines in notmuch tree buffers, via +``notmuch-tree-outline-mode``. + +|docstring::notmuch-tree-outline-mode| + +The behaviour of this minor mode is affected by the following +customizable variables: + +.. el:defcustom:: notmuch-tree-outline-enabled + + |docstring::notmuch-tree-outline-enabled| + +.. el:defcustom:: notmuch-tree-outline-visibility + + |docstring::notmuch-tree-outline-visibility| + +.. el:defcustom:: notmuch-tree-outline-auto-close + + |docstring::notmuch-tree-outline-auto-close| + .. _notmuch-unthreaded: diff --git a/emacs/notmuch-tree.el b/emacs/notmuch-tree.el index 7ceddee2..bff29351 100644 --- a/emacs/notmuch-tree.el +++ b/emacs/notmuch-tree.el @@ -989,6 +989,7 @@ unchanged ADDRESS if parsing fails." ;; We need to save the previous subject as it will get overwritten ;; by the insert-field calls. (let ((previous-subject notmuch-tree-previous-subject)) + (notmuch-tree-outline--insert-prefix msg) (insert (notmuch-tree-format-field-list (notmuch-tree-result-format) msg)) (notmuch-tree-set-message-properties msg) (notmuch-tree-set-prop :previous-subject previous-subject) @@ -1036,6 +1037,8 @@ message together with all its descendents." (setq msg (plist-put msg :first (and first (eq 0 depth)))) (setq msg (plist-put msg :tree-status tree-status)) (setq msg (plist-put msg :orig-tags (plist-get msg :tags))) + (setq msg (plist-put msg + :level (1+ (if (and (eq 0 depth) (not first)) 1 depth)))) (notmuch-tree-goto-and-insert-msg msg) (pop tree-status) (pop tree-status) @@ -1265,6 +1268,179 @@ search results and that are also tagged with the given TAG." nil notmuch-search-oldest-first))) +;;; Tree outline mode +;;;; Custom variables +(defcustom notmuch-tree-outline-enabled nil + "Whether to automatically activate `notmuch-tree-outline-mode' in tree views." + :type 'boolean) + +(defcustom notmuch-tree-outline-visibility 'hide-others + "Default state of the forest outline for `notmuch-tree-outline-mode'. +This variable controls the state of a forest initially and after +a movement command. If set to nil, all trees are displayed while +the symbol hide-all indicates that all trees in the forest should +be folded and hide-other that only the first one should be +unfolded." + :type '(choice (const :tag "Show all" nil) + (const :tag "Hide others" hide-others) + (const :tag "Hide all" hide-all))) + +(defcustom notmuch-tree-outline-auto-close nil + "Close message and tree windows when moving past the last message." + :type 'boolean) + +;;;; Helper functions +(defsubst notmuch-tree-outline--pop-at-end (pop-at-end) + (if notmuch-tree-outline-auto-close (not pop-at-end) pop-at-end)) + +(defun notmuch-tree-outline--enable-mode () + (when notmuch-tree-outline-enabled (notmuch-tree-outline-mode 1))) + +(add-hook 'notmuch-tree-mode-hook #'notmuch-tree-outline--enable-mode) + +(defun notmuch-tree-outline--set-visibility () + (when (and notmuch-tree-outline-mode (> (point-max) (point-min))) + (cond ((eq notmuch-tree-outline-visibility 'hide-others) + (notmuch-tree-outline-hide-others)) + ((eq notmuch-tree-outline-visibility 'hide-all) + (outline-hide-body))))) + +(defun notmuch-tree-outline--on-exit (proc) + (when (eq (process-status proc) 'exit) + (notmuch-tree-outline--set-visibility))) + +(add-hook 'notmuch-tree-process-exit-functions #'notmuch-tree-outline--on-exit) + +(defsubst notmuch-tree-outline--level (&optional props) + (or (plist-get (or props (notmuch-tree-get-message-properties)) :level) 0)) + +(defun notmuch-tree-outline--insert-prefix (msg) + (let ((pref (make-string (notmuch-tree-outline--level msg) ?>))) + (insert (propertize (concat pref " ") 'display "")))) + +(defsubst notmuch-tree-outline--message-open-p () + (and (buffer-live-p notmuch-tree-message-buffer) + (get-buffer-window notmuch-tree-message-buffer) + (string-match-p (regexp-quote (or (notmuch-tree-get-message-id) "")) + (buffer-name notmuch-tree-message-buffer)))) + +(defsubst notmuch-tree-outline--at-original-match-p () + (and (notmuch-tree-get-prop :match) + (equal (notmuch-tree-get-prop :orig-tags) + (notmuch-tree-get-prop :tags)))) + +(defun notmuch-tree-outline--next (prev thread pop-at-end &optional ignore-new) + (cond ((and (not ignore-new) + (notmuch-tree-outline--at-original-match-p) + (not (notmuch-tree-outline--message-open-p))) + (notmuch-tree-outline-hide-others t)) + (thread + (notmuch-tree-thread-top) + (ignore-errors + (if prev + (outline-backward-same-level 1) + (outline-forward-same-level 1)) + (when (> (notmuch-tree--outline-level) 0) (outline-show-branches))) + (notmuch-tree-outline--next nil nil pop-at-end)) + (t (outline-next-visible-heading (if prev -1 1)) + (unless (notmuch-tree-get-prop :match) + (notmuch-tree-matching-message prev pop-at-end)) + (notmuch-tree-outline-hide-others t)))) + +;;;; User commands +(defun notmuch-tree-outline-hide-others (&optional and-show) + "Fold all threads except the one around point. +If AND-SHOW is t, make the current message visible if it's not." + (interactive) + (save-excursion + (while (and (not (bobp)) (> (notmuch-tree-outline--level) 1)) + (outline-previous-heading)) + (outline-hide-sublevels 1)) + (when (> (notmuch-tree-outline--level) 0) + (outline-show-subtree) + (when and-show (notmuch-tree-show-message nil)))) + +(defun notmuch-tree-outline-next (&optional pop-at-end) + "Next matching message in a forest, taking care of thread visibility. +A prefix argument reverses the meaning of `notmuch-tree-outline-auto-close'." + (interactive "P") + (let ((pop (notmuch-tree-outline--pop-at-end pop-at-end))) + (if (null notmuch-tree-outline-visibility) + (notmuch-tree-matching-message nil pop) + (notmuch-tree-outline--next nil nil pop)))) + +(defun notmuch-tree-outline-previous (&optional pop-at-end) + "Previous matching message in forest, taking care of thread visibility. +With prefix, quit the tree view if there is no previous message." + (interactive "P") + (if (null notmuch-tree-outline-visibility) + (notmuch-tree-prev-matching-message pop-at-end) + (notmuch-tree-outline--next t nil pop-at-end))) + +(defun notmuch-tree-outline-next-thread () + "Next matching thread in forest, taking care of thread visibility." + (interactive) + (if (null notmuch-tree-outline-visibility) + (notmuch-tree-next-thread) + (notmuch-tree-outline--next nil t nil))) + +(defun notmuch-tree-outline-previous-thread () + "Previous matching thread in forest, taking care of thread visibility." + (interactive) + (if (null notmuch-tree-outline-visibility) + (notmuch-tree-prev-thread) + (notmuch-tree-outline--next t t nil))) + +;;;; Mode definition +(defvar notmuch-tree-outline-mode-lighter nil + "The lighter mark for notmuch-tree-outline mode. +Usually empty since outline-minor-mode's lighter will be active.") + +(define-minor-mode notmuch-tree-outline-mode + "Minor mode allowing message trees to be folded as outlines. + +When this mode is set, each thread and subthread in the results +list is treated as a foldable section, with its first message as +its header. + +The mode just makes available in the tree buffer all the +keybindings in `outline-minor-mode', and binds the following +additional keys: + +\\{notmuch-tree-outline-mode-map} + +The customizable variable `notmuch-tree-outline-visibility' +controls how navigation in the buffer is affected by this mode: + + - If it is set to nil, `notmuch-tree-outline-previous', + `notmuch-tree-outline-next', and their thread counterparts + behave just as the corresponding notmuch-tree navigation keys + when this mode is not enabled. + + - If, on the other hand, `notmuch-tree-outline-visibility' is + set to a non-nil value, these commands hiding the outlines of + the trees you are not reading as you move to new messages. + +To enable notmuch-tree-outline-mode by default in all +notmuch-tree buffers, just set +`notmuch-tree-outline-mode-enabled' to t." + :lighter notmuch-tree-outline-mode-lighter + :keymap `((,(kbd "TAB") . outline-cycle) + (,(kbd "M-TAB") . outline-cycle-buffer) + ("n" . notmuch-tree-outline-next) + ("p" . notmuch-tree-outline-previous) + (,(kbd "M-n") . notmuch-tree-outline-next-thread) + (,(kbd "M-p") . notmuch-tree-outline-previous-thread)) + (outline-minor-mode notmuch-tree-outline-mode) + (unless (derived-mode-p 'notmuch-tree-mode) + (user-error "notmuch-tree-outline-mode is only meaningful for notmuch trees!")) + (if notmuch-tree-outline-mode + (progn (setq-local outline-regexp "^>+ \\|^En" + outline-level #'notmuch-tree-outline--level) + (notmuch-tree-outline--set-visibility)) + (setq-local outline-regexp (default-value 'outline-regexp) + outline-level (default-value 'outline-level)))) + ;;; _ (provide 'notmuch-tree) -- 2.37.2