Mercurial > emacs
diff lisp/wid-edit.el @ 18451:8eb08560287b
Synched with 1.9936.
author | Per Abrahamsen <abraham@dina.kvl.dk> |
---|---|
date | Wed, 25 Jun 1997 15:30:27 +0000 |
parents | 947c1b6ea8de |
children | 35976f73432d |
line wrap: on
line diff
--- a/lisp/wid-edit.el Wed Jun 25 07:27:44 1997 +0000 +++ b/lisp/wid-edit.el Wed Jun 25 15:30:27 1997 +0000 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: extensions -;; Version: 1.9929 +;; Version: 1.9936 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;; This file is part of GNU Emacs. @@ -335,6 +335,17 @@ :type 'boolean :group 'widgets) +(defcustom widget-field-use-before-change + (or (> emacs-minor-version 34) + (> emacs-major-version 20) + (string-match "XEmacs" emacs-version)) + "Non-nil means use `before-change-functions' to track editable fields. +This enables the use of undo, but doesn'f work on Emacs 19.34 and earlier. +Using before hooks also means that the :notify function can't know the +new value." + :type 'boolean + :group 'widgets) + (defun widget-specify-field (widget from to) "Specify editable button for WIDGET between FROM and TO." (put-text-property from to 'read-only nil) @@ -691,14 +702,15 @@ "In WIDGET, insert GLYPH. If optional arguments DOWN and INACTIVE are given, they should be glyphs used when the widget is pushed and inactive, respectively." - (set-glyph-property glyph 'widget widget) - (when down - (set-glyph-property down 'widget widget)) - (when inactive - (set-glyph-property inactive 'widget widget)) + (when widget + (set-glyph-property glyph 'widget widget) + (when down + (set-glyph-property down 'widget widget)) + (when inactive + (set-glyph-property inactive 'widget widget))) (insert "*") (let ((ext (make-extent (point) (1- (point)))) - (help-echo (widget-get widget :help-echo))) + (help-echo (and widget (widget-get widget :help-echo)))) (set-extent-property ext 'invisible t) (set-extent-property ext 'start-open t) (set-extent-property ext 'end-open t) @@ -706,9 +718,10 @@ (when help-echo (set-extent-property ext 'balloon-help help-echo) (set-extent-property ext 'help-echo help-echo))) - (widget-put widget :glyph-up glyph) - (when down (widget-put widget :glyph-down down)) - (when inactive (widget-put widget :glyph-inactive inactive))) + (when widget + (widget-put widget :glyph-up glyph) + (when down (widget-put widget :glyph-down down)) + (when inactive (widget-put widget :glyph-inactive inactive)))) ;;; Buttons. @@ -979,24 +992,25 @@ (widget-apply-action button event))) (overlay-put overlay 'face face) (overlay-put overlay 'mouse-face mouse-face))) - (let (command up) + (let ((up t) + command) ;; Find the global command to run, and check whether it ;; is bound to an up event. (cond ((setq command ;down event - (lookup-key widget-global-map [ button2 ]))) + (lookup-key widget-global-map [ button2 ])) + (setq up nil)) ((setq command ;down event - (lookup-key widget-global-map [ down-mouse-2 ]))) - ((setq command ;up event - (lookup-key widget-global-map [ button2up ])) - (setq up t)) + (lookup-key widget-global-map [ down-mouse-2 ])) + (setq up nil)) ((setq command ;up event - (lookup-key widget-global-map [ mouse-2])) - (setq up t))) - (when command + (lookup-key widget-global-map [ button2up ]))) + ((setq command ;up event + (lookup-key widget-global-map [ mouse-2])))) + (when up ;; Don't execute up events twice. - (when up - (while (not (button-release-event-p event)) - (setq event (widget-read-event)))) + (while (not (button-release-event-p event)) + (setq event (widget-read-event)))) + (when command (call-interactively command)))))) (t (message "You clicked somewhere weird.")))) @@ -1188,11 +1202,12 @@ (widget-clear-undo) ;; We need to maintain text properties and size of the editing fields. (make-local-variable 'after-change-functions) - (make-local-variable 'before-change-functions) (setq after-change-functions (if widget-field-list '(widget-after-change) nil)) - (setq before-change-functions - (if widget-field-list '(widget-before-change) nil))) + (when widget-field-use-before-change + (make-local-variable 'before-change-functions) + (setq before-change-functions + (if widget-field-list '(widget-before-change) nil)))) (defvar widget-field-last nil) ;; Last field containing point. @@ -1665,30 +1680,33 @@ ;; Insert text representing the `on' and `off' states. (let* ((tag (or (widget-get widget :tag) (widget-get widget :value))) + (tag-glyph (widget-get widget :tag-glyph)) (text (concat widget-push-button-prefix tag widget-push-button-suffix)) (gui (cdr (assoc tag widget-push-button-cache)))) - (if (and (fboundp 'make-gui-button) + (cond (tag-glyph + (widget-glyph-insert widget text tag-glyph)) + ((and (fboundp 'make-gui-button) (fboundp 'make-glyph) widget-push-button-gui (fboundp 'device-on-window-system-p) (device-on-window-system-p) (string-match "XEmacs" emacs-version)) - (progn - (unless gui - (setq gui (make-gui-button tag 'widget-gui-action widget)) - (push (cons tag gui) widget-push-button-cache)) - (widget-glyph-insert-glyph widget - (make-glyph - (list (nth 0 (aref gui 1)) - (vector 'string ':data text))) - (make-glyph - (list (nth 1 (aref gui 1)) - (vector 'string ':data text))) - (make-glyph - (list (nth 2 (aref gui 1)) - (vector 'string ':data text))))) - (insert text)))) + (unless gui + (setq gui (make-gui-button tag 'widget-gui-action widget)) + (push (cons tag gui) widget-push-button-cache)) + (widget-glyph-insert-glyph widget + (make-glyph + (list (nth 0 (aref gui 1)) + (vector 'string ':data text))) + (make-glyph + (list (nth 1 (aref gui 1)) + (vector 'string ':data text))) + (make-glyph + (list (nth 2 (aref gui 1)) + (vector 'string ':data text))))) + (t + (insert text))))) (defun widget-gui-action (widget) "Apply :action for WIDGET."