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

* mu4e: make region maps configurable.

mu4e/mu4e-view.el

@@ -118,6 +118,33 @@ The first letter of NAME is used as a shortcut character.")
 
 (defvar mu4e-view-fill-headers t
   "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))
 	  (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)
   "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
@@ -340,20 +382,14 @@ at POINT, or if nil, at (point)."
 		(email (when (cdr c)
 			 (replace-regexp-in-string "[[:cntrl:]]" "" (cdr c))))
 		(short (or name email)) ;; name may be nil
-		(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)
+		(long (if name (format "%s <%s>" name email) email)))
 	  (propertize
 	    long
 	    'long long
 	    'short short
 	    'email email
 	    'display (if mu4e-view-show-addresses long short)
-	    'keymap map
+	    'keymap mu4e-view-contacts-header-keymap
 	    'face 'mu4e-contact-face
 	    'mouse-face 'highlight
 	    'help-echo
@@ -401,16 +437,19 @@ at POINT, or if nil, at (point)."
 	  (val (when val (concat val " (" btn ")"))))
     (mu4e~view-construct-header :signature val t)))
 
-(defun mu4e~view-open-attach-func (msg attnum)
-  "Return a function that opens attachment with ATTNUM."
-  (lexical-let ((msg msg) (attnum attnum))
-    (lambda () (interactive) (mu4e-view-open-attachment msg attnum))))
+(defun mu4e~view-open-attach-from-binding ()
+  "Open the attachement at point, or click location."
+  (interactive)
+  (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)
-  "Return a function that saves attachment with ATTNUM."
-  (lexical-let ((msg msg) (attnum attnum))
-    (lambda () (interactive)
-      (mu4e-view-save-attachment-single msg attnum))))
+(defun mu4e~view-save-attach-from-binding ()
+  "Save the attachement at point, or click location."
+  (interactive)
+  (let* (( msg (mu4e~view-get-property-from-event 'mu4e-msg))
+         ( attnum (mu4e~view-get-property-from-event 'mu4e-attnum)))
+    (mu4e-view-save-attachment-single msg attnum)))
 
 (defun mu4e~view-construct-attachments-header (msg)
   "Display attachment information; the field looks like something like:
@@ -454,27 +493,19 @@ at POINT, or if nil, at (point)."
 	      (lambda (part)
 		(let ((index (mu4e-message-part-field part :index))
 		       (name (mu4e-message-part-field part :name))
-		       (size (mu4e-message-part-field part :size))
-		       (map (make-sparse-keymap)))
+		       (size (mu4e-message-part-field part :size)))
 		  (incf id)
 		  (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
 		    (propertize (format "[%d]" id)
 		      'face 'mu4e-attach-number-face)
 		    (propertize name 'face 'mu4e-link-face
-		      'keymap map
+		      'keymap mu4e-view-attachments-header-keymap
 		      'mouse-face 'highlight
 		      'help-echo
+		      'mu4e-msg msg
+		      'mu4e-attnum id
 		      (concat
 			"[mouse-1] or [M-RET] opens the attachment\n"
 			"[mouse-2] or [S-RET] offers to save it"))
@@ -731,6 +762,16 @@ What browser is called is depending on
 	  (interactive)
 	  (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)
   "Show attached images, if `mu4e-show-images' is non-nil."
   (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))
       (goto-char (point-min))
       (while (re-search-forward mu4e~view-url-regexp nil t)
-	(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))
+	(let ((url (match-string 0)))
 	  (puthash (incf num) url mu4e~view-link-map)
 	  (add-text-properties 0 (length url)
 	    `(face mu4e-link-face
 	       mouse-face highlight
-	       keymap ,map
+	       mu4e-url ,url
+	       keymap ,mu4e-view-clickable-urls-keymap
 	       help-echo
 	       "[mouse-1] or [M-RET] to open the link") url)
 	  (replace-match
@@ -1186,7 +1225,7 @@ offer to go to a range of URLs."
 		    (mu4e~view-get-urls-num "URL to visit")))
          (url (gethash num mu4e~view-link-map)))
     (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 ()
   "Offer to visit multiple URLs from the current message.