mu/mu4e/mu4e-mark.el

;; mu4e-mark.el -- part of mu4e, the mu mail user agent -*- lexical-binding: t -*-
;;
;; Copyright (C) 2011-2019 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.
;;
;; GNU Emacs 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.

;; GNU Emacs 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 GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; In this file are function related to marking messages; they assume we are
;; currently in the headers buffer.

;;; Code:
(require 'cl-lib)
(require 'mu4e-proc)
(require 'mu4e-utils)
(require 'mu4e-message)

;; keep byte-compiler happy
(declare-function mu4e~headers-mark "mu4e-headers")
(declare-function mu4e~headers-goto-docid "mu4e-headers")
(declare-function mu4e-headers-next "mu4e-headers")

(defcustom mu4e-headers-leave-behavior 'ask
  "What to do when user leaves the headers view.
That is when he e.g. quits, refreshes or does a new search.
Value is one of the following symbols:
- `ask'     ask user whether to ignore the marks
- `apply'   automatically apply the marks before doing anything else
- `ignore'  automatically ignore the marks without asking"
  :type '(choice (const ask    :tag "ask user whether to ignore marks")
	   (const apply  :tag "apply marks without asking")
	   (const ignore :tag "ignore marks without asking"))
  :group 'mu4e-headers)

(defcustom mu4e-mark-execute-pre-hook nil
  "Hook run just *before* a mark is applied to a message.
The hook function is called with two arguments, the mark being
executed and the message itself."
  :type 'hook
  :group 'mu4e-headers)

(defvar mu4e-headers-show-target t
  "Whether to show targets (such as '-> delete', '-> /archive')
when marking message. Normally, this is useful information for the
user, however, when you often mark large numbers (thousands) of
message, showing the target makes this quite a bit slower (showing
the target uses an Emacs feature called 'overlays', which aren't
particularly fast).")

;;; insert stuff;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar mu4e~mark-map nil
  "Contains a mapping of docid->markinfo.
When a message is marked, the information is added here. markinfo
is a cons cell consisting of the following: \(mark . target)
where MARK is the type of mark (move, trash, delete)
TARGET (optional) is the target directory (for 'move')")

;; the mark-map is specific for the current header buffer
;; currently, there can't be more than one, but we never know what will
;; happen in the future

;; the fringe is the space on the left of headers, where we put marks below some
;; handy definitions; only `mu4e-mark-fringe-len' should be change (if ever),
;; the others follow from that.
(defconst mu4e~mark-fringe-len 2
  "Width of the fringe for marks on the left.")
(defconst mu4e~mark-fringe (make-string mu4e~mark-fringe-len ?\s)
  "The space on the left of message headers to put marks.")
(defconst mu4e~mark-fringe-format (format "%%-%ds" mu4e~mark-fringe-len)
  "Format string to set a mark and leave remaining space.")

(defun mu4e~mark-initialize ()
  "Initialize the marks-subsystem."
  (set (make-local-variable 'mu4e~mark-map) (make-hash-table)))

(defun mu4e~mark-clear ()
  "Clear the marks-subsystem."
  (clrhash mu4e~mark-map))

(defun mu4e~mark-find-headers-buffer ()
  "Find the headers buffer, if any."
  (cl-find-if
    (lambda (b)
      (with-current-buffer b
	(eq major-mode 'mu4e-headers-mode)))
    (buffer-list)))

(defmacro mu4e~mark-in-context (&rest body)
  "Evaluate BODY in the context of the headers buffer.
The current buffer must be either a headers or view buffer."
  `(cond
     ((eq major-mode 'mu4e-headers-mode) ,@body)
     ((eq major-mode 'mu4e-view-mode)
       (when (buffer-live-p (mu4e-get-headers-buffer))
	 (let* ((msg (mu4e-message-at-point))
		 (docid (mu4e-message-field msg :docid)))
	   (with-current-buffer (mu4e-get-headers-buffer)
	     (if (mu4e~headers-goto-docid docid)
	       ,@body
	       (mu4e-error "Cannot find message in headers buffer"))))))
     (t
       ;; even in other modes (e.g. mu4e-main-mode we try to find
       ;; the headers buffer
       (let ((hbuf (mu4e~mark-find-headers-buffer)))
	 (if (buffer-live-p hbuf)
	   (with-current-buffer hbuf ,@body)
	   ,@body)))))

(defconst mu4e-marks
    '((refile
	:char ("r" . "▶")
	:prompt "refile"
	:dyn-target (lambda (target msg) (mu4e-get-refile-folder msg))
	:action (lambda (docid msg target)
		  (mu4e~proc-move docid (mu4e~mark-check-target target) "-N")))
       (delete
	 :char ("D" . "x")
	 :prompt "Delete"
	 :show-target (lambda (target) "delete")
	 :action (lambda (docid msg target) (mu4e~proc-remove docid)))
       (flag
	 :char ("+" . "✚")
	 :prompt "+flag"
	 :show-target (lambda (target) "flag")
	 :action (lambda (docid msg target)
		   (mu4e~proc-move docid nil "+F-u-N")))
       (move
	 :char ("m" . "▷")
	 :prompt "move"
	 :ask-target  mu4e~mark-get-move-target
	 :action (lambda (docid msg target)
		   (mu4e~proc-move docid (mu4e~mark-check-target target) "-N")))
       (read
	 :char    ("!" . "◼")
	 :prompt "!read"
	 :show-target (lambda (target) "read")
	 :action (lambda (docid msg target) (mu4e~proc-move docid nil "+S-u-N")))
       (trash
	 :char ("d" . "▼")
	 :prompt "dtrash"
	 :dyn-target (lambda (target msg) (mu4e-get-trash-folder msg))
	 :action (lambda (docid msg target) (mu4e~proc-move docid
					      (mu4e~mark-check-target target) "+T-N")))
       (unflag
	 :char    ("-" . "➖")
	 :prompt "-unflag"
	 :show-target (lambda (target) "unflag")
	 :action (lambda (docid msg target) (mu4e~proc-move docid nil "-F-N")))
       (untrash
	 :char   ("=" . "▲")
	 :prompt "=untrash"
	 :show-target (lambda (target) "untrash")
	 :action (lambda (docid msg target) (mu4e~proc-move docid nil "-T")))
       (unread
	 :char    ("?" . "◻")
	 :prompt "?unread"
	 :show-target (lambda (target) "unread")
	 :action (lambda (docid msg target) (mu4e~proc-move docid nil "-S+u-N")))
       (unmark
	 :char  " "
	 :prompt "unmark"
	 :action (mu4e-error "No action for unmarking"))
       (action
	 :char ( "a" . "◯")
	 :prompt "action"
	 :ask-target  (lambda () (mu4e-read-option "Action: " mu4e-headers-actions))
	 :action  (lambda (docid msg actionfunc)
		    (save-excursion
		      (when (mu4e~headers-goto-docid docid)
			(mu4e-headers-action actionfunc)))))
       (something
	 :char  ("*" . "✱")
	 :prompt "*something"
	 :action (mu4e-error "No action for deferred mark")))

  "The list of all the possible marks.
This is an alist mapping mark symbols to their properties.  The
properties are:
  :char (string) or (basic . fancy) The character to display in
    the headers view. Either a single-character string, or a
    dotted-pair cons cell where the second item will be used if
    `mu4e-use-fancy-chars' is t, otherwise we'll use
    the first one. It can also be a plain string for backwards
    compatibility since we didn't always support
    `mu4e-use-fancy-chars' here.
  :prompt (string) The prompt to use when asking for marks (used for
     example when marking a whole thread)
  :ask-target (function returning a string) Get the target.  This
     function run once per bulk-operation, and thus is suitable
     for user-interaction.  If nil, the target is nil.
  :dyn-target (function from (TARGET MSG) to string).  Compute
     the dynamic target.  This is run once per message, which is
     passed as MSG.  The default is to just return the target.
  :show-target (function from TARGET to string) How to display
     the target.
  :action (function taking (DOCID MSG TARGET)).  The action to
     apply on the message.")

(defun mu4e-mark-at-point (mark target)
  "Mark (or unmark) message at point.
MARK specifies the mark-type. For `move'-marks and `trash'-marks
the TARGET argument is non-nil and specifies to which
maildir the message is to be moved/trashed. The function works in
both headers buffers and message buffers.

The following marks are available, and the corresponding props:

   MARK       TARGET    description
   ----------------------------------------------------------
   `refile'    y	mark this message for archiving
   `something' n	mark this message for *something* (decided later)
   `delete'    n	remove the message
   `flag'      n	mark this message for flagging
   `move'      y	move the message to some folder
   `read'      n	mark the message as read
   `trash'     y	trash the message to some folder
   `unflag'    n	mark this message for unflagging
   `untrash'   n	remove the 'trashed' flag from a message
   `unmark'    n	unmark this message
   `unread'    n	mark the message as unread
   `action'    y        mark the message for some action."
  (interactive)
  (let* ((msg (mu4e-message-at-point))
	  (docid (mu4e-message-field msg :docid))
	  ;; get a cell with the mark char and the 'target' 'move' already has a
	  ;; target (the target folder) the other ones get a pseudo "target", as
	  ;; info for the user.
	  (markdesc (cdr (or (assq mark mu4e-marks)
			   (mu4e-error "Invalid mark %S" mark))))
	  (get-markkar
	   (lambda (char)
	     (if (listp char)
	       (if mu4e-use-fancy-chars (cdr char) (car char))
	       char)))
	  (markkar (funcall get-markkar (plist-get markdesc :char)))
	  (target (mu4e~mark-get-dyn-target mark target))
	  (show-fct (plist-get markdesc :show-target))
	  (shown-target (if show-fct
			  (funcall show-fct target)
			  (if target (format "%S" target)))))
    (unless docid (mu4e-warn "No message on this line"))
    (unless (eq major-mode 'mu4e-headers-mode)
      (mu4e-error "Not in headers-mode"))
    (save-excursion
      (when (mu4e~headers-mark docid markkar)
	;; update the hash -- remove everything current, and if add the new
	;; stuff, unless we're unmarking
	(remhash docid mu4e~mark-map)
	;; remove possible overlays
	(remove-overlays (line-beginning-position) (line-end-position))
	;; now, let's set a mark (unless we were unmarking)
	(unless (eql mark 'unmark)
	  (puthash docid (cons mark target) mu4e~mark-map)
	  ;; when we have a target (ie., when moving), show the target folder in
	  ;; an overlay
	  (when (and shown-target mu4e-headers-show-target)
	    (let* ((targetstr (propertize (concat "-> " shown-target " ")
				'face 'mu4e-system-face))
		    ;; mu4e~headers-goto-docid docid t \will take us just after
		    ;; the docid cookie and then we skip the mu4e~mark-fringe
		    (start (+ (length mu4e~mark-fringe)
			     (mu4e~headers-goto-docid docid t)))
		    (overlay (make-overlay start (+ start (length targetstr)))))
	      (overlay-put overlay 'display targetstr)
	      docid)))))))

(defun mu4e~mark-get-move-target ()
  "Ask for a move target, and propose to create it if it does not exist."
  (interactive)
  ;;  (mu4e-message-at-point) ;; raises error if there is none
  (let* ((target (mu4e-ask-maildir "Move message to: "))
	  (target (if (string= (substring target 0 1) "/")
		    target
		    (concat "/" target)))
	  (fulltarget (concat mu4e-maildir target)))
    (when (or (file-directory-p fulltarget)
	    (and (yes-or-no-p
		   (format "%s does not exist.  Create now?" fulltarget))
	      (mu4e~proc-mkdir fulltarget)))
      target)))

(defun mu4e~mark-ask-target (mark)
  "Ask the target for MARK, if the user should be asked the target."
  (let ((getter (plist-get (cdr (assq mark mu4e-marks)) :ask-target)))
    (and getter (funcall getter))))

(defun mu4e~mark-get-dyn-target (mark target)
  "Get the dynamic TARGET for MARK.
The result may depend on the message at point."
  (let ((getter (plist-get (cdr (assq mark mu4e-marks)) :dyn-target)))
    (if getter
      (funcall getter target (mu4e-message-at-point))
      target)))

(defun mu4e-mark-set (mark &optional target)
  "Mark the header at point with MARK or all in the region.
Optionally, provide TARGET (for moves)."
  (unless target
    (setq target (mu4e~mark-ask-target mark)))
  (if (not (use-region-p))
    ;; single message
    (mu4e-mark-at-point mark target)
    ;; mark all messages in the region.
    (save-excursion
      (let ((cant-go-further) (eor (region-end)))
	(goto-char (region-beginning))
	(while (and (< (point) eor) (not cant-go-further))
	  (mu4e-mark-at-point mark target)
	  (setq cant-go-further (not (mu4e-headers-next))))))))

(defun mu4e-mark-restore (docid)
  "Restore the visual mark for the message with DOCID."
  (let ((markcell (gethash docid mu4e~mark-map)))
    (when markcell
      (save-excursion
	(when (mu4e~headers-goto-docid docid)
	  (mu4e-mark-at-point (car markcell) (cdr markcell)))))))

(defun mu4e~mark-get-markpair (prompt &optional allow-something)
  "Ask user with PROMPT for a mark and return (MARK . TARGET).
If ALLOW-SOMETHING is non-nil, allow the 'something' pseudo mark
as well."
  (let* ((marks (mapcar (lambda (markdescr)
			  (cons (plist-get (cdr markdescr) :prompt)
			    (car markdescr)))
		  mu4e-marks))
	  (marks
	    (if allow-something
	      marks (cl-remove-if (lambda (m) (eq 'something (cdr m))) marks)))
	  (mark (mu4e-read-option prompt marks))
	  (target (mu4e~mark-ask-target mark)))
    (cons mark target)))

(defun mu4e-mark-resolve-deferred-marks ()
  "Check if there are any deferred ('something') mark-instances.
If there are such marks, replace them with a _real_ mark (ask the
user which one)."
  (interactive)
  (mu4e~mark-in-context
    (let ((markpair))
      (maphash
	(lambda (docid val)
	  (let ((mark (car val)))
	    (when (eql mark 'something)
	      (unless markpair
		(setq markpair
		  (mu4e~mark-get-markpair "Set deferred mark(s) to: " nil)))
	      (save-excursion
		(when (mu4e~headers-goto-docid docid)
		  (mu4e-mark-set (car markpair) (cdr markpair)))))))
	mu4e~mark-map))))

(defun mu4e~mark-check-target (target)
  "Check if TARGET exists; if not, offer to create it."
  (let ((fulltarget (concat mu4e-maildir target)))
    (if (not (mu4e-create-maildir-maybe fulltarget))
      (mu4e-error "Target dir %s does not exist " fulltarget)
      target)))

(defun mu4e-mark-execute-all (&optional no-confirmation)
  "Execute the actions for all marked messages in this buffer.
After the actions have been executed successfully, the affected
messages are *hidden* from the current header list. Since the
headers are the result of a search, we cannot be certain that the
messages no longer match the current one - to get that
certainty, we need to rerun the search, but we don't want to do
that automatically, as it may be too slow and/or break the user's
flow. Therefore, we hide the message, which in practice seems to
work well.

If NO-CONFIRMATION is non-nil, don't ask user for confirmation."
  (interactive)
  (mu4e~mark-in-context
    (let* ((marknum (hash-table-count mu4e~mark-map))
	   (prompt (format "Are you sure you want to execute %d mark%s?"
		     marknum (if (> marknum 1) "s" ""))))
     (if (zerop marknum)
	 (mu4e-warn "Nothing is marked")
       (mu4e-mark-resolve-deferred-marks)
       (when (or no-confirmation (y-or-n-p prompt))
	 (maphash
	  (lambda (docid val)
	    (let* ((mark (car val)) (target (cdr val))
		   (markdescr (assq mark mu4e-marks))
		   (msg (save-excursion
			  (mu4e~headers-goto-docid docid)
			  (mu4e-message-at-point))))
	      ;; note: whenever you do something with the message,
	      ;; it looses its N (new) flag
	      (if markdescr
		  (progn
		    (run-hook-with-args
		    'mu4e-mark-execute-pre-hook mark msg)
		    (funcall (plist-get (cdr markdescr) :action)
		      docid msg target))
		(mu4e-error "Unrecognized mark %S" mark))))
	  mu4e~mark-map))
       (mu4e-mark-unmark-all)
       (message nil)))))

(defun mu4e-mark-unmark-all ()
  "Unmark all marked messages."
  (interactive)
  (mu4e~mark-in-context
    (when (or (null mu4e~mark-map) (zerop (hash-table-count mu4e~mark-map)))
      (mu4e-warn "Nothing is marked"))
    (maphash
      (lambda (docid _val)
	(save-excursion
	  (when (mu4e~headers-goto-docid docid)
	    (mu4e-mark-set 'unmark))))
      mu4e~mark-map)
    ;; in any case, clear the marks map
    (mu4e~mark-clear)))

(defun mu4e-mark-docid-marked-p (docid)
  "Is the given DOCID marked?"
  (when (gethash docid mu4e~mark-map) t))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun mu4e-mark-marks-num ()
  "Return the number of mark-instances in the current buffer."
  (mu4e~mark-in-context
    (if mu4e~mark-map (hash-table-count mu4e~mark-map) 0)))

(defun mu4e-mark-handle-when-leaving ()
  "Handle any mark-instances in the current buffer when leaving.
This is done according to the value of `mu4e-headers-leave-behavior'. This
function is to be called before any further action (like searching,
quitting the buffer) is taken; returning t means 'take the following
action', return nil means 'don't do anything'."
  (mu4e~mark-in-context
    (let ((marknum (mu4e-mark-marks-num))
	   (what mu4e-headers-leave-behavior))
      (unless (zerop marknum) ;; nothing to do?
	(when (eq what 'ask)
	  (setq what (mu4e-read-option
		       (format  "There are %d existing mark(s); should we: "
			 marknum)
		       '( ("apply marks"   . apply)
			  ("ignore marks?" . ignore)))))
	;; we determined what to do... now do it
	(when (eq what 'apply)
	  (mu4e-mark-execute-all t))))))

(provide 'mu4e-mark)
;;; mu4e-mark.el ends here