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 aILFDk+DJ2PajQAAbAwnHQ (envelope-from ) for ; Sun, 18 Sep 2022 22:45:03 +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 WGiuDk+DJ2NLHQEAauVa8A (envelope-from ) for ; Sun, 18 Sep 2022 22:45:03 +0200 Received: from mail.notmuchmail.org (yantan.tethera.net [IPv6:2a01:4f9:c011:7a79::1]) (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 B9F78106A8 for ; Sun, 18 Sep 2022 22:45:02 +0200 (CEST) Received: from yantan.tethera.net (localhost [127.0.0.1]) by mail.notmuchmail.org (Postfix) with ESMTP id 992375E012; Sun, 18 Sep 2022 20:37:25 +0000 (UTC) Received: from eggs.gnu.org (eggs.gnu.org [IPv6:2001:470:142:3::10]) by mail.notmuchmail.org (Postfix) with ESMTPS id 2ADFF5DC06 for ; Sun, 18 Sep 2022 20:37:23 +0000 (UTC) Received: from fencepost.gnu.org ([2001:470:142:3::e]:37084) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oa12W-0006SC-BR; Sun, 18 Sep 2022 16:37:20 -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=jmYmHWzIbqZyaID4iXHwArLVa7I/YEAPf6V+eu+uxN8=; b=kIwGJvl92ajdnd KKMGsIJqWqPYs8TD/UA8DiUEgLtpYqUUnPGqukYsWMoRyEL0p2pVDG6mk45w7dnFydLrF7hNzoazj 03U0fGj7G4hjcyVQKnPJg6WxzdxPWaCRM6vwI68DiL49l7N1YUl9gEY2OvXSHMoF+l9HAGyKQaTO0 F3QmFVlUyAC+nSreiEkU4xnvgRxY5euFLzN956hljZ7TOGZ++nX8LOSo2EIrP9d7S3PA1NQfxfKv5 gzb1XKkvwtSXlmmwA3Jmw93xsDkL7pBPSWNdhPtBxkx+S503DsEgo8wjUWVLGZvkIPu1OLTwucy8b 87AKfSZwJdD0LNVepd5Q==; Received: from cpc103048-sgyl39-2-0-cust502.18-2.cable.virginm.net ([92.233.85.247]:40036 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 1oa12V-00017t-IR; Sun, 18 Sep 2022 16:37:19 -0400 From: jao To: notmuch@notmuchmail.org Subject: [PATCH] emacs: notmuch-tree-outline-mode Date: Sun, 18 Sep 2022 21:36:58 +0100 Message-Id: <20220918203658.1893065-1-jao@gnu.org> X-Mailer: git-send-email 2.37.2 MIME-Version: 1.0 Message-ID-Hash: AQ46UIZP22B77YG3TJ4J5XHUS6A53YD3 X-Message-ID-Hash: AQ46UIZP22B77YG3TJ4J5XHUS6A53YD3 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=1663533902; 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=aVqe+cotxN6AUhLeB2IKjq0lwS+asytb1aG6hyLnrSI=; b=UokWLte34Lzm95U/zAoZzK82CAutuWTxCHysJCvgTe0+dHw1qpR51cyM0ZAocU4hW6C7NI XzVoskazEP3Y5zUyasCqAG0TWtvWvT1z1vVCkXSzz5eNGT7v6u4nKekTYohzEotP0egpD5 1grqLbMbVH+/RUZLI0x+CAV/zp9KyoUMswU6cHA5+W4WnUSKgLoGOtv4GAz634zQJGLaVj gBNDkRRTq+DV7lg5oPoAQWtdOSRaBp7Ft1DO7VWDl0boXnviBIIF2Fy7XeYKF5r83ycCOz +O5KFHXb58ZqnRYnFWuu7MElvLaSu2cm7CMwiKdmMfvSuRBAsnbOTcsrkykiqA== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1663533902; a=rsa-sha256; cv=none; b=ghL/4lP44/hXRc095+Trh0OQAJJshiSKXw6g9Z1LLH1kzfAhUbNMq+q/JMc8Ki5Pb/hGm1 rM+wiLzPsTTQWZ1J3mduF9bG4Iujd35CZ9xcPHClM671nMXj/W4TEVtjiKxWKr/XAXEBxn cTHliVYd7ZWuBsaylGxuu+K/u+MYedZ2VZ1d9HvB4VZz8VcMBQhT00WzxKQJAMREmJQ6YJ NFLadNl6/rpn0rM6e+/fMhlf6y0vwrublkXfxPp9py4sqbGoqec8t9/f7kYBs0TfFGjb6G grRXyaQeBenVdhU4wouyVQ/EFbqj+w240REfH5m+tIX62TSBnQ9DmIRSyVZ2Xg== 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=kIwGJvl9; 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 2a01:4f9:c011:7a79::1 as permitted sender) smtp.mailfrom=notmuch-bounces@notmuchmail.org X-Migadu-Spam-Score: 7.51 Authentication-Results: aspmx1.migadu.com; dkim=fail ("body hash did not verify") header.d=gnu.org header.s=fencepost-gnu-org header.b=kIwGJvl9; 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 2a01:4f9:c011:7a79::1 as permitted sender) smtp.mailfrom=notmuch-bounces@notmuchmail.org X-Migadu-Queue-Id: B9F78106A8 X-Spam-Score: 7.51 X-Migadu-Scanner: scn1.migadu.com X-TUID: 7MUXKZ4s6V+r 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 character before each thread head that is then used as the regexp used by outline-minor-mode to recognise headers. --- I've been using this mode for a while and seems to work well for my needs, although every now and then navigation with commands other than the ones it defines puts point in a bad place... usually it's very easy to go back to where you were (e.g., a simple C-a), but maybe i'm having stockholm syndrome :) I think the same trick i'm playing could be used to allow folding of subtrees at more than one level (just insert several hidden > instead of just one), but i'm not sure it would be of much use or introduce any problem, so i've not done it here. Perhaps we could add it under an opt-in option if people think it useful. Signed-off-by: jao --- doc/notmuch-emacs.rst | 20 ++++++ emacs/notmuch-tree.el | 157 ++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 177 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..50139589 100644 --- a/emacs/notmuch-tree.el +++ b/emacs/notmuch-tree.el @@ -984,11 +984,17 @@ unchanged ADDRESS if parsing fails." (setq result-string (concat result-string field-string)))) (notmuch-apply-face result-string face t))) +(defvar notmuch-tree--insert-pre-fun nil + "Function called before every message header in the forest view. +Mainly for internal use (e.g. by outline mode).") + (defun notmuch-tree-insert-msg (msg) "Insert the message MSG according to notmuch-tree-result-format." ;; 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 (functionp notmuch-tree--insert-pre-fun) + (funcall notmuch-tree--insert-pre-fun 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) @@ -1265,6 +1271,157 @@ 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 window when moving past the last message or before the first one." + :type 'boolean) + +;;;; Helper functions +(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 (not (looking-at-p "^$"))) + (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) + +(defun notmuch-tree-outline--insert-prefix (msg) + (insert (propertize (if (plist-get msg :first) "> " " ") 'display " "))) + +(defun notmuch-tree-outline--message-open-p () + (and (buffer-live-p notmuch-tree-message-buffer) + (get-buffer-window notmuch-tree-message-buffer))) + +(defun notmuch-tree-outline--looking-at-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) + (let ((pop (if notmuch-tree-outline-auto-close (not pop-at-end) pop-at-end))) + (cond ((and (not ignore-new) + (notmuch-tree-outline--looking-at-match-p) + (not (notmuch-tree-outline--message-open-p)))) + (thread + (notmuch-tree-next-thread prev) + (unless (or (not (notmuch-tree-get-message-properties)) + (notmuch-tree-outline--looking-at-match-p)) + (notmuch-tree-matching-message prev pop))) + (t (notmuch-tree-matching-message prev pop)))) + (when (notmuch-tree-get-message-id) + (notmuch-tree-outline-hide-others t)) + (when prev (forward-char 2))) + +;;;; 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 thread visible if it's not." + (interactive) + (outline-hide-body) + (outline-show-entry) + (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") + (if (null notmuch-tree-outline-visibility) + (notmuch-tree-matching-message nil pop-at-end) + (notmuch-tree-outline--next nil nil pop-at-end))) + +(defun notmuch-tree-outline-previous (&optional pop-at-end) + "Previous matching message in forest, taking care of thread visibility. +A prefix argument reverses the meaning of `notmuch-tree-outline-auto-close'." + (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 "P") + (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 present.") + +(define-minor-mode notmuch-tree-outline-mode + "Minor mode allowing message trees to be folded as outlines. + +When this mode is set, each thread in the results list is treated +as a foldable section, with its first message as its header. + +The customizable variable `notmuch-tree-outline-visibility' +controls how navigation in the buffer is affected this mode. By +default, it just makes available all the keybindings in +`outline-minor-mode', and binds \\[outline-cycle] to +`outline-cycle' and \\[outline-cycle-buffer] to +`outline-cycle-buffer'. If, on the other hand, +`notmuch-tree-outline-visibility' is set to a non-nil value, +visiting messages via \\[notmuch-tree-outline-next], +\\[notmuch-tree-outline-previous], +\\[notmuch-tree-outline-next-thread], and +\\[notmuch-tree-outline-previous-thread] will also take care of +hiding the outlines of the trees you are not reading. + +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 notmuch-tree--insert-pre-fun + #'notmuch-tree-outline--insert-prefix + outline-regexp "^> \\|^En") + (notmuch-tree-outline--set-visibility)) + (setq-local notmuch-tree--message-header-prefix nil + outline-regexp (default-value 'outline-regexp)))) + ;;; _ (provide 'notmuch-tree) -- 2.37.2