(mime-calist::field-match-method-ignore-case):

[elisp/semi.git] / mime-view.el

diff --git a/mime-view.el b/mime-view.el
index b5164d4..05222ac 100644 (file)
--- a/mime-view.el
+++ b/mime-view.el
@@ -22,8 +22,8 @@
 
 ;; 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:
 
@@ -599,24 +599,22 @@ mother-buffer."
                  )))
            )
           (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))
     ))
@@ -667,6 +665,19 @@ Each elements are regexp of field-name.")
 (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 #'calist-field-match-method-ignore-case)
+
 
 (defvar mime-preview-condition nil
   "Condition-tree about how to display entity.")
@@ -941,10 +952,11 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
                    (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))))
 
 ;;; @ acting-condition
 ;;;
@@ -1479,11 +1491,13 @@ 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
@@ -1559,13 +1573,13 @@ It decodes current entity to call internal or external method as
 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
@@ -1573,7 +1587,7 @@ It calls following-method selected from variable
             (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
@@ -1586,7 +1600,8 @@ It calls following-method selected from variable
        (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)))
@@ -1627,9 +1642,8 @@ It calls following-method selected from variable
        (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)
          ))
       )))
 
@@ -1818,9 +1832,9 @@ If LINES is negative, scroll up LINES lines."
          (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)