;;; mu4e-headers.el -- part of mu4e, the mu mail user agent ;; ;; Copyright (C) 2011-2016 Dirk-Jan C. Binnema ;; Author: Dirk-Jan C. Binnema ;; Maintainer: Dirk-Jan C. Binnema ;; 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 . ;;; Commentary: ;; In this file are function related mu4e-headers-mode, to creating the list of ;; one-line descriptions of emails, aka 'headers' (not to be confused with ;; headers like 'To:' or 'Subject:') ;; Code: (eval-when-compile (byte-compile-disable-warning 'cl-functions)) (require 'cl) (require 'fringe) (require 'hl-line) (require 'mu4e-utils) ;; utility functions (require 'mu4e-proc) (require 'mu4e-vars) (require 'mu4e-mark) (require 'mu4e-compose) (require 'mu4e-actions) (require 'mu4e-message) ;; the headers view (defgroup mu4e-headers nil "Settings for the headers view." :group 'mu4e) (defcustom mu4e-headers-fields '( (:human-date . 12) (:flags . 6) (:mailing-list . 10) (:from . 22) (:subject . nil)) "A list of header fields to show in the headers buffer. Each element has the form (HEADER . WIDTH), where HEADER is one of the available headers (see `mu4e-header-info') and WIDTH is the respective width in characters. A width of `nil' means 'unrestricted', and this is best reserved for the rightmost (last) field. Note that emacs may become very slow with excessively long lines (1000s of characters), so if you regularly get such messages, you want to avoid fields with `nil' altogether." :type `(repeat (cons (choice ,@(mapcar (lambda (h) (list 'const :tag (plist-get (cdr h) :help) (car h))) mu4e-header-info)) (choice (integer :tag "width") (const :tag "unrestricted width" nil)))) :group 'mu4e-headers) (defcustom mu4e-headers-date-format "%x" "Date format to use in the headers view. In the format of `format-time-string'." :type 'string :group 'mu4e-headers) (defcustom mu4e-headers-time-format "%X" "Time format to use in the headers view. In the format of `format-time-string'." :type 'string :group 'mu4e-headers) (defcustom mu4e-headers-long-date-format "%c" "Date format to use in the headers view tooltip. In the format of `format-time-string'." :type 'string :group 'mu4e-headers) (defcustom mu4e-headers-visible-lines 10 "Number of lines to display in the header view when using the horizontal split-view. This includes the header-line at the top, and the mode-line." :type 'integer :group 'mu4e-headers) (defcustom mu4e-headers-visible-columns 30 "Number of columns to display for the header view when using the vertical split-view." :type 'integer :group 'mu4e-headers) (defcustom mu4e-headers-auto-update t "Whether to automatically update the current headers buffer if an indexing operation showed changes." :type 'boolean :group 'mu4e-headers) (defcustom mu4e-headers-results-limit 500 "Maximum number of results to show; this affects performance quite a bit, especially when `mu4e-headers-include-related' is non-nil. Set to -1 for no limits, and you temporarily (for one query) ignore the limit by pressing a C-u before invoking the search." :type '(choice (const :tag "Unlimited" -1) (integer :tag "Limit")) :group 'mu4e-headers) (make-obsolete-variable 'mu4e-search-results-limit 'mu4e-headers-results-limit "0.9.9.5-dev6") (defcustom mu4e-headers-skip-duplicates nil "With this option set to non-nil, show only one of duplicate messages. This is useful when you have multiple copies of the same message, which is a common occurence for example when using Gmail and offlineimap." :type 'boolean :group 'mu4e-headers) (defcustom mu4e-headers-include-related nil "With this option set to non-nil, not just return the matches for a searches, but also messages that are related (through their references) to these messages. This can be useful e.g. to include sent messages into message threads." :type 'boolean :group 'mu4e-headers) (defcustom mu4e-headers-visible-flags '(draft flagged new passed replied seen trashed attach encrypted signed unread) "An ordered list of flags to show in the headers buffer. Each element is a symbol in the list (DRAFT FLAGGED NEW PASSED REPLIED SEEN TRASHED ATTACH ENCRYPTED SIGNED UNREAD)." :type '(set (const :tag "Draft" draft) (const :tag "Flagged" flagged) (const :tag "New" new) (const :tag "Passed" passed) (const :tag "Replied" replied) (const :tag "Seen" seen) (const :tag "Trashed" trashed) (const :tag "Attach" attach) (const :tag "Encrypted" encrypted) (const :tag "Signed" signed) (const :tag "Unread" unread)) :group 'mu4e-headers) (defcustom mu4e-headers-found-hook nil "Hook run just *after* all of the headers for the last search query have been received and are displayed." :type 'hook :group 'mu4e-headers) (defcustom mu4e-headers-search-bookmark-hook nil "Hook run just after we invoke a bookmarked search. This function receives the query as its parameter. The reason to use this instead of `mu4e-headers-search-hook' is if you only want to execute a hook when a search is entered via a bookmark, e.g. if you'd like to treat the bookmarks as a custom folder and change the options for the search, e.g. `mu4e-headers-show-threads', `mu4e-headers-include-related', `mu4e-headers-skip-duplicates` or `mu4e-headers-results-limit'." :type 'hook :group 'mu4e-headers) (defcustom mu4e-headers-search-hook nil "Hook run just before executing a new search operation. This function receives the query as its parameter. This is a more general hook facility than the `mu4e-headers-search-bookmark-hook'. It gets called on every executed search, not just those that are invoked via bookmarks, but also manually invoked searches." :type 'hook :group 'mu4e-headers) (defvar mu4e-headers-sort-field :date "Field to sort the headers by. Field must be a symbol, one of: :date, :subject, :size, :prio, :from, :to.") (defvar mu4e-headers-sort-direction 'descending "Direction to sort by; a symbol either `descending' (sorting Z->A) or `ascending' (sorting A->Z).") ;; marks for headers of the form; each is a cons-cell (basic . fancy) ;; each of which is basic ascii char and something fancy, respectively (defvar mu4e-headers-draft-mark '("D" . "⚒") "Draft.") (defvar mu4e-headers-flagged-mark '("F" . "✚") "Flagged.") (defvar mu4e-headers-new-mark '("N" . "✱") "New.") (defvar mu4e-headers-passed-mark '("P" . "❯") "Passed (fwd).") (defvar mu4e-headers-replied-mark '("R" . "❮") "Replied.") (defvar mu4e-headers-seen-mark '("S" . "✔") "Seen.") (defvar mu4e-headers-trashed-mark '("T" . "⏚") "Trashed.") (defvar mu4e-headers-attach-mark '("a" . "⚓") "W/ attachments.") (defvar mu4e-headers-encrypted-mark '("x" . "⚴") "Encrypted.") (defvar mu4e-headers-signed-mark '("s" . "☡") "Signed.") (defvar mu4e-headers-unread-mark '("u" . "⎕") "Unread.") ;; thread prefix marks (defvar mu4e-headers-has-child-prefix '("+" . "◼ ") "Parent.") (defvar mu4e-headers-empty-parent-prefix '("-" . "◽ ") "Orphan.") (defvar mu4e-headers-first-child-prefix '("\\" . "┗▶") "First child.") (defvar mu4e-headers-duplicate-prefix '("=" . "≡ ") "Duplicate.") (defvar mu4e-headers-default-prefix '("|" . "│ ") "Default.") (defvar mu4e-headers-actions '( ("capture message" . mu4e-action-capture-message) ("show this thread" . mu4e-action-show-thread)) "List of actions to perform on messages in the headers list. The actions are of the form (NAME SHORTCUT FUNC) where: * NAME is the name of the action (e.g. \"Count lines\") * SHORTCUT is a one-character shortcut to call this action * FUNC is a function which receives a message plist as an argument.") (defvar mu4e-headers-custom-markers '(("Older than" (lambda (msg date) (time-less-p (mu4e-msg-field msg :date) date)) (lambda () (mu4e-get-time-date "Match messages before: "))) ("Newer than" (lambda (msg date) (time-less-p date (mu4e-msg-field msg :date))) (lambda () (mu4e-get-time-date "Match messages after: "))) ("Bigger than" (lambda (msg bytes) (> (mu4e-msg-field msg :size) (* 1024 bytes))) (lambda () (read-number "Match messages bigger than (Kbytes): ")))) "List of custom markers -- functions to mark message that match some custom function. Each of the list members has the following format: (NAME PREDICATE-FUNC PARAM-FUNC) * NAME is the name of the predicate function, and the first character is the shortcut (so keep those unique). * PREDICATE-FUNC is a function that takes two parameters, MSG and (optionally) PARAM, and should return non-nil when there's a match. * PARAM-FUNC is function that is evaluated once, and its value is then passed to PREDICATE-FUNC as PARAM. This is useful for getting user-input.") (defvar mu4e-headers-show-threads t "Whether to show threads in the headers list.") (defvar mu4e-headers-full-search nil "Whether to show all results. If this is nil show results up to `mu4e-search-results-limit')") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; internal variables/constants ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; docid cookies (defconst mu4e~headers-docid-pre "\376" "Each header starts (invisibly) with the `mu4e~headers-docid-pre', followed by the docid, followed by `mu4e~headers-docid-post'.") (defconst mu4e~headers-docid-post "\377" "Each header starts (invisibly) with the `mu4e~headers-docid-pre', followed by the docid, followed by `mu4e~headers-docid-post'.") (defvar mu4e~headers-view-win nil "The view window connected to this headers view.") (defvar mu4e~headers-sort-field-choices '( ("date" . :date) ("from" . :from) ("prio" . :prio) ("zsize" . :size) ("subject" . :subject) ("to" . :to)) "List of cells describing the various sort-options. In the format needed for `mu4e-read-option'.") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun mu4e~headers-clear () "Clear the header buffer and related data structures." (when (buffer-live-p mu4e~headers-buffer) (let ((inhibit-read-only t)) (with-current-buffer mu4e~headers-buffer (setq mu4e~view-msg nil) (mu4e~mark-clear) (erase-buffer))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; handler functions ;; ;; next are a bunch of handler functions; those will be called from mu4e~proc in ;; response to output from the server process (defun mu4e~headers-view-handler (msg) "Handler function for displaying a message." (mu4e-view msg mu4e~headers-buffer)) (defun mu4e~headers-view-this-message-p (docid) "Is DOCID currently being viewed?" (let ((viewbuf (get-buffer mu4e~view-buffer-name))) (when (and viewbuf (buffer-live-p viewbuf)) (with-current-buffer viewbuf (eq docid (plist-get mu4e~view-msg :docid)))))) (defun mu4e~headers-update-handler (msg is-move) "Update handler, will be called when a message has been updated in the database. This function will update the current list of headers." (when (buffer-live-p mu4e~headers-buffer) (with-current-buffer mu4e~headers-buffer (let* ((docid (mu4e-message-field msg :docid)) (initial-message-at-point (mu4e~headers-docid-at-point)) (initial-column (current-column)) (point (mu4e~headers-docid-pos docid))) (when point ;; is the message present in this list? ;; if it's marked, unmark it now (when (mu4e-mark-docid-marked-p docid) (mu4e-mark-set 'unmark)) ;; re-use the thread info from the old one; this is needed because ;; *update* messages don't have thread info by themselves (unlike ;; search results) ;; since we still have the search results, re-use ;; those (plist-put msg :thread (mu4e~headers-field-for-docid docid :thread)) ;; first, remove the old one (otherwise, we'd have two headers with ;; the same docid... (mu4e~headers-remove-handler docid) ;; if we're actually viewing this message (in mu4e-view mode), we ;; update it; that way, the flags can be updated, as well as the path ;; (which is useful for viewing the raw message) (when (mu4e~headers-view-this-message-p docid) (mu4e-view msg mu4e~headers-buffer)) ;; now, if this update was about *moving* a message, we don't show it ;; anymore (of course, we cannot be sure if the message really no ;; longer matches the query, but this seem a good heuristic. ;; if it was only a flag-change, show the message with its updated flags. (unless is-move (mu4e~headers-header-handler msg point)) (if (and initial-message-at-point (mu4e~headers-goto-docid initial-message-at-point)) (progn (move-to-column initial-column) (mu4e~headers-highlight initial-message-at-point)) ;; attempt to highlight the corresponding line and make it visible (mu4e~headers-highlight docid)) ))))) (defun mu4e~headers-remove-handler (docid) "Remove handler, will be called when a message with DOCID has been removed from the database. This function will hide the removed message from the current list of headers. If the message is not present, don't do anything." (when (buffer-live-p mu4e~headers-buffer) (with-current-buffer mu4e~headers-buffer (mu4e~headers-remove-header docid t) ;; if we were viewing this message, close it now. (when (and (mu4e~headers-view-this-message-p docid) (buffer-live-p mu4e~view-buffer)) (with-current-buffer mu4e~view-buffer ;; XXX it seems this sometimes fails; investigate; ;; for now, just ignore the error (ignore-errors (kill-buffer-and-window))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defsubst mu4e~headers-contact-str (contacts) "Turn the list of contacts CONTACTS (with elements (NAME . EMAIL) into a string." (mapconcat (lambda (ct) (let ((name (car ct)) (email (cdr ct))) (or name email "?"))) contacts ", ")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defsubst mu4e~headers-thread-prefix (thread) "Calculate the thread prefix based on thread info THREAD." (when thread (let ((get-prefix (lambda (cell) (if mu4e-use-fancy-chars (cdr cell) (car cell))))) (concat (make-string (* (if (plist-get thread :empty-parent) 0 1) (plist-get thread :level)) ?\s) (cond ((plist-get thread :has-child) (funcall get-prefix mu4e-headers-has-child-prefix)) ((plist-get thread :empty-parent) (funcall get-prefix mu4e-headers-empty-parent-prefix)) ((plist-get thread :first-child) (funcall get-prefix mu4e-headers-first-child-prefix)) ((plist-get thread :duplicate) (funcall get-prefix mu4e-headers-duplicate-prefix)) (t (funcall get-prefix mu4e-headers-default-prefix))) " ")))) (defsubst mu4e~headers-flags-str (flags) "Get a display string for the flags. Note that `mu4e-flags-to-string' is for internal use only; this function is for display. (This difference is significant, since internally, the Maildir spec determines what the flags look like, while our display may be different)." (let ((str "") (get-prefix (lambda (cell) (if mu4e-use-fancy-chars (cdr cell) (car cell))))) (dolist (flag mu4e-headers-visible-flags) (when (member flag flags) (setq str (concat str (case flag ('draft (funcall get-prefix mu4e-headers-draft-mark)) ('flagged (funcall get-prefix mu4e-headers-flagged-mark)) ('new (funcall get-prefix mu4e-headers-new-mark)) ('passed (funcall get-prefix mu4e-headers-passed-mark)) ('replied (funcall get-prefix mu4e-headers-replied-mark)) ('seen (funcall get-prefix mu4e-headers-seen-mark)) ('trashed (funcall get-prefix mu4e-headers-trashed-mark)) ('attach (funcall get-prefix mu4e-headers-attach-mark)) ('encrypted (funcall get-prefix mu4e-headers-encrypted-mark)) ('signed (funcall get-prefix mu4e-headers-signed-mark)) ('unread (funcall get-prefix mu4e-headers-unread-mark))))))) str)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defconst mu4e-headers-from-or-to-prefix '("" . "To ") "Prefix for the :from-or-to field. It's a cons cell with the car element being the From: prefix, the cdr element the To: prefix.") (defsubst mu4e~headers-from-or-to (msg) "When the from address for message MSG is one of the the user's addresses, \(as per `mu4e-user-mail-address-list'), show the To address; otherwise ; show the from address; prefixed with the appropriate `mu4e-headers-from-or-to-prefix'." (let ((addr (cdr-safe (car-safe (mu4e-message-field msg :from))))) (if (mu4e-user-mail-address-p addr) (concat (cdr mu4e-headers-from-or-to-prefix) (mu4e~headers-contact-str (mu4e-message-field msg :to))) (concat (car mu4e-headers-from-or-to-prefix) (mu4e~headers-contact-str (mu4e-message-field msg :from)))))) (defsubst mu4e~headers-human-date (msg) "Show a 'human' date. If the date is today, show the time, otherwise, show the date. The formats used for date and time are `mu4e-headers-date-format' and `mu4e-headers-time-format'." (let ((date (mu4e-msg-field msg :date))) (if (equal date '(0 0 0)) "None" (let ((day1 (decode-time date)) (day2 (decode-time (current-time)))) (if (and (eq (nth 3 day1) (nth 3 day2)) ;; day (eq (nth 4 day1) (nth 4 day2)) ;; month (eq (nth 5 day1) (nth 5 day2))) ;; year (format-time-string mu4e-headers-time-format date) (format-time-string mu4e-headers-date-format date)))))) (defsubst mu4e~headers-thread-subject (msg) "Get the subject if it is the first one in a thread; otherwise, return the thread-prefix without the subject-text. In other words, show the subject of a thread only once, similar to e.g. 'mutt'." (let* ((tinfo (mu4e-message-field msg :thread)) (subj (mu4e-msg-field msg :subject))) (concat ;; prefix subject with a thread indicator (mu4e~headers-thread-prefix tinfo) (if (or (not tinfo) (zerop (plist-get tinfo :level)) (plist-get tinfo :empty-parent)) (truncate-string-to-width subj 600) "")))) (defsubst mu4e~headers-mailing-list (list) "Get some identifier for the mailing list." (if list (propertize (mu4e-get-mailing-list-shortname list) 'help-echo list) "")) (defun mu4e~headers-custom-field (msg field) "Show some custom header field, or raise an error if it is not found." (let* ((item (or (assoc field mu4e-header-info-custom) (mu4e-error "field %S not found" field))) (func (or (plist-get (cdr-safe item) :function) (mu4e-error "no :function defined for field %S %S" field (cdr item))))) (funcall func msg))) (defun mu4e~headers-field-apply-basic-properties (msg field val width) (case field (:subject (concat ;; prefix subject with a thread indicator (mu4e~headers-thread-prefix (mu4e-message-field msg :thread)) ;; "["(plist-get (mu4e-message-field msg :thread) :path) "] " ;; work-around: emacs' display gets really slow when lines are too long; ;; so limit subject length to 600 (truncate-string-to-width val 600))) (:thread-subject (mu4e~headers-thread-subject msg)) ((:maildir :path :message-id) val) ((:to :from :cc :bcc) (mu4e~headers-contact-str val)) ;; if we (ie. `user-mail-address' is the 'From', show ;; 'To', otherwise show From (:from-or-to (mu4e~headers-from-or-to msg)) (:date (format-time-string mu4e-headers-date-format val)) (:mailing-list (mu4e~headers-mailing-list val)) (:human-date (propertize (mu4e~headers-human-date msg) 'help-echo (format-time-string mu4e-headers-long-date-format (mu4e-msg-field msg :date)))) (:flags (propertize (mu4e~headers-flags-str val) 'help-echo (format "%S" val))) (:tags (propertize (mapconcat 'identity val ", "))) (:size (mu4e-display-size val)) (t (mu4e~headers-custom-field msg field)))) (defun mu4e~headers-field-truncate-to-width (_msg _field val width) "Truncate VAL to WIDTH." (if width (truncate-string-to-width val width 0 ?\s t) val)) (defvar mu4e~headers-field-handler-functions '(mu4e~headers-field-apply-basic-properties mu4e~headers-field-truncate-to-width)) (defun mu4e~headers-field-handler (f-w msg) "Create a description of the field of MSG described by F-W." (let* ((field (car f-w)) (width (cdr f-w)) (val (mu4e-message-field msg (car f-w)))) (dolist (func mu4e~headers-field-handler-functions) (setq val (funcall func msg field val width))) val)) (defvar mu4e~headers-line-handler-functions '(mu4e~headers-line-apply-flag-face)) (defun mu4e~headers-line-apply-flag-face (msg line) "Adjust LINE's face property based on FLAGS." (let* ((flags (mu4e-message-field msg :flags)) (face (cond ((memq 'trashed flags) 'mu4e-trashed-face) ((memq 'draft flags) 'mu4e-draft-face) ((or (memq 'unread flags) (memq 'new flags)) 'mu4e-unread-face) ((memq 'flagged flags) 'mu4e-flagged-face) ((memq 'replied flags) 'mu4e-replied-face) ((memq 'passed flags) 'mu4e-forwarded-face) (t 'mu4e-header-face)))) ;; hmmm, this only works with emacs 24.4+ (when (fboundp 'add-face-text-property) (add-face-text-property 0 (length line) face t line)) line)) (defun mu4e~headers-line-handler (msg line) (dolist (func mu4e~headers-line-handler-functions) (setq line (funcall func msg line))) line) ;; note: this function is very performance-sensitive (defun mu4e~headers-header-handler (msg &optional point) "Create a one line description of MSG in this buffer, at POINT, if provided, or at the end of the buffer otherwise." (let ((docid (mu4e-message-field msg :docid)) (line (mapconcat (lambda (f-w) (mu4e~headers-field-handler f-w msg)) mu4e-headers-fields " "))) (setq line (mu4e~headers-line-handler msg line)) (mu4e~headers-add-header line docid point msg))) (defconst mu4e~no-matches "No matching messages found") (defconst mu4e~end-of-results "End of search results") (defun mu4e~headers-found-handler (count) "Create a one line description of the number of headers found after the end of the search results." (when (buffer-live-p mu4e~headers-buffer) (with-current-buffer mu4e~headers-buffer (save-excursion (goto-char (point-max)) (let ((inhibit-read-only t) (str (if (zerop count) mu4e~no-matches mu4e~end-of-results))) (insert (propertize str 'face 'mu4e-system-face 'intangible t)) (unless (zerop count) (mu4e-message "Found %d matching message%s" count (if (= 1 count) "" "s"))))) ;; if we need to jump to some specific message, do so now (goto-char (point-min)) (when mu4e~headers-msgid-target (mu4e-headers-goto-message-id mu4e~headers-msgid-target)) (when mu4e~headers-view-target (mu4e-headers-view-message)) ;; view the message at point (setq mu4e~headers-view-target nil mu4e~headers-msgid-target nil)) (when (mu4e~headers-docid-at-point) (mu4e~headers-highlight (mu4e~headers-docid-at-point))) ;; run-hooks (run-hooks 'mu4e-headers-found-hook))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defmacro mu4e~headers-defun-mark-for (mark) "Define a function mu4e~headers-mark-MARK." (let ((funcname (intern (format "mu4e-headers-mark-for-%s" mark))) (docstring (format "Mark header at point with %s." mark))) `(progn (defun ,funcname () ,docstring (interactive) (mu4e-headers-mark-and-next ',mark)) (put ',funcname 'definition-name ',mark)))) (mu4e~headers-defun-mark-for refile) (mu4e~headers-defun-mark-for something) (mu4e~headers-defun-mark-for delete) (mu4e~headers-defun-mark-for flag) (mu4e~headers-defun-mark-for move) (mu4e~headers-defun-mark-for read) (mu4e~headers-defun-mark-for trash) (mu4e~headers-defun-mark-for unflag) (mu4e~headers-defun-mark-for untrash) (mu4e~headers-defun-mark-for unmark) (mu4e~headers-defun-mark-for unread) (mu4e~headers-defun-mark-for action) ;;; headers-mode and mode-map ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar mu4e-headers-mode-map nil "Keymap for *mu4e-headers* buffers.") (unless mu4e-headers-mode-map (setq mu4e-headers-mode-map (let ((map (make-sparse-keymap))) (define-key map (kbd "C-S-u") 'mu4e-update-mail-and-index) ;; for terminal users (define-key map (kbd "C-c C-u") 'mu4e-update-mail-and-index) (define-key map "s" 'mu4e-headers-search) (define-key map "S" 'mu4e-headers-search-edit) (define-key map "/" 'mu4e-headers-search-narrow) (define-key map "j" 'mu4e~headers-jump-to-maildir) (define-key map (kbd "") 'mu4e-headers-query-prev) (define-key map (kbd "\\") 'mu4e-headers-query-prev) (define-key map (kbd "") 'mu4e-headers-query-next) (define-key map "b" 'mu4e-headers-search-bookmark) (define-key map "B" 'mu4e-headers-search-bookmark-edit) (define-key map "O" 'mu4e-headers-change-sorting) (define-key map "P" 'mu4e-headers-toggle-threading) (define-key map "Q" 'mu4e-headers-toggle-full-search) (define-key map "W" 'mu4e-headers-toggle-include-related) (define-key map "V" 'mu4e-headers-toggle-skip-duplicates) (define-key map "q" 'mu4e~headers-quit-buffer) (define-key map "g" 'mu4e-headers-rerun-search) ;; for compatibility (define-key map "%" 'mu4e-headers-mark-pattern) (define-key map "t" 'mu4e-headers-mark-subthread) (define-key map "T" 'mu4e-headers-mark-thread) ;; navigation between messages (define-key map "p" 'mu4e-headers-prev) (define-key map "n" 'mu4e-headers-next) (define-key map (kbd "") 'mu4e-headers-prev) (define-key map (kbd "") 'mu4e-headers-next) (define-key map (kbd "[") 'mu4e-headers-prev-unread) (define-key map (kbd "]") 'mu4e-headers-next-unread) ;; change the number of headers (define-key map (kbd "C-+") 'mu4e-headers-split-view-grow) (define-key map (kbd "C--") 'mu4e-headers-split-view-shrink) (define-key map (kbd "") 'mu4e-headers-split-view-grow) (define-key map (kbd "") 'mu4e-headers-split-view-shrink) (define-key map ";" 'mu4e-context-switch) ;; switching to view mode (if it's visible) (define-key map "y" 'mu4e-select-other-view) ;; marking/unmarking ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define-key map (kbd "") 'mu4e-headers-mark-for-trash) (define-key map (kbd "d") 'mu4e-headers-mark-for-trash) (define-key map (kbd "") 'mu4e-headers-mark-for-delete) (define-key map (kbd "") 'mu4e-headers-mark-for-delete) (define-key map (kbd "D") 'mu4e-headers-mark-for-delete) (define-key map (kbd "m") 'mu4e-headers-mark-for-move) (define-key map (kbd "r") 'mu4e-headers-mark-for-refile) (define-key map (kbd "?") 'mu4e-headers-mark-for-unread) (define-key map (kbd "!") 'mu4e-headers-mark-for-read) (define-key map (kbd "A") 'mu4e-headers-mark-for-action) (define-key map (kbd "u") 'mu4e-headers-mark-for-unmark) (define-key map (kbd "+") 'mu4e-headers-mark-for-flag) (define-key map (kbd "-") 'mu4e-headers-mark-for-unflag) (define-key map (kbd "=") 'mu4e-headers-mark-for-untrash) (define-key map (kbd "&") 'mu4e-headers-mark-custom) (define-key map (kbd "*") 'mu4e-headers-mark-for-something) (define-key map (kbd "") 'mu4e-headers-mark-for-something) (define-key map (kbd "") 'mu4e-headers-mark-for-something) (define-key map (kbd "") 'mu4e-headers-mark-for-something) (define-key map (kbd "#") 'mu4e-mark-resolve-deferred-marks) (define-key map "U" 'mu4e-mark-unmark-all) (define-key map "x" 'mu4e-mark-execute-all) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define-key map "a" 'mu4e-headers-action) ;; message composition (define-key map "R" 'mu4e-compose-reply) (define-key map "F" 'mu4e-compose-forward) (define-key map "C" 'mu4e-compose-new) (define-key map "E" 'mu4e-compose-edit) (define-key map (kbd "RET") 'mu4e-headers-view-message) (define-key map [mouse-2] 'mu4e-headers-view-message) (define-key map "$" 'mu4e-show-log) (define-key map "H" 'mu4e-display-manual) ;; menu (define-key map [menu-bar] (make-sparse-keymap)) (let ((menumap (make-sparse-keymap "Headers"))) (define-key map [menu-bar headers] (cons "Headers" menumap)) (define-key menumap [mu4e~headers-quit-buffer] '("Quit view" . mu4e~headers-quit-buffer)) (define-key menumap [display-help] '("Help" . mu4e-display-manual)) (define-key menumap [sepa0] '("--")) (define-key menumap [toggle-include-related] '(menu-item "Toggle related messages" mu4e-headers-toggle-include-related :button (:toggle . (and (boundp 'mu4e-headers-include-related) mu4e-headers-include-related)))) (define-key menumap [toggle-threading] '(menu-item "Toggle threading" mu4e-headers-toggle-threading :button (:toggle . (and (boundp 'mu4e-headers-show-threads) mu4e-headers-show-threads)))) (define-key menumap [sepa1] '("--")) (define-key menumap [execute-marks] '("Execute marks" . mu4e-mark-execute-all)) (define-key menumap [unmark-all] '("Unmark all" . mu4e-mark-unmark-all)) (define-key menumap [unmark] '("Unmark" . mu4e-headers-mark-for-unmark)) (define-key menumap [mark-pattern] '("Mark pattern" . mu4e-headers-mark-pattern)) (define-key menumap [mark-as-read] '("Mark as read" . mu4e-headers-mark-for-read)) (define-key menumap [mark-as-unread] '("Mark as unread" . mu4e-headers-mark-for-unread)) (define-key menumap [mark-delete] '("Mark for deletion" . mu4e-headers-mark-for-delete)) (define-key menumap [mark-trash] '("Mark for trash" . mu4e-headers-mark-for-trash)) (define-key menumap [mark-move] '("Mark for move" . mu4e-headers-mark-for-move)) (define-key menumap [sepa2] '("--")) (define-key menumap [resend] '("Resend" . mu4e-compose-resend)) (define-key menumap [forward] '("Forward" . mu4e-compose-forward)) (define-key menumap [reply] '("Reply" . mu4e-compose-reply)) (define-key menumap [compose-new] '("Compose new" . mu4e-compose-new)) (define-key menumap [sepa3] '("--")) (define-key menumap [query-next] '("Next query" . mu4e-headers-query-next)) (define-key menumap [query-prev] '("Previous query" . mu4e-headers-query-prev)) (define-key menumap [narrow-search] '("Narrow search" . mu4e-headers-search-narrow)) (define-key menumap [bookmark] '("Search bookmark" . mu4e-headers-search-bookmark)) (define-key menumap [jump] '("Jump to maildir" . mu4e~headers-jump-to-maildir)) (define-key menumap [refresh] '("Refresh" . mu4e-headers-rerun-search)) (define-key menumap [search] '("Search" . mu4e-headers-search)) (define-key menumap [sepa4] '("--")) (define-key menumap [view] '("View" . mu4e-headers-view-message)) (define-key menumap [next] '("Next" . mu4e-headers-next)) (define-key menumap [previous] '("Previous" . mu4e-headers-prev)) (define-key menumap [sepa5] '("--"))) map))) (fset 'mu4e-headers-mode-map mu4e-headers-mode-map) (defun mu4e~header-line-format () "Get the format for the header line." (let ((uparrow (if mu4e-use-fancy-chars " ▲" " ^")) (downarrow (if mu4e-use-fancy-chars " ▼" " V"))) (cons (make-string (+ mu4e~mark-fringe-len (floor (fringe-columns 'left t))) ?\s) (mapcar (lambda (item) (let* ((field (car item)) (width (cdr item)) (info (cdr (assoc field (append mu4e-header-info mu4e-header-info-custom)))) (sortable (plist-get info :sortable)) ;; if sortable, it is either t (when field is sortable itself) ;; or a symbol (if another field is used for sorting) (sortfield (when sortable (if (booleanp sortable) field sortable))) (help (plist-get info :help)) ;; triangle to mark the sorted-by column (arrow (when (and sortable (eq sortfield mu4e-headers-sort-field)) (if (eq mu4e-headers-sort-direction 'descending) downarrow uparrow))) (name (concat (plist-get info :shortname) arrow)) (map (make-sparse-keymap))) (when sortable (define-key map [header-line mouse-1] (lambda (&optional e) ;; getting the field, inspired by `tabulated-list-col-sort' (interactive "e") (let* ((obj (posn-object (event-start e))) (field (and obj (get-text-property 0 'field (car obj))))) ;; "t": if we're already sorted by field, the sort-order is ;; changed (mu4e-headers-change-sorting field t))))) (concat (propertize (if width (truncate-string-to-width name width 0 ?\s t) name) 'face (when arrow 'bold) 'help-echo help 'mouse-face (when sortable 'highlight) 'keymap (when sortable map) 'field field) " "))) mu4e-headers-fields)))) (defvar mu4e-headers-mode-abbrev-table nil) (defun mu4e~headers-do-auto-update () "Update the current headers buffer after indexing has brought some changes, `mu4e-headers-auto-update' is non-nil and there is no user-interaction ongoing." (when (and mu4e-headers-auto-update ;; must be set (zerop (mu4e-mark-marks-num)) ;; non active marks (not (active-minibuffer-window))) ;; no user input (with-current-buffer mu4e~headers-buffer (mu4e-headers-rerun-search)))) (define-derived-mode mu4e-headers-mode special-mode "mu4e:headers" "Major mode for displaying mu4e search results. \\{mu4e-headers-mode-map}." (use-local-map mu4e-headers-mode-map) (make-local-variable 'mu4e~headers-proc) (make-local-variable 'mu4e~highlighted-docid) (make-local-variable 'global-mode-string) (set (make-local-variable 'hl-line-face) 'mu4e-header-highlight-face) ;; maybe update the current headers upon indexing changes (add-hook 'mu4e-index-updated-hook 'mu4e~headers-do-auto-update nil t) (setq truncate-lines t buffer-undo-list t ;; don't record undo information overwrite-mode nil header-line-format (mu4e~header-line-format)) (mu4e~mark-initialize) ;; initialize the marking subsystem (hl-line-mode 1)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; highlighting (defvar mu4e~highlighted-docid nil "The highlighted docid") (defun mu4e~headers-highlight (docid) "Highlight the header with DOCID, or do nothing if it's not found. Also, unhighlight any previously highlighted headers." (with-current-buffer mu4e~headers-buffer (save-excursion ;; first, unhighlight the previously highlighted docid, if any (when (and docid mu4e~highlighted-docid (mu4e~headers-goto-docid mu4e~highlighted-docid)) (hl-line-unhighlight)) ;; now, highlight the new one (when (mu4e~headers-goto-docid docid) (hl-line-highlight))) (setq mu4e~highlighted-docid docid))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun mu4e~headers-select-window () "When there is a visible window for the headers buffer, make sure to select it. This is needed when adding new headers, otherwise adding a lot of new headers looks really choppy." (let ((win (get-buffer-window mu4e~headers-buffer))) (when win (select-window win)))) ;;;; headers in the buffer are prefixed by an invisible string with the docid ;;;; followed by an EOT ('end-of-transmission', \004, ^D) non-printable ascii ;;;; character. this string also has a text-property with the docid. the former ;;;; is used for quickly finding a certain header, the latter for retrieving the ;;;; docid at point without string matching etc. (defsubst mu4e~headers-docid-cookie (docid) "Create an invisible string containing DOCID; this is to be used at the beginning of lines to identify headers." (propertize (format "%s%d%s" mu4e~headers-docid-pre docid mu4e~headers-docid-post) 'docid docid 'invisible t));; (defsubst mu4e~headers-docid-at-point (&optional point) "Get the docid for the header at POINT, or at current (point) if nil. Returns the docid, or nil if there is none." (save-excursion (when point (goto-char point)) (get-text-property (line-beginning-position) 'docid))) (defun mu4e~headers-goto-docid (docid &optional to-mark) "Go to the beginning of the line with the header with docid DOCID, or nil if it cannot be found. If the optional TO-MARK is non-nil, go to the point directly *after* the docid-cookie instead of the beginning of the line." (let ((oldpoint (point)) (newpoint)) (goto-char (point-min)) (setq newpoint (search-forward (mu4e~headers-docid-cookie docid) nil t)) (unless to-mark (if (null newpoint) (goto-char oldpoint) ;; not found; restore old pos (progn (beginning-of-line) ;; found, move to beginning of line (setq newpoint (point))))) newpoint)) ;; return the point, or nil if not found (defsubst mu4e~headers-docid-pos (docid) "Return the pos of the beginning of the line with the header with docid DOCID, or nil if it cannot be found." (let ((pos)) (save-excursion (setq pos (mu4e~headers-goto-docid docid))) pos)) (defsubst mu4e~headers-field-for-docid (docid field) "Get FIELD (a symbol, see `mu4e-headers-names') for the message with DOCID which must be present in the headers buffer." (save-excursion (when (mu4e~headers-goto-docid docid) (mu4e-message-field (mu4e-message-at-point) field)))) (defun mu4e-headers-goto-message-id (msgid) "Go to the next message with message-id MSGID. Return the message plist, or nil if not found." (mu4e-headers-find-if (lambda (msg) (let ((this-msgid (mu4e-message-field msg :message-id))) (when (and this-msgid (string= msgid this-msgid)) msg))))) ;;;; markers mark headers for (defun mu4e~headers-mark (docid mark) "(Visually) mark the header for DOCID with character MARK." (with-current-buffer mu4e~headers-buffer (let ((inhibit-read-only t) (oldpoint (point))) (unless (mu4e~headers-goto-docid docid) (mu4e-error "Cannot find message with docid %S" docid)) ;; now, we're at the beginning of the header, looking at ;; \004 ;; (which is invisible). jump past that… (unless (re-search-forward mu4e~headers-docid-post nil t) (mu4e-error "Cannot find the `mu4e~headers-docid-post' separator")) ;; clear old marks, and add the new ones. (let ((msg (get-text-property (point) 'msg))) (delete-char mu4e~mark-fringe-len) (insert (propertize (format mu4e~mark-fringe-format mark) 'face 'mu4e-header-marks-face 'docid docid 'msg msg))) (goto-char oldpoint)))) (defsubst mu4e~headers-add-header (str docid point &optional msg) "Add header STR with DOCID to the buffer at POINT if non-nil, or at (point-max) otherwise. If MSG is not nil, add it as the text-property `msg'." (when (buffer-live-p mu4e~headers-buffer) (with-current-buffer mu4e~headers-buffer (let ((inhibit-read-only t) (is-first-header (= (point-min) (point-max)))) (save-excursion (goto-char (if point point (point-max))) (insert (propertize (concat (mu4e~headers-docid-cookie docid) mu4e~mark-fringe str "\n") 'docid docid 'msg msg))))))) (defun mu4e~headers-remove-header (docid &optional ignore-missing) "Remove header with DOCID at point. When IGNORE-MISSING is non-nill, don't raise an error when the docid is not found." (with-current-buffer mu4e~headers-buffer (if (mu4e~headers-goto-docid docid) (let ((inhibit-read-only t)) (delete-region (line-beginning-position) (line-beginning-position 2))) (unless ignore-missing (mu4e-error "Cannot find message with docid %S" docid))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun mu4e~headers-search-execute (expr ignore-history) "Search in the mu database for EXPR, and switch to the output buffer for the results. If IGNORE-HISTORY is true, do *not* update the query history stack." ;; note: we don't want to update the history if this query comes from ;; `mu4e~headers-query-next' or `mu4e~headers-query-prev'. (mu4e-hide-other-mu4e-buffers) (let* ((buf (get-buffer-create mu4e~headers-buffer-name)) (inhibit-read-only t) (maxnum (unless mu4e-headers-full-search mu4e-headers-results-limit))) (with-current-buffer buf (mu4e-headers-mode) (unless ignore-history ;; save the old present query to the history list (when mu4e~headers-last-query (mu4e~headers-push-query mu4e~headers-last-query 'past))) (setq mu4e~headers-buffer buf mode-name "mu4e-headers" mu4e~headers-last-query expr global-mode-string '(:eval (concat (propertize (mu4e~quote-for-modeline mu4e~headers-last-query) 'face 'mu4e-modeline-face) " " (mu4e-context-label))))) (switch-to-buffer buf) (run-hook-with-args 'mu4e-headers-search-hook expr) (mu4e~proc-find expr mu4e-headers-show-threads mu4e-headers-sort-field mu4e-headers-sort-direction maxnum mu4e-headers-skip-duplicates mu4e-headers-include-related))) (defun mu4e~headers-redraw-get-view-window () "Close all windows, redraw the headers buffer based on the value of `mu4e-split-view', and return a window for the message view." (mu4e-hide-other-mu4e-buffers) (unless (buffer-live-p mu4e~headers-buffer) (mu4e-error "No headers buffer available")) (switch-to-buffer mu4e~headers-buffer) ;; kill the existing view win (when (buffer-live-p mu4e~view-buffer) (kill-buffer mu4e~view-buffer)) ;; get a new view window (setq mu4e~headers-view-win (let* ((new-win-func (cond ((eq mu4e-split-view 'horizontal) ;; split horizontally '(split-window-vertically mu4e-headers-visible-lines)) ((eq mu4e-split-view 'vertical) ;; split vertically '(split-window-horizontally mu4e-headers-visible-columns))))) (cond ((with-demoted-errors "Unable to split window: %S" (eval new-win-func))) (t ;; no splitting; just use the currently selected one (selected-window))))) mu4e~headers-view-win) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; search-based marking (defun mu4e-headers-for-each (func) "Call FUNC for each header, moving point to the header. FUNC receives one argument, the message s-expression for the corresponding header." (save-excursion (goto-char (point-min)) (while (search-forward mu4e~headers-docid-pre nil t) ;; not really sure why we need to jump to bol; we do need to, otherwise we ;; miss lines sometimes... (let ((msg (get-text-property (line-beginning-position) 'msg))) (when msg (funcall func msg)))))) (defun mu4e-headers-find-if (func &optional backward) "Move to the next header for which FUNC returns non-`nil', starting from the current position. FUNC receives one argument, the message s-expression for the corresponding header. If BACKWARD is non-`nil', search backwards. Returns the new position, or `nil' if nothing was found. If you want to exclude matches for the current message, you can use `mu4e-headers-find-if-next'." (let ((pos) (search-func (if backward 'search-backward 'search-forward))) (save-excursion (while (and (null pos) (funcall search-func mu4e~headers-docid-pre nil t)) ;; not really sure why we need to jump to bol; we do need to, otherwise we ;; miss lines sometimes... (let ((msg (get-text-property (line-beginning-position) 'msg))) (when (and msg (funcall func msg)) (setq pos (point)))))) (when pos (goto-char pos)))) (defun mu4e-headers-find-if-next (func &optional backwards) "Like `mu4e-headers-find-if', but do not match the current header. Move to the next or (if BACKWARDS is non-`nil') header for which FUNC returns non-`nil', starting from the current position." (let ((pos)) (save-excursion (if backwards (beginning-of-line) (end-of-line)) (setq pos (mu4e-headers-find-if func backwards))) (when pos (goto-char pos)))) (defvar mu4e~headers-regexp-hist nil "History list of regexps used.") (defun mu4e-headers-mark-for-each-if (markpair mark-pred &optional param) "Mark all headers for which predicate function MARK-PRED returns non-nil with MARKPAIR. MARK-PRED is function that receives two arguments, MSG (the message at point) and PARAM (a user-specified parameter). MARKPAIR is a cell (MARK . TARGET); see `mu4e-mark-at-point' for details about marks." (mu4e-headers-for-each (lambda (msg) (when (funcall mark-pred msg param) (mu4e-mark-at-point (car markpair) (cdr markpair)))))) (defun mu4e-headers-mark-pattern () "Ask user for a kind of mark (move, delete etc.), a field to match and a regular expression to match with. Then, mark all matching messages with that mark." (interactive) (let ((markpair (mu4e~mark-get-markpair "Mark matched messages with: " t)) (field (mu4e-read-option "Field to match: " '( ("subject" . :subject) ("from" . :from) ("to" . :to) ("cc" . :cc) ("bcc" . :bcc) ("list" . :mailing-list)))) (pattern (read-string (mu4e-format "Regexp:") nil 'mu4e~headers-regexp-hist))) (mu4e-headers-mark-for-each-if markpair (lambda (msg param) (let* ((do-mark) (value (mu4e-msg-field msg field))) (setq do-mark (if (member field '(:to :from :cc :bcc :reply-to)) (find-if (lambda (contact) (let ((name (car contact)) (email (cdr contact))) (or (and name (string-match pattern name)) (and email (string-match pattern email))))) value) (string-match pattern (or value ""))))))))) (defun mu4e-headers-mark-custom () "Mark messages based on a user-provided predicate function." (interactive) (let* ((pred (mu4e-read-option "Match function: " mu4e-headers-custom-markers)) (param (when (cdr pred) (eval (cdr pred)))) (markpair (mu4e~mark-get-markpair "Mark matched messages with: " t))) (mu4e-headers-mark-for-each-if markpair (car pred) param))) (defun mu4e~headers-get-thread-info (msg what) "Get WHAT (a symbol, either path or thread-id) for MSG." (let* ((thread (or (mu4e-message-field msg :thread) (mu4e-error "No thread info found"))) (path (or (plist-get thread :path) (mu4e-error "No threadpath found")))) (case what (path path) (thread-id (save-match-data ;; the thread id is the first segment of the thread path (when (string-match "^\\([[:xdigit:]]+\\):?" path) (match-string 1 path)))) (otherwise (mu4e-error "Not supported"))))) (defun mu4e-headers-mark-thread-using-markpair (markpair &optional subthread) "Mark the thread at point using the given markpair. If SUBTHREAD is non-nil, marking is limited to the message at point and its descendants." (let* ((mark (car markpair)) (allowed-marks (mapcar 'car mu4e-marks))) (unless (memq mark allowed-marks) (mu4e-error "The mark (%s) has to be one of: %s" mark allowed-marks))) ;; note: the tread id is shared by all messages in a thread (let* ((msg (mu4e-message-at-point)) (thread-id (mu4e~headers-get-thread-info msg 'thread-id)) (path (mu4e~headers-get-thread-info msg 'path)) (last-marked-point)) (mu4e-headers-for-each (lambda (mymsg) (let ((my-thread-id (mu4e~headers-get-thread-info mymsg 'thread-id))) (if subthread ;; subthread matching; mymsg's thread path should have path as its ;; prefix (when (string-match (concat "^" path) (mu4e~headers-get-thread-info mymsg 'path)) (mu4e-mark-at-point (car markpair) (cdr markpair)) (setq last-marked-point (point))) ;; nope; not looking for the subthread; looking for the whole thread (when (string= thread-id (mu4e~headers-get-thread-info mymsg 'thread-id)) (mu4e-mark-at-point (car markpair) (cdr markpair)) (setq last-marked-point (point))))))) (when last-marked-point (goto-char last-marked-point) (mu4e-headers-next)))) (defun mu4e-headers-mark-thread (&optional subthread markpair) "Like `mu4e-headers-mark-thread-using-markpair' but prompt for the markpair." (interactive (let* ((subthread current-prefix-arg)) (list current-prefix-arg ;; FIXME: e.g., for refiling we should evaluate this ;; for each line separately (mu4e~mark-get-markpair (if subthread "Mark subthread with: " "Mark whole thread with: ") t)))) (mu4e-headers-mark-thread-using-markpair markpair subthread)) (defun mu4e-headers-mark-subthread (&optional markpair) "Like `mu4e-mark-thread', but only for a sub-thread." (interactive) (if markpair (mu4e-headers-mark-thread t markpair) (let ((current-prefix-arg t)) (call-interactively 'mu4e-headers-mark-thread)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; the query past / present / future ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar mu4e~headers-query-past nil "Stack of queries before the present one.") (defvar mu4e~headers-query-future nil "Stack of queries after the present one.") (defvar mu4e~headers-query-stack-size 20 "Maximum size for the query stacks.") (defun mu4e~headers-push-query (query where) "Push QUERY to one of the query stacks. WHERE is a symbol telling us where to push; it's a symbol, either 'future or 'past. Functional also removes duplicats, limits the stack size." (let ((stack (case where (past mu4e~headers-query-past) (future mu4e~headers-query-future)))) ;; only add if not the same item (unless (and stack (string= (car stack) query)) (push query stack) ;; limit the stack to `mu4e~headers-query-stack-size' elements (when (> (length stack) mu4e~headers-query-stack-size) (setq stack (subseq stack 0 mu4e~headers-query-stack-size))) ;; remove all duplicates of the new element (remove-if (lambda (elm) (string= elm (car stack))) (cdr stack)) ;; update the stacks (case where (past (setq mu4e~headers-query-past stack)) (future (setq mu4e~headers-query-future stack)))))) (defun mu4e~headers-pop-query (whence) "Pop a query from the stack. WHENCE is a symbol telling us where to get it from, either `future' or `past'." (case whence (past (unless mu4e~headers-query-past (mu4e-warn "No more previous queries")) (pop mu4e~headers-query-past)) (future (unless mu4e~headers-query-future (mu4e-warn "No more next queries")) (pop mu4e~headers-query-future)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; interactive functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar mu4e~headers-search-hist nil "History list of searches.") (defvar mu4e~headers-msgid-target nil "Message-id to jump to after the search has finished.") (defvar mu4e~headers-view-target nil "Whether to automatically view (open) the target message (as per `mu4e~headers-msgid-target').") (defun mu4e-headers-search (&optional expr prompt edit ignore-history msgid show) "Search in the mu database for EXPR, and switch to the output buffer for the results. This is an interactive function which ask user for EXPR. PROMPT, if non-nil, is the prompt used by this function (default is \"Search for:\"). If EDIT is non-nil, instead of executing the query for EXPR, let the user edit the query before executing it. If IGNORE-HISTORY is true, do *not* update the query history stack. If MSGID is non-nil, attempt to move point to the first message with that message-id after searching. If SHOW is non-nil, show the message with MSGID." ;; note: we don't want to update the history if this query comes from ;; `mu4e~headers-query-next' or `mu4e~headers-query-prev'." (interactive) (let* ((prompt (mu4e-format (or prompt "Search for: "))) (expr (if edit (read-string prompt expr) (or expr (read-string prompt nil 'mu4e~headers-search-hist))))) (mu4e-mark-handle-when-leaving) (mu4e~headers-search-execute expr ignore-history) (setq mu4e~headers-msgid-target msgid mu4e~headers-view-target show))) (defun mu4e-headers-search-edit () "Edit the last search expression." (interactive) (mu4e-headers-search mu4e~headers-last-query nil t)) (defun mu4e-headers-search-bookmark (&optional expr edit) "Search using some bookmarked query EXPR. If EDIT is non-nil, let the user edit the bookmark before starting the search." (interactive) (let ((expr (or expr (mu4e-ask-bookmark (if edit "Select bookmark: " "Bookmark: "))))) (run-hook-with-args 'mu4e-headers-search-bookmark-hook expr) (mu4e-headers-search expr (when edit "Edit bookmark: ") edit))) (defun mu4e-headers-search-bookmark-edit () "Edit an existing bookmark before executing it." (interactive) (mu4e-headers-search-bookmark nil t)) (defun mu4e-headers-search-narrow (filter ) "Narrow the last search by appending search expression FILTER to the last search expression. Note that you can go back to previous query (effectively, 'widen' it), with `mu4e-headers-query-prev'." (interactive (let ((filter (read-string (mu4e-format "Narrow down to: ") nil 'mu4e~headers-search-hist nil t))) (list filter))) (unless mu4e~headers-last-query (mu4e-warn "There's nothing to filter")) (mu4e-headers-search (format "(%s) AND (%s)" mu4e~headers-last-query filter))) (defun mu4e-headers-change-sorting (&optional field dir) "Change the sorting/threading parameters. FIELD is the field to sort by; DIR is a symbol: either 'ascending, 'descending, 't (meaning: if FIELD is the same as the current sortfield, change the sort-order) or nil (ask the user)." (interactive) (let* ((field (or field (mu4e-read-option "Sortfield: " mu4e~headers-sort-field-choices))) ;; note: 'sortable' is either a boolean (meaning: if non-nil, this is ;; sortable field), _or_ another field (meaning: sort by this other field). (sortable (plist-get (cdr (assoc field mu4e-header-info)) :sortable)) ;; error check (sortable (if sortable sortable (mu4e-error "Not a sortable field"))) (sortfield (if (booleanp sortable) field sortable)) (dir (case dir ((ascending descending) dir) ;; change the sort order if field = curfield (t (if (eq sortfield mu4e-headers-sort-field) (if (eq mu4e-headers-sort-direction 'ascending) 'descending 'ascending) 'descending)) (mu4e-read-option "Direction: " '(("ascending" . 'ascending) ("descending" . 'descending)))))) (setq mu4e-headers-sort-field sortfield mu4e-headers-sort-direction dir) (mu4e-message "Sorting by %s (%s)" (symbol-name sortfield) (symbol-name mu4e-headers-sort-direction)) (mu4e-headers-rerun-search))) (defun mu4e~headers-toggle (name togglevar dont-refresh) "Toggle variable TOGGLEVAR for feature NAME. Unless DONT-REFRESH is non-nil, re-run the last search." (set togglevar (not (symbol-value togglevar))) (mu4e-message "%s turned %s%s" name (if (symbol-value togglevar) "on" "off") (if dont-refresh " (press 'g' to refresh)" "")) (unless dont-refresh (mu4e-headers-rerun-search))) (defun mu4e-headers-toggle-threading (&optional dont-refresh) "Toggle `mu4e-headers-show-threads'. With prefix-argument, do _not_ refresh the last search with the new setting for threading." (interactive "P") (mu4e~headers-toggle "Threading" 'mu4e-headers-show-threads dont-refresh)) (defun mu4e-headers-toggle-full-search (&optional dont-refresh) "Toggle `mu4e-headers-full-search'. With prefix-argument, do _not_ refresh the last search with the new setting for threading." (interactive "P") (mu4e~headers-toggle "Full-search" 'mu4e-headers-full-search dont-refresh)) (defun mu4e-headers-toggle-include-related (&optional dont-refresh) "Toggle `mu4e-headers-include-related'. With prefix-argument, do _not_ refresh the last search with the new setting for threading." (interactive "P") (mu4e~headers-toggle "Include-related" 'mu4e-headers-include-related dont-refresh)) (defun mu4e-headers-toggle-skip-duplicates (&optional dont-refresh) "Toggle `mu4e-headers-skip-duplicates'. With prefix-argument, do _not_ refresh the last search with the new setting for threading." (interactive "P") (mu4e~headers-toggle "Skip-duplicates" 'mu4e-headers-skip-duplicates dont-refresh)) (defvar mu4e~headers-loading-buf nil "A buffer for loading a message view.") (defun mu4e~headers-get-loading-buf () "Get a buffer to give feedback while loading a message view." (unless (buffer-live-p mu4e~headers-loading-buf) (setq mu4e~headers-loading-buf (get-buffer-create " *mu4e-loading*"))) (with-current-buffer mu4e~headers-loading-buf (let ((inhibit-read-only t)) (erase-buffer) (local-set-key (kbd "q") 'kill-buffer-and-window) (insert (propertize "Waiting for message..." 'face 'mu4e-system-face 'intangible t)))) mu4e~headers-loading-buf) (defun mu4e-headers-view-message () "View message at point. If there's an existing window for the view, re-use that one. If not, create a new one, depending on the value of `mu4e-split-view': if it's a symbol `horizontal' or `vertical', split the window accordingly; if it is nil, replace the current window. " (interactive) (unless (eq major-mode 'mu4e-headers-mode) (mu4e-error "Must be in mu4e-headers-mode (%S)" major-mode)) (let* ((msg (mu4e-message-at-point)) (docid (or (mu4e-message-field msg :docid) (mu4e-warn "No message at point"))) ;; decrypt (or not), based on `mu4e-decryption-policy'. (decrypt (and (member 'encrypted (mu4e-message-field msg :flags)) (if (eq mu4e-decryption-policy 'ask) (yes-or-no-p (mu4e-format "Decrypt message?")) mu4e-decryption-policy))) (viewwin (mu4e~headers-redraw-get-view-window))) (unless (window-live-p viewwin) (mu4e-error "Cannot get a message view")) (select-window viewwin) (switch-to-buffer (mu4e~headers-get-loading-buf)) (mu4e~proc-view docid mu4e-view-show-images decrypt))) (defun mu4e-headers-rerun-search () "Rerun the search for the last search expression." (interactive) ;; if possible, try to return to the same message (let* ((msg (mu4e-message-at-point)) (msgid (and msg (mu4e-message-field msg :message-id)))) (mu4e-headers-search mu4e~headers-last-query nil nil t msgid))) (defun mu4e~headers-query-navigate (whence) "Execute the previous query from the query stacks. WHENCE determines where the query is taken from and is a symbol, either `future' or `past'." (let ((query (mu4e~headers-pop-query whence)) (where (if (eq whence 'future) 'past 'future))) (when query (mu4e~headers-push-query mu4e~headers-last-query where) (mu4e-headers-search query nil nil t)))) (defun mu4e-headers-query-next () "Execute the previous query from the query stacks." (interactive) (mu4e~headers-query-navigate 'future)) (defun mu4e-headers-query-prev () "Execute the previous query from the query stacks." (interactive) (mu4e~headers-query-navigate 'past)) ;; forget the past so we don't repeat it :/ (defun mu4e-headers-forget-queries () "Forget all the complete query history." (interactive) (setq ;; note: don't forget the present one mu4e~headers-query-past nil mu4e~headers-query-future nil) (mu4e-message "Query history cleared")) (defun mu4e~headers-move (lines) "Move point LINES lines forward (if LINES is positive) or backward (if LINES is negative). If this succeeds, return the new docid. Otherwise, return nil." (unless (eq major-mode 'mu4e-headers-mode) (mu4e-error "Must be in mu4e-headers-mode (%S)" major-mode)) (let ((succeeded (zerop (forward-line lines))) (docid (mu4e~headers-docid-at-point))) ;; move point, even if this function is called when this window is not ;; visible (when docid ;; update all windows showing the headers buffer (walk-windows (lambda (win) (when (eq (window-buffer win) mu4e~headers-buffer) (set-window-point win (point)))) nil t) ;;(set-window-point (get-buffer-window mu4e~headers-buffer t) (point)) ;; attempt to highlight the new line, display the message (mu4e~headers-highlight docid) ;; update message view if it was already showing (when (and mu4e-split-view (window-live-p mu4e~headers-view-win)) (mu4e-headers-view-message)) docid))) (defun mu4e-headers-next (&optional n) "Move point to the next message header. If this succeeds, return the new docid. Otherwise, return nil. Optionally, takes an integer N (prefix argument), to the Nth next header." (interactive "P") (mu4e~headers-move (or n 1))) (defun mu4e-headers-prev (&optional n) "Move point to the previous message header. If this succeeds, return the new docid. Otherwise, return nil. Optionally, takes an integer N (prefix argument), to the Nth previous header." (interactive "P") (mu4e~headers-move (- (or n 1)))) (defun mu4e~headers-prev-or-next-unread (backwards) "Move point to the next message that is unread (and untrashed). If BACKWARDS is non-`nil', move backwards." (interactive) (or (mu4e-headers-find-if-next (lambda (msg) (let ((flags (mu4e-message-field msg :flags))) (and (member 'unread flags) (not (member 'trashed flags))))) backwards) (mu4e-message (format "No %s unread message found" (if backwards "previous" "next"))))) (defun mu4e-headers-prev-unread () "Move point to the previous message that is unread (and untrashed)." (interactive) (mu4e~headers-prev-or-next-unread t)) (defun mu4e-headers-next-unread () "Move point to the next message that is unread (and untrashed)." (interactive) (mu4e~headers-prev-or-next-unread nil)) (defun mu4e~headers-jump-to-maildir (maildir) "Show the messages in maildir (user is prompted to ask what maildir)." (interactive (let ((maildir (mu4e-ask-maildir "Jump to maildir: "))) (list maildir))) (when maildir (mu4e-mark-handle-when-leaving) (mu4e-headers-search (format "maildir:\"%s\"" maildir)))) (defun mu4e-headers-split-view-grow (&optional n) "In split-view, grow the headers window. In horizontal split-view, increase the number of lines shown by N. In vertical split-view, increase the number of columns shown by N. If N is negative shrink the headers window. When not in split-view do nothing." (interactive "P") (let ((n (or n 1)) (hwin (get-buffer-window mu4e~headers-buffer))) (when (and (buffer-live-p mu4e~view-buffer) (window-live-p hwin)) (let ((n (or n 1))) (case mu4e-split-view ;; emacs has weird ideas about what horizontal, vertical means... (horizontal (window-resize hwin n nil) (incf mu4e-headers-visible-lines n)) (vertical (window-resize hwin n t) (incf mu4e-headers-visible-columns n))))))) (defun mu4e-headers-split-view-shrink (&optional n) "In split-view, shrink the headers window. In horizontal split-view, decrease the number of lines shown by N. In vertical split-view, decrease the number of columns shown by N. If N is negative grow the headers window. When not in split-view do nothing." (interactive "P") (mu4e-headers-split-view-grow (- (or n 1)))) (defun mu4e-headers-action (&optional actionfunc) "Ask user what to do with message-at-point, then do it. The actions are specified in `mu4e-headers-actions'. Optionally, pass ACTIONFUNC, which is a function that takes a msg-plist argument." (interactive) (let ((msg (mu4e-message-at-point)) (afunc (or actionfunc (mu4e-read-option "Action: " mu4e-headers-actions)))) (funcall afunc msg))) (defun mu4e-headers-mark-and-next (mark) "Set mark MARK on the message at point or on all messages in the region if there is a region, then move to the next message." (interactive) (mu4e-mark-set mark) (mu4e-headers-next)) (defun mu4e~headers-quit-buffer () "Quit the mu4e-headers buffer. This is a rather complex function, to ensure we don't disturb other windows." (interactive) (unless (eq major-mode 'mu4e-headers-mode) (mu4e-error "Must be in mu4e-headers-mode (%S)" major-mode)) (mu4e-mark-handle-when-leaving) (let ((curbuf (current-buffer)) (curwin (selected-window)) (headers-visible)) (walk-windows (lambda (win) (with-selected-window win ;; if we the view window connected to this one, kill it (when (and (not (one-window-p win)) (eq mu4e~headers-view-win win)) (delete-window win) (setq mu4e~headers-view-win nil))) ;; and kill any _other_ (non-selected) window that shows the current ;; buffer (when (and (eq curbuf (window-buffer win)) ;; does win show curbuf? (not (eq curwin win)) ;; it's not the curwin? (not (one-window-p))) ;; and not the last one? (delete-window win)))) ;; delete it! ;; now, all *other* windows should be gone. kill ourselves, and return ;; to the main view (kill-buffer) (mu4e~main-view))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (provide 'mu4e-headers)