diff --git a/toys/mm/mm-hdrs.el b/toys/mm/mm-hdrs.el index 4806750e..e3d0c988 100644 --- a/toys/mm/mm-hdrs.el +++ b/toys/mm/mm-hdrs.el @@ -103,6 +103,17 @@ headers." ;; first, remove the old one (otherwise, we'd have to headers with ;; the same docid... (mm/hdrs-remove-handler docid) + + ;; if we we're actually viewing this message (in mm/view mode), we + ;; update the `mm/current-msg' there as well; that way, the flags can + ;; be updated, as well as the path (which is useful for viewing the + ;; raw message) + (let ((viewbuf (get-buffer mm/view-buffer-name))) + (when (and viewbuf (buffer-live-p viewbuf)) + (with-current-buffer viewbuf + (when (eq docid (plist-get mm/current-msg :docid)) + (setq mm/current-msg msg))))) + ;; now, if this update was about *moving* a message, we don't show it ;; anymore (of course, we cannot be sure if the message really no ;; longer matches the query, but this seem a good heuristic. @@ -124,7 +135,7 @@ the current list of headers." (error "At point %d, expected docid %d, but got %d" pos docid docid-at-pos)) (mm/hdrs-remove-header docid pos)))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +w;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun mm/hdrs-contact-str (contacts) "Turn the list of contacts CONTACTS (with elements (NAME . EMAIL) @@ -197,7 +208,7 @@ if provided, or at the end of the buffer otherwise." (propertize line 'face 'mm/unread-face)) (t ;; else (propertize line 'face 'mm/header-face))))) - + ;; store the thread info, so we can use it when updating the message (when thread-info (puthash docid thread-info mm/thread-info-map)) diff --git a/toys/mm/mm-view.el b/toys/mm/mm-view.el index bd48662f..0c74dec2 100644 --- a/toys/mm/mm-view.el +++ b/toys/mm/mm-view.el @@ -38,6 +38,9 @@ (defconst mm/view-buffer-name "*mm-view*" "*internal* Name for the message view buffer") +(defconst mm/view-raw-buffer-name "*mm-view-raw*" + "*internal* Name for the raw message view buffer") + ;; some buffer-local variables (defvar mm/hdrs-buffer nil "*internal* Headers buffer connected to this view.") @@ -191,7 +194,7 @@ or if not available, :body-html converted to text)." atts ", "))) (mm/view-header (format "Attachments(%d)" id) vals t))))) -(setq mm/view-mode-map nil) + (defvar mm/view-mode-map nil "Keymap for \"*mm-view*\" buffers.") (unless mm/view-mode-map @@ -208,6 +211,8 @@ or if not available, :body-html converted to text)." (define-key map "c" 'mm/compose-new) (define-key map "e" 'mm/edit-draft) + (define-key map "." 'mm/view-raw) + ;; intra-message navigation (define-key map (kbd "SPC") 'scroll-up) (define-key map (kbd "") @@ -254,7 +259,7 @@ or if not available, :body-html converted to text)." (let ((menumap (make-sparse-keymap "View"))) (define-key map [menu-bar headers] (cons "View" menumap)) - (define-key menumap [quit-buffer] '("Quit view" . mm/quit-buffer)) + (define-key menumap [quit-buffer] '("Quit view" . mm/view-quit-buffer)) (define-key menumap [sepa0] '("--")) (define-key menumap [wrap-lines] @@ -366,16 +371,71 @@ removing '^M' etc." 'face 'mm/view-url-number-face)))))))) -;;;; raw view -;; (defun mm/view-raw-mode () -;; "Major mode for viewing of raw e-mail message." -;; (interactive) -;; (kill-all-local-variables) -;; (use-local-map mm/view-raw-mode-map) -;; (setq major-mode 'mm/view-raw-mode -;; mode-name mm/view-raw-buffer-name) -;; (setq truncate-lines t buffer-read-only t)) + + +;; raw mode ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun mm/view-raw-mode () + "Major mode for viewing of raw e-mail message." + (interactive) + (kill-all-local-variables) + (use-local-map mm/view-raw-mode-map) + + (setq major-mode 'mm/view-raw-mode + mode-name mm/view-raw-buffer-name) + (setq truncate-lines t buffer-read-only t)) + + +(defvar mm/view-raw-mode-map nil + "Keymap for \"*mm-view-raw*\" buffers.") + +(unless mm/view-raw-mode-map + (setq mm/view-raw-mode-map + (let ((map (make-sparse-keymap))) + + (define-key map "q" 'kill-buffer) + (define-key map "." 'kill-buffer) + + ;; intra-message navigation + (define-key map (kbd "SPC") 'scroll-up) + (define-key map (kbd "") + '(lambda () (interactive) (goto-char (point-min)))) + (define-key map (kbd "") + '(lambda () (interactive) (goto-char (point-max)))) + (define-key map (kbd "RET") + '(lambda () (interactive) (scroll-up 1))) + (define-key map (kbd "") + '(lambda () (interactive) (scroll-up -1))) + + ;; menu + (define-key map [menu-bar] (make-sparse-keymap)) + (let ((menumap (make-sparse-keymap "Raw view"))) + (define-key map [menu-bar headers] (cons "Raw view" menumap)) + + (define-key menumap [quit-buffer] '("Quit" . kill-buffer)) + map)))) + +(fset 'mm/view-raw-mode-map mm/view-raw-mode-map) + + +(defun mm/view-raw-message (msg) + "Display the raw contents of message MSG in a new buffer." + (let ((buf (get-buffer-create mm/view-raw-buffer-name)) + (inhibit-read-only t) + (file (plist-get msg :path))) + (unless (and file (file-readable-p file)) + (error "Not a readable file: %S" file)) + (with-current-buffer buf + (erase-buffer) + (insert-file file) + ;; initialize view-mode + (mm/view-raw-mode) + (switch-to-buffer buf) + (goto-char (point-min))))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + @@ -498,5 +558,12 @@ list." (unless url (error "Invalid number for URL")) (browse-url url))) +(defun mm/view-raw () + "Show the the raw text of the current message." + (interactive) + (unless mm/current-msg + (error "No current message")) + (mm/view-raw-message mm/current-msg)) + (provide 'mm-view)