Merging WEMI except for the XPM button implementation.
authorueno <ueno>
Tue, 12 Sep 2000 16:40:56 +0000 (16:40 +0000)
committerueno <ueno>
Tue, 12 Sep 2000 16:40:56 +0000 (16:40 +0000)
* mime-view.el (widget-keymap): Declare.
(mime-view-maybe-inherit-widget-keymap): New function.
(mime-view-define-keymap-hook): Add
`mime-view-maybe-inherit-widget-keymap'.

* semi-def.el: Add setting for `widget-convert-button' to
autoload "wid-edit".
(mime-button-mother-dispatcher): Abolish.
(mime-button-dispatcher): Abolish.
(mime-add-button): Abolish.
(mime-button-action): New function.
(mime-button): New widget.
(mime-add-url-buttons): Rewrite with `url-link' widget.
(mime-button-face): Abolish.
(mime-button-mouse-face): Abolish.

ChangeLog
mime-view.el
semi-def.el

index 87168d2..072de4b 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,21 @@
+2000-09-12   Daiki Ueno  <ueno@unixuser.org>
+
+       * mime-view.el (widget-keymap): Declare.
+       (mime-view-maybe-inherit-widget-keymap): New function.
+       (mime-view-define-keymap-hook): Add
+       `mime-view-maybe-inherit-widget-keymap'.
+
+       * semi-def.el: Add setting for `widget-convert-button' to
+       autoload "wid-edit".
+       (mime-button-mother-dispatcher): Abolish.
+       (mime-button-dispatcher): Abolish.
+       (mime-add-button): Abolish.
+       (mime-button-action): New function.
+       (mime-button): New widget.
+       (mime-add-url-buttons): Rewrite with `url-link' widget.
+       (mime-button-face): Abolish.
+       (mime-button-mouse-face): Abolish.
+
 2000-08-28   Daiki Ueno  <ueno@unixuser.org>
 
        * mime-view.el (mime-display-entity): Call `mime-add-url-buttons'.
index 6a2bc95..85d0771 100644 (file)
@@ -79,8 +79,7 @@ buttom. Nil means don't scroll at all."
 (defvar mime-raw-representation-type-alist
   '((mime-show-message-mode     . binary)
     (mime-temp-message-mode     . binary)
-    (t                          . cooked)
-    )
+    (t                          . cooked))
   "Alist of major-mode vs. representation-type of mime-raw-buffer.
 Each element looks like (SYMBOL . REPRESENTATION-TYPE).  SYMBOL is
 major-mode or t.  t means default.  REPRESENTATION-TYPE must be
@@ -112,8 +111,7 @@ mother-buffer."
   (if (and recursive mime-mother-buffer)
       (save-excursion
        (set-buffer mime-mother-buffer)
-       (mime-preview-original-major-mode recursive)
-       )
+       (mime-preview-original-major-mode recursive))
     (cdr (assq 'major-mode
               (get-text-property (or point
                                      (if (> (point) (buffer-size))
@@ -133,15 +131,13 @@ mother-buffer."
       (setq rest (or (mime-entity-content-type entity)
                     (make-mime-content-type 'text 'plain))
            situation (cons (car rest) situation)
-           rest (cdr rest))
-      )
+           rest (cdr rest)))
     (unless (assq 'subtype situation)
       (or rest
          (setq rest (or (cdr (mime-entity-content-type entity))
                         '((subtype . plain)))))
       (setq situation (cons (car rest) situation)
-           rest (cdr rest))
-      )
+           rest (cdr rest)))
     (while rest
       (setq param (car rest))
       (or (assoc (car param) situation)
@@ -156,8 +152,7 @@ mother-buffer."
          (setq situation (cons (cons 'disposition-type
                                      (mime-content-disposition-type rest))
                                situation)
-               rest (mime-content-disposition-parameters rest))
-       ))
+               rest (mime-content-disposition-parameters rest))))
     (while rest
       (setq param (car rest)
            name (car param))
@@ -207,8 +202,7 @@ mother-buffer."
             (cell (assq field situation)))
        (if cell
            (or (memq (cdr cell) ignored-values)
-               (setq dest (cons situation dest))
-               )))
+               (setq dest (cons situation dest)))))
       (setq situations (cdr situations)))
     dest))
 
@@ -222,13 +216,9 @@ mother-buffer."
        (when ecell
          (if (equal cell ecell)
              (setq match (1+ match))
-           (setq example (delq ecell example))
-           ))
-       )
-      (setq situation (cdr situation))
-      )
-    (cons match example)
-    ))
+           (setq example (delq ecell example)))))
+      (setq situation (cdr situation)))
+    (cons match example)))
 
 (defun mime-sort-situation (situation)
   (sort situation
@@ -240,30 +230,23 @@ mother-buffer."
                           (mode . 3)
                           (method . 4)
                           (major-mode . 5)
-                          (disposition-type . 6)
-                          ))
+                          (disposition-type . 6)))
                  a-order b-order)
              (if (symbolp a-t)
                  (let ((ret (assq a-t order)))
                    (if ret
                        (setq a-order (cdr ret))
-                     (setq a-order 7)
-                     ))
-               (setq a-order 8)
-               )
+                     (setq a-order 7)))
+               (setq a-order 8))
              (if (symbolp b-t)
                  (let ((ret (assq b-t order)))
                    (if ret
                        (setq b-order (cdr ret))
-                     (setq b-order 7)
-                     ))
-               (setq b-order 8)
-               )
+                     (setq b-order 7)))
+               (setq b-order 8))
              (if (= a-order b-order)
                  (string< (format "%s" a-t)(format "%s" b-t))
-               (< a-order b-order))
-             )))
-  )
+               (< a-order b-order))))))
 
 (defun mime-unify-situations (entity-situation
                              condition situation-examples
@@ -296,21 +279,18 @@ mother-buffer."
                             (setq max-score ret-score
                                   max-escore (cdar examples)
                                   max-examples (list (cdr ret))
-                                  max-situations (list situation))
-                            )
+                                  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))
-                                   )
+                                         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)))
-                                   )))))
+                                             (cons situation max-situations))))))))
                    (setq examples (cdr examples))))
                (setq rest (cdr rest)))
              (when max-situations
@@ -323,10 +303,8 @@ mother-buffer."
                        (setcdr cell (1+ (cdr cell)))
                      (setq situation-examples
                            (cons (cons example 0)
-                                 situation-examples))
-                     ))
-                 (setq max-examples (cdr max-examples))
-                 )))))
+                                 situation-examples))))
+                 (setq max-examples (cdr max-examples)))))))
     (cons ret situation-examples)
     ;; ret: list of situations
     ;; situation-examples: new examples (notoce that contents of
@@ -422,8 +400,7 @@ mother-buffer."
                       min-freq freq
                       d-i i
                       d-j j
-                      dest (cons (cdr ret) freq))
-                )
+                      dest (cons (cdr ret) freq)))
                ((= max-sim sim)
                 (cond ((> min-det-ret det-ret)
                        (setq min-det-ret det-ret
@@ -431,27 +408,20 @@ mother-buffer."
                              min-freq freq
                              d-i i
                              d-j j
-                             dest (cons (cdr ret) freq))
-                       )
+                             dest (cons (cdr ret) freq)))
                       ((= min-det-ret det-ret)
                        (cond ((> min-det-org det-org)
                               (setq min-det-org det-org
                                     min-freq freq
                                     d-i i
                                     d-j j
-                                    dest (cons (cdr ret) freq))
-                              )
+                                    dest (cons (cdr ret) freq)))
                              ((= min-det-org det-org)
                               (cond ((> min-freq freq)
                                      (setq min-freq freq
                                            d-i i
                                            d-j j
-                                           dest (cons (cdr ret) freq))
-                                     ))
-                              ))
-                       ))
-                ))
-         )
+                                           dest (cons (cdr ret) freq)))))))))))
        (setq jr (cdr jr)
              j (1+ j)))
       (setq ir (cdr ir)
@@ -466,8 +436,7 @@ mother-buffer."
        (setq situation-examples
              (cdr situation-examples))
       (setq ir (nthcdr (1- d-i) situation-examples))
-      (setcdr ir (cddr ir))
-      )
+      (setcdr ir (cddr ir)))
     (if (setq ir (assoc (car dest) situation-examples))
        (progn
          (setcdr ir (+ (cdr ir)(cdr dest)))
@@ -516,11 +485,9 @@ mother-buffer."
                    (if (consp entity-node-id)
                        (mapconcat (function
                                    (lambda (num)
-                                     (format "%s" (1+ num))
-                                     ))
+                                     (format "%s" (1+ num))))
                                   (reverse entity-node-id) ".")
-                     "0"))
-               ))
+                     "0"))))
        (cond (access-type
              (let ((server (assoc "server" params)))
                (setq access-type (cdr access-type))
@@ -529,15 +496,12 @@ mother-buffer."
                            num subject access-type (cdr server))
                (let ((site (cdr (assoc "site" params)))
                      (dir (cdr (assoc "directory" params)))
-                     (url (cdr (assoc "url" params)))
-                     )
+                     (url (cdr (assoc "url" params))))
                  (if url
                      (format "%s %s ([%s] %s)"
                              num subject access-type url)
                    (format "%s %s ([%s] %s:%s)"
-                           num subject access-type site dir))
-                 )))
-           )
+                           num subject access-type site dir))))))
           (t
            (let ((media-type (mime-entity-media-type entity))
                  (media-subtype (mime-entity-media-subtype entity))
@@ -556,10 +520,8 @@ mother-buffer."
                                ""))))
                 (if (>= (+ (current-column)(length rest))(window-width))
                     "\n\t")
-                rest)))
-           )))
-     (function mime-preview-play-current-entity))
-    ))
+                rest))))))
+     (function mime-preview-play-current-entity))))
 
 
 ;;; @@ entity-header
@@ -597,8 +559,7 @@ Each elements are regexp of field-name.")
                                                        field-type field-value)
   (let ((s-field (assq field-type calist)))
     (cond ((null s-field)
-          (cons (cons field-type field-value) calist)
-          )
+          (cons (cons field-type field-value) calist))
          (t calist))))
 
 (define-calist-field-match-method
@@ -736,14 +697,12 @@ Each elements are regexp of field-name.")
     (run-hooks 'mime-text-decode-hook)
     (goto-char (point-max))
     (if (not (eq (char-after (1- (point))) ?\n))
-       (insert "\n")
-      )
+       (insert "\n"))
     (if (and mime-preview-fill-flowed-text
             (equal (cdr (assoc "format" situation)) "flowed"))
        (fill-flowed))
     (mime-add-url-buttons)
-    (run-hooks 'mime-display-text/plain-hook)
-    ))
+    (run-hooks 'mime-display-text/plain-hook)))
 
 (defun mime-display-text/richtext (entity situation)
   (save-restriction
@@ -752,8 +711,7 @@ Each elements are regexp of field-name.")
     (run-hooks 'mime-text-decode-hook)
     (let ((beg (point-min)))
       (remove-text-properties beg (point-max) '(face nil))
-      (richtext-decode beg (point-max))
-      )))
+      (richtext-decode beg (point-max)))))
 
 (defun mime-display-text/enriched (entity situation)
   (save-restriction
@@ -762,8 +720,7 @@ Each elements are regexp of field-name.")
     (run-hooks 'mime-text-decode-hook)
     (let ((beg (point-min)))
       (remove-text-properties beg (point-max) '(face nil))
-      (enriched-decode beg (point-max))
-      )))
+      (enriched-decode beg (point-max)))))
 
 (defvar mime-view-announcement-for-message/partial
   (if (and (>= emacs-major-version 19) window-system)
@@ -773,21 +730,18 @@ Each elements are regexp of field-name.")
 \[[ or click here by mouse button-2.             ]]"
     "\
 \[[ This is message/partial style split message. ]]
-\[[ Please press `v' key in this buffer.         ]]"
-    ))
+\[[ Please press `v' key in this buffer.         ]]"))
 
 (defun mime-display-message/partial-button (&optional entity situation)
   (save-restriction
     (goto-char (point-max))
     (if (not (search-backward "\n\n" nil t))
-       (insert "\n")
-      )
+       (insert "\n"))
     (goto-char (point-max))
     (narrow-to-region (point-max)(point-max))
     (insert mime-view-announcement-for-message/partial)
     (mime-add-button (point-min)(point-max)
-                    #'mime-preview-play-current-entity)
-    ))
+                    #'mime-preview-play-current-entity)))
 
 (defun mime-display-multipart/mixed (entity situation)
   (let ((children (mime-entity-children entity))
@@ -799,8 +753,7 @@ Each elements are regexp of field-name.")
              (cons original-major-mode-cell default-situation)))
     (while children
       (mime-display-entity (car children) nil default-situation)
-      (setq children (cdr children))
-      )))
+      (setq children (cdr children)))))
 
 (defcustom mime-view-type-subtype-score-alist
   '(((text . enriched) . 3)
@@ -849,15 +802,12 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
                                        mime-view-type-subtype-score-alist)
                                       (assq
                                        t
-                                       mime-view-type-subtype-score-alist)
-                                      ))))
+                                       mime-view-type-subtype-score-alist)))))
                             (if (> score max-score)
                                 (setq p i
-                                      max-score score)
-                              )))
+                                      max-score score))))
                       (setq i (1+ i))
-                      situation)
-                    ))
+                      situation)))
                  children))
     (setq i 0)
     (while children
@@ -889,10 +839,8 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
              (cond ((eq field-type 'view)  (setq view field))
                    ((eq field-type 'print) (setq print field))
                    ((memq field-type '(compose composetyped edit)))
-                   (t (setq shared (cons field shared))))
-             )
-           (setq entry (cdr entry))
-           )
+                   (t (setq shared (cons field shared)))))
+           (setq entry (cdr entry)))
          (setq shared (nreverse shared))
          (ctree-set-calist-with-default
           'mime-acting-condition
@@ -901,18 +849,14 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
              (ctree-set-calist-with-default
               'mime-acting-condition
               (append shared
-                      (list '(mode . "print")(cons 'method (cdr view))))
-              ))
-         )
-       (setq entries (cdr entries))
-       )))
+                      (list '(mode . "print")(cons 'method (cdr view)))))))
+       (setq entries (cdr entries)))))
 
 (ctree-set-calist-strictly
  'mime-acting-condition
  '((type . application)(subtype . octet-stream)
    (mode . "play")
-   (method . mime-detect-content)
-   ))
+   (method . mime-detect-content)))
 
 (ctree-set-calist-with-default
  'mime-acting-condition
@@ -922,44 +866,37 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
 (ctree-set-calist-strictly
  'mime-acting-condition
  '((type . text)(subtype . x-rot13-47)(mode . "play")
-   (method . mime-view-caesar)
-   ))
+   (method . mime-view-caesar)))
 (ctree-set-calist-strictly
  'mime-acting-condition
  '((type . text)(subtype . x-rot13-47-48)(mode . "play")
-   (method . mime-view-caesar)
-   ))
+   (method . mime-view-caesar)))
 
 (ctree-set-calist-strictly
  'mime-acting-condition
  '((type . message)(subtype . rfc822)(mode . "play")
-   (method . mime-view-message/rfc822)
-   ))
+   (method . mime-view-message/rfc822)))
 (ctree-set-calist-strictly
  'mime-acting-condition
  '((type . message)(subtype . partial)(mode . "play")
-   (method . mime-store-message/partial-piece)
-   ))
+   (method . mime-store-message/partial-piece)))
 
 (ctree-set-calist-strictly
  'mime-acting-condition
  '((type . message)(subtype . external-body)
    ("access-type" . "anon-ftp")
-   (method . mime-view-message/external-anon-ftp)
-   ))
+   (method . mime-view-message/external-anon-ftp)))
 
 (ctree-set-calist-strictly
  'mime-acting-condition
  '((type . message)(subtype . external-body)
    ("access-type" . "url")
-   (method . mime-view-message/external-url)
-   ))
+   (method . mime-view-message/external-url)))
 
 (ctree-set-calist-strictly
  'mime-acting-condition
  '((type . application)(subtype . octet-stream)
-   (method . mime-save-content)
-   ))
+   (method . mime-save-content)))
 
 
 ;;; @ quitting method
@@ -1046,12 +983,10 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
                (mime-display-text/plain entity situation)))
          (when button-is-invisible
            (goto-char (point-max))
-           (mime-view-insert-entity-button entity)
-           )
+           (mime-view-insert-entity-button entity))
          (unless header-is-visible
            (goto-char (point-max))
-           (insert "\n"))
-         ))
+           (insert "\n"))))
       (setq ne (point-max))
       (widen)
       (put-text-property nb ne 'mime-view-entity entity)
@@ -1063,8 +998,7 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
                 (cdr (assq 'body-presentation-method situation))))
            (if (functionp body-presentation-method)
                (funcall body-presentation-method entity situation)
-             (mime-display-multipart/mixed entity situation))))
-      )))
+             (mime-display-multipart/mixed entity situation)))))))
 
 
 ;;; @ MIME viewer mode
@@ -1079,8 +1013,7 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
     (scroll-up  "Scroll-up"               mime-preview-scroll-up-entity)
     (play       "Play current entity"     mime-preview-play-current-entity)
     (extract    "Extract current entity"  mime-preview-extract-current-entity)
-    (print      "Print current entity"    mime-preview-print-current-entity)
-    )
+    (print      "Print current entity"    mime-preview-print-current-entity))
   "Menu for MIME Viewer")
 
 (cond ((featurep 'xemacs)
@@ -1088,8 +1021,7 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
         (cons mime-view-menu-title
               (mapcar (function
                        (lambda (item)
-                         (vector (nth 1 item)(nth 2 item) t)
-                         ))
+                         (vector (nth 1 item)(nth 2 item) t)))
                       mime-view-menu-list)))
        (defun mime-view-xemacs-popup-menu (event)
         "Popup the menu in the MIME Viewer buffer"
@@ -1097,8 +1029,7 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
         (select-window (event-window event))
         (set-buffer (event-buffer event))
         (popup-menu 'mime-view-xemacs-popup-menu))
-       (defvar mouse-button-2 'button2)
-       )
+       (defvar mouse-button-2 'button2))
       (t
        (defvar mime-view-popup-menu 
          (let ((menu (make-sparse-keymap mime-view-menu-title)))
@@ -1106,8 +1037,7 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
                   (mapcar (function
                            (lambda (item)
                              (list (intern (nth 1 item)) 'menu-item 
-                                   (nth 1 item)(nth 2 item))
-                             ))
+                                   (nth 1 item)(nth 2 item))))
                           mime-view-menu-list))))
        (defun mime-view-popup-menu (event)
          "Popup the menu in the MIME Viewer buffer"
@@ -1118,14 +1048,21 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
                 (setq func (lookup-key menu (apply #'vector events)))
                 (commandp func)
                 (funcall func))))
-       (defvar mouse-button-2 [mouse-2])
-       ))
+       (defvar mouse-button-2 [mouse-2])))
 
+;;; The current local map is taken precendence over `widget-keymap', because GNU Emacs'
+;;; widget implementation doesn't set `local-map' property.  So we need to specify derivation.
+(defvar widget-keymap)
+(defun mime-view-maybe-inherit-widget-keymap ()
+  (when (boundp 'widget-keymap)
+    (set-keymap-parent (current-local-map) widget-keymap)))
+
+(add-hook 'mime-view-define-keymap-hook 'mime-view-maybe-inherit-widget-keymap)
+         
 (defun mime-view-define-keymap (&optional default)
   (let ((mime-view-mode-map (if (keymapp default)
                                (copy-keymap default)
-                             (make-sparse-keymap)
-                             )))
+                             (make-sparse-keymap))))
     (define-key mime-view-mode-map
       "u"        (function mime-preview-move-to-upper))
     (define-key mime-view-mode-map
@@ -1194,20 +1131,13 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
       [backspace] (function mime-preview-scroll-down-entity))
     (if (functionp default)
        (cond ((featurep 'xemacs)
-              (set-keymap-default-binding mime-view-mode-map default)
-              )
+              (set-keymap-default-binding mime-view-mode-map default))
              (t
               (setq mime-view-mode-map
-                    (append mime-view-mode-map (list (cons t default))))
-              )))
-    (if mouse-button-2
-       (define-key mime-view-mode-map
-         mouse-button-2 (function mime-button-dispatcher))
-      )
+                    (append mime-view-mode-map (list (cons t default)))))))
     (cond ((featurep 'xemacs)
           (define-key mime-view-mode-map
-            mouse-button-3 (function mime-view-xemacs-popup-menu))
-          )
+            mouse-button-3 (function mime-view-xemacs-popup-menu)))
          ((>= emacs-major-version 19)
           (define-key mime-view-mode-map
              mouse-button-3 (function mime-view-popup-menu))
@@ -1218,15 +1148,10 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
                    (lambda (item)
                      (define-key mime-view-mode-map
                        (vector 'menu-bar 'mime-view (car item))
-                       (cons (nth 1 item)(nth 2 item))
-                       )
-                     ))
-                  (reverse mime-view-menu-list)
-                  )
-          ))
+                       (cons (nth 1 item)(nth 2 item)))))
+                  (reverse mime-view-menu-list))))
     (use-local-map mime-view-mode-map)
-    (run-hooks 'mime-view-define-keymap-hook)
-    ))
+    (run-hooks 'mime-view-define-keymap-hook)))
 
 (defsubst mime-maybe-hide-echo-buffer ()
   "Clear mime-echo buffer and delete window for it."
@@ -1237,10 +1162,8 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
          (erase-buffer)
          (let ((win (get-buffer-window buf)))
            (if win
-               (delete-window win)
-             ))
-         (bury-buffer buf)
-         ))))
+               (delete-window win)))
+         (bury-buffer buf)))))
 
 (defvar mime-view-redisplay nil)
 
@@ -1271,8 +1194,7 @@ keymap of MIME-View mode."
       (widen)
       (erase-buffer)
       (if mother
-         (setq mime-mother-buffer mother)
-       )
+         (setq mime-mother-buffer mother))
       (setq mime-preview-original-window-configuration win-conf)
       (setq major-mode 'mime-view-mode)
       (setq mode-name "MIME-View")
@@ -1287,8 +1209,7 @@ keymap of MIME-View mode."
        (if point
            (goto-char point)
          (goto-char (point-min))
-         (search-forward "\n\n" nil t)
-         ))
+         (search-forward "\n\n" nil t)))
       (run-hooks 'mime-view-mode-hook)
       (set-buffer-modified-p nil)
       (setq buffer-read-only t)
@@ -1316,11 +1237,9 @@ message.  It must be nil, `binary' or `cooked'.  If it is nil,
            (save-excursion
              (set-buffer raw-buffer)
              (cdr (or (assq major-mode mime-raw-representation-type-alist)
-                      (assq t mime-raw-representation-type-alist)))
-             )))
+                      (assq t mime-raw-representation-type-alist))))))
   (if (eq representation-type 'binary)
-      (setq representation-type 'buffer)
-    )
+      (setq representation-type 'buffer))
   (setq preview-buffer (mime-display-message
                        (mime-open-entity representation-type raw-buffer)
                        preview-buffer mother default-keymap-or-function))
@@ -1331,8 +1250,7 @@ message.  It must be nil, `binary' or `cooked'.  If it is nil,
          (let ((m-win (and mother (get-buffer-window mother))))
            (if m-win
                (set-window-buffer m-win preview-buffer)
-             (switch-to-buffer preview-buffer)
-             ))))))
+             (switch-to-buffer preview-buffer)))))))
 
 (defun mime-view-mode (&optional mother ctl encoding
                                 raw-buffer preview-buffer
@@ -1368,18 +1286,14 @@ button-2        Move to point under the mouse cursor
              (or (assq major-mode mime-raw-representation-type-alist)
                  (assq t mime-raw-representation-type-alist)))))
        (if (eq type 'binary)
-           (setq type 'buffer)
-         )
+           (setq type 'buffer))
        (setq mime-message-structure (mime-open-entity type raw-buffer))
        (or (mime-entity-content-type mime-message-structure)
-           (mime-entity-set-content-type mime-message-structure ctl))
-       )
+           (mime-entity-set-content-type mime-message-structure ctl)))
       (or (mime-entity-encoding mime-message-structure)
-         (mime-entity-set-encoding mime-message-structure encoding))
-      ))
+         (mime-entity-set-encoding mime-message-structure encoding))))
   (mime-display-message mime-message-structure preview-buffer
-                       mother default-keymap-or-function)
-  )
+                       mother default-keymap-or-function))
 
 
 ;;; @@ utility
@@ -1401,19 +1315,15 @@ button-2        Move to point under the mouse cursor
                                                      'mime-view-entity)
                         (point))
                     (point)
-                  (point-min)))
-          )
+                  (point-min))))
          ((eq (next-single-property-change p-beg 'mime-view-entity)
               (point))
-          (setq p-beg (point))
-          ))
+          (setq p-beg (point))))
     (setq p-end (next-single-property-change p-beg 'mime-view-entity))
     (cond ((null p-end)
-          (setq p-end (point-max))
-          )
+          (setq p-end (point-max)))
          ((null entity-node-id)
-          (setq p-end (point-max))
-          )
+          (setq p-end (point-max)))
          (get-mother
           (save-excursion
             (goto-char p-end)
@@ -1430,8 +1340,7 @@ button-2  Move to point under the mouse cursor
                              (equal entity-node-id (nthcdr i rc)))
                         (throw 'tag nil)))
                   (setq p-end e)))
-              (setq p-end (point-max))))
-          ))
+              (setq p-end (point-max))))))
     (vector p-beg p-end entity)))
 
 
@@ -1447,8 +1356,7 @@ It decodes current entity to call internal or external method as
 \"extract\" mode.  The method is selected from variable
 `mime-acting-condition'."
   (interactive "P")
-  (mime-preview-play-current-entity ignore-examples "extract")
-  )
+  (mime-preview-play-current-entity ignore-examples "extract"))
 
 (defun mime-preview-print-current-entity (&optional ignore-examples)
   "Print current entity (maybe).
@@ -1456,8 +1364,7 @@ It decodes current entity to call internal or external method as
 \"print\" mode.  The method is selected from variable
 `mime-acting-condition'."
   (interactive "P")
-  (mime-preview-play-current-entity ignore-examples "print")
-  )
+  (mime-preview-play-current-entity ignore-examples "print"))
 
 
 ;;; @@ following
@@ -1508,8 +1415,7 @@ It calls following-method selected from variable
                        (mime-insert-header current-entity fields)
                        t))
            (setq fields (std11-collect-field-names)
-                 current-entity (mime-entity-parent current-entity))
-           ))
+                 current-entity (mime-entity-parent current-entity))))
        (let ((rest mime-view-following-required-fields-list)
              field-name ret)
          (while rest
@@ -1527,20 +1433,15 @@ It calls following-method selected from variable
                                                   entity field-name))))
                        (setq entity (mime-entity-parent entity)))))
                  (if ret
-                     (insert (concat field-name ": " ret "\n"))
-                   )))
-           (setq rest (cdr rest))
-           ))
-       )
+                     (insert (concat field-name ": " ret "\n")))))
+           (setq rest (cdr rest)))))
       (let ((f (cdr (assq mode mime-preview-following-method-alist))))
        (if (functionp f)
            (funcall f new-buf)
          (message
           (format
            "Sorry, following method for %s is not implemented yet."
-           mode))
-         ))
-      )))
+           mode)))))))
 
 
 ;;; @@ moving
@@ -1553,8 +1454,7 @@ If there is no upper entity, call function `mime-preview-quit'."
   (let (cinfo)
     (while (null (setq cinfo
                       (get-text-property (point) 'mime-view-entity)))
-      (backward-char)
-      )
+      (backward-char))
     (let ((r (mime-entity-parent cinfo))
          point)
       (catch 'tag
@@ -1571,11 +1471,8 @@ If there is no upper entity, call function `mime-preview-quit'."
                               (beginning-of-line)
                               (point)))))
                (recenter next-screen-context-lines))
-           (throw 'tag t)
-           )
-         )
-       (mime-preview-quit)
-       ))))
+           (throw 'tag t)))
+       (mime-preview-quit)))))
 
 (defun mime-preview-move-to-previous ()
   "Move to previous entity.
@@ -1584,8 +1481,7 @@ variable `mime-preview-over-to-previous-method-alist'."
   (interactive)
   (while (and (not (bobp))
              (null (get-text-property (point) 'mime-view-entity)))
-    (backward-char)
-    )
+    (backward-char))
   (let ((point (previous-single-property-change (point) 'mime-view-entity)))
     (if (and point
             (>= point (point-min)))
@@ -1602,14 +1498,11 @@ variable `mime-preview-over-to-previous-method-alist'."
                                  (point)))))
                        (recenter (* -1 next-screen-context-lines))))
          (goto-char (1- point))
-         (mime-preview-move-to-previous)
-         )
+         (mime-preview-move-to-previous))
       (let ((f (assq (mime-preview-original-major-mode)
                     mime-preview-over-to-previous-method-alist)))
        (if f
-           (funcall (cdr f))
-         ))
-      )))
+           (funcall (cdr f)))))))
 
 (defun mime-preview-move-to-next ()
   "Move to next entity.
@@ -1618,8 +1511,7 @@ variable `mime-preview-over-to-next-method-alist'."
   (interactive)
   (while (and (not (eobp))
              (null (get-text-property (point) 'mime-view-entity)))
-    (forward-char)
-    )
+    (forward-char))
   (let ((point (next-single-property-change (point) 'mime-view-entity)))
     (if (and point
             (<= point (point-max)))
@@ -1637,14 +1529,11 @@ variable `mime-preview-over-to-next-method-alist'."
                            (* -1 next-screen-context-lines))
                           (beginning-of-line)
                           (point)))))
-                (recenter next-screen-context-lines))
-           ))
+                (recenter next-screen-context-lines))))
       (let ((f (assq (mime-preview-original-major-mode)
                     mime-preview-over-to-next-method-alist)))
        (if f
-           (funcall (cdr f))
-         ))
-      )))
+           (funcall (cdr f)))))))
 
 (defun mime-preview-scroll-up-entity (&optional h)
   "Scroll up current entity.
@@ -1655,8 +1544,7 @@ If reached to (point-max), it calls function registered in variable
       (let ((f (assq (mime-preview-original-major-mode)
                     mime-preview-over-to-next-method-alist)))
        (if f
-           (funcall (cdr f))
-         ))
+           (funcall (cdr f))))
     (let ((point
           (or (next-single-property-change (point) 'mime-view-entity)
               (point-max)))
@@ -1668,8 +1556,7 @@ If reached to (point-max), it calls function registered in variable
        (condition-case nil
            (scroll-up h)
          (end-of-buffer
-          (goto-char (point-max)))))
-      )))
+          (goto-char (point-max))))))))
 
 (defun mime-preview-scroll-down-entity (&optional h)
   "Scroll down current entity.
@@ -1680,8 +1567,7 @@ If reached to (point-min), it calls function registered in variable
       (let ((f (assq (mime-preview-original-major-mode)
                     mime-preview-over-to-previous-method-alist)))
        (if f
-           (funcall (cdr f))
-         ))
+           (funcall (cdr f))))
     (let ((point
           (or (previous-single-property-change (point) 'mime-view-entity)
               (point-min)))
@@ -1693,22 +1579,19 @@ If reached to (point-min), it calls function registered in variable
        (condition-case nil
            (scroll-down h)
          (beginning-of-buffer
-          (goto-char (point-min)))))
-      )))
+          (goto-char (point-min))))))))
 
 (defun mime-preview-next-line-entity (&optional lines)
   "Scroll up one line (or prefix LINES lines).
 If LINES is negative, scroll down LINES lines."
   (interactive "p")
-  (mime-preview-scroll-up-entity (or lines 1))
-  )
+  (mime-preview-scroll-up-entity (or lines 1)))
 
 (defun mime-preview-previous-line-entity (&optional lines)
   "Scrroll down one line (or prefix LINES lines).
 If LINES is negative, scroll up LINES lines."
   (interactive "p")
-  (mime-preview-scroll-down-entity (or lines 1))
-  )
+  (mime-preview-scroll-down-entity (or lines 1)))
 
 
 ;;; @@ display
@@ -1780,13 +1663,11 @@ It calls function registered in variable
   (let ((r (assq (mime-preview-original-major-mode)
                 mime-preview-quitting-method-alist)))
     (if r
-       (funcall (cdr r))
-      )))
+       (funcall (cdr r)))))
 
 (defun mime-preview-kill-buffer ()
   (interactive)
-  (kill-buffer (current-buffer))
-  )
+  (kill-buffer (current-buffer)))
 
 
 ;;; @ end
index abdd1ed..dbae683 100644 (file)
@@ -36,6 +36,7 @@
 (autoload 'mule-caesar-region "mule-caesar"
   "Caesar rotation of current region." t)
 
+(autoload 'widget-convert-button "wid-edit")
 
 ;;; @ constants
 ;;;
 ;;; @ button
 ;;;
 
-(defcustom mime-button-face 'bold
-  "Face used for content-button or URL-button of MIME-Preview buffer."
-  :group 'mime
-  :type 'face)
-
-(defcustom mime-button-mouse-face 'highlight
-  "Face used for MIME-preview buffer mouse highlighting."
-  :group 'mime
-  :type 'face)
-
-(defsubst mime-add-button (from to function &optional data)
-  "Create a button between FROM and TO with callback FUNCTION and DATA."
-  (and mime-button-face
-       (put-text-property from to 'face mime-button-face))
-  (and mime-button-mouse-face
-       (put-text-property from to 'mouse-face mime-button-mouse-face))
-  (put-text-property from to 'mime-button-callback function)
-  (and data
-       (put-text-property from to 'mime-button-data data))
-  )
+(define-widget 'mime-button 'push-button
+  "Widget for MIME button."
+  :action 'mime-button-action)
 
+(defun mime-button-action (widget &optional event)
+  (let ((function (widget-get widget :mime-callback))
+       (data (widget-get widget :mime-data)))
+    (when function
+      (funcall function data))))
+    
 (defsubst mime-insert-button (string function &optional data)
   "Insert STRING as button with callback FUNCTION and DATA."
-  (save-restriction
-    (narrow-to-region (point)(point))
-    (insert (concat "[" string "]\n"))
-    (mime-add-button (point-min)(point-max) function data)
-    ))
-
-(defvar mime-button-mother-dispatcher nil)
-
-(defun mime-button-dispatcher (event)
-  "Select the button under point."
-  (interactive "e")
-  (let (buf point func data)
-    (save-window-excursion
-      (mouse-set-point event)
-      (setq buf (current-buffer)
-           point (point)
-           func (get-text-property (point) 'mime-button-callback)
-           data (get-text-property (point) 'mime-button-data)
-           ))
-    (save-excursion
-      (set-buffer buf)
-      (goto-char point)
-      (if func
-         (apply func data)
-       (if (fboundp mime-button-mother-dispatcher)
-           (funcall mime-button-mother-dispatcher event)
-         )))))
+  (widget-create 'mime-button :mime-callback function :mime-data data string)
+  (insert "\n"))
 
 
 ;;; @ for URL
   "Add URL-buttons for text body."
   (goto-char (point-min))
   (while (re-search-forward mime-browse-url-regexp nil t)
-    (let ((beg (match-beginning 0))
-         (end (match-end 0)))
-      (mime-add-button beg end mime-browse-url-function
-                      (list (buffer-substring beg end))))))
+    (widget-convert-button 'url-link (match-beginning 0)(match-end 0)
+                          (match-string-no-properties 0))))
 
 
 ;;; @ menu
                               (vector (car cell)
                                       `(progn
                                          (setq ret ',(cdr cell))
-                                         (throw 'exit nil)
-                                         )
-                                      t)
-                              ))
-                           menu-alist)
-                   ))
+                                         (throw 'exit nil))
+                                      t)))
+                           menu-alist)))
            (recursive-edit)
            ret))
       (defun select-menu-alist (title menu-alist)
        (x-popup-menu
         (list '(1 1) (selected-window))
-        (list title (cons title menu-alist))
-        ))
-      )
+        (list title (cons title menu-alist)))))
   (defun select-menu-alist (title menu-alist)
     (cdr
      (assoc (completing-read (concat title " : ") menu-alist)
-           menu-alist)
-     ))
-  )
+           menu-alist))))
 
 
 ;;; @ Other Utility
@@ -193,13 +149,9 @@ activate."
                (funcall func sym condition)
                (if file
                    (let ((method (cdr (assq 'method condition))))
-                     (autoload method file)
-                     ))
-               )
-           (error "Function for mode `%s' is not found." mode)
-           ))
-      (error "Variable for target-type `%s' is not found." target-type)
-      )))
+                     (autoload method file))))
+           (error "Function for mode `%s' is not found." mode)))
+      (error "Variable for target-type `%s' is not found." target-type))))
 
 
 ;;; @ end