xemacs-beta: lisp/wid-edit.el comparison

comparison lisp/wid-edit.el @ 1173:315720febed1

[xemacs-hg @ 2002-12-26 15:52:41 by stephent] synch GNUisances <87el84sru1.fsf@tleepslib.sk.tsukuba.ac.jp>

author	stephent
date	Thu, 26 Dec 2002 15:52:43 +0000
parents	79940b592197
children	00abb1091204

comparison

equal deleted inserted replaced

-:1ea662584c01
+:315720febed1
 "Faces used by the widget library."
 :group 'widgets
 :group 'faces)
 (defvar widget-documentation-face 'widget-documentation-face
-"Face used for documentation strings in widges.
+"Face used for documentation strings in widgets.
 This exists as a variable so it can be set locally in certain buffers.")
 (defface widget-documentation-face '((((class color)
 				       (background dark))
 				      (:foreground "lime green"))
 "Face used for documentation text."
 :group 'widget-documentation
 :group 'widget-faces)
 (defvar widget-button-face 'widget-button-face
-"Face used for buttons in widges.
+"Face used for buttons in widgets.
 This exists as a variable so it can be set locally in certain buffers.")
 (defface widget-button-face '((t (:bold t)))
 "Face used for widget buttons."
 :group 'widget-faces)
 (defun widget-choose (title items &optional event)
 "Choose an item from a list.
 First argument TITLE is the name of the list.
-Second argument ITEMS is an list whose members are either
+Second argument ITEMS is a list whose members are either
 (NAME . VALUE), to indicate selectable items, or just strings to
 indicate unselectable items.
 Optional third argument EVENT is an input event.
 The user is asked to choose between each NAME from the items alist,
 "Specify editable button for WIDGET between FROM and TO."
 (save-excursion
 (goto-char to)
 (cond ((null (widget-get widget :size))
 	   (forward-char 1))
+	  ;; #### This comment goes outside of the save-excursion in GNU
 	  ;; Terminating space is not part of the field, but necessary in
 	  ;; order for local-map to work.  Remove next sexp if local-map works
 	  ;; at the end of the extent.
 	  (widget-field-add-space
 	   (insert-and-inherit " ")))
 (let ((secret (widget-get field :secret))
 	(size (widget-get field :size)))
 (when secret
 (let ((begin (widget-field-start field))
 	    (end (widget-field-end field)))
 	(when size
 	  (while (and (> end begin)
 		      (eq (char-after (1- end)) ?\ ))
 	    (setq end (1- end))))
 	(while (< begin end)
 	  (let ((old (char-after begin)))
 (set-extent-property extent 'widget-doc widget)
 (set-extent-property extent 'face widget-documentation-face)
 (widget-put widget :doc-extent extent)))
 (defmacro widget-specify-insert (&rest form)
-;; Execute FORM without inheriting any text properties.
+"Execute FORM without inheriting any text properties."
 `(save-restriction
 (let ((inhibit-read-only t)
 	   before-change-functions
 	   after-change-functions)
 (insert "<>")
 (narrow-to-region (- (point) 2) (point))
 (goto-char (1+ (point-min)))
-;; We use `prog1' instead of a `result' variable, as the latter
+;; XEmacs: use `prog1' instead of a `result' variable.  The latter
 ;; confuses the byte-compiler in some cases (a warning).
 (prog1 (progn ,@form)
 	 (delete-region (point-min) (1+ (point-min)))
 	 (delete-region (1- (point-max)) (point-max))
 	 (goto-char (point-max))))))
 (if (symbolp value)
 	(symbol-value value)
 value)))
 (defun widget-member (widget property)
-"Return t if there is a definition in WIDGET for PROPERTY."
+"Non-nil iff there is a definition in WIDGET for PROPERTY."
 (cond ((widget-plist-member (cdr widget) property)
 	 t)
 	((car widget)
 	 (widget-member (get (car widget) 'widget-type) property))
 	(t nil)))
 		      :value (widget-apply widget :value-to-internal value))))
 ;; Return the newly created widget.
 widget))
 (defun widget-insert (&rest args)
-"Call `insert' with ARGS and make the text read only."
+"Call `insert' with ARGS even if surrounding text is read only."
 (let ((inhibit-read-only t)
 	before-change-functions
 	after-change-functions)
 (apply 'insert args)))
 ;;; Keymap and Commands.
 (defvar widget-keymap nil
-"Keymap containing useful binding for buffers containing widgets.
+"Keymap containing useful bindings for buffers containing widgets.
 Recommended as a parent keymap for modes using widgets.")
 (unless widget-keymap
 (setq widget-keymap (make-sparse-keymap))
 (define-key widget-keymap [tab] 'widget-forward)
 (define-key widget-keymap [(shift tab)] 'widget-backward)
 (define-key widget-keymap [(meta tab)] 'widget-backward)
 (define-key widget-keymap [backtab] 'widget-backward))
 (defvar widget-global-map global-map
-"Keymap used for events the widget does not handle themselves.")
+"Keymap used for events a widget does not handle itself.")
 (make-variable-buffer-local 'widget-global-map)
 (defvar widget-field-keymap nil
 "Keymap used inside an editable field.")
 "Character position of the mouse event, or nil."
 (and (mouse-event-p event)
 (event-point event)))
 (defun widget-button-click (event)
-"Invoke button below mouse pointer."
+"Invoke button under mouse pointer."
 (interactive "e")
 (with-current-buffer (event-buffer event)
 (cond ((event-glyph event)
 	   (widget-glyph-click event))
 	  ((widget-event-point event)
 (defun widget-default-sample-face-get (widget)
 ;; Use :sample-face.
 (widget-get widget :sample-face))
 (defun widget-default-delete (widget)
-;; Remove widget from the buffer.
+"Remove widget from the buffer."
 (let ((from (widget-get widget :from))
 	(to (widget-get widget :to))
 	(inactive-extent (widget-get widget :inactive))
 	(button-extent (widget-get widget :button-extent))
 	(sample-extent (widget-get widget :sample-extent))
 (set-marker from nil)
 (set-marker to nil))
 (widget-clear-undo))
 (defun widget-default-value-set (widget value)
-;; Recreate widget with new value.
+"Recreate widget with new value."
 (let* ((old-pos (point))
 	 (from (copy-marker (widget-get widget :from)))
 	 (to (copy-marker (widget-get widget :to)))
 	 (offset (if (and (<= from old-pos) (<= old-pos to))
 		     (if (>= old-pos (1- to))
 (if (< offset 0)
 	  (goto-char (+ (widget-get widget :to) offset 1))
 	(goto-char (min (+ from offset) (1- (widget-get widget :to))))))))
 (defun widget-default-value-inline (widget)
-;; Wrap value in a list unless it is inline.
+"Wrap value in a list unless it is inline."
 (if (widget-get widget :inline)
 (widget-value widget)
 (list (widget-value widget))))
 (defun widget-default-default-get (widget)
-;; Get `:value'.
+"Get `:value'."
 (widget-get widget :value))
 (defun widget-default-menu-tag-get (widget)
-;; Use tag or value for menus.
+"Use tag or value for menus."
 (or (widget-get widget :menu-tag)
 (widget-get widget :tag)
 (widget-princ-to-string (widget-get widget :value))))
 (defun widget-default-active (widget)
 (widget-specify-inactive widget
 			   (widget-get widget :from)
 			   (widget-get widget :to)))
 (defun widget-default-action (widget &optional event)
-;; Notify the parent when a widget change
+"Notify the parent when a widget changes."
 (let ((parent (widget-get widget :parent)))
 (when parent
 (widget-apply parent :notify widget event))))
 (defun widget-default-notify (widget child &optional event)
-;; Pass notification to parent.
+"Pass notification to parent."
 (widget-default-action widget event))
 (defun widget-default-prompt-value (widget prompt value unbound)
-;; Read an arbitrary value.  Stolen from `set-variable'.
+"Read an arbitrary value.  Stolen from `set-variable'."
-;;  (let ((initial (if unbound
+;; (let ((initial (if unbound
-;;		     nil
+;; nil
-;;		   ;; It would be nice if we could do a `(cons val 1)' here.
+;; It would be nice if we could do a `(cons val 1)' here.
-;;		   (prin1-to-string (custom-quote value))))))
+;; (prin1-to-string (custom-quote value))))))
-(eval-minibuffer prompt ))
+(eval-minibuffer prompt))
 ;;; The `item' Widget.
 (define-widget 'item 'default
 "Constant items for inclusion in other widgets."
 :match-inline 'widget-item-match-inline
 :action 'widget-item-action
 :format "%t\n")
 (defun widget-item-value-create (widget)
-;; Insert the printed representation of the value.
+"Insert the printed representation of the value."
 (let ((standard-output (current-buffer)))
 (princ (widget-get widget :value))))
 (defun widget-item-match (widget value)
 ;; Match if the value is the same.
 :button-suffix ""
 :value-create 'widget-push-button-value-create
 :format "%[%v%]")
 (defun widget-push-button-value-create (widget)
-;; Insert text representing the `on' and `off' states.
+"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))
 (define-widget 'link 'item
 "An embedded link."
 :button-prefix 'widget-link-prefix
 :button-suffix 'widget-link-suffix
-:help-echo "Follow the link"
+:help-echo "Follow the link."
 :format "%[%t%]")
 ;;; The `info-link' Widget.
 (define-widget 'info-link 'link
 (defun widget-url-link-action (widget &optional event)
 "Open the url specified by WIDGET."
 (if-fboundp 'browse-url
 (browse-url (widget-value widget))
+;; #### Should subclass a 'missing-package error.
 (error 'unimplemented "No `browse-url' package; cannot follow URLs in this XEmacs")))
 ;;; The `function-link' Widget.
 (define-widget 'function-link 'link
 (defvar widget-field-history nil
 "History of field minibuffer edits.")
 (defun widget-field-prompt-internal (widget prompt initial history)
-;; Read string for WIDGET prompting with PROMPT.
+"Read string for WIDGET prompting with PROMPT.
-;; INITIAL is the initial input and HISTORY is a symbol containing
+INITIAL is the initial input and HISTORY is a symbol containing
-;; the earlier input.
+the earlier input."
 (read-string prompt initial history))
 (defun widget-field-prompt-value (widget prompt value unbound)
-;; Prompt for a string.
+"Prompt for a string."
 (let ((initial (if unbound
 		     nil
 		   (cons (widget-apply widget :value-to-internal
 				       value) 0)))
 	(history (widget-get widget :prompt-history)))
 ;  ;; Move to next field.
 ;  (widget-forward 1)
 ;  (run-hook-with-args 'widget-edit-functions widget))
 (defun widget-field-validate (widget)
-;; Valid if the content matches `:valid-regexp'.
+"Valid if the content matches `:valid-regexp'."
 (save-excursion
 (let ((value (widget-apply widget :value-get))
 	  (regexp (widget-get widget :valid-regexp)))
 (if (string-match regexp value)
 	  nil
 	widget))))
 (defun widget-field-value-create (widget)
-;; Create an editable text field.
+"Create an editable text field."
 (let ((size (widget-get widget :size))
 	(value (widget-get widget :value))
 	(from (point))
 	;; This is changed to a real extent in `widget-setup'.  We
 	;; need the end points to behave differently until
 (insert ?\n))
 (move-marker (car extent) from)
 (set-marker-insertion-type (car extent) t)))
 (defun widget-field-value-delete (widget)
-;; Remove the widget from the list of active editing fields.
+"Remove the widget from the list of active editing fields."
 (setq widget-field-list (delq widget widget-field-list))
 ;; These are nil if the :format string doesn't contain `%v'.
 (let ((extent (widget-get widget :field-extent)))
 (when extent
 (detach-extent extent))))
 (defun widget-field-value-get (widget)
-;; Return current text in editing field.
+"Return current text in editing field."
 (let ((from (widget-field-start widget))
 	(to (widget-field-end widget))
 	(buffer (widget-field-buffer widget))
 	(size (widget-get widget :size))
 	(secret (widget-get widget :secret))
 :validate 'widget-choice-validate
 :match 'widget-choice-match
 :match-inline 'widget-choice-match-inline)
 (defun widget-choice-value-create (widget)
-;; Insert the first choice that matches the value.
+"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))
 	current)
 (if explicit
 	(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)
 :match (lambda (widget value) t)
 :on "on"
 :off "off")
 (defun widget-toggle-value-create (widget)
-;; Insert text representing the `on' and `off' states.
+"Insert text representing the `on' and `off' states."
 (if (widget-value widget)
 (widget-glyph-insert widget
 			   (widget-get widget :on)
 			   (widget-get widget :on-glyph))
 (widget-glyph-insert widget
 (widget-checklist-add-item widget (car args) (assq (car args) alist))
 (setq args (cdr args)))
 (widget-put widget :children (nreverse (widget-get widget :children)))))
 (defun widget-checklist-add-item (widget type chosen)
-;; Create checklist item in WIDGET of type TYPE.
+"Create checklist item in WIDGET of type TYPE.
-;; If the item is checked, CHOSEN is a cons whose cdr is the value.
+If the item is checked, CHOSEN is a cons whose cdr is the value."
 (and (eq (preceding-char) ?\n)
 (widget-get widget :indent)
 (insert-char ?\  (widget-get widget :indent)))
 (widget-specify-insert
 (let* ((children (widget-get widget :children))
 	       (setq rest (append rest values)
 		     values nil)))))
 (cons found rest)))
 (defun widget-checklist-match-find (widget vals)
-;; Find the vals which match a type in the checklist.
+"Find the vals which match a type in the checklist.
-;; Return an alist of (TYPE MATCH).
+Return an alist of (TYPE MATCH)."
 (let ((greedy (widget-get widget :greedy))
 	(args (copy-sequence (widget-get widget :args)))
 	found)
 (while vals
 (let ((answer (widget-checklist-match-up args vals)))
 	      (t
 	       (setq vals nil)))))
 found))
 (defun widget-checklist-match-up (args vals)
-;; Return the first type from ARGS that matches VALS.
+"Return the first type from ARGS that matches VALS."
 (let (current found)
 (while (and args (null found))
 (setq current (car args)
 	    args (cdr args)
 	    found (widget-match-inline current vals)))
 ;;; The `insert-button' Widget.
 (define-widget 'insert-button 'push-button
 "An insert button for the `editable-list' widget."
 :tag "INS"
-:help-echo "Insert a new item into the list at this position"
+:help-echo "Insert a new item into the list at this position."
 :action 'widget-insert-button-action)
 (defun widget-insert-button-action (widget &optional event)
 ;; Ask the parent to insert a new item.
 (widget-apply (widget-get widget :parent)
 ;;; The `delete-button' Widget.
 (define-widget 'delete-button 'push-button
 "A delete button for the `editable-list' widget."
 :tag "DEL"
-:help-echo "Delete this item from the list"
+:help-echo "Delete this item from the list."
 :action 'widget-delete-button-action)
 (defun widget-delete-button-action (widget &optional event)
 ;; Ask the parent to insert a new item.
 (widget-apply (widget-get widget :parent)
 	   (widget-get widget :indent)
 	   (insert-char ?\  (widget-get widget :indent)))
 (push (cond ((null answer)
 		   (widget-create-child widget arg))
 		  ((widget-get arg :inline)
-		   (widget-create-child-value widget arg  (car answer)))
+		   (widget-create-child-value widget arg (car answer)))
 		  (t
-		   (widget-create-child-value widget arg  (car (car answer)))))
+		   (widget-create-child-value widget arg (car (car answer)))))
 	    children))
 (widget-put widget :children (nreverse children))))
 (defun widget-group-default-get (widget)
 ;; Get the default of the components.
 ;;;				 dir nil must-match file)))
 ;;;    (widget-value-set widget (abbreviate-file-name answer))
 ;;;    (widget-setup)
 ;;;    (widget-apply widget :notify widget event)))
+;; Fixme: use file-name-as-directory.
 (define-widget 'directory 'file
 "A directory widget.
 It will read a directory name from the minibuffer when invoked."
 :tag "Directory")
 (defvar widget-symbol-prompt-value-history nil
 "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"
 :match (lambda (widget value) (symbolp value))
 :complete-function 'lisp-complete-symbol
 (defvar widget-function-prompt-value-history nil
 "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
 :prompt-match 'fboundp
 :prompt-history 'widget-function-prompt-value-history
 (defvar widget-variable-prompt-value-history nil
 "History of input to `widget-variable-prompt-value'.")
 (define-widget 'variable 'symbol
 ;; Should complete on variables.
-"A lisp variable."
+"A Lisp variable."
 :prompt-match 'boundp
 :prompt-history 'widget-variable-prompt-value-history
 :tag "Variable")
 ;; This part issues a warning when compiling without Mule.  Is there a
 ;    (widget-value-set widget answer)
 ;    (widget-apply widget :notify widget event)
 ;    (widget-setup)))
 (define-widget 'sexp 'editable-field
-"An arbitrary lisp expression."
+"An arbitrary Lisp expression."
 :tag "Lisp expression"
 :format "%{%t%}: %v"
 :value nil
 :validate 'widget-sexp-validate
 :match (lambda (widget value) t)
 :value 0
 :type-error "This field should contain an integer"
 :match-alternatives '(integerp))
 (define-widget 'number 'restricted-sexp
-"A floating point number."
+"A number (floating point or integer)."
 :tag "Number"
 :value 0.0
-:type-error "This field should contain a number"
+:type-error "This field should contain a number (floating point or integer)"
 :match-alternatives '(numberp))
 (define-widget 'character 'editable-field
 "A character."
 :tag "Character"
 (defun widget-choice-prompt-value (widget prompt value unbound)
 "Make a choice."
 (let ((args (widget-get widget :args))
 	(completion-ignore-case (widget-get widget :case-fold))
 	current choices old)
-;; Find the first arg that match VALUE.
+;; Find the first arg that matches VALUE.
 (let ((look args))
 (while look
 	(if (widget-apply (car look) :match value)
 	    (setq old (car look)
 		  look nil)
 ;; Toggle a boolean.
 (y-or-n-p prompt))
 ;;; The `color' Widget.
+;; Fixme: match
 (define-widget 'color 'editable-field
 "Choose a color name (with sample)."
 :format "%[%t%]: %v (%{sample%})\n"
 :size 10
 :tag "Color"
 (let* ((prefix (buffer-substring-no-properties (widget-field-start widget)
 						 (point)))
 	 (list (read-color-completion-table))
 	 (completion (try-completion prefix list)))
 (cond ((eq completion t)
-	   (message "Exact match"))
+	   (message "Exact match."))
 	  ((null completion)
 	   (error "Can't find completion for \"%s\"" prefix))
 	  ((not (string-equal prefix completion))
 	   (insert (substring completion (length prefix))))
 	  (t
 (defvar widget-color-history nil
 "History of entered colors.")
 (defun widget-color-action (widget &optional event)
-;; Prompt for a color.
+"Prompt for a color."
 (let* ((tag (widget-apply widget :menu-tag-get))
 	 (answer (read-color (concat tag ": "))))
 (unless (zerop (length answer))
 (widget-value-set widget answer)
 (widget-setup)
 (defun widget-at (pos)
 "The button or field at POS."
 (or (get-char-property pos 'button)
 (get-char-property pos 'field)))
+;;; The Help Echo
 (defun widget-echo-help (pos)
-"Display the help echo for widget at POS."
+"Display the help-echo text for widget at POS."
 (let* ((widget (widget-at pos))
 	 (help-echo (and widget (widget-get widget :help-echo))))
 (and (functionp help-echo)
 	 (setq help-echo (funcall help-echo widget)))
 (when (stringp help-echo)
 ;;; The End:
 (provide 'wid-edit)
-;; wid-edit.el ends here
+;;; wid-edit.el ends here

Mercurial > hg > xemacs-beta

comparison lisp/wid-edit.el @ 1173:315720febed1