;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Code:
(defun mime-save-situation-examples ()
(if (or mime-preview-situation-example-list
mime-acting-situation-example-list)
- (let ((file mime-situation-examples-file))
+ (let ((file mime-situation-examples-file)
+ print-length print-level)
(with-temp-buffer
(insert ";;; " (file-name-nondirectory file) "\n")
(insert "\n;; This file is generated automatically by "
(insert "\n;;; "
(file-name-nondirectory file)
" ends here.\n")
- (static-cond
+ (static-cond
((boundp 'buffer-file-coding-system)
(setq buffer-file-coding-system
mime-situation-examples-file-coding-system))
(setq file-coding-system
mime-situation-examples-file-coding-system)))
;; (setq buffer-file-coding-system
- ;; mime-situation-examples-file-coding-system)
+ ;; mime-situation-examples-file-coding-system)
(setq buffer-file-name file)
(save-buffer)))))
(car (mime-entity-children entity))))
(original-major-mode-cell (assq 'major-mode situation))
(default-situation (cdr (assq 'childrens-situation situation))))
- (if original-major-mode-cell
- (setq default-situation
- (cons original-major-mode-cell default-situation)))
- (mime-display-entity start nil default-situation)))
+ (when start
+ (if original-major-mode-cell
+ (setq default-situation
+ (cons original-major-mode-cell default-situation)))
+ (mime-display-entity start nil default-situation))))
(defun mime-view-entity-content (entity situation)
(mime-decode-string
(buffer-disable-undo)
(kill-all-local-variables)
(mime-view-insert-text-content entity situation)
- (if mode
- (funcall mode)
- (if (setq filename (mime-entity-filename entity))
- (unwind-protect
- (progn
- (setq buffer-file-name filename)
- (set-auto-mode))
- (setq buffer-file-name nil))))
(require 'font-lock)
- (let ((font-lock-verbose nil))
- ;; I find font-lock a bit too verbose.
- (font-lock-fontify-buffer))
+ (let ((font-lock-maximum-size nil)
+ ;; Disable support modes, e.g., jit-lock, lazy-lock, etc.
+ (font-lock-mode-hook nil)
+ (font-lock-support-mode nil)
+ ;; I find font-lock a bit too verbose.
+ (font-lock-verbose nil))
+ (cond (mode
+ (funcall mode))
+ ((setq filename (mime-entity-filename entity))
+ (let ((buffer-file-name
+ (expand-file-name (file-name-nondirectory filename)
+ temporary-file-directory)))
+ (set-auto-mode))))
+ ;; The mode function might have already turned on font-lock.
+ (unless (symbol-value 'font-lock-mode)
+ (font-lock-fontify-buffer)))
;; By default, XEmacs font-lock uses non-duplicable text
;; properties. This code forces all the text properties
;; to be copied along with the text.
;;; @@ utility
;;;
-(defun mime-preview-find-boundary-info (&optional get-mother)
+(defun mime-preview-find-boundary-info (&optional with-children)
"Return boundary information of current part.
-If GET-MOTHER, refer boundary surrounding current part and its branches."
+If WITH-CHILDREN, refer boundary surrounding current part and its branches."
(let (entity
p-beg p-end
entity-node-id len)
- (while (null (setq entity
- (get-text-property (point) 'mime-view-entity)))
+ (while (and
+ (null (setq entity
+ (get-text-property (point) 'mime-view-entity)))
+ (> (point) (point-min)))
(backward-char))
(setq p-beg (previous-single-property-change (point) 'mime-view-entity))
- (setq entity-node-id (mime-entity-node-id entity))
+ (setq entity-node-id (and entity (mime-entity-node-id entity)))
(setq len (length entity-node-id))
(cond ((null p-beg)
(setq p-beg
(setq p-end (point-max)))
((null entity-node-id)
(setq p-end (point-max)))
- (get-mother
+ (with-children
(save-excursion
(catch 'tag
(let (e i)
It calls following-method selected from variable
`mime-preview-following-method-alist'."
(interactive)
- (let ((entity (mime-preview-find-boundary-info t))
- p-beg p-end
- pb-beg)
- (setq p-beg (aref entity 0)
- p-end (aref entity 1)
- entity (aref entity 2))
- (if (get-text-property p-beg 'mime-view-entity-body)
+ (let* ((boundary-info (mime-preview-find-boundary-info t))
+ (p-beg (aref boundary-info 0))
+ (p-end (aref boundary-info 1))
+ (entity (aref boundary-info 2))
+ pb-beg)
+ (if (or (get-text-property p-beg 'mime-view-entity-body)
+ (null entity))
(setq pb-beg p-beg)
(setq pb-beg
(next-single-property-change
(or (next-single-property-change p-beg 'mime-view-entity)
p-end))))
(let* ((mode (mime-preview-original-major-mode 'recursive))
- (entity-node-id (mime-entity-node-id entity))
+ (entity-node-id (and entity (mime-entity-node-id entity)))
(new-name
(format "%s-%s" (buffer-name) (reverse entity-node-id)))
new-buf
(insert-buffer-substring the-buf pb-beg p-end)
(goto-char (point-min))
(let ((current-entity
- (if (and (eq (mime-entity-media-type entity) 'message)
+ (if (and entity
+ (eq (mime-entity-media-type entity) 'message)
(eq (mime-entity-media-subtype entity) 'rfc822))
(car (mime-entity-children entity))
entity)))
(if (functionp f)
(funcall f new-buf)
(message
- (format
- "Sorry, following method for %s is not implemented yet."
- mode)))))))
+ "Sorry, following method for %s is not implemented yet."
+ mode))))))
;;; @@ moving
default-charset))
(defun mime-preview-toggle-display (type &optional display)
- (let ((situation (mime-preview-find-boundary-info))
+ (let ((situation (mime-preview-find-boundary-info t))
(sym (intern (concat "*" (symbol-name type))))
entity p-beg p-end encoding charset)
(setq p-beg (aref situation 0)
projects / elisp / semi.git / blobdiff