/[emacs]/emacs/lisp/wid-edit.el
ViewVC logotype

Diff of /emacs/lisp/wid-edit.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.110 by monnier, Mon May 20 18:28:09 2002 UTC revision 1.110.2.1 by miles, Fri Apr 4 06:20:12 2003 UTC
# Line 202  nil means read a single character." Line 202  nil means read a single character."
202    "Choose an item from a list.    "Choose an item from a list.
203    
204  First argument TITLE is the name of the list.  First argument TITLE is the name of the list.
205  Second argument ITEMS is an list whose members are either  Second argument ITEMS is a list whose members are either
206   (NAME . VALUE), to indicate selectable items, or just strings to   (NAME . VALUE), to indicate selectable items, or just strings to
207   indicate unselectable items.   indicate unselectable items.
208  Optional third argument EVENT is an input event.  Optional third argument EVENT is an input event.
# Line 271  minibuffer." Line 271  minibuffer."
271                   (while (not (or (and (>= char ?0) (< char next-digit))                   (while (not (or (and (>= char ?0) (< char next-digit))
272                                   (eq value 'keyboard-quit)))                                   (eq value 'keyboard-quit)))
273                     ;; Unread a SPC to lead to our new menu.                     ;; Unread a SPC to lead to our new menu.
274                     (setq unread-command-events (cons ?\ unread-command-events))                     (setq unread-command-events (cons ?\  unread-command-events))
275                     (setq keys (read-key-sequence title))                     (setq keys (read-key-sequence title))
276                     (setq value                     (setq value
277                           (lookup-key overriding-terminal-local-map keys t)                           (lookup-key overriding-terminal-local-map keys t)
# Line 301  minibuffer." Line 301  minibuffer."
301      (nreverse result)))      (nreverse result)))
302    
303  ;;; Widget text specifications.  ;;; Widget text specifications.
304  ;;  ;;
305  ;; These functions are for specifying text properties.  ;; These functions are for specifying text properties.
306    
307  (defvar widget-field-add-space t  (defvar widget-field-add-space t
# Line 333  new value.") Line 333  new value.")
333          (rear-sticky          (rear-sticky
334           (or (not widget-field-add-space) (widget-get widget :size))))           (or (not widget-field-add-space) (widget-get widget :size))))
335      (if (functionp help-echo)      (if (functionp help-echo)
336        (setq help-echo 'widget-mouse-help))            (setq help-echo 'widget-mouse-help))
337      (when (= (char-before to) ?\n)      (when (= (char-before to) ?\n)
338        ;; When the last character in the field is a newline, we want to        ;; When the last character in the field is a newline, we want to
339        ;; give it a `field' char-property of `boundary', which helps the        ;; give it a `field' char-property of `boundary', which helps the
# Line 508  Otherwise, just return the value." Line 508  Otherwise, just return the value."
508                                           :value-to-internal value)))                                           :value-to-internal value)))
509    
510  (defun widget-default-get (widget)  (defun widget-default-get (widget)
511    "Extract the default value of WIDGET."    "Extract the default external value of WIDGET."
512    (or (widget-get widget :value)    (widget-apply widget :value-to-external
513        (widget-apply widget :default-get)))                  (or (widget-get widget :value)
514                        (widget-apply widget :default-get))))
515    
516  (defun widget-match-inline (widget vals)  (defun widget-match-inline (widget vals)
517    "In WIDGET, match the start of VALS."    "In WIDGET, match the start of VALS."
# Line 688  The child is converted, using the keywor Line 689  The child is converted, using the keywor
689    
690  (defun widget-create-child (parent type)  (defun widget-create-child (parent type)
691    "Create widget of TYPE."    "Create widget of TYPE."
692    (let ((widget (copy-sequence type)))    (let ((widget (widget-copy type)))
693      (widget-put widget :parent parent)      (widget-put widget :parent parent)
694      (unless (widget-get widget :indent)      (unless (widget-get widget :indent)
695        (widget-put widget :indent (+ (or (widget-get parent :indent) 0)        (widget-put widget :indent (+ (or (widget-get parent :indent) 0)
# Line 699  The child is converted, using the keywor Line 700  The child is converted, using the keywor
700    
701  (defun widget-create-child-value (parent type value)  (defun widget-create-child-value (parent type value)
702    "Create widget of TYPE with value VALUE."    "Create widget of TYPE with value VALUE."
703    (let ((widget (copy-sequence type)))    (let ((widget (widget-copy type)))
704      (widget-put widget :value (widget-apply widget :value-to-internal value))      (widget-put widget :value (widget-apply widget :value-to-internal value))
705      (widget-put widget :parent parent)      (widget-put widget :parent parent)
706      (unless (widget-get widget :indent)      (unless (widget-get widget :indent)
# Line 714  The child is converted, using the keywor Line 715  The child is converted, using the keywor
715    "Delete WIDGET."    "Delete WIDGET."
716    (widget-apply widget :delete))    (widget-apply widget :delete))
717    
718    (defun widget-copy (widget)
719      "Make a deep copy of WIDGET."
720      (widget-apply (copy-sequence widget) :copy))
721    
722  (defun widget-convert (type &rest args)  (defun widget-convert (type &rest args)
723    "Convert TYPE to a widget without inserting it in the buffer.    "Convert TYPE to a widget without inserting it in the buffer.
724  The optional ARGS are additional keyword arguments."  The optional ARGS are additional keyword arguments."
# Line 722  The optional ARGS are additional keyword Line 727  The optional ARGS are additional keyword
727                       (list type)                       (list type)
728                     (copy-sequence type)))                     (copy-sequence type)))
729           (current widget)           (current widget)
730             done
731           (keys args))           (keys args))
732      ;; First set the :args keyword.      ;; First set the :args keyword.
733      (while (cdr current)                ;Look in the type.      (while (cdr current)                ;Look in the type.
734        (if (keywordp (car (cdr current)))        (if (and (keywordp (cadr current))
735            (setq current (cdr (cdr current)))                 ;; If the last element is a keyword,
736                   ;; it is still the :args element,
737                   ;; even though it is a keyword.
738                   (cddr current))
739              (if (eq (cadr current) :args)
740                  ;; If :args is explicitly specified, obey it.
741                  (setq current nil)
742                ;; Some other irrelevant keyword.
743                (setq current (cdr (cdr current))))
744          (setcdr current (list :args (cdr current)))          (setcdr current (list :args (cdr current)))
745          (setq current nil)))          (setq current nil)))
746      (while args                         ;Look in the args.      (while (and args (not done))        ;Look in ARGS.
747        (if (keywordp (nth 0 args))        (cond ((eq (car args) :args)
748            (setq args (nthcdr 2 args))               ;; Handle explicit specification of :args.
749          (widget-put widget :args args)               (setq args (cadr args)
750          (setq args nil)))                     done t))
751                ((keywordp (car args))
752                 (setq args (cddr args)))
753                (t (setq done t))))
754        (when done
755          (widget-put widget :args args))
756      ;; Then Convert the widget.      ;; Then Convert the widget.
757      (setq type widget)      (setq type widget)
758      (while type      (while type
# Line 873  Recommended as a parent keymap for modes Line 892  Recommended as a parent keymap for modes
892    (if (widget-event-point event)    (if (widget-event-point event)
893        (let* ((pos (widget-event-point event))        (let* ((pos (widget-event-point event))
894               (start (event-start event))               (start (event-start event))
895               (button (get-char-property               (button (get-char-property
896                        pos 'button (and (windowp (posn-window start))                        pos 'button (and (windowp (posn-window start))
897                                         (window-buffer (posn-window start))))))                                         (window-buffer (posn-window start))))))
898          (if button          (if button
# Line 983  This is much faster, but doesn't work re Line 1002  This is much faster, but doesn't work re
1002    "Move point to the ARG next field or button.    "Move point to the ARG next field or button.
1003  ARG may be negative to move backward."  ARG may be negative to move backward."
1004    (or (bobp) (> arg 0) (backward-char))    (or (bobp) (> arg 0) (backward-char))
1005    (let ((pos (point))    (let ((wrapped 0)
1006          (number arg)          (number arg)
1007          (old (widget-tabable-at))          (old (widget-tabable-at))
1008          new)          new)
1009      ;; Forward.      ;; Forward.
1010      (while (> arg 0)      (while (> arg 0)
1011        (cond ((eobp)        (cond ((eobp)
1012               (goto-char (point-min)))               (goto-char (point-min))
1013                 (setq wrapped (1+ wrapped)))
1014              (widget-use-overlay-change              (widget-use-overlay-change
1015               (goto-char (next-overlay-change (point))))               (goto-char (next-overlay-change (point))))
1016              (t              (t
1017               (forward-char 1)))               (forward-char 1)))
1018        (and (eq pos (point))        (and (= wrapped 2)
1019             (eq arg number)             (eq arg number)
1020             (error "No buttons or fields found"))             (error "No buttons or fields found"))
1021        (let ((new (widget-tabable-at)))        (let ((new (widget-tabable-at)))
# Line 1006  ARG may be negative to move backward." Line 1026  ARG may be negative to move backward."
1026      ;; Backward.      ;; Backward.
1027      (while (< arg 0)      (while (< arg 0)
1028        (cond ((bobp)        (cond ((bobp)
1029               (goto-char (point-max)))               (goto-char (point-max))
1030                 (setq wrapped (1+ wrapped)))
1031              (widget-use-overlay-change              (widget-use-overlay-change
1032               (goto-char (previous-overlay-change (point))))               (goto-char (previous-overlay-change (point))))
1033              (t              (t
1034               (backward-char 1)))               (backward-char 1)))
1035        (and (eq pos (point))        (and (= wrapped 2)
1036             (eq arg number)             (eq arg number)
1037             (error "No buttons or fields found"))             (error "No buttons or fields found"))
1038        (let ((new (widget-tabable-at)))        (let ((new (widget-tabable-at)))
# Line 1257  Optional EVENT is the event that trigger Line 1278  Optional EVENT is the event that trigger
1278              found (widget-apply child :validate)))              found (widget-apply child :validate)))
1279      found))      found))
1280    
1281    (defun widget-types-copy (widget)
1282      "Copy :args as widget types in WIDGET."
1283      (widget-put widget :args (mapcar 'widget-copy (widget-get widget :args)))
1284      widget)
1285    
1286  ;; Made defsubst to speed up face editor creation.  ;; Made defsubst to speed up face editor creation.
1287  (defsubst widget-types-convert-widget (widget)  (defsubst widget-types-convert-widget (widget)
1288    "Convert :args as widget types in WIDGET."    "Convert :args as widget types in WIDGET."
# Line 1291  Optional EVENT is the event that trigger Line 1317  Optional EVENT is the event that trigger
1317    :indent nil    :indent nil
1318    :offset 0    :offset 0
1319    :format-handler 'widget-default-format-handler    :format-handler 'widget-default-format-handler
1320    :button-face-get 'widget-default-button-face-get    :button-face-get 'widget-default-button-face-get
1321    :sample-face-get 'widget-default-sample-face-get    :sample-face-get 'widget-default-sample-face-get
1322    :delete 'widget-default-delete    :delete 'widget-default-delete
1323      :copy 'identity
1324    :value-set 'widget-default-value-set    :value-set 'widget-default-value-set
1325    :value-inline 'widget-default-value-inline    :value-inline 'widget-default-value-inline
1326    :default-get 'widget-default-default-get    :default-get 'widget-default-default-get
# Line 1507  If that does not exists, call the value Line 1534  If that does not exists, call the value
1534    (or (widget-get widget :always-active)    (or (widget-get widget :always-active)
1535        (and (not (widget-get widget :inactive))        (and (not (widget-get widget :inactive))
1536             (let ((parent (widget-get widget :parent)))             (let ((parent (widget-get widget :parent)))
1537               (or (null parent)               (or (null parent)
1538                   (widget-apply parent :active))))))                   (widget-apply parent :active))))))
1539    
1540  (defun widget-default-deactivate (widget)  (defun widget-default-deactivate (widget)
# Line 1701  If END is omitted, it defaults to the le Line 1728  If END is omitted, it defaults to the le
1728    (find-file (locate-library (widget-value widget))))    (find-file (locate-library (widget-value widget))))
1729    
1730  ;;; The `emacs-commentary-link' Widget.  ;;; The `emacs-commentary-link' Widget.
1731        
1732  (define-widget 'emacs-commentary-link 'link  (define-widget 'emacs-commentary-link 'link
1733    "A link to Commentary in an Emacs Lisp library file."    "A link to Commentary in an Emacs Lisp library file."
1734    :action 'widget-emacs-commentary-link-action)    :action 'widget-emacs-commentary-link-action)
1735        
1736  (defun widget-emacs-commentary-link-action (widget &optional event)  (defun widget-emacs-commentary-link-action (widget &optional event)
1737    "Find the Commentary section of the Emacs file specified by WIDGET."    "Find the Commentary section of the Emacs file specified by WIDGET."
1738    (finder-commentary (widget-value widget)))    (finder-commentary (widget-value widget)))
# Line 1839  the earlier input." Line 1866  the earlier input."
1866  (define-widget 'menu-choice 'default  (define-widget 'menu-choice 'default
1867    "A menu of options."    "A menu of options."
1868    :convert-widget  'widget-types-convert-widget    :convert-widget  'widget-types-convert-widget
1869      :copy 'widget-types-copy
1870    :format "%[%t%]: %v"    :format "%[%t%]: %v"
1871    :case-fold t    :case-fold t
1872    :tag "choice"    :tag "choice"
# Line 1968  when he invoked the menu." Line 1996  when he invoked the menu."
1996        (when this-explicit        (when this-explicit
1997          (widget-put widget :explicit-choice current)          (widget-put widget :explicit-choice current)
1998          (widget-put widget :explicit-choice-value (widget-get widget :value)))          (widget-put widget :explicit-choice-value (widget-get widget :value)))
1999        (widget-value-set        (widget-value-set widget (widget-default-get current))
        widget (widget-apply current  
                             :value-to-external (widget-default-get current)))  
2000        (widget-setup)        (widget-setup)
2001        (widget-apply widget :notify widget event)))        (widget-apply widget :notify widget event)))
2002    (run-hook-with-args 'widget-edit-functions widget))    (run-hook-with-args 'widget-edit-functions widget))
# Line 2077  when he invoked the menu." Line 2103  when he invoked the menu."
2103  (define-widget 'checklist 'default  (define-widget 'checklist 'default
2104    "A multiple choice widget."    "A multiple choice widget."
2105    :convert-widget 'widget-types-convert-widget    :convert-widget 'widget-types-convert-widget
2106      :copy 'widget-types-copy
2107    :format "%v"    :format "%v"
2108    :offset 4    :offset 4
2109    :entry-format "%b %v"    :entry-format "%b %v"
# Line 2254  Return an alist of (TYPE MATCH)." Line 2281  Return an alist of (TYPE MATCH)."
2281  (define-widget 'radio-button-choice 'default  (define-widget 'radio-button-choice 'default
2282    "Select one of multiple options."    "Select one of multiple options."
2283    :convert-widget 'widget-types-convert-widget    :convert-widget 'widget-types-convert-widget
2284      :copy 'widget-types-copy
2285    :offset 4    :offset 4
2286    :format "%v"    :format "%v"
2287    :entry-format "%b %v"    :entry-format "%b %v"
# Line 2442  Return an alist of (TYPE MATCH)." Line 2470  Return an alist of (TYPE MATCH)."
2470  (define-widget 'editable-list 'default  (define-widget 'editable-list 'default
2471    "A variable list of widgets of the same type."    "A variable list of widgets of the same type."
2472    :convert-widget 'widget-types-convert-widget    :convert-widget 'widget-types-convert-widget
2473      :copy 'widget-types-copy
2474    :offset 12    :offset 12
2475    :format "%v%i\n"    :format "%v%i\n"
2476    :format-handler 'widget-editable-list-format-handler    :format-handler 'widget-editable-list-format-handler
# Line 2593  Return an alist of (TYPE MATCH)." Line 2622  Return an alist of (TYPE MATCH)."
2622                      (setq child (widget-create-child-value                      (setq child (widget-create-child-value
2623                                   widget type value))                                   widget type value))
2624                    (setq child (widget-create-child-value                    (setq child (widget-create-child-value
2625                                 widget type                                 widget type (widget-default-get type)))))
                                (widget-apply type :value-to-external  
                                              (widget-default-get type))))))  
2626                 (t                 (t
2627                  (error "Unknown escape `%c'" escape)))))                  (error "Unknown escape `%c'" escape)))))
2628       (widget-put widget       (widget-put widget
# Line 2617  Return an alist of (TYPE MATCH)." Line 2644  Return an alist of (TYPE MATCH)."
2644  (define-widget 'group 'default  (define-widget 'group 'default
2645    "A widget which groups other widgets inside."    "A widget which groups other widgets inside."
2646    :convert-widget 'widget-types-convert-widget    :convert-widget 'widget-types-convert-widget
2647      :copy 'widget-types-copy
2648    :format "%v"    :format "%v"
2649    :value-create 'widget-group-value-create    :value-create 'widget-group-value-create
2650    :value-delete 'widget-children-value-delete    :value-delete 'widget-children-value-delete
# Line 2804  link for that string." Line 2832  link for that string."
2832                  (widget-create-child-and-convert                  (widget-create-child-and-convert
2833                   widget 'visibility                   widget 'visibility
2834                   :help-echo "Show or hide rest of the documentation."                   :help-echo "Show or hide rest of the documentation."
2835                     :on "Hide Rest"
2836                   :off "More"                   :off "More"
2837                   :always-active t                   :always-active t
2838                   :action 'widget-parent-action                   :action 'widget-parent-action
# Line 3030  It will read a directory name from the m Line 3059  It will read a directory name from the m
3059    
3060  (defvar widget-coding-system-prompt-value-history nil  (defvar widget-coding-system-prompt-value-history nil
3061    "History of input to `widget-coding-system-prompt-value'.")    "History of input to `widget-coding-system-prompt-value'.")
3062      
3063  (define-widget 'coding-system 'symbol  (define-widget 'coding-system 'symbol
3064    "A MULE coding-system."    "A MULE coding-system."
3065    :format "%{%t%}: %v"    :format "%{%t%}: %v"
# Line 3166  To use this type, you must define :match Line 3195  To use this type, you must define :match
3195    :match-alternatives '(integerp))    :match-alternatives '(integerp))
3196    
3197  (define-widget 'number 'restricted-sexp  (define-widget 'number 'restricted-sexp
3198    "A floating point number."    "A number (floating point or integer)."
3199    :tag "Number"    :tag "Number"
3200    :value 0.0    :value 0.0
3201    :type-error "This field should contain a number"    :type-error "This field should contain a number (floating point or integer)"
3202    :match-alternatives '(numberp))    :match-alternatives '(numberp))
3203    
3204    (define-widget 'float 'restricted-sexp
3205      "A floating point number."
3206      :tag "Floating point number"
3207      :value 0.0
3208      :type-error "This field should contain a floating point number"
3209      :match-alternatives '(floatp))
3210    
3211  (define-widget 'character 'editable-field  (define-widget 'character 'editable-field
3212    "A character."    "A character."
3213    :tag "Character"    :tag "Character"
# Line 3395  To use this type, you must define :match Line 3431  To use this type, you must define :match
3431    
3432  ;;; The `color' Widget.  ;;; The `color' Widget.
3433    
3434  ;; Fixme: match  ;; Fixme: match
3435  (define-widget 'color 'editable-field  (define-widget 'color 'editable-field
3436    "Choose a color name (with sample)."    "Choose a color name (with sample)."
3437    :format "%t: %v (%{sample%})\n"    :format "%t: %v (%{sample%})\n"

Legend:
Removed from v.1.110  
changed lines
  Added in v.1.110.2.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26