From b4c32a53b7516c792e5ef19a759cb7c9381a8671 Mon Sep 17 00:00:00 2001 From: djcb Date: Sun, 13 Nov 2011 12:44:54 +0200 Subject: [PATCH] * mm updates --- toys/mm/mm-hdrs.el | 67 +++++++++++++++++++++++----------------------- toys/mm/mm-send.el | 21 ++++++++++----- toys/mm/mm-view.el | 2 +- 3 files changed, 49 insertions(+), 41 deletions(-) diff --git a/toys/mm/mm-hdrs.el b/toys/mm/mm-hdrs.el index d5af81a2..c5a37881 100644 --- a/toys/mm/mm-hdrs.el +++ b/toys/mm/mm-hdrs.el @@ -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))))))) diff --git a/toys/mm/mm-send.el b/toys/mm/mm-send.el index 3d9fc66c..2ae43da3 100644 --- a/toys/mm/mm-send.el +++ b/toys/mm/mm-send.el @@ -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")) diff --git a/toys/mm/mm-view.el b/toys/mm/mm-view.el index 33611d29..7c6abb6f 100644 --- a/toys/mm/mm-view.el +++ b/toys/mm/mm-view.el @@ -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)