Mercurial > hg > xemacs-beta
diff lisp/gui.el @ 412:697ef44129c6 r21-2-14
Import from CVS: tag r21-2-14
author | cvs |
---|---|
date | Mon, 13 Aug 2007 11:20:41 +0200 |
parents | 74fd4e045ea6 |
children | 95016f13131a |
line wrap: on
line diff
--- a/lisp/gui.el Mon Aug 13 11:19:22 2007 +0200 +++ b/lisp/gui.el Mon Aug 13 11:20:41 2007 +0200 @@ -64,7 +64,6 @@ menubar-visible-p nil has-modeline-p nil default-toolbar-visible-p nil - default-gutter-visible-p nil modeline-shadow-thickness 0 left ,(+ fleft (- (/ fwidth 2) (/ (* dfwidth fontw) @@ -83,7 +82,7 @@ "True if OBJECT is a GUI button." (and (vectorp object) (> (length object) 0) - (eq 'button (aref object 0)))) + (eq 'gui-button (aref object 0)))) (make-face 'gui-button-face "Face used for gui buttons") (if (not (face-differs-from-default-p 'gui-button-face)) @@ -98,15 +97,26 @@ "Make a GUI button whose label is STRING and whose action is ACTION. If the button is inserted in a buffer and then clicked on, and ACTION is non-nil, ACTION will be called with one argument, USER-DATA." - (vector 'button - :descriptor string - :face 'gui-button-face - :callback `(funcall (quote ,action) (quote ,user-data)))) + (vector 'gui-button + (if (featurep 'xpm) + (xpm-button-create + string gui-button-shadow-thickness + (color-instance-name (face-foreground-instance 'gui-button-face)) + (color-instance-name (face-background-instance 'gui-button-face))) + (xbm-button-create string gui-button-shadow-thickness)) + action user-data)) (defun insert-gui-button (button &optional pos buffer) "Insert GUI button BUTTON at POS in BUFFER." (check-argument-type 'gui-button-p button) - (make-annotation (make-glyph button) - pos 'text buffer nil)) + (let ((annotation + (make-annotation (make-glyph (car (aref button 1))) + pos 'text buffer nil + (make-glyph (cadr (aref button 1))))) + (action (aref button 2))) + (and action + (progn + (set-annotation-action annotation action) + (set-annotation-data annotation (aref button 3)))))) ;;; gui.el ends here