alx/mu4e
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

* mm updates

Browse Source
This commit is contained in:
djcb
2011-11-13 12:44:54 +02:00
parent 38bd3e5fce
commit b4c32a53b7
3 changed files with 49 additions and 41 deletions
Download Patch File Download Diff File Expand all files Collapse all files

7
toys/mm/mm-hdrs.el
View File

@ -138,7 +138,8 @@ into a string."
(defun mm/hdrs-header-handler (msg &optional point) (defun mm/hdrs-header-handler (msg &optional point)
"Create a one line description of MSG in this buffer, at POINT, "Create a one line description of MSG in this buffer, at POINT,
if provided, or at the end of the buffer otherwise." if provided, or at the end of the buffer otherwise."
(let* ((line (mapconcat (let* ((line
(mapconcat
(lambda (f-w) (lambda (f-w)
(let* ((field (car f-w)) (width (cdr f-w)) (let* ((field (car f-w)) (width (cdr f-w))
(val (plist-get msg field)) (val (plist-get msg field))
@ -152,7 +153,7 @@ if provided, or at the end of the buffer otherwise."
(let* ((from-lst (plist-get msg :from)) (let* ((from-lst (plist-get msg :from))
(from (and from-lst (cdar from-lst)))) (from (and from-lst (cdar from-lst))))
(if (and from (string-match mm/user-mail-address-regexp from)) (if (and from (string-match mm/user-mail-address-regexp from))
(concat (propertize "To " 'face 'mm/system-face) (concat "To "
(mm/hdrs-contact-str (plist-get msg :to))) (mm/hdrs-contact-str (plist-get msg :to)))
(mm/hdrs-contact-str from-lst)))) (mm/hdrs-contact-str from-lst))))
(:date (format-time-string mm/headers-date-format val)) (:date (format-time-string mm/headers-date-format val))
@ -451,7 +452,7 @@ The following marks are available, and the corresponding props:
(when target (when target
(let* ((targetstr (propertize (concat "-> " target " ") (let* ((targetstr (propertize (concat "-> " target " ")
'face 'mm/system-face)) 'face 'mm/system-face))
(start (+ 2 (point))) ;; +2 for the marker fringe (start (+ 2 (line-beginning-position))) ;; +2 for the marker fringe
(overlay (make-overlay start (+ start (length targetstr))))) (overlay (make-overlay start (+ start (length targetstr)))))
(overlay-put overlay 'display targetstr))))))) (overlay-put overlay 'display targetstr)))))))

13
toys/mm/mm-send.el
View File

@ -360,6 +360,14 @@ using Gnus' `message-mode'."
"Move the message in this buffer to the sent folder. This is "Move the message in this buffer to the sent folder. This is
meant to be called from message mode's `message-sent-hook'." meant to be called from message mode's `message-sent-hook'."
(unless mm/sent-folder (error "mm/sent-folder not set")) (unless mm/sent-folder (error "mm/sent-folder not set"))
(save-excursion
(goto-char (point-min))
;; remove the --text follows this line-- separator
(if (search-forward-regexp (concat "^" mail-header-separator "\n"))
(replace-match "")
(error "cannot find mail-header-separator"))
(save-buffer)
(let ((docid (gethash (buffer-file-name) mm/path-docid-map))) (let ((docid (gethash (buffer-file-name) mm/path-docid-map)))
(unless docid (error "unknown message (%S)" (buffer-file-name))) (unless docid (error "unknown message (%S)" (buffer-file-name)))
;; ok, all seems well, well move the message to the sent-folder ;; ok, all seems well, well move the message to the sent-folder
@ -369,8 +377,8 @@ using Gnus' `message-mode'."
;; mark the buffer as read-only, as its pointing at a non-existing file ;; mark the buffer as read-only, as its pointing at a non-existing file
;; now... ;; now...
(message "Message has been sent") (kill-buffer-and-window)
(setq buffer-read-only t))) (message "Message has been sent"))))
@ -403,7 +411,6 @@ This is meant to be called from message mode's
(while (re-search-forward "<[^ <]+@[^ <]+>" nil t) (while (re-search-forward "<[^ <]+@[^ <]+>" nil t)
(push (match-string 0) refs)) (push (match-string 0) refs))
(setq forwarded-from (car-safe (last refs))))))) (setq forwarded-from (car-safe (last refs)))))))
;; remove the <> ;; remove the <>
(when (and in-reply-to (string-match "<\\(.*\\)>" in-reply-to)) (when (and in-reply-to (string-match "<\\(.*\\)>" in-reply-to))
(mm/proc-flag (match-string 1 in-reply-to) "+R")) (mm/proc-flag (match-string 1 in-reply-to) "+R"))

2
toys/mm/mm-view.el
View File

@ -342,7 +342,7 @@ removing '^M' etc."
(add-text-properties p (point-max) '(face mm/view-footer-face)))) (add-text-properties p (point-max) '(face mm/view-footer-face))))
;; this is fairly simplistic... ;; this is fairly simplistic...
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward "\\(https?://[-a-zA-Z0-9?_.$%/=+&#@!]*\\)\\>" nil t) (while (re-search-forward "\\(https?://[-a-zA-Z0-9?_.$%/=+&#@!~,]*\\)\\>" nil t)
(let ((subst (propertize (match-string-no-properties 0) (let ((subst (propertize (match-string-no-properties 0)
'face 'mm/view-link-face))) 'face 'mm/view-link-face)))
(incf num) (incf num)