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