Merge pull request #361 from sabof/make-view-region-keymaps-external

* mu4e: make region maps configurable.
This commit is contained in:
Dirk-Jan C. Binnema 2014-02-06 20:40:40 -08:00
commit 49e46e99ac
1 changed files with 74 additions and 35 deletions

View File

@ -118,6 +118,33 @@ The first letter of NAME is used as a shortcut character.")
(defvar mu4e-view-fill-headers t (defvar mu4e-view-fill-headers t
"If non-nil, automatically fill the headers when viewing them.") "If non-nil, automatically fill the headers when viewing them.")
(defvar mu4e-view-contacts-header-keymap
(let ((map (make-sparse-keymap)))
(define-key map [mouse-1] 'mu4e~view-toggle-contact)
(define-key map [?\M-\r] 'mu4e~view-toggle-contact)
(define-key map [mouse-2] 'mu4e~view-compose-contact)
(define-key map "C" 'mu4e~view-compose-contact)
(define-key map "c" 'mu4e~view-copy-contact)
map)
"Keymap used for the contacts in the header fields.")
(defvar mu4e-view-clickable-urls-keymap
(let ((map (make-sparse-keymap)))
(define-key map [mouse-1] 'mu4e~view-browse-url-from-binding)
(define-key map [?\M-\r] 'mu4e~view-browse-url-from-binding)
map)
"Keymap used for the urls inside the body.")
(defvar mu4e-view-attachments-header-keymap
(let ((map (make-sparse-keymap)))
(define-key map [mouse-1] 'mu4e~view-open-attach-from-binding)
(define-key map [?\M-\r] 'mu4e~view-open-attach-from-binding)
(define-key map [mouse-2] 'mu4e~view-save-attach-from-binding)
(define-key map (kbd "<S-return>") 'mu4e~view-save-attach-from-binding)
map)
"Keymap used in the \"Attachements\" header field.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -266,6 +293,21 @@ marking if it still had that."
(when embedded (local-set-key "q" 'kill-buffer-and-window)) (when embedded (local-set-key "q" 'kill-buffer-and-window))
(mu4e-view-mode)))))) (mu4e-view-mode))))))
(defun mu4e~view-get-property-from-event (prop)
"Get the property PROP at point, or the location of the mouse.
The action is chosen based on the `last-command-event'.
Meant to be evoked from interactive commands."
(if (and (eventp last-command-event)
(mouse-event-p last-command-event))
(let ((posn (event-end last-command-event)))
(when (numberp (posn-point posn))
(get-text-property
(posn-point posn)
prop
(window-buffer (posn-window posn)))
))
(get-text-property (point) prop)))
(defun mu4e~view-construct-header (field val &optional dont-propertize-val) (defun mu4e~view-construct-header (field val &optional dont-propertize-val)
"Return header field FIELD (as in `mu4e-header-info') with value "Return header field FIELD (as in `mu4e-header-info') with value
VAL if VAL is non-nil. If DONT-PROPERTIZE-VAL is non-nil, do not VAL if VAL is non-nil. If DONT-PROPERTIZE-VAL is non-nil, do not
@ -340,20 +382,14 @@ at POINT, or if nil, at (point)."
(email (when (cdr c) (email (when (cdr c)
(replace-regexp-in-string "[[:cntrl:]]" "" (cdr c)))) (replace-regexp-in-string "[[:cntrl:]]" "" (cdr c))))
(short (or name email)) ;; name may be nil (short (or name email)) ;; name may be nil
(long (if name (format "%s <%s>" name email) email)) (long (if name (format "%s <%s>" name email) email)))
(map (make-sparse-keymap)))
(define-key map [mouse-1] 'mu4e~view-toggle-contact)
(define-key map [?\M-\r] 'mu4e~view-toggle-contact)
(define-key map [mouse-2] 'mu4e~view-compose-contact)
(define-key map "C" 'mu4e~view-compose-contact)
(define-key map "c" 'mu4e~view-copy-contact)
(propertize (propertize
long long
'long long 'long long
'short short 'short short
'email email 'email email
'display (if mu4e-view-show-addresses long short) 'display (if mu4e-view-show-addresses long short)
'keymap map 'keymap mu4e-view-contacts-header-keymap
'face 'mu4e-contact-face 'face 'mu4e-contact-face
'mouse-face 'highlight 'mouse-face 'highlight
'help-echo 'help-echo
@ -401,16 +437,19 @@ at POINT, or if nil, at (point)."
(val (when val (concat val " (" btn ")")))) (val (when val (concat val " (" btn ")"))))
(mu4e~view-construct-header :signature val t))) (mu4e~view-construct-header :signature val t)))
(defun mu4e~view-open-attach-func (msg attnum) (defun mu4e~view-open-attach-from-binding ()
"Return a function that opens attachment with ATTNUM." "Open the attachement at point, or click location."
(lexical-let ((msg msg) (attnum attnum)) (interactive)
(lambda () (interactive) (mu4e-view-open-attachment msg attnum)))) (let* (( msg (mu4e~view-get-property-from-event 'mu4e-msg))
( attnum (mu4e~view-get-property-from-event 'mu4e-attnum)))
(mu4e-view-open-attachment msg attnum)))
(defun mu4e~view-save-attach-func (msg attnum) (defun mu4e~view-save-attach-from-binding ()
"Return a function that saves attachment with ATTNUM." "Save the attachement at point, or click location."
(lexical-let ((msg msg) (attnum attnum)) (interactive)
(lambda () (interactive) (let* (( msg (mu4e~view-get-property-from-event 'mu4e-msg))
(mu4e-view-save-attachment-single msg attnum)))) ( attnum (mu4e~view-get-property-from-event 'mu4e-attnum)))
(mu4e-view-save-attachment-single msg attnum)))
(defun mu4e~view-construct-attachments-header (msg) (defun mu4e~view-construct-attachments-header (msg)
"Display attachment information; the field looks like something like: "Display attachment information; the field looks like something like:
@ -454,27 +493,19 @@ at POINT, or if nil, at (point)."
(lambda (part) (lambda (part)
(let ((index (mu4e-message-part-field part :index)) (let ((index (mu4e-message-part-field part :index))
(name (mu4e-message-part-field part :name)) (name (mu4e-message-part-field part :name))
(size (mu4e-message-part-field part :size)) (size (mu4e-message-part-field part :size)))
(map (make-sparse-keymap)))
(incf id) (incf id)
(puthash id index mu4e~view-attach-map) (puthash id index mu4e~view-attach-map)
(define-key map [mouse-1]
(mu4e~view-open-attach-func msg id))
(define-key map [?\M-\r]
(mu4e~view-open-attach-func msg id))
(define-key map [mouse-2]
(mu4e~view-save-attach-func msg id))
(define-key map (kbd "<S-return>")
(mu4e~view-save-attach-func msg id))
(concat (concat
(propertize (format "[%d]" id) (propertize (format "[%d]" id)
'face 'mu4e-attach-number-face) 'face 'mu4e-attach-number-face)
(propertize name 'face 'mu4e-link-face (propertize name 'face 'mu4e-link-face
'keymap map 'keymap mu4e-view-attachments-header-keymap
'mouse-face 'highlight 'mouse-face 'highlight
'help-echo 'help-echo
'mu4e-msg msg
'mu4e-attnum id
(concat (concat
"[mouse-1] or [M-RET] opens the attachment\n" "[mouse-1] or [M-RET] opens the attachment\n"
"[mouse-2] or [S-RET] offers to save it")) "[mouse-2] or [S-RET] offers to save it"))
@ -731,6 +762,16 @@ What browser is called is depending on
(interactive) (interactive)
(browse-url url)))))) (browse-url url))))))
(defun mu4e~view-browse-url-from-binding (&optional url)
"View in browser the url at point, or click location.
If the optional argument URL is provided, browse that instead.
If the url is mailto link, start writing an email to that address."
(interactive)
(let* (( url (or url (mu4e~view-get-property-from-event 'mu4e-url))))
(if (string-match-p "^mailto:" url)
(mu4e~compose-browse-url-mail url)
(browse-url url))))
(defun mu4e~view-show-images-maybe (msg) (defun mu4e~view-show-images-maybe (msg)
"Show attached images, if `mu4e-show-images' is non-nil." "Show attached images, if `mu4e-show-images' is non-nil."
(when (and (display-images-p) mu4e-view-show-images) (when (and (display-images-p) mu4e-view-show-images)
@ -757,15 +798,13 @@ Also number them so they can be opened using `mu4e-view-go-to-url'."
(make-hash-table :size 32 :weakness nil)) (make-hash-table :size 32 :weakness nil))
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward mu4e~view-url-regexp nil t) (while (re-search-forward mu4e~view-url-regexp nil t)
(let ((url (match-string 0)) (let ((url (match-string 0)))
(map (make-sparse-keymap)))
(define-key map [mouse-1] (mu4e~view-browse-url-func url))
(define-key map [?\M-\r] (mu4e~view-browse-url-func url))
(puthash (incf num) url mu4e~view-link-map) (puthash (incf num) url mu4e~view-link-map)
(add-text-properties 0 (length url) (add-text-properties 0 (length url)
`(face mu4e-link-face `(face mu4e-link-face
mouse-face highlight mouse-face highlight
keymap ,map mu4e-url ,url
keymap ,mu4e-view-clickable-urls-keymap
help-echo help-echo
"[mouse-1] or [M-RET] to open the link") url) "[mouse-1] or [M-RET] to open the link") url)
(replace-match (replace-match
@ -1186,7 +1225,7 @@ offer to go to a range of URLs."
(mu4e~view-get-urls-num "URL to visit"))) (mu4e~view-get-urls-num "URL to visit")))
(url (gethash num mu4e~view-link-map))) (url (gethash num mu4e~view-link-map)))
(unless url (mu4e-warn "Invalid number for URL")) (unless url (mu4e-warn "Invalid number for URL"))
(funcall (mu4e~view-browse-url-func url)))) (mu4e~view-browse-url-from-binding url)))
(defun mu4e-view-go-to-urls-multi () (defun mu4e-view-go-to-urls-multi ()
"Offer to visit multiple URLs from the current message. "Offer to visit multiple URLs from the current message.