mirror of https://github.com/djcb/mu.git
* mm: add raw view
This commit is contained in:
parent
9c7d990422
commit
69ee855b88
|
@ -103,6 +103,17 @@ headers."
|
||||||
;; first, remove the old one (otherwise, we'd have to headers with
|
;; first, remove the old one (otherwise, we'd have to headers with
|
||||||
;; the same docid...
|
;; the same docid...
|
||||||
(mm/hdrs-remove-handler 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
|
;; 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
|
;; anymore (of course, we cannot be sure if the message really no
|
||||||
;; longer matches the query, but this seem a good heuristic.
|
;; 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))
|
(error "At point %d, expected docid %d, but got %d" pos docid docid-at-pos))
|
||||||
(mm/hdrs-remove-header docid pos))))
|
(mm/hdrs-remove-header docid pos))))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
w;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(defun mm/hdrs-contact-str (contacts)
|
(defun mm/hdrs-contact-str (contacts)
|
||||||
"Turn the list of contacts CONTACTS (with elements (NAME . EMAIL)
|
"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))
|
(propertize line 'face 'mm/unread-face))
|
||||||
(t ;; else
|
(t ;; else
|
||||||
(propertize line 'face 'mm/header-face)))))
|
(propertize line 'face 'mm/header-face)))))
|
||||||
|
|
||||||
;; store the thread info, so we can use it when updating the message
|
;; store the thread info, so we can use it when updating the message
|
||||||
(when thread-info
|
(when thread-info
|
||||||
(puthash docid thread-info mm/thread-info-map))
|
(puthash docid thread-info mm/thread-info-map))
|
||||||
|
|
|
@ -38,6 +38,9 @@
|
||||||
(defconst mm/view-buffer-name "*mm-view*"
|
(defconst mm/view-buffer-name "*mm-view*"
|
||||||
"*internal* Name for the message view buffer")
|
"*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
|
;; some buffer-local variables
|
||||||
(defvar mm/hdrs-buffer nil
|
(defvar mm/hdrs-buffer nil
|
||||||
"*internal* Headers buffer connected to this view.")
|
"*internal* Headers buffer connected to this view.")
|
||||||
|
@ -191,7 +194,7 @@ or if not available, :body-html converted to text)."
|
||||||
atts ", ")))
|
atts ", ")))
|
||||||
(mm/view-header (format "Attachments(%d)" id) vals t)))))
|
(mm/view-header (format "Attachments(%d)" id) vals t)))))
|
||||||
|
|
||||||
(setq mm/view-mode-map nil)
|
|
||||||
(defvar mm/view-mode-map nil
|
(defvar mm/view-mode-map nil
|
||||||
"Keymap for \"*mm-view*\" buffers.")
|
"Keymap for \"*mm-view*\" buffers.")
|
||||||
(unless mm/view-mode-map
|
(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 "c" 'mm/compose-new)
|
||||||
(define-key map "e" 'mm/edit-draft)
|
(define-key map "e" 'mm/edit-draft)
|
||||||
|
|
||||||
|
(define-key map "." 'mm/view-raw)
|
||||||
|
|
||||||
;; intra-message navigation
|
;; intra-message navigation
|
||||||
(define-key map (kbd "SPC") 'scroll-up)
|
(define-key map (kbd "SPC") 'scroll-up)
|
||||||
(define-key map (kbd "<home>")
|
(define-key map (kbd "<home>")
|
||||||
|
@ -254,7 +259,7 @@ or if not available, :body-html converted to text)."
|
||||||
(let ((menumap (make-sparse-keymap "View")))
|
(let ((menumap (make-sparse-keymap "View")))
|
||||||
(define-key map [menu-bar headers] (cons "View" menumap))
|
(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 [sepa0] '("--"))
|
||||||
(define-key menumap [wrap-lines]
|
(define-key menumap [wrap-lines]
|
||||||
|
@ -366,16 +371,71 @@ removing '^M' etc."
|
||||||
'face 'mm/view-url-number-face))))))))
|
'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 "<home>")
|
||||||
|
'(lambda () (interactive) (goto-char (point-min))))
|
||||||
|
(define-key map (kbd "<end>")
|
||||||
|
'(lambda () (interactive) (goto-char (point-max))))
|
||||||
|
(define-key map (kbd "RET")
|
||||||
|
'(lambda () (interactive) (scroll-up 1)))
|
||||||
|
(define-key map (kbd "<backspace>")
|
||||||
|
'(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"))
|
(unless url (error "Invalid number for URL"))
|
||||||
(browse-url 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)
|
(provide 'mm-view)
|
||||||
|
|
Loading…
Reference in New Issue