From: yamaoka Date: Tue, 9 Nov 1999 12:56:59 +0000 (+0000) Subject: (mime-insert-button): Simplify. X-Git-Tag: wemi-1_13-last-~11 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=9b8f6f7569e44ea1de32bfef8edd1373d670fd84;p=elisp%2Fsemi.git (mime-insert-button): Simplify. (mime-create-button-function): To share the customizing widget. (mime-create-xpm-button): Replace with `mime-create-widget-button' if the feature `xpm' is not provided and TTY frame is used; add doc string. (mime-create-widget-button): Add doc string. --- diff --git a/ChangeLog b/ChangeLog index 8e2c38b..1d2a161 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,12 @@ +1999-11-09 Katsumi Yamaoka + + * semi-def.el (mime-insert-button): Simplify. + (mime-create-button-function): To share the customizing widget. + (mime-create-xpm-button): Replace with `mime-create-widget-button' + if the feature `xpm' is not provided and TTY frame is used; add + doc string. + (mime-create-widget-button): Add doc string. + 1999-11-05 Katsumi Yamaoka * semi-def.el (mime-insert-button): Don't use xpm buttons under TTY. diff --git a/semi-def.el b/semi-def.el index ec2d69e..d81f3a3 100644 --- a/semi-def.el +++ b/semi-def.el @@ -53,6 +53,10 @@ ;;; (defun mime-create-widget-button (string function) + "Display STRING as a widget button with the callback FUNCTION. +Under XEmacs, the function `mime-create-xpm-button' might be identical +to the function `mime-create-widget-button' if the feature `xpm' is not +provided and TTY frame is used." (let ((start (point))) (widget-create 'push-button @@ -68,16 +72,16 @@ (goto-char point) (,function)))) string) - (static-if (featurep 'xemacs) - (let ((end (point)) - extent) - (insert "[" string "]") - (while (setq extent (extent-at start nil nil extent)) - (set-extent-endpoints extent end (point))) - (delete-region start end)))) + (static-when (featurep 'xemacs) + (let ((end (point)) + extent) + (insert "[" string "]") + (while (setq extent (extent-at start nil nil extent)) + (set-extent-endpoints extent end (point))) + (delete-region start end)))) (insert "\n")) -(static-when (and (featurep 'xemacs) (featurep 'xpm)) +(static-when (featurep 'xemacs) (defcustom mime-xpm-button-shadow-thickness 3 "A number of pixels should be used for the shadows on the edges of the buttons." @@ -96,55 +100,63 @@ the buttons." (defvar mime-xpm-button-glyph-cache nil) - (defun mime-create-xpm-button (string function) - (set-extent-properties (make-extent (point) - (progn - (insert "[" string "]") - (point))) - '(invisible t intangible t)) - (let* ((spec (list string - mime-xpm-button-shadow-thickness - mime-xpm-button-foreground - mime-xpm-button-background)) - (button (cdr (assoc spec mime-xpm-button-glyph-cache)))) - (or button - (set-alist 'mime-xpm-button-glyph-cache spec - (setq button (apply (function xpm-button-create) - spec)))) - (let* ((extent (make-extent (point) (point))) - (down-glyph (make-glyph (car (cdr button)))) - (up-glyph (make-glyph (car button))) - (down-func `(lambda (event) - (interactive "e") - (set-extent-begin-glyph ,extent ,down-glyph))) - (up-func `(lambda (event) - (interactive "e") - (mouse-set-point event) - (set-extent-begin-glyph ,extent ,up-glyph) - (,function))) - (keymap (make-sparse-keymap))) - (define-key keymap 'button1 down-func) - (define-key keymap 'button2 down-func) - (define-key keymap 'button1up up-func) - (define-key keymap 'button2up up-func) - (set-extent-begin-glyph extent up-glyph) - (set-extent-property extent 'keymap keymap)) - (insert "\n"))) + (if (and (featurep 'xpm) (device-on-window-system-p)) + (defun mime-create-xpm-button (string function) + "Display STRING as a XPM button with the callback FUNCTION. +It might be identical to the function `mime-create-widget-button' +if the feature `xpm' is not provided and TTY frame is used." + (set-extent-properties (make-extent (point) + (progn + (insert "[" string "]") + (point))) + '(invisible t intangible t)) + (let* ((spec (list string + mime-xpm-button-shadow-thickness + mime-xpm-button-foreground + mime-xpm-button-background)) + (button (cdr (assoc spec mime-xpm-button-glyph-cache)))) + (or button + (set-alist 'mime-xpm-button-glyph-cache spec + (setq button (apply (function xpm-button-create) + spec)))) + (let* ((extent (make-extent (point) (point))) + (down-glyph (make-glyph (car (cdr button)))) + (up-glyph (make-glyph (car button))) + (down-func `(lambda (event) + (interactive "e") + (set-extent-begin-glyph ,extent ,down-glyph))) + (up-func `(lambda (event) + (interactive "e") + (mouse-set-point event) + (set-extent-begin-glyph ,extent ,up-glyph) + (,function))) + (keymap (make-sparse-keymap))) + (define-key keymap 'button1 down-func) + (define-key keymap 'button2 down-func) + (define-key keymap 'button1up up-func) + (define-key keymap 'button2up up-func) + (set-extent-begin-glyph extent up-glyph) + (set-extent-property extent 'keymap keymap)) + (insert "\n"))) + (fset 'mime-create-xpm-button 'mime-create-widget-button)) ) -(static-if (and (featurep 'xemacs) (featurep 'xpm)) - (defcustom mime-create-button-function 'mime-create-widget-button - "A function called to create the content button." - :group 'mime - :type '(radio (const :tag "Widget button" mime-create-widget-button) - (const :tag "Xpm button" mime-create-xpm-button) - (function :tag "Other"))) - (defcustom mime-create-button-function 'mime-create-widget-button - "A function called to create the content button." - :group 'mime - :type '(radio (const :tag "Widget button" mime-create-widget-button) - (function :tag "Other"))) - ) +(defcustom mime-create-button-function 'mime-create-widget-button + "A function called to create the content button." + :group 'mime + :type (list + 'cons + :convert-widget + (function + (lambda (widget) + (list + 'radio + :args + (append + '((const :tag "Widget button" mime-create-widget-button)) + (static-when (featurep 'xemacs) + '((const :tag "Xpm button" mime-create-xpm-button))) + '((function :tag "Other")))))))) (defsubst mime-insert-button (string function &optional data) "Insert STRING as button with callback FUNCTION and DATA." @@ -152,13 +164,7 @@ the buttons." (narrow-to-region (point) (point)) (mapcar (function (lambda (line) - (static-if (featurep 'xemacs) - (if (and (not (device-on-window-system-p)) - (eq 'mime-create-xpm-button - mime-create-button-function)) - (mime-create-widget-button line function) - (funcall mime-create-button-function line function)) - (funcall mime-create-button-function line function)))) + (funcall mime-create-button-function line function))) (split-string string "\n")))) (defvar mime-button-mother-dispatcher nil)