(require 'filename)
(eval-when-compile
- (require 'mime-text)
(condition-case nil
(require 'bbdb)
(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)
(erase-buffer)
(insert ";;; " (file-name-nondirectory file) "\n")
(insert "\n;; This file is generated automatically by "
- mime-view-version-string "\n\n")
+ mime-view-version "\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 0)
+ 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))
(let ((method (cdr (assoc 'method situation)))
(name (mime-entity-safe-filename entity)))
(setq name
- (if name
- (expand-file-name name mime-temp-directory)
+ (if (and name (not (string= name "")))
+ (expand-file-name name temporary-file-directory)
(make-temp-name
- (expand-file-name "EMI" mime-temp-directory))
+ (expand-file-name "EMI" temporary-file-directory))
))
- (mime-write-decoded-region (mime-entity-body-start entity) end
- name (cdr (assq 'encoding situation)))
+ (mime-write-entity-content entity name)
(message "External method is starting...")
(let ((process
(let ((command
(remove-alist 'mime-mailcap-method-filename-alist process)
(message (format "%s %s" process event)))
-(defvar mime-echo-window-is-shared-with-bbdb t
+(defvar mime-echo-window-is-shared-with-bbdb
+ (module-installed-p 'bbdb)
"*If non-nil, mime-echo window is shared with BBDB window.")
(defvar mime-echo-window-height
"Show mime-echo buffer to display MIME-playing information."
(get-buffer-create mime-echo-buffer-name)
(let ((the-win (selected-window))
- (win (get-buffer-window mime-echo-buffer-name))
+ (win (get-buffer-window mime-echo-buffer-name)))
+ (unless win
+ (unless (and mime-echo-window-is-shared-with-bbdb
+ (condition-case nil
+ (setq win (get-buffer-window bbdb-buffer-name))
+ (error nil)))
+ (select-window (get-buffer-window mime-preview-buffer))
+ (setq win (split-window-vertically
+ (- (window-height)
+ (if (functionp mime-echo-window-height)
+ (funcall mime-echo-window-height)
+ mime-echo-window-height)
+ )))
)
- (or win
- (if (and mime-echo-window-is-shared-with-bbdb
- (boundp 'bbdb-buffer-name)
- (setq win (get-buffer-window bbdb-buffer-name))
- )
- (set-window-buffer win mime-echo-buffer-name)
- (select-window (get-buffer-window mime-preview-buffer))
- (setq win (split-window-vertically
- (- (window-height)
- (if (functionp mime-echo-window-height)
- (funcall mime-echo-window-height)
- mime-echo-window-height)
- )))
- (set-window-buffer win mime-echo-buffer-name)
- ))
+ (set-window-buffer win mime-echo-buffer-name)
+ )
(select-window win)
(goto-char (point-max))
(if forms
;;; @ 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 (looking-at (car cell))
- (setq type (nth 1 cell)
- subtype (nth 2 cell))
- )))
- (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
(goto-char (mime-entity-point-min entity))
(let* ((root-dir
(expand-file-name
- (concat "m-prts-" (user-login-name)) mime-temp-directory))
+ (concat "m-prts-" (user-login-name)) temporary-file-directory))
(id (cdr (assoc "id" cal)))
(number (cdr (assoc "number" cal)))
(total (cdr (assoc "total" cal)))
(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)))
)
(setq buffer-read-only nil)
(erase-buffer)
- (mime-text-insert-decoded-body entity)
+ (mime-insert-text-content entity)
(mule-caesar-region (point-min) (point-max))
(set-buffer-modified-p nil)
(set-buffer mother)
(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))))
projects / elisp / semi.git / blobdiff