From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp12.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms5.migadu.com with LMTPS id 2AcrCbCYK2PLMAEAbAwnHQ (envelope-from ) for ; Thu, 22 Sep 2022 01:05:20 +0200 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp12.migadu.com with LMTPS id ILwLCbCYK2MUdAAAauVa8A (envelope-from ) for ; Thu, 22 Sep 2022 01:05:20 +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 B8C8ECECA for ; Thu, 22 Sep 2022 01:05:19 +0200 (CEST) Received: from yantan.tethera.net (localhost [127.0.0.1]) by mail.notmuchmail.org (Postfix) with ESMTP id 900D25F393; Wed, 21 Sep 2022 22:55:59 +0000 (UTC) Received: from eggs.gnu.org (eggs.gnu.org [IPv6:2001:470:142:3::10]) by mail.notmuchmail.org (Postfix) with ESMTPS id 65ADD5F38E for ; Wed, 21 Sep 2022 22:55:57 +0000 (UTC) Received: from fencepost.gnu.org ([2001:470:142:3::e]:33674) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1ob8d4-0005Gu-7j; Wed, 21 Sep 2022 18:55:55 -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=CXRnG0SCrvWWozmC50efGAPJQZHAnvIiSkc5TTR9cnE=; b=VNGjWLAARTZ/NW 0CeGxa5LkuVhBul8cEiWUypoPERa8/uHs8iTQbWrTJhfcL86j9/h/sw8fvRnUKLI1pc1JIcBQJ78w lROe4OHapi9Q5fvqPlpdcC2WOF48tGouvsvZ9K2df34zDDYlTIaWnJbx5ot6+2eU9bXPtwVj66aAd KkxoIUCrZRGhnGG0ZbU2VvvN2th0Wtct5YRowgQnr2CJXYuTcZX1UPMj8vphhhNNcIl3WV/T832Jt igcZZ2T6OZ+HYviYiuFA/z67e5p9GGgzssuYPUuAqbEgcaxNEAIn5GOCxhPKCB+Zyxc8idOpDxgAF FUTAPamhkCTS3xPGn81A==; Received: from cpc103048-sgyl39-2-0-cust502.18-2.cable.virginm.net ([92.233.85.247]:43524 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 1ob8cf-0006uj-EL; Wed, 21 Sep 2022 18:55:41 -0400 From: jao To: notmuch@notmuchmail.org Subject: [PATCH v3] emacs: notmuch-tree-outline-mode Date: Wed, 21 Sep 2022 23:55:10 +0100 Message-Id: <20220921225510.3159023-1-jao@gnu.org> X-Mailer: git-send-email 2.37.2 MIME-Version: 1.0 Message-ID-Hash: Q5AKWPRKEBBGH6EEPQHJRYQGU7RYJBGG X-Message-ID-Hash: Q5AKWPRKEBBGH6EEPQHJRYQGU7RYJBGG 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=1663801519; 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=l21g/9ER98+2O/afogg4l5JQB7+t02ZMBbvLnMVVfjE=; b=Fh9KFPOTRi/qwJzrXZrEmYksBIYH5+5FOmpCI2XhzMCNe9svzRuUreRgMSAteR9h2zoXHz bjw8eKo+G5e986KFV6GD4ETLSHT3X6bX3ZlFYb9OXCPzesSG+8QOBvzEQSwnNNqjVX9WJX aq2I60fgSoAcWSctt39ojbJApmG7keBProPM6jV6TI50uRRQSu2lEIgM6dVGvJJ4r+f7kS 271dIos+M6gWUnrD4Pn689vqv0qXy3b+VTu9Z1M9lW/oiNPGjWTSjS0lfOY7Zojaa+sRVN dr/cMJN7agcFnsLCslJlkgoZahquaGmmpFBcm4qOkEkDpTL3H87rPApih0L2TQ== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1663801519; a=rsa-sha256; cv=none; b=PC+3UqjGUroQqkJcZ1R5lhQUIvOXe3hIkKoY5py7ldU/sWJTsuxNvfh5acSGud7sWn5gqa 3AAbBmDn8y41MJl83lbv/OSXjzuxPT2J64bBKpUHrA/m8kjMK0lXjGpQJXVBCmQxfkbObP k4ZltQbDPO2gnFtQH+0IgysOr0byyQerCMjUb7wRSratspKM1Ewo1ncTunn3sgWfdOze/z aH8XAn/4UCPczR+mty8KcpRUEGNjjRw7owLsggWkG53C/5max7s3b88kMzQG9xUpVeJyNg GJCDOKLLorzHsa/B5U01FsO6PV1BSZCV5tkUOMowiZzmbbA5TZVhi4K7rbj8pg== 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=VNGjWLAA; 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.52 Authentication-Results: aspmx1.migadu.com; dkim=fail ("body hash did not verify") header.d=gnu.org header.s=fencepost-gnu-org header.b=VNGjWLAA; 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: B8C8ECECA X-Spam-Score: 7.52 X-Migadu-Scanner: scn1.migadu.com X-TUID: mmUZEWahCSoc 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 v2 (id:87v8ta60w4.fsf@mail.jao.io) with a small fix for one of the auxiliary functions (notmuch-tree-outline--message-open-p). This version supersedes id:20220918203658.1893065-1-jao@gnu.org with: It improves on the above by allowing folding operations for nested subtrees, and fixing some glitches with (folded) thread navigation. 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..79de4c3d 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)) + (when notmuch-tree-outline-mode (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-mode-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-mode-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