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

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

@ -138,38 +138,39 @@ into a string."
(defun mm/hdrs-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* ((line (mapconcat
(lambda (f-w)
(let* ((field (car f-w)) (width (cdr f-w))
(val (plist-get msg field))
(str
(case field
((:subject :maildir :path) val)
((:to :from :cc :bcc) (mm/hdrs-contact-str val))
;; if we (ie. `user-mail-address' is the 'From', show 'To', otherwise
;; show From
(:from-or-to
(let* ((from-lst (plist-get msg :from))
(from (and from-lst (cdar from-lst))))
(if (and from (string-match mm/user-mail-address-regexp from))
(concat (propertize "To " 'face 'mm/system-face)
(mm/hdrs-contact-str (plist-get msg :to)))
(mm/hdrs-contact-str from-lst))))
(:date (format-time-string mm/headers-date-format val))
(:flags (mm/flags-to-string val))
(:size
(cond
((>= val 1000000) (format "%2.1fM" (/ val 1000000.0)))
((and (>= val 1000) (< val 1000000))
(format "%2.1fK" (/ val 1000.0)))
((< val 1000) (format "%d" val))))
(t
(error "Unsupported header field (%S)" field)))))
(when str
(if (not width)
str
(truncate-string-to-width str width 0 ?\s t)))))
mm/headers-fields " "))
(let* ((line
(mapconcat
(lambda (f-w)
(let* ((field (car f-w)) (width (cdr f-w))
(val (plist-get msg field))
(str
(case field
((:subject :maildir :path) val)
((:to :from :cc :bcc) (mm/hdrs-contact-str val))
;; if we (ie. `user-mail-address' is the 'From', show 'To', otherwise
;; show From
(:from-or-to
(let* ((from-lst (plist-get msg :from))
(from (and from-lst (cdar from-lst))))
(if (and from (string-match mm/user-mail-address-regexp from))
(concat "To "
(mm/hdrs-contact-str (plist-get msg :to)))
(mm/hdrs-contact-str from-lst))))
(:date (format-time-string mm/headers-date-format val))
(:flags (mm/flags-to-string val))
(:size
(cond
((>= val 1000000) (format "%2.1fM" (/ val 1000000.0)))
((and (>= val 1000) (< val 1000000))
(format "%2.1fK" (/ val 1000.0)))
((< val 1000) (format "%d" val))))
(t
(error "Unsupported header field (%S)" field)))))
(when str
(if (not width)
str
(truncate-string-to-width str width 0 ?\s t)))))
mm/headers-fields " "))
(flags (plist-get msg :flags))
(line (cond
((member 'draft flags)
@ -451,7 +452,7 @@ The following marks are available, and the corresponding props:
(when target
(let* ((targetstr (propertize (concat "-> " target " ")
'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-put overlay 'display targetstr)))))))

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

@ -360,18 +360,26 @@ using Gnus' `message-mode'."
"Move the message in this buffer to the sent folder. This is
meant to be called from message mode's `message-sent-hook'."
(unless mm/sent-folder (error "mm/sent-folder not set"))
(let ((docid (gethash (buffer-file-name) mm/path-docid-map)))
(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)))
(unless docid (error "unknown message (%S)" (buffer-file-name)))
;; ok, all seems well, well move the message to the sent-folder
(mm/proc-move-msg docid mm/sent-folder "-T-D+S")
;; we can remove the value from the hash now, if we can establish there
;; are not other compose buffers using this very same docid...
;; mark the buffer as read-only, as its pointing at a non-existing file
;; now...
(message "Message has been sent")
(setq buffer-read-only t)))
;; now...
(kill-buffer-and-window)
(message "Message has been sent"))))
(defun mm/send-set-parent-flag ()
@ -403,7 +411,6 @@ This is meant to be called from message mode's
(while (re-search-forward "<[^ <]+@[^ <]+>" nil t)
(push (match-string 0) refs))
(setq forwarded-from (car-safe (last refs)))))))
;; remove the <>
(when (and in-reply-to (string-match "<\\(.*\\)>" in-reply-to))
(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))))
;; this is fairly simplistic...
(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)
'face 'mm/view-link-face)))
(incf num)