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.16 1995/11/11 13:02:40 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 (defvar tm-mh-e/decode-encoded-word t)
  41
  42
  43 ;;; @ functions
  44 ;;;
  45
  46 (if (not (fboundp 'tm-mh-e/original-mh-display-msg))
  47     (fset 'tm-mh-e/original-mh-display-msg
  48           (symbol-function 'mh-display-msg))
  49   )
  50
  51 (defun mh-display-msg (msg-num folder &optional show-buffer mode)
  52   (or mode
  53       (setq mode tm-mh-e/decode-all)
  54       )
  55   ;; Display message NUMBER of FOLDER.
  56   ;; Sets the current buffer to the show buffer.
  57   (set-buffer folder)
  58   (or show-buffer
  59       (setq show-buffer mh-show-buffer))
  60   ;; Bind variables in folder buffer in case they are local
  61   (let ((msg-filename (mh-msg-filename msg-num)))
  62     (if (not (file-exists-p msg-filename))
  63         (error "Message %d does not exist" msg-num))
  64     (set-buffer show-buffer)
  65     (cond ((not (equal msg-filename buffer-file-name))
  66            ;; Buffer does not yet contain message.
  67            (clear-visited-file-modtime)
  68            (unlock-buffer)
  69            (setq buffer-file-name nil)  ; no locking during setup
  70            (setq buffer-read-only nil)
  71            (erase-buffer)
  72            (if mode
  73                (let* ((aname (concat "article-" folder))
  74                       (abuf (get-buffer aname))
  75                       )
  76                  (if abuf
  77                      (progn
  78                        (set-buffer abuf)
  79                        (setq buffer-read-only nil)
  80                        (erase-buffer)
  81                        )
  82                    (setq abuf (get-buffer-create aname))
  83                    (set-buffer abuf)
  84                    )
  85                  (let ((file-coding-system-for-read
  86                         (if (boundp 'MULE) *noconv*))
  87                        kanji-fileio-code)
  88                    (insert-file-contents msg-filename)
  89                    ;; (goto-char (point-min))
  90                    (while (re-search-forward "\r$" nil t)
  91                      (replace-match "")
  92                      )
  93                    )
  94                  (set-buffer-modified-p nil)
  95                  (setq buffer-read-only t)
  96                  (mh-show-mode)
  97                  (mime/viewer-mode nil nil nil
  98                                    aname (concat "show-" folder))
  99                  (goto-char (point-min))
 100                  )
 101              (let ((clean-message-header mh-clean-message-header)
 102                    (invisible-headers mh-invisible-headers)
 103                    (visible-headers mh-visible-headers)
 104                    )
 105                ;; 1995/9/21
 106                ;;   modified by ARIURA <ariura@cc.tuat.ac.jp>
 107                ;;   to support mhl.
 108                (if mhl-formfile
 109                    (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear"
 110                                            (if (stringp mhl-formfile)
 111                                                (list "-form" mhl-formfile))
 112                                            msg-filename)
 113                  (insert-file-contents msg-filename))
 114                ;; end
 115                (goto-char (point-min))
 116                (cond (clean-message-header
 117                       (mh-clean-msg-header (point-min)
 118                                            invisible-headers
 119                                            visible-headers)
 120                       (goto-char (point-min)))
 121                      (t
 122                       (mh-start-of-uncleaned-message)))
 123                (if tm-mh-e/decode-encoded-word
 124                    (mime/decode-message-header)
 125                  )
 126                (set-buffer-modified-p nil)
 127                (setq buffer-read-only t)
 128                (mh-show-mode)
 129                ))
 130            (or (eq buffer-undo-list t)  ;don't save undo info for prev msgs
 131                (setq buffer-undo-list nil))
 132            (setq buffer-file-name msg-filename)
 133            (set-mark nil)
 134            (setq mode-line-buffer-identification
 135                  (list (format mh-show-buffer-mode-line-buffer-id
 136                                folder msg-num)))
 137            (set-buffer folder)
 138            (setq mh-showing-with-headers nil)))))
 139
 140 (defun tm-mh-e/view-message (&optional msg)
 141   "MIME decode and play this message."
 142   (interactive)
 143   (if (or (null tm-mh-e/decode-all)
 144           (null (get-buffer mh-show-buffer))
 145           (save-excursion
 146             (set-buffer mh-show-buffer)
 147             (not (eq major-mode 'mime/viewer-mode))
 148             ))
 149       (let ((tm-mh-e/decode-all t))
 150         (mh-invalidate-show-buffer)
 151         (mh-show-msg msg)
 152         ))
 153   (pop-to-buffer mh-show-buffer)
 154   )
 155
 156 (defun tm-mh-e/toggle-decoding-mode (arg)
 157   "Toggle MIME processing mode.
 158 With arg, turn MIME processing on if arg is positive."
 159   (interactive "P")
 160   (setq tm-mh-e/decode-all
 161         (if (null arg)
 162             (not tm-mh-e/decode-all)
 163           arg))
 164   (save-excursion
 165     (set-buffer mh-show-buffer)
 166     (if (null tm-mh-e/decode-all)
 167         (if (and mime::preview/article-buffer
 168                  (get-buffer mime::preview/article-buffer))
 169             (kill-buffer mime::preview/article-buffer)
 170           )))
 171   (mh-invalidate-show-buffer)
 172   (mh-show (mh-get-msg-num t))
 173   )
 174
 175 (defun tm-mh-e/show (&optional message)
 176   (interactive)
 177   (mh-invalidate-show-buffer)
 178   (mh-show message)
 179   )
 180
 181 (defun tm-mh-e/header-display ()
 182   (interactive)
 183   (mh-invalidate-show-buffer)
 184   (let (mime-viewer/ignored-field-list
 185         tm-mh-e/decode-encoded-word)
 186     (mh-header-display)
 187     ))
 188
 189 (defun tm-mh-e/raw-display ()
 190   (interactive)
 191   (mh-invalidate-show-buffer)
 192   (let (tm-mh-e/decode-all
 193         tm-mh-e/decode-encoded-word)
 194     (mh-header-display)
 195     ))
 196
 197
 198 ;;; @ for tm-view
 199 ;;;
 200
 201 (fset 'tm-mh-e/code-convert-region-to-emacs
 202       (symbol-function 'mime/code-convert-region-to-emacs))
 203
 204 (defun tm-mh-e/content-header-filter ()
 205   (goto-char (point-min))
 206   (while (and (re-search-forward mime-viewer/ignored-field-regexp nil t)
 207               (progn
 208                 (delete-region
 209                  (match-beginning 0)
 210                  (save-excursion
 211                    (and
 212                     (re-search-forward "^\\([^ \t]\\|$\\)" nil t)
 213                     (match-beginning 0)
 214                     )))
 215                 t)))
 216   (tm-mh-e/code-convert-region-to-emacs (point-min)(point-max)
 217                                         mime/default-coding-system)
 218   (mime/decode-message-header)
 219   (if (featurep 'hilit19)
 220       (hilit-rehighlight-buffer-quietly)
 221     )
 222   )
 223
 224 (defun tm-mh-e/quitting-method ()
 225   (let ((win (get-buffer-window
 226               mime/output-buffer-name))
 227         (buf (current-buffer))
 228         )
 229     (if win
 230         (delete-window win)
 231       )
 232     (pop-to-buffer
 233      (let ((name (buffer-name buf)))
 234        (substring name 5)
 235        ))
 236     (if (not tm-mh-e/decode-all)
 237         (mh-invalidate-show-buffer)
 238       )
 239     (mh-show (mh-get-msg-num t))
 240     ))
 241
 242
 243 ;;; @ for tm-partial
 244 ;;;
 245
 246 (call-after-loaded
 247  'tm-partial
 248  (function
 249   (lambda ()
 250     (set-atype 'mime/content-decoding-condition
 251                '((type . "message/partial")
 252                  (method . mime-article/grab-message/partials)
 253                  (major-mode . mh-show-mode)
 254                  (summary-buffer-exp
 255                   . (and (or (string-match "^article-\\(.+\\)$" article-buffer)
 256                              (string-match "^show-\\(.+\\)$" article-buffer))
 257                          (substring article-buffer
 258                                     (match-beginning 1) (match-end 1))
 259                          ))
 260                  ))
 261     (set-alist 'tm-partial/preview-article-method-alist
 262                'mh-show-mode
 263                (function
 264                 (lambda ()
 265                   (let ((tm-mh-e/decode-all t))
 266                     (tm-mh-e/show)
 267                     ))))
 268     )))
 269
 270
 271 ;;; @ for tm-edit
 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         (default (and (boundp 'mh-sent-from-msg) mh-sent-from-msg))
 297         )
 298     (setq default
 299           (if default
 300               (int-to-string default)
 301             (car files)
 302             ))
 303     (completing-read prompt
 304                      (let ((i 0))
 305                        (mapcar (function
 306                                 (lambda (file)
 307                                   (setq i (+ i 1))
 308                                   (list file i)
 309                                   ))
 310                                files)
 311                        ) nil nil default)
 312     ))
 313
 314 (defun tm-mh-e/query-message ()
 315   (let* ((folder (mh-prompt-for-folder "Visit" "+inbox" nil))
 316          (number (tm-mh-e/prompt-for-message "Number: " folder))
 317          )
 318     (tm-mh-e::make-message folder number)
 319     ))
 320
 321 (defun tm-mh-e/insert-message (&optional message)
 322   (if (null message)
 323       (setq message (tm-mh-e/query-message))
 324     )
 325   (insert-file (tm-mh-e::message/file-name message))
 326   (mime-editor/inserted-message-filter)
 327   )
 328
 329 (call-after-loaded
 330  'tm-edit
 331  (function
 332   (lambda ()
 333     (set-alist
 334      'mime-editor/message-inserter-alist
 335      'mh-letter-mode (function tm-mh-e/insert-message))
 336     (set-alist
 337      'mime-editor/mail-inserter-alist
 338      'mh-letter-mode (function tm-mh-e/insert-message))
 339     (set-alist
 340      'mime-editor/mail-inserter-alist
 341      'news-reply-mode (function tm-mh-e/insert-message))
 342     )))
 343
 344
 345 ;;; @ set up
 346 ;;;
 347
 348 (define-key mh-folder-mode-map "v" (function tm-mh-e/view-message))
 349 (define-key mh-folder-mode-map "\et" (function tm-mh-e/toggle-decoding-mode))
 350 (define-key mh-folder-mode-map "." (function tm-mh-e/show))
 351 (define-key mh-folder-mode-map "," (function tm-mh-e/header-display))
 352 (define-key mh-folder-mode-map "\e," (function tm-mh-e/raw-display))
 353 (define-key mh-folder-mode-map "\r"
 354   (function (lambda ()
 355               (interactive)
 356               (scroll-other-window 1)
 357               )))
 358 (define-key mh-folder-mode-map "\e\r"
 359   (function (lambda ()
 360               (interactive)
 361               (scroll-other-window -1)
 362               )))
 363
 364 (defun tm-mh-e/summary-before-quit ()
 365   (let ((buf (get-buffer mh-show-buffer)))
 366     (if buf
 367         (let ((the-buf (current-buffer)))
 368           (switch-to-buffer buf)
 369           (if (and mime::article/preview-buffer
 370                    (setq buf (get-buffer mime::article/preview-buffer))
 371                    )
 372               (progn
 373                 (switch-to-buffer the-buf)
 374                 (kill-buffer buf)
 375                 )
 376             (switch-to-buffer the-buf)
 377             )
 378           ))))
 379
 380 (add-hook 'mh-before-quit-hook (function tm-mh-e/summary-before-quit))
 381
 382 (set-alist 'mime-viewer/quitting-method-alist
 383            'mh-show-mode
 384            (function tm-mh-e/quitting-method))
 385
 386 (set-alist 'mime-viewer/content-header-filter-alist
 387            'mh-show-mode
 388            (function tm-mh-e/content-header-filter))
 389
 390 (set-alist 'mime-viewer/code-converter-alist
 391            'mh-show-mode
 392            (function tm-mh-e/code-convert-region-to-emacs))
 393
 394
 395 ;;; @ end
 396 ;;;
 397
 398 (provide 'tm-mh-e)
 399
 400 (run-hooks 'tm-mh-e-load-hook)