mh-e/tm-mh-e.el

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