mirror of https://github.com/djcb/mu.git
1801 lines
73 KiB
EmacsLisp
1801 lines
73 KiB
EmacsLisp
;;; mu4e-headers.el -- part of mu4e -*- lexical-binding: t; coding:utf-8 -*-
|
||
|
||
;; 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:
|
||
|
||
;; 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:
|
||
|
||
(require 'cl-lib)
|
||
(require 'fringe)
|
||
(require 'hl-line)
|
||
(require 'mailcap)
|
||
(require 'mule-util) ;; seems _some_ people need this for truncate-string-ellipsis
|
||
|
||
(require 'mu4e-update)
|
||
|
||
;; utility functions
|
||
(require 'mu4e-server)
|
||
(require 'mu4e-vars)
|
||
(require 'mu4e-mark)
|
||
(require 'mu4e-context)
|
||
(require 'mu4e-contacts)
|
||
(require 'mu4e-search)
|
||
(require 'mu4e-compose)
|
||
(require 'mu4e-actions)
|
||
(require 'mu4e-message)
|
||
(require 'mu4e-lists)
|
||
(require 'mu4e-update)
|
||
(require 'mu4e-folders)
|
||
|
||
(declare-function mu4e-view "mu4e-view")
|
||
(declare-function mu4e--main-view "mu4e-main")
|
||
|
||
|
||
|
||
;;; Configuration
|
||
|
||
(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-precise-alignment nil
|
||
"When set, use precise (but relatively slow) alignment for columns.
|
||
By default, do it in a slightly inaccurate but faster way. To get
|
||
an idea about the difference, In some tests, the rendering time
|
||
was around 5.8 ms per messages for precise alignment, versus 3.3
|
||
for non-precise aligment (for 445 messages)."
|
||
:type 'boolean
|
||
: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-advance-after-mark t
|
||
"With this option set to non-nil, automatically advance to the
|
||
next mail after marking a message in header view."
|
||
:type 'boolean
|
||
:group 'mu4e-headers)
|
||
|
||
|
||
(defvar mu4e-headers-hide-predicate nil
|
||
"Predicate function applied to headers before they are shown;
|
||
if function is nil or evaluates to nil, show the header,
|
||
otherwise don't. function takes one parameter MSG, which is the
|
||
message plist for the message to be hidden or not.
|
||
|
||
Example that hides all 'trashed' messages:
|
||
(setq mu4e-headers-hide-predicate
|
||
(lambda (msg)
|
||
(member 'trashed (mu4e-message-field msg :flags))))
|
||
|
||
Note that this is merely a display filter.")
|
||
|
||
(defcustom mu4e-headers-visible-flags
|
||
'(draft flagged new passed replied trashed attach encrypted signed list personal)
|
||
"An ordered list of flags to show in the headers buffer.
|
||
Each element is a symbol in the list.
|
||
|
||
By default, we leave out `unread' and `seen', since those are
|
||
mostly covered by `new', and the display gets cluttered otherwise."
|
||
: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 "List" list)
|
||
(const :tag "Personal" personal))
|
||
: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)
|
||
|
||
;;; Public variables
|
||
|
||
(defvar mu4e-headers-sort-field :date
|
||
"Field to sort the headers by. A symbol:
|
||
one of: `:date', `:subject', `:size', `:prio', `:from', `:to.',
|
||
`:list'.
|
||
|
||
Note that when threading is enabled (through
|
||
`mu4e-search-threads'), the headers are exclusively sorted
|
||
chronologically (`:date') by the newest message in the thread.")
|
||
|
||
(defvar mu4e-headers-sort-direction 'descending
|
||
"Direction to sort by; a symbol either `descending' (sorting
|
||
Z->A) or `ascending' (sorting A->Z).")
|
||
|
||
;;;; Fancy marks
|
||
|
||
;; 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.")
|
||
(defvar mu4e-headers-list-mark '("s" . "Ⓛ") "Mailing list.")
|
||
(defvar mu4e-headers-personal-mark '("p" . "Ⓟ") "Personal.")
|
||
|
||
|
||
|
||
;;;; Graph drawing
|
||
|
||
(defvar mu4e-headers-thread-mark-as-orphan 'first
|
||
"Define which messages should be prefixed with the orphan mark.
|
||
`all' marks all the messages without a parent as orphan, `first'
|
||
only marks the first message in the thread.")
|
||
|
||
(defvar mu4e-headers-thread-root-prefix '("* " . "□ ")
|
||
"Prefix for root messages.")
|
||
(defvar mu4e-headers-thread-child-prefix '("|>" . "│ ")
|
||
"Prefix for messages in sub threads that do have a following sibling.")
|
||
(defvar mu4e-headers-thread-first-child-prefix '("o " . "⚬ ")
|
||
"Prefix for messages in sub threads that do not have a following sibling.")
|
||
(defvar mu4e-headers-thread-last-child-prefix '("L" . "└ ")
|
||
"Prefix for messages in sub threads that do not have a following sibling.")
|
||
(defvar mu4e-headers-thread-connection-prefix '("|" . "│ ")
|
||
"Prefix to connect sibling messages that do not follow each other.
|
||
Must have the same length as `mu4e-headers-thread-blank-prefix'.")
|
||
(defvar mu4e-headers-thread-blank-prefix '(" " . " ")
|
||
"Prefix to separate non connected messages.
|
||
Must have the same length as `mu4e-headers-thread-connection-prefix'.")
|
||
(defvar mu4e-headers-thread-orphan-prefix '("<>" . "♢ ")
|
||
"Prefix for orphan messages with siblings.")
|
||
(defvar mu4e-headers-thread-single-orphan-prefix '("<>" . "♢ ")
|
||
"Prefix for orphan messages with no siblings.")
|
||
(defvar mu4e-headers-thread-duplicate-prefix '("=" . "≡ ")
|
||
"Prefix for duplicate messages.")
|
||
|
||
|
||
|
||
(defvar mu4e-headers-threaded-label '("T" . "🎄")
|
||
"Non-fancy and fancy labels for threaded search in the mode-line.")
|
||
(defvar mu4e-headers-full-label '("F" . "∀")
|
||
"Non-fancy and fancy labels for full search in the mode-line.")
|
||
(defvar mu4e-headers-related-label '("R" . "🤝")
|
||
"Non-fancy and fancy labels for include-related search in the mode-line.")
|
||
|
||
;;;; Various
|
||
|
||
(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 cons-cells of the form (NAME . FUNC) where:
|
||
* NAME is the name of the action (e.g. \"Count lines\")
|
||
* FUNC is a function which receives a message plist as an argument.
|
||
|
||
The first character of NAME is used as the shortcut.")
|
||
|
||
(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.")
|
||
;;; 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-sort-field-choices
|
||
'( ("date" . :date)
|
||
("from" . :from)
|
||
("list" . :list)
|
||
("maildir" . :maildir)
|
||
("prio" . :prio)
|
||
("zsize" . :size)
|
||
("subject" . :subject)
|
||
("to" . :to))
|
||
"List of cells describing the various sort-options.
|
||
In the format needed for `mu4e-read-option'.")
|
||
|
||
|
||
(defvar mu4e~headers-search-start nil)
|
||
(defvar mu4e~headers-render-start nil)
|
||
(defvar mu4e~headers-render-time nil)
|
||
|
||
(defvar mu4e-headers-report-render-time nil
|
||
"If non-nil, report on the time it took to render the messages.
|
||
This is mostly useful for profiling.")
|
||
|
||
|
||
|
||
;;; Clear
|
||
|
||
(defun mu4e~headers-clear (&optional msg)
|
||
"Clear the header buffer and related data structures."
|
||
(when (buffer-live-p (mu4e-get-headers-buffer))
|
||
(setq mu4e~headers-render-start (float-time))
|
||
(let ((inhibit-read-only t))
|
||
(with-current-buffer (mu4e-get-headers-buffer)
|
||
(mu4e--mark-clear)
|
||
(erase-buffer)
|
||
(when msg
|
||
(goto-char (point-min))
|
||
(insert (propertize msg 'face 'mu4e-system-face 'intangible t)))))))
|
||
|
||
|
||
;;; Misc
|
||
|
||
(defun mu4e~headers-contact-str (contacts)
|
||
"Turn the list of contacts CONTACTS (with elements (NAME . EMAIL)
|
||
into a string."
|
||
(mapconcat
|
||
(lambda (contact)
|
||
(let ((name (mu4e-contact-name contact))
|
||
(email (mu4e-contact-email contact)))
|
||
(or name email "?"))) contacts ", "))
|
||
|
||
(defun mu4e~headers-thread-prefix-map (type)
|
||
"Return the thread prefix based on the symbol TYPE."
|
||
(let ((get-prefix
|
||
(lambda (cell)
|
||
(if mu4e-use-fancy-chars (cdr cell) (car cell)))))
|
||
(cl-case type
|
||
('child (funcall get-prefix mu4e-headers-thread-child-prefix))
|
||
('first-child (funcall get-prefix mu4e-headers-thread-first-child-prefix))
|
||
('last-child (funcall get-prefix mu4e-headers-thread-last-child-prefix))
|
||
('connection (funcall get-prefix mu4e-headers-thread-connection-prefix))
|
||
('blank (funcall get-prefix mu4e-headers-thread-blank-prefix))
|
||
('orphan (funcall get-prefix mu4e-headers-thread-orphan-prefix))
|
||
('single-orphan (funcall get-prefix mu4e-headers-thread-single-orphan-prefix))
|
||
('duplicate (funcall get-prefix mu4e-headers-thread-duplicate-prefix))
|
||
(t "?"))))
|
||
|
||
|
||
;; 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.
|
||
|
||
(defun 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))
|
||
|
||
(defun 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));;
|
||
|
||
(defun 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
|
||
|
||
(defun 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))))
|
||
|
||
|
||
;; In order to print a thread tree with all the message connections,
|
||
;; it's necessary to keep track of all sub levels that still have
|
||
;; following messages. For each level, mu4e~headers-thread-state keeps
|
||
;; the value t for a connection or nil otherwise.
|
||
(defvar-local mu4e~headers-thread-state '())
|
||
|
||
(defun mu4e~headers-thread-prefix (thread)
|
||
"Calculate the thread prefix based on thread info THREAD."
|
||
(when thread
|
||
(let* ((prefix "")
|
||
(level (plist-get thread :level))
|
||
(has-child (plist-get thread :has-child))
|
||
(first-child (plist-get thread :first-child))
|
||
(last-child (plist-get thread :last-child))
|
||
(orphan (plist-get thread :orphan))
|
||
(single-orphan(and orphan first-child last-child))
|
||
(duplicate (plist-get thread :duplicate)))
|
||
;; Do not prefix root messages.
|
||
(if (= level 0)
|
||
(setq mu4e~headers-thread-state '()))
|
||
(if (> level 0)
|
||
(let* ((length (length mu4e~headers-thread-state))
|
||
(padding (make-list (max 0 (- level length)) nil)))
|
||
;; Trim and pad the state to ensure a message will
|
||
;; always be shown with the correct indentation, even if
|
||
;; a broken thread is returned. It's trimmed to level-1
|
||
;; because the current level has always an connection
|
||
;; and it used a special formatting.
|
||
(setq mu4e~headers-thread-state
|
||
(cl-subseq (append mu4e~headers-thread-state padding)
|
||
0 (- level 1)))
|
||
;; Prepare the thread prefix.
|
||
(setq prefix
|
||
(concat
|
||
;; Current mu4e~headers-thread-state, composed by
|
||
;; connections or blanks.
|
||
(mapconcat
|
||
(lambda (s)
|
||
(mu4e~headers-thread-prefix-map
|
||
(if s 'connection 'blank)))
|
||
mu4e~headers-thread-state "")
|
||
;; Current entry.
|
||
(mu4e~headers-thread-prefix-map
|
||
(if single-orphan 'single-orphan
|
||
(if (and orphan
|
||
(or first-child
|
||
(not (eq mu4e-headers-thread-mark-as-orphan 'first))))
|
||
'orphan
|
||
(if last-child 'last-child
|
||
(if first-child 'first-child
|
||
'child)))))))))
|
||
;; If a new sub-thread will follow (has-child) and the current
|
||
;; one is still not done (not last-child), then a new
|
||
;; connection needs to be added to the tree-state. It's not
|
||
;; necessary to a blank (nil), because padding will handle
|
||
;; that.
|
||
(if (and has-child (not last-child))
|
||
(setq mu4e~headers-thread-state
|
||
(append mu4e~headers-thread-state '(t))))
|
||
;; Return the thread prefix.
|
||
(format "%s%s"
|
||
prefix
|
||
(if duplicate
|
||
(mu4e~headers-thread-prefix-map 'duplicate) "")))))
|
||
|
||
(defun mu4e~headers-flags-str (flags)
|
||
"Get a display string for 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)."
|
||
(or (mapconcat
|
||
(lambda (flag)
|
||
(when (member flag mu4e-headers-visible-flags)
|
||
(if-let* ((mark (intern-soft
|
||
(format "mu4e-headers-%s-mark" (symbol-name flag))))
|
||
(cell (symbol-value mark)))
|
||
(if mu4e-use-fancy-chars (cdr cell) (car cell))
|
||
"")))
|
||
flags "")
|
||
""))
|
||
|
||
;;; Special headers
|
||
|
||
(defun mu4e~headers-from-or-to (msg)
|
||
"Get the From: address from MSG if not one of user's; otherwise get To:.
|
||
When the from address for message MSG is one of the the user's addresses,
|
||
\(as per `mu4e-personal-address-p'), show the To address;
|
||
otherwise ; show the from address; prefixed with the appropriate
|
||
`mu4e-headers-from-or-to-prefix'."
|
||
(let* ((from1 (car-safe (mu4e-message-field msg :from)))
|
||
(from1-addr (and from1 (mu4e-contact-email from1)))
|
||
(is-user (and from1-addr (mu4e-personal-address-p from1-addr))))
|
||
(if is-user
|
||
(concat "To " (mu4e~headers-contact-str (mu4e-message-field msg :to)))
|
||
(mu4e~headers-contact-str (mu4e-message-field msg :from)))))
|
||
|
||
|