mh-e/tm-mh-e.el

   1 ;;;
   2 ;;; A MIME extender for mh-e
   3 ;;;
   4 ;;; by Morioka Tomohiko, 1993/11/21
   5 ;;;
   6
   7
   8 ;;; @ require modules
   9 ;;;
  10
  11 (require 'tl-str)
  12 (require 'tl-misc)
  13 (require 'mh-e)
  14 (if (not (boundp 'mh-e-version))
  15     (require 'tm-mh-e3)
  16   )
  17 (require 'tm-view)
  18
  19
  20 ;;; @ version
  21 ;;;
  22
  23 (defconst tm-mh-e/RCS-ID
  24   "$Id: tm-mh-e.el,v 6.27 1995/09/20 12:34:39 morioka Exp $")
  25
  26 (defconst tm-mh-e/version (get-version-string tm-mh-e/RCS-ID))
  27
  28
  29 ;;; @ variable
  30 ;;;
  31
  32 (defvar tm-mh-e/decode-all t
  33   "*If t, decode all of the message. Otherwise decode header only.")
  34
  35
  36 ;;; @ functions
  37 ;;;
  38
  39 (defun tm-mh-e/display-msg (msg-num folder &optional show-buffer mode)
  40   (or mode
  41       (setq mode tm-mh-e/decode-all)
  42       )
  43   ;; Display message NUMBER of FOLDER.
  44   ;; Sets the current buffer to the show buffer.
  45   (set-buffer folder)
  46   (or show-buffer
  47       (setq show-buffer mh-show-buffer))
  48   ;; Bind variables in folder buffer in case they are local
  49   (let ((msg-filename (mh-msg-filename msg-num)))
  50     (if (not (file-exists-p msg-filename))
  51         (error "Message %d does not exist" msg-num))
  52     (set-buffer show-buffer)
  53     (cond ((not (equal msg-filename buffer-file-name))
  54            ;; Buffer does not yet contain message.
  55            (clear-visited-file-modtime)
  56            (unlock-buffer)
  57            (setq buffer-file-name nil)  ; no locking during setup
  58            (setq buffer-read-only nil)
  59            (erase-buffer)
  60            (if mode
  61                (progn
  62                  (let ((file-coding-system-for-read
  63                         (if (boundp 'MULE) *noconv*))
  64                        kanji-fileio-code)
  65                    (insert-file-contents msg-filename)
  66                    ;; (goto-char (point-min))
  67                    (while (re-search-forward "\r$" nil t)
  68                      (replace-match "")
  69                      )
  70                    )
  71                  (set-buffer-modified-p nil)
  72                  (setq buffer-read-only t)
  73                  (mh-show-mode)
  74                  (mime/viewer-mode)
  75                  (goto-char (point-min))
  76                  )
  77              (let ((clean-message-header mh-clean-message-header)
  78                    (invisible-headers mh-invisible-headers)
  79                    (visible-headers mh-visible-headers)
  80                    )
  81                (insert-file-contents msg-filename)
  82                (goto-char (point-min))
  83                (cond (clean-message-header
  84                       (mh-clean-msg-header (point-min)
  85                                            invisible-headers
  86                                            visible-headers)
  87                       (goto-char (point-min)))
  88                      (t
  89                       (mh-start-of-uncleaned-message)))
  90                (mime/decode-message-header)
  91                (set-buffer-modified-p nil)
  92                (setq buffer-read-only t)
  93                (mh-show-mode)
  94                ))
  95            (or (eq buffer-undo-list t)  ;don't save undo info for prev msgs
  96                (setq buffer-undo-list nil))
  97            (setq buffer-file-name msg-filename)
  98            (set-mark nil)
  99            (setq mode-line-buffer-identification
 100                  (list (format mh-show-buffer-mode-line-buffer-id
 101                                folder msg-num)))
 102            (set-buffer folder)
 103            (setq mh-showing-with-headers nil)))))
 104
 105 (fset 'mh-display-msg (symbol-function 'tm-mh-e/display-msg))
 106
 107 (defun tm-mh-e/view-message (&optional msg)
 108   "MIME decode and play this message."
 109   (interactive)
 110   (mh-invalidate-show-buffer)
 111   (let ((tm-mh-e/decode-all t))
 112     (mh-show-msg msg)
 113     )
 114   (pop-to-buffer (save-window-excursion
 115                    (switch-to-buffer mh-show-buffer)
 116                    mime::article/preview-buffer))
 117   )
 118
 119 (defun tm-mh-e/toggle-decoding-mode (arg)
 120   "Toggle MIME processing mode.
 121 With arg, turn MIME processing on if arg is positive."
 122   (interactive "P")
 123   (setq tm-mh-e/decode-all
 124         (if (null arg)
 125             (not tm-mh-e/decode-all)
 126           arg))
 127   (save-window-excursion
 128     (switch-to-buffer mh-show-buffer)
 129     (if (null tm-mh-e/decode-all)
 130         (if (and mime::article/preview-buffer
 131                  (get-buffer mime::article/preview-buffer))
 132             (kill-buffer mime::article/preview-buffer)
 133           )))
 134   (mh-show (mh-get-msg-num t))
 135   (if tm-mh-e/decode-all
 136       (let ((the-buf (current-buffer)))
 137         (if mime::article/preview-buffer
 138             (pop-to-buffer (save-excursion
 139                              (switch-to-buffer mh-show-buffer)
 140                              mime::article/preview-buffer))
 141           (tm-mh-e/view-message (mh-get-msg-num t)))
 142         (pop-to-buffer the-buf)
 143         )))
 144
 145 (defun tm-mh-e/page-msg ()
 146   (interactive)
 147   (if tm-mh-e/decode-all
 148       (scroll-other-window)
 149     (mh-page-msg)
 150     ))
 151
 152 (defun tm-mh-e/previous-page ()
 153   (interactive)
 154   (if tm-mh-e/decode-all
 155       (scroll-other-window (- (save-window-excursion
 156                                 (other-window 1)
 157                                 (window-height))))
 158     (mh-previous-page)
 159     ))
 160
 161 (defun tm-mh-e/cite ()
 162   (interactive)
 163   (if tm-mh-e/decode-all
 164       (save-excursion
 165         (save-restriction
 166           (insert-buffer
 167            (save-window-excursion
 168              (switch-to-buffer (concat "show-" mh-sent-from-folder))
 169              mime::article/preview-buffer))
 170           (if (looking-at "^\\[.+\\(\n[ \t].+\\)*\\]\n")
 171               (replace-match ""))
 172           (narrow-to-region (point)(point-max))
 173           (mh-insert-prefix-string mh-ins-buf-prefix)
 174           ))
 175     (mh-yank-cur-msg)
 176     ))
 177
 178 (defun tm-mh-e/toggle-showing ()
 179   "Toggle the scanning mode/showing mode of displaying messages."
 180   (interactive)
 181   (if mh-showing
 182       (if tm-mh-e/decode-all
 183           (let ((pbuf
 184                  (save-window-excursion
 185                    (set-buffer mh-show-buffer)
 186                    mime::article/preview-buffer)))
 187             (if (get-buffer pbuf)
 188                 (delete-windows-on pbuf)
 189               )
 190             (setq mh-showing nil)
 191             (set-buffer-modified-p (buffer-modified-p)) ;force mode line update
 192             (if mh-recenter-summary-p
 193                 (mh-recenter nil)
 194               ))
 195         (mh-set-scan-mode)
 196         )
 197     (mh-show)
 198     ))
 199
 200
 201 ;;; @ for tm-view
 202 ;;;
 203
 204 (fset 'tm-mh-e/code-convert-region-to-emacs
 205       (symbol-function 'mime/code-convert-region-to-emacs))
 206
 207 (defun tm-mh-e/content-header-filter ()
 208   (mime-viewer/x-face-function)
 209   (goto-char (point-min))
 210   (while (and (re-search-forward
 211                (concat "^" mime-viewer/ignored-field-regexp ":")
 212                nil t)
 213               (progn
 214                 (delete-region
 215                  (match-beginning 0)
 216                  (save-excursion
 217                    (and
 218                     (re-search-forward "^\\([^ \t]\\|$\\)" nil t)
 219                     (match-beginning 0)
 220                     )))
 221                 t)))
 222   (tm-mh-e/code-convert-region-to-emacs (point-min)(point-max)
 223                                         mime/default-coding-system)
 224   (mime/decode-message-header)
 225   (if (featurep 'hilit19)
 226       (hilit-rehighlight-buffer-quietly)
 227     )
 228   )
 229
 230 (defun tm-mh-e/quitting-method ()
 231   (let ((win (get-buffer-window
 232               mime/output-buffer-name))
 233         (buf mime::preview/article-buffer)
 234         )
 235     (if win
 236         (delete-window win)
 237       )
 238     (pop-to-buffer
 239      (let ((name (buffer-name buf)))
 240        (substring name 5)
 241        ))
 242     (if (not tm-mh-e/decode-all)
 243         (mh-show (mh-get-msg-num t))
 244       )))
 245
 246
 247 ;;; @ for tm-comp
 248 ;;;
 249
 250 (defun tm-mh-e::make-message (folder number)
 251   (vector folder number)
 252   )
 253
 254 (defun tm-mh-e::message/folder (message)
 255   (elt message 0)
 256   )
 257
 258 (defun tm-mh-e::message/number (message)
 259   (elt message 1)
 260   )
 261
 262 (defun tm-mh-e::message/file-name (message)
 263   (expand-file-name
 264    (tm-mh-e::message/number message)
 265    (mh-expand-file-name (tm-mh-e::message/folder message))
 266    ))
 267
 268 (defun tm-mh-e::prompt-for-message (prompt folder &optional default)
 269   (let ((files
 270          (directory-files (mh-expand-file-name folder) nil "^[0-9]+$")
 271          ))
 272     (completing-read prompt
 273                      (let ((i 0))
 274                        (mapcar (function
 275                                 (lambda (file)
 276                                   (setq i (+ i 1))
 277                                   (list file i)
 278                                   ))
 279                                files)
 280                        ))
 281     ))
 282
 283 (defun tm-mh-e::query-message ()
 284   (let* ((folder (mh-prompt-for-folder "Visit" "+inbox" nil))
 285          (number (tm-mh-e::prompt-for-message "Number?" folder))
 286          )
 287     (tm-mh-e::make-message folder number)
 288     ))
 289
 290 (defun tm-mh-e::insert-message (&optional message)
 291   (if (null message)
 292       (setq message (tm-mh-e::query-message))
 293     )
 294   (insert-file (tm-mh-e::message/file-name message))
 295   )
 296
 297 (call-after-loaded
 298  'tm-comp
 299  (function
 300   (lambda ()
 301     (set-alist
 302      'tm-comp/message-inserter-alist
 303      'mh-letter-mode (function tm-mh-e::insert-message))
 304     )))
 305
 306
 307 ;;; @ set up
 308 ;;;
 309
 310 ;;(add-hook 'mh-show-mode-hook (function mime/viewer-mode))
 311
 312 (define-key mh-folder-mode-map "v" (function tm-mh-e/view-message))
 313 (define-key mh-folder-mode-map "\et" (function tm-mh-e/toggle-decoding-mode))
 314 (define-key mh-folder-mode-map "t" (function tm-mh-e/toggle-showing))
 315 (define-key mh-folder-mode-map "\r"
 316   (function (lambda ()
 317               (interactive)
 318               (scroll-other-window 1)
 319               )))
 320 (define-key mh-folder-mode-map "\e\r"
 321   (function (lambda ()
 322               (interactive)
 323               (scroll-other-window -1)
 324               )))
 325 (define-key mh-folder-mode-map " " (function tm-mh-e/page-msg))
 326 (define-key mh-folder-mode-map "\177" (function tm-mh-e/previous-page))
 327
 328 (add-hook 'mh-letter-mode-hook
 329           (function
 330            (lambda ()
 331              (define-key mh-letter-mode-map "\C-c\C-y" (function tm-mh-e/cite))
 332              )))
 333
 334 (defun tm-mh-e/summary-before-quit ()
 335   (let ((buf (get-buffer mh-show-buffer)))
 336     (if buf
 337         (let ((the-buf (current-buffer)))
 338           (switch-to-buffer buf)
 339           (if (and mime::article/preview-buffer
 340                    (setq buf (get-buffer mime::article/preview-buffer))
 341                    )
 342               (progn
 343                 (switch-to-buffer the-buf)
 344                 (kill-buffer buf)
 345                 )
 346             (switch-to-buffer the-buf)
 347             )
 348           ))))
 349
 350 (add-hook 'mh-before-quit-hook (function tm-mh-e/summary-before-quit))
 351
 352 (set-alist 'mime-viewer/quitting-method-alist
 353            'mh-show-mode
 354            (function tm-mh-e/quitting-method))
 355
 356 (set-alist 'mime-viewer/content-header-filter-alist
 357            'mh-show-mode
 358            (function tm-mh-e/content-header-filter))
 359
 360 (set-alist 'mime-viewer/code-converter-alist
 361            'mh-show-mode
 362            (function tm-mh-e/code-convert-region-to-emacs))
 363
 364
 365 ;;; @ end
 366 ;;;
 367
 368 (provide 'tm-mh-e)
 369
 370 (run-hooks 'tm-mh-e-load-hook)