debian/notmuch
1
0
Fork 0
mirror of https://git.notmuchmail.org/git/notmuch synced 2024-11-21 18:38:08 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

emacs: create notmuch-tag.el, and move appropriate functions from notmuch.el

Browse source 
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 2012-04-14 11:52:50 -07:00 committed by David Bremner
parent f5102f71ea
commit eb8feb1666
5 changed files with 139 additions and 110 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
emacs/Makefile.local
View file

@ -13,6 +13,7 @@ emacs_sources := \
$(dir)/notmuch-maildir-fcc.el \ $(dir)/notmuch-maildir-fcc.el \
$(dir)/notmuch-message.el \ $(dir)/notmuch-message.el \
$(dir)/notmuch-crypto.el \ $(dir)/notmuch-crypto.el \
$(dir)/notmuch-tag.el \
$(dir)/coolj.el \ $(dir)/coolj.el \
$(dir)/notmuch-print.el $(dir)/notmuch-print.el

1
emacs/notmuch-message.el
View file

@ -20,6 +20,7 @@
;; Authors: Jesse Rosenthal <jrosenthal@jhu.edu> ;; Authors: Jesse Rosenthal <jrosenthal@jhu.edu>
(require 'message) (require 'message)
(require 'notmuch-tag)
(require 'notmuch-mua) (require 'notmuch-mua)
(defcustom notmuch-message-replied-tags '("replied") (defcustom notmuch-message-replied-tags '("replied")

3
emacs/notmuch-show.el
View file

@ -30,6 +30,7 @@
(require 'goto-addr) (require 'goto-addr)
(require 'notmuch-lib) (require 'notmuch-lib)
(require 'notmuch-tag)
(require 'notmuch-query) (require 'notmuch-query)
(require 'notmuch-wash) (require 'notmuch-wash)
(require 'notmuch-mua) (require 'notmuch-mua)
@ -38,10 +39,8 @@
(declare-function notmuch-call-notmuch-process "notmuch" (&rest args)) (declare-function notmuch-call-notmuch-process "notmuch" (&rest args))
(declare-function notmuch-fontify-headers "notmuch" nil) (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-next-thread "notmuch" nil)
(declare-function notmuch-search-show-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") (defcustom notmuch-message-headers '("Subject" "To" "Cc" "Date")
"Headers that should be shown in a message, in this order. "Headers that should be shown in a message, in this order.

135
emacs/notmuch-tag.el Normal file
View 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
View file

@ -48,11 +48,11 @@
;; required, but is available from http://notmuchmail.org). ;; required, but is available from http://notmuchmail.org).
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl))
(require 'crm)
(require 'mm-view) (require 'mm-view)
(require 'message) (require 'message)
(require 'notmuch-lib) (require 'notmuch-lib)
(require 'notmuch-tag)
(require 'notmuch-show) (require 'notmuch-show)
(require 'notmuch-mua) (require 'notmuch-mua)
(require 'notmuch-hello) (require 'notmuch-hello)
@ -76,68 +76,6 @@ For example:
(defvar notmuch-query-history nil (defvar notmuch-query-history nil
"Variable to store minibuffer history for notmuch queries") "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) (defun notmuch-foreach-mime-part (function mm-handle)
(cond ((stringp (car mm-handle)) (cond ((stringp (car mm-handle))
(dolist (part (cdr 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)) (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) (defun notmuch-search-set-tags (tags)
(save-excursion (save-excursion
(end-of-line) (end-of-line)