mirror of
https://git.notmuchmail.org/git/notmuch
synced 2024-12-22 09:24:54 +01:00
emacs: create notmuch-tag.el, and move appropriate functions from notmuch.el
Tagging functions are used in notmuch.el, notmuch-show.el, and notmuch-message.el. There are enough common functions for tagging that it makes sense to put them all in their own library. No code is modified, just moved around.
This commit is contained in:
Jameson Graef Rollins
David Bremner
parent
f5102f71ea
commit
eb8feb1666
5 changed files with 139 additions and 110 deletions
|
|
@ -13,6 +13,7 @@ emacs_sources := \
|
|||
$(dir)/notmuch-maildir-fcc.el \
|
||||
$(dir)/notmuch-message.el \
|
||||
$(dir)/notmuch-crypto.el \
|
||||
$(dir)/notmuch-tag.el \
|
||||
$(dir)/coolj.el \
|
||||
$(dir)/notmuch-print.el
|
||||
|
||||
|
|
|
|||
|
|
@ -20,6 +20,7 @@
|
|||
;; Authors: Jesse Rosenthal <jrosenthal@jhu.edu>
|
||||
|
||||
(require 'message)
|
||||
(require 'notmuch-tag)
|
||||
(require 'notmuch-mua)
|
||||
|
||||
(defcustom notmuch-message-replied-tags '("replied")
|
||||
|
|
|
|||
|
|
@ -30,6 +30,7 @@
|
|||
(require 'goto-addr)
|
||||
|
||||
(require 'notmuch-lib)
|
||||
(require 'notmuch-tag)
|
||||
(require 'notmuch-query)
|
||||
(require 'notmuch-wash)
|
||||
(require 'notmuch-mua)
|
||||
|
|
@ -38,10 +39,8 @@
|
|||
|
||||
(declare-function notmuch-call-notmuch-process "notmuch" (&rest args))
|
||||
(declare-function notmuch-fontify-headers "notmuch" nil)
|
||||
(declare-function notmuch-read-tag-changes "notmuch" (&optional initial-input &rest search-terms))
|
||||
(declare-function notmuch-search-next-thread "notmuch" nil)
|
||||
(declare-function notmuch-search-show-thread "notmuch" nil)
|
||||
(declare-function notmuch-update-tags "notmuch" (current-tags tag-changes))
|
||||
|
||||
(defcustom notmuch-message-headers '("Subject" "To" "Cc" "Date")
|
||||
"Headers that should be shown in a message, in this order.
|
||||
|
|
|
|||
135
emacs/notmuch-tag.el
Normal file
135
emacs/notmuch-tag.el
Normal file
|
|
@ -0,0 +1,135 @@
|
|||
;; notmuch-tag.el --- tag messages within emacs
|
||||
;;
|
||||
;; Copyright © Carl Worth
|
||||
;;
|
||||
;; This file is part of Notmuch.
|
||||
;;
|
||||
;; Notmuch is free software: you can redistribute it and/or modify it
|
||||
;; under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
;;
|
||||
;; Notmuch is distributed in the hope that it will be useful, but
|
||||
;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
;; General Public License for more details.
|
||||
;;
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with Notmuch. If not, see <http://www.gnu.org/licenses/>.
|
||||
;;
|
||||
;; Authors: Carl Worth <cworth@cworth.org>
|
||||
|
||||
(eval-when-compile (require 'cl))
|
||||
(require 'crm)
|
||||
(require 'notmuch-lib)
|
||||
|
||||
(defcustom notmuch-before-tag-hook nil
|
||||
"Hooks that are run before tags of a message are modified.
|
||||
|
||||
'tags' will contain the tags that are about to be added or removed as
|
||||
a list of strings of the form \"+TAG\" or \"-TAG\".
|
||||
'query' will be a string containing the search query that determines
|
||||
the messages that are about to be tagged"
|
||||
|
||||
:type 'hook
|
||||
:options '(notmuch-hl-line-mode)
|
||||
:group 'notmuch-hooks)
|
||||
|
||||
(defcustom notmuch-after-tag-hook nil
|
||||
"Hooks that are run after tags of a message are modified.
|
||||
|
||||
'tags' will contain the tags that were added or removed as
|
||||
a list of strings of the form \"+TAG\" or \"-TAG\".
|
||||
'query' will be a string containing the search query that determines
|
||||
the messages that were tagged"
|
||||
:type 'hook
|
||||
:options '(notmuch-hl-line-mode)
|
||||
:group 'notmuch-hooks)
|
||||
|
||||
(defvar notmuch-select-tag-history nil
|
||||
"Variable to store minibuffer history for
|
||||
`notmuch-select-tag-with-completion' function.")
|
||||
|
||||
(defvar notmuch-read-tag-changes-history nil
|
||||
"Variable to store minibuffer history for
|
||||
`notmuch-read-tag-changes' function.")
|
||||
|
||||
(defun notmuch-tag-completions (&optional search-terms)
|
||||
(if (null search-terms)
|
||||
(setq search-terms (list "*")))
|
||||
(split-string
|
||||
(with-output-to-string
|
||||
(with-current-buffer standard-output
|
||||
(apply 'call-process notmuch-command nil t
|
||||
nil "search" "--output=tags" "--exclude=false" search-terms)))
|
||||
"\n+" t))
|
||||
|
||||
(defun notmuch-select-tag-with-completion (prompt &rest search-terms)
|
||||
(let ((tag-list (notmuch-tag-completions search-terms)))
|
||||
(completing-read prompt tag-list nil nil nil 'notmuch-select-tag-history)))
|
||||
|
||||
(defun notmuch-read-tag-changes (&optional initial-input &rest search-terms)
|
||||
(let* ((all-tag-list (notmuch-tag-completions))
|
||||
(add-tag-list (mapcar (apply-partially 'concat "+") all-tag-list))
|
||||
(remove-tag-list (mapcar (apply-partially 'concat "-")
|
||||
(if (null search-terms)
|
||||
all-tag-list
|
||||
(notmuch-tag-completions search-terms))))
|
||||
(tag-list (append add-tag-list remove-tag-list))
|
||||
(crm-separator " ")
|
||||
;; By default, space is bound to "complete word" function.
|
||||
;; Re-bind it to insert a space instead. Note that <tab>
|
||||
;; still does the completion.
|
||||
(crm-local-completion-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(set-keymap-parent map crm-local-completion-map)
|
||||
(define-key map " " 'self-insert-command)
|
||||
map)))
|
||||
(delete "" (completing-read-multiple "Tags (+add -drop): "
|
||||
tag-list nil nil initial-input
|
||||
'notmuch-read-tag-changes-history))))
|
||||
|
||||
(defun notmuch-update-tags (tags tag-changes)
|
||||
"Return a copy of TAGS with additions and removals from TAG-CHANGES.
|
||||
|
||||
TAG-CHANGES must be a list of tags names, each prefixed with
|
||||
either a \"+\" to indicate the tag should be added to TAGS if not
|
||||
present or a \"-\" to indicate that the tag should be removed
|
||||
from TAGS if present."
|
||||
(let ((result-tags (copy-sequence tags)))
|
||||
(dolist (tag-change tag-changes)
|
||||
(let ((op (string-to-char tag-change))
|
||||
(tag (unless (string= tag-change "") (substring tag-change 1))))
|
||||
(case op
|
||||
(?+ (unless (member tag result-tags)
|
||||
(push tag result-tags)))
|
||||
(?- (setq result-tags (delete tag result-tags)))
|
||||
(otherwise
|
||||
(error "Changed tag must be of the form `+this_tag' or `-that_tag'")))))
|
||||
(sort result-tags 'string<)))
|
||||
|
||||
(defun notmuch-tag (query &rest tag-changes)
|
||||
"Add/remove tags in TAG-CHANGES to messages matching QUERY.
|
||||
|
||||
TAG-CHANGES should be a list of strings of the form \"+tag\" or
|
||||
\"-tag\" and QUERY should be a string containing the
|
||||
search-query.
|
||||
|
||||
Note: Other code should always use this function alter tags of
|
||||
messages instead of running (notmuch-call-notmuch-process \"tag\" ..)
|
||||
directly, so that hooks specified in notmuch-before-tag-hook and
|
||||
notmuch-after-tag-hook will be run."
|
||||
;; Perform some validation
|
||||
(mapc (lambda (tag-change)
|
||||
(unless (string-match-p "^[-+]\\S-+$" tag-change)
|
||||
(error "Tag must be of the form `+this_tag' or `-that_tag'")))
|
||||
tag-changes)
|
||||
(unless (null tag-changes)
|
||||
(run-hooks 'notmuch-before-tag-hook)
|
||||
(apply 'notmuch-call-notmuch-process "tag"
|
||||
(append tag-changes (list "--" query)))
|
||||
(run-hooks 'notmuch-after-tag-hook)))
|
||||
|
||||
;;
|
||||
|
||||
(provide 'notmuch-tag)
|
||||
109
emacs/notmuch.el
109
emacs/notmuch.el
|
|
@ -48,11 +48,11 @@
|
|||
;; required, but is available from http://notmuchmail.org).
|
||||
|
||||
(eval-when-compile (require 'cl))
|
||||
(require 'crm)
|
||||
(require 'mm-view)
|
||||
(require 'message)
|
||||
|
||||
(require 'notmuch-lib)
|
||||
(require 'notmuch-tag)
|
||||
(require 'notmuch-show)
|
||||
(require 'notmuch-mua)
|
||||
(require 'notmuch-hello)
|
||||
|
|
@ -76,68 +76,6 @@ For example:
|
|||
(defvar notmuch-query-history nil
|
||||
"Variable to store minibuffer history for notmuch queries")
|
||||
|
||||
(defvar notmuch-select-tag-history nil
|
||||
"Variable to store minibuffer history for
|
||||
`notmuch-select-tag-with-completion' function.")
|
||||
|
||||
(defvar notmuch-read-tag-changes-history nil
|
||||
"Variable to store minibuffer history for
|
||||
`notmuch-read-tag-changes' function.")
|
||||
|
||||
(defun notmuch-tag-completions (&optional search-terms)
|
||||
(if (null search-terms)
|
||||
(setq search-terms (list "*")))
|
||||
(split-string
|
||||
(with-output-to-string
|
||||
(with-current-buffer standard-output
|
||||
(apply 'call-process notmuch-command nil t
|
||||
nil "search" "--output=tags" "--exclude=false" search-terms)))
|
||||
"\n+" t))
|
||||
|
||||
(defun notmuch-select-tag-with-completion (prompt &rest search-terms)
|
||||
(let ((tag-list (notmuch-tag-completions search-terms)))
|
||||
(completing-read prompt tag-list nil nil nil 'notmuch-select-tag-history)))
|
||||
|
||||
(defun notmuch-read-tag-changes (&optional initial-input &rest search-terms)
|
||||
(let* ((all-tag-list (notmuch-tag-completions))
|
||||
(add-tag-list (mapcar (apply-partially 'concat "+") all-tag-list))
|
||||
(remove-tag-list (mapcar (apply-partially 'concat "-")
|
||||
(if (null search-terms)
|
||||
all-tag-list
|
||||
(notmuch-tag-completions search-terms))))
|
||||
(tag-list (append add-tag-list remove-tag-list))
|
||||
(crm-separator " ")
|
||||
;; By default, space is bound to "complete word" function.
|
||||
;; Re-bind it to insert a space instead. Note that <tab>
|
||||
;; still does the completion.
|
||||
(crm-local-completion-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(set-keymap-parent map crm-local-completion-map)
|
||||
(define-key map " " 'self-insert-command)
|
||||
map)))
|
||||
(delete "" (completing-read-multiple "Tags (+add -drop): "
|
||||
tag-list nil nil initial-input
|
||||
'notmuch-read-tag-changes-history))))
|
||||
|
||||
(defun notmuch-update-tags (tags tag-changes)
|
||||
"Return a copy of TAGS with additions and removals from TAG-CHANGES.
|
||||
|
||||
TAG-CHANGES must be a list of tags names, each prefixed with
|
||||
either a \"+\" to indicate the tag should be added to TAGS if not
|
||||
present or a \"-\" to indicate that the tag should be removed
|
||||
from TAGS if present."
|
||||
(let ((result-tags (copy-sequence tags)))
|
||||
(dolist (tag-change tag-changes)
|
||||
(let ((op (string-to-char tag-change))
|
||||
(tag (unless (string= tag-change "") (substring tag-change 1))))
|
||||
(case op
|
||||
(?+ (unless (member tag result-tags)
|
||||
(push tag result-tags)))
|
||||
(?- (setq result-tags (delete tag result-tags)))
|
||||
(otherwise
|
||||
(error "Changed tag must be of the form `+this_tag' or `-that_tag'")))))
|
||||
(sort result-tags 'string<)))
|
||||
|
||||
(defun notmuch-foreach-mime-part (function mm-handle)
|
||||
(cond ((stringp (car mm-handle))
|
||||
(dolist (part (cdr mm-handle))
|
||||
|
|
@ -545,51 +483,6 @@ and will also appear in a buffer named \"*Notmuch errors*\"."
|
|||
(error (buffer-substring beg end))
|
||||
))))))
|
||||
|
||||
(defun notmuch-tag (query &rest tag-changes)
|
||||
"Add/remove tags in TAG-CHANGES to messages matching QUERY.
|
||||
|
||||
TAG-CHANGES should be a list of strings of the form \"+tag\" or
|
||||
\"-tag\" and QUERY should be a string containing the
|
||||
search-query.
|
||||
|
||||
Note: Other code should always use this function alter tags of
|
||||
messages instead of running (notmuch-call-notmuch-process \"tag\" ..)
|
||||
directly, so that hooks specified in notmuch-before-tag-hook and
|
||||
notmuch-after-tag-hook will be run."
|
||||
;; Perform some validation
|
||||
(mapc (lambda (tag-change)
|
||||
(unless (string-match-p "^[-+]\\S-+$" tag-change)
|
||||
(error "Tag must be of the form `+this_tag' or `-that_tag'")))
|
||||
tag-changes)
|
||||
(unless (null tag-changes)
|
||||
(run-hooks 'notmuch-before-tag-hook)
|
||||
(apply 'notmuch-call-notmuch-process "tag"
|
||||
(append tag-changes (list "--" query)))
|
||||
(run-hooks 'notmuch-after-tag-hook)))
|
||||
|
||||
(defcustom notmuch-before-tag-hook nil
|
||||
"Hooks that are run before tags of a message are modified.
|
||||
|
||||
'tags' will contain the tags that are about to be added or removed as
|
||||
a list of strings of the form \"+TAG\" or \"-TAG\".
|
||||
'query' will be a string containing the search query that determines
|
||||
the messages that are about to be tagged"
|
||||
|
||||
:type 'hook
|
||||
:options '(notmuch-hl-line-mode)
|
||||
:group 'notmuch-hooks)
|
||||
|
||||
(defcustom notmuch-after-tag-hook nil
|
||||
"Hooks that are run after tags of a message are modified.
|
||||
|
||||
'tags' will contain the tags that were added or removed as
|
||||
a list of strings of the form \"+TAG\" or \"-TAG\".
|
||||
'query' will be a string containing the search query that determines
|
||||
the messages that were tagged"
|
||||
:type 'hook
|
||||
:options '(notmuch-hl-line-mode)
|
||||
:group 'notmuch-hooks)
|
||||
|
||||
(defun notmuch-search-set-tags (tags)
|
||||
(save-excursion
|
||||
(end-of-line)
|
||||
|
|
|
|||
Loading…
Reference in a new issue