(error (defvar bbdb-buffer-name nil)))
)
-(defvar mime-acting-situation-examples nil)
+(defvar mime-acting-situation-example-list nil)
+
+(defvar mime-acting-situation-example-list-max-size 16)
(defun mime-save-acting-situation-examples ()
(let* ((file mime-acting-situation-examples-file)
(insert "\n;; This file is generated automatically by "
mime-view-version-string "\n\n")
(insert ";;; Code:\n\n")
- (pp `(setq mime-acting-situation-examples
- ',mime-acting-situation-examples)
+ (pp `(setq mime-acting-situation-example-list
+ ',mime-acting-situation-example-list)
(current-buffer))
(insert "\n;;; "
(file-name-nondirectory file)
(add-hook 'kill-emacs-hook 'mime-save-acting-situation-examples)
-
+(defun mime-reduce-acting-situation-examples ()
+ (let* ((rest mime-acting-situation-example-list)
+ (min-example (car rest))
+ (min-score (cdr min-example)))
+ (while rest
+ (let* ((example (car rest))
+ (score (cdr example)))
+ (cond ((< score min-score)
+ (setq min-score score
+ min-example example)
+ )
+ ((= score min-score)
+ (if (<= (length (car example))(length (car min-example)))
+ (setq min-example example)
+ ))
+ ))
+ (setq rest (cdr rest)))
+ (setq mime-acting-situation-example-list
+ (delq min-example mime-acting-situation-example-list))
+ (setq min-example (car min-example))
+ (let ((examples mime-acting-situation-example-list)
+ (max-score 0)
+ max-examples)
+ (while examples
+ (let* ((ret (mime-compare-situation-with-example min-example
+ (caar examples)))
+ (ret-score (car ret)))
+ (cond ((> ret-score max-score)
+ (setq max-score ret-score
+ max-examples (list (cdr ret)))
+ )
+ ((= ret-score max-score)
+ (setq max-examples (cons (cdr ret) max-examples))
+ )))
+ (setq examples (cdr examples)))
+ (while max-examples
+ (let* ((example (car max-examples))
+ (cell (assoc example mime-acting-situation-example-list)))
+ (if cell
+ (setcdr cell (1+ (cdr cell)))
+ (setq mime-acting-situation-example-list
+ (cons (cons example 0)
+ mime-acting-situation-example-list))
+ ))
+ (setq max-examples (cdr max-examples))
+ ))))
+
+
;;; @ content decoder
;;;
(defvar mime-preview-after-decoded-position nil)
-(defun mime-preview-play-current-entity (&optional mode)
+(defun mime-preview-play-current-entity (&optional ignore-examples mode)
"Play current entity.
It decodes current entity to call internal or external method. The
method is selected from variable `mime-acting-condition'.
+If IGNORE-EXAMPLES (C-u prefix) is specified, this function ignores
+`mime-acting-situation-example-list'.
If MODE is specified, play as it. Default MODE is \"play\"."
- (interactive (list "play"))
+ (interactive "P")
(let ((entity (get-text-property (point) 'mime-view-entity)))
(if entity
(let ((the-buf (current-buffer))
(raw-buffer (mime-entity-buffer entity)))
(setq mime-preview-after-decoded-position (point))
(set-buffer raw-buffer)
- (mime-raw-play-entity entity mode)
+ (mime-raw-play-entity entity (or mode "play") nil ignore-examples)
(when (eq (current-buffer) raw-buffer)
(set-buffer the-buf)
(goto-char mime-preview-after-decoded-position)
)))
)
-(defsubst mime-delq-null-situation (situations field)
+(defsubst mime-delq-null-situation (situations field
+ &optional ignored-value)
(let (dest)
(while situations
- (let ((situation (car situations)))
- (if (assq field situation)
- (setq dest (cons situation dest))
- ))
+ (let* ((situation (car situations))
+ (cell (assq field situation)))
+ (if cell
+ (or (eq (cdr cell) ignored-value)
+ (setq dest (cons situation dest))
+ )))
(setq situations (cdr situations)))
dest))
-(defun mime-raw-play-entity (entity &optional mode situation)
+(defun mime-compare-situation-with-example (situation example)
+ (let ((example (copy-alist example))
+ (match 0))
+ (while situation
+ (let* ((cell (car situation))
+ (key (car cell))
+ (ecell (assoc key example)))
+ (when ecell
+ (if (equal cell ecell)
+ (setq match (1+ match))
+ (setq example (delq ecell example))
+ ))
+ )
+ (setq situation (cdr situation))
+ )
+ (cons match example)
+ ))
+
+(defun mime-raw-play-entity (entity &optional mode situation ignore-examples
+ ignored-method)
"Play entity specified by ENTITY.
It decodes the entity to call internal or external method. The method
is selected from variable `mime-acting-condition'. If MODE is
(if mode
(setq situation (cons (cons 'mode mode) situation))
)
+ (if ignore-examples
+ (or (assq 'ignore-examples situation)
+ (setq situation
+ (cons (cons 'ignore-examples ignore-examples) situation)))
+ )
(setq ret
- (or (ctree-match-calist mime-acting-situation-examples situation)
- (ctree-match-calist-partially mime-acting-situation-examples
- situation)
- situation))
- (setq ret
- (or (mime-delq-null-situation
- (ctree-find-calist mime-acting-condition ret
- mime-view-find-every-acting-situation)
- 'method)
- (mime-delq-null-situation
- (ctree-find-calist mime-acting-condition situation
- mime-view-find-every-acting-situation)
- 'method)
- ))
+ (mime-delq-null-situation
+ (ctree-find-calist mime-acting-condition situation
+ mime-view-find-every-acting-situation)
+ 'method ignored-method))
+ (or ignore-examples
+ (if (cdr ret)
+ (let ((rest ret)
+ (max-score 0)
+ max-escore
+ max-examples
+ max-situations)
+ (while rest
+ (let ((situation (car rest))
+ (examples mime-acting-situation-example-list))
+ (while examples
+ (let* ((ret
+ (mime-compare-situation-with-example
+ situation (caar examples)))
+ (ret-score (car ret)))
+ (cond ((> ret-score max-score)
+ (setq max-score ret-score
+ max-escore (cdar examples)
+ max-examples (list (cdr ret))
+ max-situations (list situation))
+ )
+ ((= ret-score max-score)
+ (cond ((> (cdar examples) max-escore)
+ (setq max-escore (cdar examples)
+ max-examples (list (cdr ret))
+ max-situations (list situation))
+ )
+ ((= (cdar examples) max-escore)
+ (setq max-examples
+ (cons (cdr ret) max-examples))
+ (or (member situation max-situations)
+ (setq max-situations
+ (cons situation max-situations)))
+ )))))
+ (setq examples (cdr examples))))
+ (setq rest (cdr rest)))
+ (when max-situations
+ (setq ret max-situations)
+ (while max-examples
+ (let* ((example (car max-examples))
+ (cell
+ (assoc example mime-acting-situation-example-list)))
+ (if cell
+ (setcdr cell (1+ (cdr cell)))
+ (setq mime-acting-situation-example-list
+ (cons (cons example 0)
+ mime-acting-situation-example-list))
+ ))
+ (setq max-examples (cdr max-examples))
+ )))))
(cond ((cdr ret)
(setq ret (select-menu-alist
"Methods"
situation)))
ret)))
(setq ret (mime-sort-situation ret))
- (ctree-set-calist-strictly 'mime-acting-situation-examples ret)
+ (add-to-list 'mime-acting-situation-example-list (cons ret 0))
)
(t
(setq ret (car ret))
;;; @ file detection
;;;
-(defvar mime-file-content-type-alist
- '(("JPEG" image jpeg)
- ("GIF" image gif)
+(defvar mime-magic-type-alist
+ '(("^\377\330\377[\340\356]..JFIF" image jpeg)
+ ("^\211PNG" image png)
+ ("^GIF8[79]" image gif)
+ ("^II\\*\000" image tiff)
+ ("^MM\000\\*" image tiff)
+ ("^MThd" audio midi)
+ ("^\000\000\001\263" video mpeg)
)
- "*Alist of \"file\" output patterns vs. corresponding media-types.
+ "*Alist of regexp about magic-number vs. corresponding media-types.
Each element looks like (REGEXP TYPE SUBTYPE).
-REGEXP is pattern for \"file\" command output.
+REGEXP is a regular expression to match against the beginning of the
+content of entity.
TYPE is symbol to indicate primary type of media-type.
SUBTYPE is symbol to indicate subtype of media-type.")
(defun mime-detect-content (entity situation)
- (let ((beg (mime-entity-point-min entity))
- (end (mime-entity-point-max entity)))
- (goto-char beg)
- (let* ((name (save-restriction
- (narrow-to-region beg end)
- (mime-entity-safe-filename entity)
- ))
- (encoding (or (cdr (assq 'encoding situation)) "7bit"))
- (filename (if (and name (not (string-equal name "")))
- (expand-file-name name mime-temp-directory)
- (make-temp-name
- (expand-file-name "EMI" mime-temp-directory)))))
- (mime-write-decoded-region (mime-entity-body-start entity) end
- filename encoding)
- (let (type subtype)
- (with-temp-buffer
- (call-process "file" nil t nil filename)
- (goto-char (point-min))
- (if (search-forward (concat filename ": ") nil t)
- (let ((rest mime-file-content-type-alist))
- (while (not (let ((cell (car rest)))
- (if cell
- (if (looking-at (car cell))
- (setq type (nth 1 cell)
- subtype (nth 2 cell))
- )
- t)))
- (setq rest (cdr rest))))))
- (if type
- (mime-raw-play-entity
- entity "play"
- (put-alist 'type type
- (put-alist 'subtype subtype
- (mime-entity-situation entity))))
- ))
- )))
+ (let (type subtype)
+ (let ((mdata (save-excursion
+ ;;(set-buffer (mime-entity-buffer entity))
+ (let* ((start (mime-entity-body-start entity))
+ (end (progn
+ (goto-char start)
+ (end-of-line)
+ (point))))
+ (mime-decode-string (buffer-substring start end)
+ (mime-entity-encoding entity))
+ )))
+ (rest mime-magic-type-alist))
+ (while (not (let ((cell (car rest)))
+ (if cell
+ (if (string-match (car cell) mdata)
+ (setq type (nth 1 cell)
+ subtype (nth 2 cell))
+ )
+ t)))
+ (setq rest (cdr rest))))
+ (if type
+ (mime-raw-play-entity
+ entity nil
+ (put-alist 'type type
+ (put-alist 'subtype subtype
+ (del-alist 'method
+ (copy-alist situation))))
+ (cdr (assq 'ignore-examples situation))
+ 'mime-detect-content)
+ ))
+ )
;;; @ mail/news message
(erase-buffer)
(as-binary-input-file (insert-file-contents file))
(setq major-mode 'mime-show-message-mode)
- (mime-view-mode mother)
+ (mime-view-buffer (current-buffer) nil mother)
)
(set-window-buffer pwin
(save-excursion
))
(save-window-excursion
(setq major-mode 'mime-show-message-mode)
- (mime-view-mode mother)
+ (mime-view-buffer (current-buffer) nil mother)
)
(let ((pwin (or (get-buffer-window mother)
- (get-largest-window)
- ))
+ (get-largest-window)))
(pbuf (save-excursion
(set-buffer full-buf)
mime-preview-buffer)))
(insert-file-contents file)
(eval-buffer)
;; format check
- (or (eq (car mime-acting-situation-examples) 'type)
- (setq mime-acting-situation-examples nil))
+ (condition-case nil
+ (let ((i 0))
+ (while (and (> (length mime-acting-situation-example-list)
+ mime-acting-situation-example-list-max-size)
+ (< i 16))
+ (mime-reduce-acting-situation-examples)
+ (setq i (1+ i))
+ ))
+ (error (setq mime-acting-situation-example-list nil)))
)
(kill-buffer buffer))))