comparison lisp/wid-edit.el @ 18372:5b5261ce8db9

(widget-file-complete): New function. (file): Use widget-file-complete for :completion. Delete :action. (symbol): Use lisp-complete-symbol for :completion. (widget-file-action): Function deleted. (widget-field-action): Just move to next field. (widget-choice-action, widget-toggle-action): Preserve point usefully if it is within the widget. (group-visibility): Inherit from visibility.

18371:a32f9b2c2e0c

    (let ((answer (widget-apply widget
				:prompt-internal prompt initial history)))
      (widget-apply widget :value-to-external answer))))

(defun widget-field-action (widget &optional event)
  ;; Edit the value in the minibuffer.
  (let ((invalid (widget-apply widget :validate)))
    (let ((prompt (concat (widget-apply widget :menu-tag-get) ": "))
	  (value (unless invalid 
		   (widget-value widget))))
      (let ((answer (widget-apply widget :prompt-value prompt value invalid) ))
	(widget-value-set widget answer)))
    (widget-setup)
    (widget-apply widget :notify widget event)))

(defun widget-field-validate (widget)
  ;; Valid if the content matches `:valid-regexp'.
  (save-excursion
    (let ((value (widget-apply widget :value-get))

		   (setq choices
			 (cons (cons (widget-apply current :menu-tag-get)
				     current)
			       choices)))
		 (widget-choose tag (reverse choices) event))))
    (when current
      (widget-value-set widget 
			(widget-apply current :value-to-external
				      (widget-get current :value)))
      (widget-setup)
      (widget-apply widget :notify widget event))))

(defun widget-choice-validate (widget)
  ;; Valid if we have made a valid choice.
  (let ((void (widget-get widget :void))
	(choice (widget-get widget :choice))

			 (widget-get widget :off)
			 (widget-get widget :off-glyph))))

(defun widget-toggle-action (widget &optional event)
  ;; Toggle value.
  (widget-value-set widget (not (widget-value widget)))
  (widget-apply widget :notify widget event))

;;; The `checkbox' Widget.

(define-widget 'checkbox 'toggle
  "A checkbox toggle."

      (setq off ""))
    (if (widget-value widget)
	(widget-glyph-insert widget on "down" "down-pushed")
      (widget-glyph-insert widget off "right" "right-pushed"))))

(define-widget 'group-visibility 'item
  "An indicator and manipulator for hidden group contents."
  :format "%[%v%]"
  :create 'widget-group-visibility-create
  :button-prefix ""
  :button-suffix ""
  :on "Hide"
  :off "Show"
  :value-create 'widget-visibility-value-create
  :action 'widget-toggle-action
  :match (lambda (widget value) t))

(defun widget-group-visibility-create (widget)
  (let ((visible (widget-value widget)))
    (if visible
	(insert "--------")))

	     widget))))

(define-widget 'file 'string
  "A file widget.  
It will read a file name from the minibuffer when invoked."
  :prompt-value 'widget-file-prompt-value
  :format "%{%t%}: %v"
  :tag "File"
  :action 'widget-file-action)

(defun widget-file-prompt-value (widget prompt value unbound)
  ;; Read file from minibuffer.
  (abbreviate-file-name
   (if unbound

	   (dir (file-name-directory value))
	   (file (file-name-nondirectory value))
	   (must-match (widget-get widget :must-match)))
       (read-file-name prompt2 dir nil must-match file)))))

(defun widget-file-action (widget &optional event)
  ;; Read a file name from the minibuffer.
  (let* ((value (widget-value widget))
	 (dir (file-name-directory value))
	 (file (file-name-nondirectory value))
	 (menu-tag (widget-apply widget :menu-tag-get))
	 (must-match (widget-get widget :must-match))
	 (answer (read-file-name (concat menu-tag ": (default `" value "') ")
				 dir nil must-match file)))
    (widget-value-set widget (abbreviate-file-name answer))
    (widget-setup)
    (widget-apply widget :notify widget event)))

(define-widget 'directory 'file
  "A directory widget.  
It will read a directory name from the minibuffer when invoked."
  :tag "Directory")

  "A lisp symbol."
  :value nil
  :tag "Symbol"
  :format "%{%t%}: %v"
  :match (lambda (widget value) (symbolp value))
  :prompt-internal 'widget-symbol-prompt-internal
  :prompt-match 'symbolp
  :prompt-history 'widget-symbol-prompt-value-history
  :value-to-internal (lambda (widget value)
		       (if (symbolp value)

18372:5b5261ce8db9

    (let ((answer (widget-apply widget
				:prompt-internal prompt initial history)))
      (widget-apply widget :value-to-external answer))))

(defun widget-field-action (widget &optional event)
  ;; Move to next field.
  (widget-forward 1)
  (message "To set this variable or face, invoke [State] and choose Set"))

(defun widget-field-validate (widget)
  ;; Valid if the content matches `:valid-regexp'.
  (save-excursion
    (let ((value (widget-apply widget :value-get))

		   (setq choices
			 (cons (cons (widget-apply current :menu-tag-get)
				     current)
			       choices)))
		 (widget-choose tag (reverse choices) event))))
    ;; Try to preserve point even if it is within the widget.
    (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))
		       (- old-pos from))))
      (when current
	(widget-value-set widget 
			  (widget-apply current :value-to-external
					(widget-get current :value)))
	(widget-setup)
	(widget-apply widget :notify widget event))
      (if offset
	  (goto-char (min (+ from offset) to))))))

(defun widget-choice-validate (widget)
  ;; Valid if we have made a valid choice.
  (let ((void (widget-get widget :void))
	(choice (widget-get widget :choice))

			 (widget-get widget :off)
			 (widget-get widget :off-glyph))))

(defun widget-toggle-action (widget &optional event)
  ;; Toggle value.
  ;; Try to preserve point even if it is within the widget.
  (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))
		     (- old-pos from))))
    (widget-value-set widget (not (widget-value widget)))
    (widget-apply widget :notify widget event)
    (if offset
	(goto-char (min (+ from offset) to)))))

;;; The `checkbox' Widget.

(define-widget 'checkbox 'toggle
  "A checkbox toggle."

      (setq off ""))
    (if (widget-value widget)
	(widget-glyph-insert widget on "down" "down-pushed")
      (widget-glyph-insert widget off "right" "right-pushed"))))

(define-widget 'group-visibility 'visibility
  "An indicator and manipulator for hidden group contents."
  :create 'widget-group-visibility-create)

(defun widget-group-visibility-create (widget)
  (let ((visible (widget-value widget)))
    (if visible
	(insert "--------")))

	     widget))))

(define-widget 'file 'string
  "A file widget.  
It will read a file name from the minibuffer when invoked."
  :complete-function 'widget-file-complete
  :prompt-value 'widget-file-prompt-value
  :format "%{%t%}: %v"
  :tag "File")

(defun widget-file-complete ()
  "Perform completion on file name preceding point."
  (interactive)
  (let* ((end (point))
	 (beg (save-excursion
		(skip-chars-backward "^ ")
		(point)))
	 (pattern (buffer-substring beg end))
	 (name-part (file-name-nondirectory pattern))
	 (directory (file-name-directory pattern))
	 (completion (file-name-completion name-part directory)))
    (cond ((eq completion t))
	  ((null completion)
	   (message "Can't find completion for \"%s\"" pattern)
	   (ding))
	  ((not (string= name-part completion))
	   (delete-region beg end)
	   (insert (expand-file-name completion directory)))
	  (t
	   (message "Making completion list...")
	   (let ((list (file-name-all-completions name-part directory)))
	     (setq list (sort list 'string<))
	     (with-output-to-temp-buffer "*Completions*"
	       (display-completion-list list)))
	   (message "Making completion list...%s" "done")))))

(defun widget-file-prompt-value (widget prompt value unbound)
  ;; Read file from minibuffer.
  (abbreviate-file-name
   (if unbound

	   (dir (file-name-directory value))
	   (file (file-name-nondirectory value))
	   (must-match (widget-get widget :must-match)))
       (read-file-name prompt2 dir nil must-match file)))))

;;;(defun widget-file-action (widget &optional event)
;;;  ;; Read a file name from the minibuffer.
;;;  (let* ((value (widget-value widget))
;;;	 (dir (file-name-directory value))
;;;	 (file (file-name-nondirectory value))
;;;	 (menu-tag (widget-apply widget :menu-tag-get))
;;;	 (must-match (widget-get widget :must-match))
;;;	 (answer (read-file-name (concat menu-tag ": (default `" value "') ")
;;;				 dir nil must-match file)))
;;;    (widget-value-set widget (abbreviate-file-name answer))
;;;    (widget-setup)
;;;    (widget-apply widget :notify widget event)))

(define-widget 'directory 'file
  "A directory widget.  
It will read a directory name from the minibuffer when invoked."
  :tag "Directory")

  "A lisp symbol."
  :value nil
  :tag "Symbol"
  :format "%{%t%}: %v"
  :match (lambda (widget value) (symbolp value))
  :complete-function 'lisp-complete-symbol
  :prompt-internal 'widget-symbol-prompt-internal
  :prompt-match 'symbolp
  :prompt-history 'widget-symbol-prompt-value-history
  :value-to-internal (lambda (widget value)
		       (if (symbolp value)