;; 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:
:group 'mime-view
:type '(repeat file))
+(defcustom mime-view-buttons-visible t
+ "Toggle visibility of MIME buttons."
+ :group 'mime-view
+ :type 'boolean)
;;; @ in raw-buffer (representation space)
;;;
(defun mime-save-situation-examples ()
(if (or mime-preview-situation-example-list
mime-acting-situation-example-list)
- (let ((file mime-situation-examples-file))
- (with-temp-buffer
- (insert ";;; " (file-name-nondirectory file) "\n")
- (insert "\n;; This file is generated automatically by "
- mime-view-version "\n\n")
- (insert ";;; Code:\n\n")
- (if mime-preview-situation-example-list
- (pp `(setq mime-preview-situation-example-list
- ',mime-preview-situation-example-list)
- (current-buffer)))
- (if mime-acting-situation-example-list
- (pp `(setq mime-acting-situation-example-list
- ',mime-acting-situation-example-list)
- (current-buffer)))
- (insert "\n;;; "
- (file-name-nondirectory file)
- " ends here.\n")
- (static-cond
- ((boundp 'buffer-file-coding-system)
- (setq buffer-file-coding-system
- mime-situation-examples-file-coding-system))
- ((boundp 'file-coding-system)
- (setq file-coding-system
- mime-situation-examples-file-coding-system)))
- ;; (setq buffer-file-coding-system
- ;; mime-situation-examples-file-coding-system)
- (setq buffer-file-name file)
- (save-buffer)))))
+ (let ((file mime-situation-examples-file)
+ print-length print-level)
+ (when file
+ (with-temp-buffer
+ (insert ";;; " (file-name-nondirectory file) "\n")
+ (insert "\n;; This file is generated automatically by "
+ mime-view-version "\n\n")
+ (insert ";;; Code:\n\n")
+ (if mime-preview-situation-example-list
+ (pp `(setq mime-preview-situation-example-list
+ ',mime-preview-situation-example-list)
+ (current-buffer)))
+ (if mime-acting-situation-example-list
+ (pp `(setq mime-acting-situation-example-list
+ ',mime-acting-situation-example-list)
+ (current-buffer)))
+ (insert "\n;;; "
+ (file-name-nondirectory file)
+ " ends here.\n")
+ (static-cond
+ ((boundp 'buffer-file-coding-system)
+ (setq buffer-file-coding-system
+ mime-situation-examples-file-coding-system))
+ ((boundp 'file-coding-system)
+ (setq file-coding-system
+ mime-situation-examples-file-coding-system)))
+ ;; (setq buffer-file-coding-system
+ ;; mime-situation-examples-file-coding-system)
+ (setq buffer-file-name file)
+ (save-buffer))))))
(add-hook 'kill-emacs-hook 'mime-save-situation-examples)
)))
)
(t
- (let ((media-type (mime-entity-media-type entity))
- (media-subtype (mime-entity-media-subtype entity))
- (charset (cdr (assoc "charset" params)))
- (encoding (mime-entity-encoding entity)))
+ (let* ((charset (cdr (assoc "charset" params)))
+ (encoding (mime-entity-encoding entity))
+ (rest (format " <%s/%s%s%s>"
+ (mime-entity-media-type entity)
+ (mime-entity-media-subtype entity)
+ (if charset
+ (concat "; " charset)
+ "")
+ (if encoding
+ (concat " (" encoding ")")
+ ""))))
(concat
num " " subject
- (let ((rest
- (format " <%s/%s%s%s>"
- media-type media-subtype
- (if charset
- (concat "; " charset)
- "")
- (if encoding
- (concat " (" encoding ")")
- ""))))
- (if (>= (+ (current-column)(length rest))(window-width))
- "\n\t")
- rest)))
+ (if (>= (+ (current-column)(length rest))(window-width))
+ "\n\t")
+ rest))
)))
(function mime-preview-play-current-entity))
))
(define-calist-field-match-method
'body #'mime-calist::field-match-method-as-default-rule)
+(defun mime-calist::field-match-method-ignore-case (calist
+ field-type field-value)
+ (let ((s-field (assoc field-type calist)))
+ (cond ((null s-field)
+ (cons (cons field-type field-value) calist))
+ ((eq field-value t)
+ calist)
+ ((string= (downcase (cdr s-field)) (downcase field-value))
+ calist))))
+
+(define-calist-field-match-method
+ 'access-type #'mime-calist::field-match-method-ignore-case)
+
(defvar mime-preview-condition nil
"Condition-tree about how to display entity.")
(ctree-set-calist-strictly
'mime-preview-condition
+ '((type . multipart)(subtype . related)
+ (body . visible)
+ (body-presentation-method . mime-display-multipart/related)))
+
+(ctree-set-calist-strictly
+ 'mime-preview-condition
'((type . multipart)(subtype . t)
(body . visible)
(body-presentation-method . mime-display-multipart/mixed)))
situations (cdr situations)
i (1+ i)))))
+(defun mime-display-multipart/related (entity situation)
+ (let* ((param-start (mime-parse-msg-id
+ (std11-lexical-analyze
+ (cdr (assoc "start"
+ (mime-content-type-parameters
+ (mime-entity-content-type entity)))))))
+ (start (or (and param-start (mime-find-entity-from-content-id
+ param-start
+ entity))
+ (car (mime-entity-children entity))))
+ (original-major-mode-cell (assq 'major-mode situation))
+ (default-situation (cdr (assq 'childrens-situation 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))))
;;; @ acting-condition
;;;
(setq situation
(mime-find-entity-preview-situation entity default-situation)))
(let ((button-is-invisible
- (eq (cdr (or (assq '*entity-button situation)
- (assq 'entity-button situation)))
- 'invisible))
+ (or (not mime-view-buttons-visible)
+ (eq (cdr (or (assq '*entity-button situation)
+ (assq 'entity-button situation)))
+ 'invisible)))
(header-is-visible
(eq (cdr (or (assq '*header situation)
(assq 'header situation)))
(if (functionp body-presentation-method)
(funcall body-presentation-method entity situation)
(mime-display-text/plain entity situation)))
- (when button-is-invisible
- (goto-char (point-max))
- (mime-view-insert-entity-button entity)
- )
(unless header-is-visible
(goto-char (point-max))
(insert "\n"))
;;; @@ 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 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
((null entity-node-id)
(setq p-end (point-max))
)
- (get-mother
+ (with-children
(save-excursion
- (goto-char p-end)
(catch 'tag
(let (e i)
(while (setq e
(point) 'mime-view-entity))
(goto-char e)
(let ((rc (mime-entity-node-id
- (get-text-property (1- (point))
+ (get-text-property (point)
'mime-view-entity))))
(or (and (>= (setq i (- (length rc) len)) 0)
(equal entity-node-id (nthcdr i rc)))
(throw 'tag nil)))
- (setq p-end e)))
+ (setq p-end (or (next-single-property-change
+ (point) 'mime-view-entity)
+ (point-max)))))
(setq p-end (point-max))))
))
(vector p-beg p-end entity)))
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)
))
)))
;;;
(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)
(setq p-beg (aref situation 0)
(display)
(t
(setq display
- (eq (cdr (or (assq sym situation)
- (assq type situation)))
- 'invisible))))
+ (memq (cdr (or (assq sym situation)
+ (assq type situation)))
+ '(nil invisible)))))
(setq situation (put-alist sym (if display
'visible
'invisible)
projects / elisp / semi.git / blobdiff