mu/mu4e/mu4e-actions.el

253 lines
8.8 KiB
EmacsLisp
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;; mu4e-actions.el -- part of mu4e, the mu mail user agent -*- lexical-binding: t -*-
;; Copyright (C) 2011-2022 Dirk-Jan C. Binnema
;; Author: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
;; Maintainer: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
;; This file is not part of GNU Emacs.
;; mu4e 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.
;; mu4e 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 mu4e. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Example actions for messages, attachments (see chapter 'Actions' in the
;; manual)
;;; Code:
(require 'ido)
(require 'mu4e-helpers)
(require 'mu4e-message)
(require 'mu4e-search)
;;; Count lines
(defun mu4e-action-count-lines (msg)
"Count the number of lines in the e-mail MSG.
Works for headers view and message-view."
(message "Number of lines: %s"
(shell-command-to-string
(concat "wc -l < "
(shell-quote-argument (mu4e-message-field msg :path))))))
;;; Org Helpers
(defvar mu4e-captured-message nil
"The most recently captured message.")
(defun mu4e-action-capture-message (msg)
"Remember MSG.
Later, we can create an attachment based on this message with
`mu4e-compose-attach-captured-message'."
(setq mu4e-captured-message msg)
(message "Message has been captured"))
(defun mu4e-action-copy-message-file-path (msg)
"Save the full path for the current MSG to the kill ring."
(kill-new (mu4e-message-field msg :path)))
(defvar mu4e-org-contacts-file nil
"File to store contact information for org-contacts.
Needed by `mu4e-action-add-org-contact'.")
(eval-when-compile ;; silence compiler warning about free variable
(unless (require 'org-capture nil 'noerror)
(defvar org-capture-templates nil)))
(defun mu4e-action-add-org-contact (msg)
"Add an org-contact based on the sender ddress of the current MSG.
You need to set `mu4e-org-contacts-file' to the full path to the
file where you store your org-contacts."
(unless (require 'org-capture nil 'noerror)
(mu4e-error "Feature org-capture is not available"))
(unless mu4e-org-contacts-file
(mu4e-error "Variable `mu4e-org-contacts-file' is nil"))
(let* ((sender (car-safe (mu4e-message-field msg :from)))
(name (car-safe sender)) (email (cdr-safe sender))
(blurb
(format
(concat
"* %%?%s\n"
":PROPERTIES:\n"
":EMAIL: %s\n"
":NICK:\n"
":BIRTHDAY:\n"
":END:\n\n")
(or name email "")
(or email "")))
(key "mu4e-add-org-contact-key")
(org-capture-templates
(append org-capture-templates
(list (list key "contacts" 'entry
(list 'file mu4e-org-contacts-file) blurb)))))
(message "%S" org-capture-templates)
(when (fboundp 'org-capture)
(org-capture nil key))))
;;; Patches
(defvar mu4e--patch-directory-history nil
"History of directories we have applied patches to.")
;; This essentially works around the fact that read-directory-name
;; can't have custom history.
(defun mu4e--read-patch-directory (&optional prompt)
"Read a `PROMPT'ed directory name via `completing-read' with history."
(unless prompt
(setq prompt "Target directory:"))
(file-truename
(completing-read prompt 'read-file-name-internal #'file-directory-p
nil nil 'mu4e--patch-directory-history)))
(defun mu4e-action-git-apply-patch (msg)
"Apply `MSG' as a git patch."
(let ((path (mu4e--read-patch-directory "Target directory: ")))
(let ((default-directory path))
(shell-command
(format "git apply %s"
(shell-quote-argument (mu4e-message-field msg :path)))))))
(defun mu4e-action-git-apply-mbox (msg &optional signoff)
"Apply `MSG' a git patch with optional `SIGNOFF'.
If the `default-directory' matches the most recent history entry don't
bother asking for the git tree again (useful for bulk actions)."
(let ((cwd (substring-no-properties
(or (car mu4e--patch-directory-history)
"not-a-dir"))))
(unless (and (stringp cwd) (string= default-directory cwd))
(setq cwd (mu4e--read-patch-directory "Target directory: ")))
(let ((default-directory cwd))
(shell-command
(format "git am %s %s"
(if signoff "--signoff" "")
(shell-quote-argument (mu4e-message-field msg :path)))))))
;;; Tagging
(defvar mu4e-action-tags-header "X-Keywords"
"Header where tags are stored.
Used by `mu4e-action-retag-message'. Make sure it is one of the
headers mu recognizes for storing tags: X-Keywords, X-Label,
Keywords. Also note that changing this setting on already tagged
messages can lead to messages with multiple tags headers.")
(defvar mu4e-action-tags-completion-list '()
"List of tags for completion in `mu4e-action-retag-message'.")
(defun mu4e--contains-line-matching (regexp path)
"Return non-nil if the file at PATH contain a line matching REGEXP.
Otherwise return nil."
(with-temp-buffer
(insert-file-contents path)
(save-excursion
(goto-char (point-min))
(re-search-forward regexp nil t))))
(defun mu4e--replace-first-line-matching (regexp to-string path)
"Replace first line matching REGEXP in PATH with TO-STRING."
(with-temp-file path
(insert-file-contents path)
(save-excursion
(goto-char (point-min))
(if (re-search-forward regexp nil t)
(replace-match to-string nil nil)))))
(declare-function mu4e--server-add "mu4e-server")
(defun mu4e--refresh-message (path)
"Re-parse message at PATH.
if this works, we will
receive (:info add :path <path> :docid <docid>) as well as (:update
<msg-sexp>)."
(mu4e--server-add path))
(defun mu4e-action-retag-message (msg &optional retag-arg)
"Change tags of MSG with RETAG-ARG.
RETAG-ARG is a comma-separated list of additions and removals.
Example: +tag,+long tag,-oldtag
would add \"tag\" and \"long tag\", and remove \"oldtag\"."
(let* (
(path (mu4e-message-field msg :path))
(oldtags (mu4e-message-field msg :tags))
(tags-completion
(append
mu4e-action-tags-completion-list
(mapcar (lambda (tag) (format "+%s" tag))
mu4e-action-tags-completion-list)
(mapcar (lambda (tag) (format "-%s" tag))
oldtags)))
(retag (if retag-arg
(split-string retag-arg ",")
(completing-read-multiple "Tags: " tags-completion)))
(header mu4e-action-tags-header)
(sep (cond ((string= header "Keywords") ", ")
((string= header "X-Label") " ")
((string= header "X-Keywords") ", ")
(t ", ")))
(taglist (if oldtags (copy-sequence oldtags) '()))
tagstr)
(dolist (tag retag taglist)
(cond
((string-match "^\\+\\(.+\\)" tag)
(setq taglist (push (match-string 1 tag) taglist)))
((string-match "^\\-\\(.+\\)" tag)
(setq taglist (delete (match-string 1 tag) taglist)))
(t
(setq taglist (push tag taglist)))))
(setq taglist (sort (delete-dups taglist) 'string<))
(setq tagstr (mapconcat 'identity taglist sep))
(setq tagstr (replace-regexp-in-string "[\\&]" "\\\\\\&" tagstr))
(setq tagstr (replace-regexp-in-string "[/]" "\\&" tagstr))
(if (not (mu4e--contains-line-matching (concat header ":.*") path))
;; Add tags header just before the content
(mu4e--replace-first-line-matching
"^$" (concat header ": " tagstr "\n") path)
;; replaces keywords, restricted to the header
(mu4e--replace-first-line-matching
(concat header ":.*")
(concat header ": " tagstr)
path))
(mu4e-message (concat "tagging: " (mapconcat 'identity taglist ", ")))
(mu4e--refresh-message path)))
(defun mu4e-action-show-thread (msg)
"Show thread for message at point with point remaining on MSG.
I.e., point remains on the message with the message-id where the
action was invoked. If invoked in view mode, continue to display
the message."
(let ((msgid (mu4e-message-field msg :message-id)))
(when msgid
(let ((mu4e-search-threads t)
(mu4e-headers-include-related t))
(mu4e-search
(format "msgid:%s" msgid)
nil nil nil
msgid (and (eq major-mode 'mu4e-view-mode)
(not (eq mu4e-split-view 'single-window))))))))
;;; _
(provide 'mu4e-actions)
;;; mu4e-actions.el ends here