# HG changeset patch # User Richard M. Stallman # Date 891498806 0 # Node ID 901472ec6f29bcd988fa797a40dce61d06ef53ac # Parent e78bc1ffd88d7ac5139bac5455dab107b1076913 Delete some compatibility code. (widget-event-point, widget-read-event): Define unconditionally. (widget-echo-help-mouse): Don't use window-end. (widget-choice-value-create): If there is an :explicit-choice, respect it. (widget-choice-action): Record an explicit choice in :explicit-choice. diff -r e78bc1ffd88d -r 901472ec6f29 lisp/wid-edit.el --- a/lisp/wid-edit.el Thu Apr 02 05:04:20 1998 +0000 +++ b/lisp/wid-edit.el Thu Apr 02 06:33:26 1998 +0000 @@ -34,31 +34,18 @@ (eval-when-compile (require 'cl)) ;;; Compatibility. + +(defun widget-event-point (event) + "Character position of the end of event if that exists, or nil." + (posn-point (event-end event)))) + +(defalias 'widget-read-event 'read-event) (eval-and-compile (autoload 'pp-to-string "pp") (autoload 'Info-goto-node "info") (autoload 'finder-commentary "finder" nil t) - (when (string-match "XEmacs" emacs-version) - (condition-case nil - (require 'overlay) - (error (load-library "x-overlay")))) - - (if (string-match "XEmacs" emacs-version) - (defun widget-event-point (event) - "Character position of the end of event if that exists, or nil." - (if (mouse-event-p event) - (event-point event) - nil)) - (defun widget-event-point (event) - "Character position of the end of event if that exists, or nil." - (posn-point (event-end event)))) - - (defalias 'widget-read-event (if (string-match "XEmacs" emacs-version) - 'next-event - 'read-event)) - (unless (and (featurep 'custom) (fboundp 'custom-declare-variable)) ;; We have the old custom-library, hack around it! (defmacro defgroup (&rest args) nil) @@ -78,24 +65,7 @@ (and (eventp event) (memq (event-basic-type event) '(mouse-1 mouse-2 mouse-3)) (or (memq 'click (event-modifiers event)) - (memq 'drag (event-modifiers event)))))) - - (unless (fboundp 'functionp) - ;; Missing from Emacs 19.34 and earlier. - (defun functionp (object) - "Non-nil of OBJECT is a type of object that can be called as a function." - (or (subrp object) (byte-code-function-p object) - (eq (car-safe object) 'lambda) - (and (symbolp object) (fboundp object))))) - - (unless (fboundp 'error-message-string) - ;; Emacs function missing in XEmacs. - (defun error-message-string (obj) - "Convert an error value to an error message." - (let ((buf (get-buffer-create " *error-message*"))) - (erase-buffer buf) - (display-error obj buf) - (buffer-string buf))))) + (memq 'drag (event-modifiers event))))))) ;;; Customization. @@ -1965,21 +1935,30 @@ ;; Insert the first choice that matches the value. (let ((value (widget-get widget :value)) (args (widget-get widget :args)) + (explicit (widget-get widget :explicit-choice)) + (explicit-value (widget-get widget :explicit-choice-value)) current) - (while args - (setq current (car args) - args (cdr args)) - (when (widget-apply current :match value) - (widget-put widget :children (list (widget-create-child-value - widget current value))) - (widget-put widget :choice current) - (setq args nil - current nil))) - (when current - (let ((void (widget-get widget :void))) - (widget-put widget :children (list (widget-create-child-and-convert - widget void :value value))) - (widget-put widget :choice void))))) + (if (and explicit (eq value explicit-value)) + (progn + ;; If the user specified the choice for this value, + ;; respect that choice as long as the value is the same. + (widget-put widget :children (list (widget-create-child-value + widget explicit value))) + (widget-put widget :choice explicit)) + (while args + (setq current (car args) + args (cdr args)) + (when (widget-apply current :match value) + (widget-put widget :children (list (widget-create-child-value + widget current value))) + (widget-put widget :choice current) + (setq args nil + current nil))) + (when current + (let ((void (widget-get widget :void))) + (widget-put widget :children (list (widget-create-child-and-convert + widget void :value value))) + (widget-put widget :choice void)))))) (defun widget-choice-value-get (widget) ;; Get value of the child widget. @@ -2028,6 +2007,7 @@ (old (widget-get widget :choice)) (tag (widget-apply widget :menu-tag-get)) (completion-ignore-case (widget-get widget :case-fold)) + this-explicit current choices) ;; Remember old value. (if (and old (not (widget-apply widget :validate))) @@ -2054,8 +2034,16 @@ (cons (cons (widget-apply current :menu-tag-get) current) choices))) + (setq this-explicit t) (widget-choose tag (reverse choices) event)))) (when current + ;; If this was an explicit user choice, + ;; record the choice, and the record the value it was made for. + ;; widget-choice-value-create will respect this choice, + ;; as long as the value is the same. + (when this-explicit + (widget-put widget :explicit-choice current) + (widget-put widget :explicit-choice-value (widget-get widget :value))) (widget-value-set widget (widget-apply current :value-to-external (widget-get current :value))) @@ -3025,7 +3013,7 @@ "History of input to `widget-symbol-prompt-value'.") (define-widget 'symbol 'editable-field - "A lisp symbol." + "A Lisp symbol." :value nil :tag "Symbol" :format "%{%t%}: %v" @@ -3057,7 +3045,7 @@ "History of input to `widget-function-prompt-value'.") (define-widget 'function 'sexp - "A lisp function." + "A Lisp function." :complete-function 'lisp-complete-symbol :prompt-value 'widget-field-prompt-value :prompt-internal 'widget-symbol-prompt-internal @@ -3454,7 +3442,7 @@ (select-window win) (let* ((result (compute-motion (window-start win) '(0 . 0) - (window-end win) + (point-max) where (window-width win) (cons (window-hscroll) 0)