comparison lisp/wid-edit.el @ 64565:e4fcf58d872c

(widget-default-create, widget-after-change, widget-default-format-handler, widget-checklist-add-item, widget-radio-add-item, widget-choose, widget-specify-secret, widget-field-value-create, widget-field-value-get, widget-editable-list-format-handler, widget-editable-list-entry-create, widget-group-value-create, widget-documentation-link-add, widget-documentation-string-value-create): "?\ " -> "?\s". (widget-convert-text): Doc fix. (widget-narrow-to-field, widget-field-find, widget-url-link-action, widget-emacs-library-link-action, widget-color-notify): Fix typos in docstrings.

64564:4b552d6938e8

		     (char 0)
		     (arg 1))
		 (while (not (or (and (>= char ?0) (< char next-digit))
				 (eq value 'keyboard-quit)))
		   ;; Unread a SPC to lead to our new menu.
		   (setq unread-command-events (cons ?\  unread-command-events))
		   (setq keys (read-key-sequence title))
		   (setq value
			 (lookup-key overriding-terminal-local-map keys t)
			 char (string-to-char (substring keys 1)))
		   (cond ((eq value 'scroll-other-window)

    (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)))
	    (unless (eq old secret)
	      (subst-char-in-region begin (1+ begin) old secret)

(defun widget-convert-text (type from to
				 &optional button-from button-to
				 &rest args)
  "Return a widget of type TYPE with endpoint FROM TO.
Optional ARGS are extra keyword arguments for TYPE.
and TO will be used as the widgets end points. If optional arguments
BUTTON-FROM and BUTTON-TO are given, these will be used as the widgets
button end points.
Optional ARGS are extra keyword arguments for TYPE."
  (let ((widget (apply 'widget-convert type :delete 'widget-leave-text args))
	(from (copy-marker from))

  :options '(ispell-complete-word complete-tag lisp-complete-symbol)
  :type 'function
  :group 'widgets)

(defun widget-narrow-to-field ()
  "Narrow to field"
  (interactive)
  (let ((field (widget-field-find (point))))
    (if field
	(narrow-to-region (line-beginning-position) (line-end-position)))))

	  (overlay-end overlay))
      (cdr overlay))))

(defun widget-field-find (pos)
  "Return the field at POS.
Unlike (get-char-property POS 'field) this, works with empty fields too."
  (let ((fields widget-field-list)
	field found)
    (while fields
      (setq field (car fields)
	    fields (cdr fields))

		(end (widget-field-end field)))
	    (cond ((< (- end begin) size)
		   ;; Field too small.
		   (save-excursion
		     (goto-char end)
		     (insert-char ?\  (- (+ begin size) end))))
		  ((> (- end begin) size)
		   ;; Field too large and
		   (if (or (< (point) (+ begin size))
			   (> (point) end))
		       ;; Point is outside extra space.
		       (setq begin (+ begin size))
		     ;; Point is within the extra space.
		     (setq begin (point)))
		   (save-excursion
		     (goto-char end)
		     (while (and (eq (preceding-char) ?\ )
				 (> (point) begin))
		       (delete-backward-char 1)))))))
	(widget-specify-secret field))
      (widget-apply field :notify field))))

	       ((eq escape ?\})
		(setq sample-end (point)))
	       ((eq escape ?n)
		(when (widget-get widget :indent)
		  (insert ?\n)
		  (insert-char ?  (widget-get widget :indent))))
	       ((eq escape ?t)
		(let ((image (widget-get widget :tag-glyph))
		      (tag (widget-get widget :tag)))
		  (cond (image
			 (widget-image-insert widget (or tag "image") image))

				 doc-try))
		  (doc-indent (widget-get widget :documentation-indent)))
	     (when doc-text
	       (and (eq (preceding-char) ?\n)
		    (widget-get widget :indent)
		    (insert-char ?  (widget-get widget :indent)))
	       ;; The `*' in the beginning is redundant.
	       (when (eq (aref doc-text  0) ?*)
		 (setq doc-text (substring doc-text 1)))
	       ;; Get rid of trailing newlines.
	       (when (string-match "\n+\\'" doc-text)

(define-widget 'url-link 'link
  "A link to an www page."
  :action 'widget-url-link-action)

(defun widget-url-link-action (widget &optional event)
  "Open the url specified by WIDGET."
  (browse-url (widget-value widget)))

;;; The `function-link' Widget.

(define-widget 'function-link 'link

(define-widget 'emacs-library-link 'link
  "A link to an Emacs Lisp library file."
  :action 'widget-emacs-library-link-action)

(defun widget-emacs-library-link-action (widget &optional event)
  "Find the Emacs Library file specified by WIDGET."
  (find-file (locate-library (widget-value widget))))

;;; The `emacs-commentary-link' Widget.

(define-widget 'emacs-commentary-link 'link

	(overlay (cons (make-marker) (make-marker))))
    (widget-put widget :field-overlay overlay)
    (insert value)
    (and size
	 (< (length value) size)
	 (insert-char ?\  (- size (length value))))
    (unless (memq widget widget-field-list)
      (setq widget-field-new (cons widget widget-field-new)))
    (move-marker (cdr overlay) (point))
    (set-marker-insertion-type (cdr overlay) nil)
    (when (null size)

	(progn
	  (set-buffer buffer)
	  (while (and size
		      (not (zerop size))
		      (> to from)
		      (eq (char-after (1- to)) ?\ ))
	    (setq to (1- to)))
	  (let ((result (buffer-substring-no-properties from to)))
	    (when secret
	      (let ((index 0))
		(while (< (+ from index) to)

(defun widget-checklist-add-item (widget type chosen)
  "Create checklist item in WIDGET of type TYPE.
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))
	  (buttons (widget-get widget :buttons))
	  (button-args (or (widget-get type :sibling-args)
			   (widget-get widget :button-args)))

(defun widget-radio-add-item (widget type)
  "Add to radio widget WIDGET a new radio button item of type TYPE."
  ;; (setq type (widget-convert type))
  (and (eq (preceding-char) ?\n)
       (widget-get widget :indent)
       (insert-char ?  (widget-get widget :indent)))
  (widget-specify-insert
   (let* ((value (widget-get widget :value))
	  (children (widget-get widget :children))
	  (buttons (widget-get widget :buttons))
	  (button-args (or (widget-get type :sibling-args)

(defun widget-editable-list-format-handler (widget escape)
  ;; We recognize the insert button.
    ;; (let ((widget-push-button-gui widget-editable-list-gui))
    (cond ((eq escape ?i)
	   (and (widget-get widget :indent)
		(insert-char ?\  (widget-get widget :indent)))
	   (apply 'widget-create-child-and-convert
		  widget 'insert-button
		  (widget-get widget :append-button-args)))
	  (t
	   (widget-default-format-handler widget escape)))

	;; (widget-push-button-gui widget-editable-list-gui)
	child delete insert)
    (widget-specify-insert
     (save-excursion
       (and (widget-get widget :indent)
	    (insert-char ?\  (widget-get widget :indent)))
       (insert (widget-get widget :entry-format)))
     ;; Parse % escapes in format.
     (while (re-search-forward "%\\(.\\)" nil t)
       (let ((escape (char-after (match-beginning 1))))
	 (delete-backward-char 2)

	    args (cdr args)
	    answer (widget-match-inline arg value)
	    value (cdr answer))
      (and (eq (preceding-char) ?\n)
	   (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)))
		  (t

      (save-excursion
	(save-restriction
	  (narrow-to-region from to)
	  (goto-char (point-min))
	  (while (search-forward "\n" nil t)
	    (insert-char ?\  indent)))))))

;;; The `documentation-string' Widget.

(define-widget 'documentation-string 'item
  "A documentation string."

	(start (point)))
    (if (string-match "\n" doc)
	(let ((before (substring doc 0 (match-beginning 0)))
	      (after (substring doc (match-beginning 0)))
	      button)
	  (insert before ?\ )
	  (widget-documentation-link-add widget start (point))
	  (setq button
		(widget-create-child-and-convert
		 widget 'visibility
		 :help-echo "Show or hide rest of the documentation."

		 :action 'widget-parent-action
		 shown))
	  (when shown
	    (setq start (point))
	    (when (and indent (not (zerop indent)))
	      (insert-char ?\  indent))
	    (insert after)
	    (widget-documentation-link-add widget start (point)))
	  (widget-put widget :buttons (list button)))
      (insert doc)
      (widget-documentation-link-add widget start (point))))

      (widget-value-set widget answer)
      (widget-setup)
      (widget-apply widget :notify widget event))))

(defun widget-color-notify (widget child &optional event)
  "Update the sample, and notofy the parent."
  (overlay-put (widget-get widget :sample-overlay)
	       'face (widget-apply widget :sample-face-get))
  (widget-default-notify widget child event))

;;; The Help Echo

64565:e4fcf58d872c

		     (char 0)
		     (arg 1))
		 (while (not (or (and (>= char ?0) (< char next-digit))
				 (eq value 'keyboard-quit)))
		   ;; Unread a SPC to lead to our new menu.
		   (setq unread-command-events (cons ?\s unread-command-events))
		   (setq keys (read-key-sequence title))
		   (setq value
			 (lookup-key overriding-terminal-local-map keys t)
			 char (string-to-char (substring keys 1)))
		   (cond ((eq value 'scroll-other-window)

    (when secret
      (let ((begin (widget-field-start field))
	    (end (widget-field-end field)))
	(when size
	  (while (and (> end begin)
		      (eq (char-after (1- end)) ?\s))
	    (setq end (1- end))))
	(while (< begin end)
	  (let ((old (char-after begin)))
	    (unless (eq old secret)
	      (subst-char-in-region begin (1+ begin) old secret)

(defun widget-convert-text (type from to
				 &optional button-from button-to
				 &rest args)
  "Return a widget of type TYPE with endpoint FROM TO.
No text will be inserted to the buffer, instead the text between FROM
and TO will be used as the widgets end points.  If optional arguments
BUTTON-FROM and BUTTON-TO are given, these will be used as the widgets
button end points.
Optional ARGS are extra keyword arguments for TYPE."
  (let ((widget (apply 'widget-convert type :delete 'widget-leave-text args))
	(from (copy-marker from))

  :options '(ispell-complete-word complete-tag lisp-complete-symbol)
  :type 'function
  :group 'widgets)

(defun widget-narrow-to-field ()
  "Narrow to field."
  (interactive)
  (let ((field (widget-field-find (point))))
    (if field
	(narrow-to-region (line-beginning-position) (line-end-position)))))

	  (overlay-end overlay))
      (cdr overlay))))

(defun widget-field-find (pos)
  "Return the field at POS.
Unlike (get-char-property POS 'field), this works with empty fields too."
  (let ((fields widget-field-list)
	field found)
    (while fields
      (setq field (car fields)
	    fields (cdr fields))

		(end (widget-field-end field)))
	    (cond ((< (- end begin) size)
		   ;; Field too small.
		   (save-excursion
		     (goto-char end)
		     (insert-char ?\s (- (+ begin size) end))))
		  ((> (- end begin) size)
		   ;; Field too large and
		   (if (or (< (point) (+ begin size))
			   (> (point) end))
		       ;; Point is outside extra space.
		       (setq begin (+ begin size))
		     ;; Point is within the extra space.
		     (setq begin (point)))
		   (save-excursion
		     (goto-char end)
		     (while (and (eq (preceding-char) ?\s)
				 (> (point) begin))
		       (delete-backward-char 1)))))))
	(widget-specify-secret field))
      (widget-apply field :notify field))))

	       ((eq escape ?\})
		(setq sample-end (point)))
	       ((eq escape ?n)
		(when (widget-get widget :indent)
		  (insert ?\n)
		  (insert-char ?\s (widget-get widget :indent))))
	       ((eq escape ?t)
		(let ((image (widget-get widget :tag-glyph))
		      (tag (widget-get widget :tag)))
		  (cond (image
			 (widget-image-insert widget (or tag "image") image))

				 doc-try))
		  (doc-indent (widget-get widget :documentation-indent)))
	     (when doc-text
	       (and (eq (preceding-char) ?\n)
		    (widget-get widget :indent)
		    (insert-char ?\s (widget-get widget :indent)))
	       ;; The `*' in the beginning is redundant.
	       (when (eq (aref doc-text  0) ?*)
		 (setq doc-text (substring doc-text 1)))
	       ;; Get rid of trailing newlines.
	       (when (string-match "\n+\\'" doc-text)

(define-widget 'url-link 'link
  "A link to an www page."
  :action 'widget-url-link-action)

(defun widget-url-link-action (widget &optional event)
  "Open the URL specified by WIDGET."
  (browse-url (widget-value widget)))

;;; The `function-link' Widget.

(define-widget 'function-link 'link

(define-widget 'emacs-library-link 'link
  "A link to an Emacs Lisp library file."
  :action 'widget-emacs-library-link-action)

(defun widget-emacs-library-link-action (widget &optional event)
  "Find the Emacs library file specified by WIDGET."
  (find-file (locate-library (widget-value widget))))

;;; The `emacs-commentary-link' Widget.

(define-widget 'emacs-commentary-link 'link

	(overlay (cons (make-marker) (make-marker))))
    (widget-put widget :field-overlay overlay)
    (insert value)
    (and size
	 (< (length value) size)
	 (insert-char ?\s (- size (length value))))
    (unless (memq widget widget-field-list)
      (setq widget-field-new (cons widget widget-field-new)))
    (move-marker (cdr overlay) (point))
    (set-marker-insertion-type (cdr overlay) nil)
    (when (null size)

	(progn
	  (set-buffer buffer)
	  (while (and size
		      (not (zerop size))
		      (> to from)
		      (eq (char-after (1- to)) ?\s))
	    (setq to (1- to)))
	  (let ((result (buffer-substring-no-properties from to)))
	    (when secret
	      (let ((index 0))
		(while (< (+ from index) to)

(defun widget-checklist-add-item (widget type chosen)
  "Create checklist item in WIDGET of type TYPE.
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 ?\s (widget-get widget :indent)))
  (widget-specify-insert
   (let* ((children (widget-get widget :children))
	  (buttons (widget-get widget :buttons))
	  (button-args (or (widget-get type :sibling-args)
			   (widget-get widget :button-args)))

(defun widget-radio-add-item (widget type)
  "Add to radio widget WIDGET a new radio button item of type TYPE."
  ;; (setq type (widget-convert type))
  (and (eq (preceding-char) ?\n)
       (widget-get widget :indent)
       (insert-char ?\s (widget-get widget :indent)))
  (widget-specify-insert
   (let* ((value (widget-get widget :value))
	  (children (widget-get widget :children))
	  (buttons (widget-get widget :buttons))
	  (button-args (or (widget-get type :sibling-args)

(defun widget-editable-list-format-handler (widget escape)
  ;; We recognize the insert button.
    ;; (let ((widget-push-button-gui widget-editable-list-gui))
    (cond ((eq escape ?i)
	   (and (widget-get widget :indent)
		(insert-char ?\s (widget-get widget :indent)))
	   (apply 'widget-create-child-and-convert
		  widget 'insert-button
		  (widget-get widget :append-button-args)))
	  (t
	   (widget-default-format-handler widget escape)))

	;; (widget-push-button-gui widget-editable-list-gui)
	child delete insert)
    (widget-specify-insert
     (save-excursion
       (and (widget-get widget :indent)
	    (insert-char ?\s (widget-get widget :indent)))
       (insert (widget-get widget :entry-format)))
     ;; Parse % escapes in format.
     (while (re-search-forward "%\\(.\\)" nil t)
       (let ((escape (char-after (match-beginning 1))))
	 (delete-backward-char 2)

	    args (cdr args)
	    answer (widget-match-inline arg value)
	    value (cdr answer))
      (and (eq (preceding-char) ?\n)
	   (widget-get widget :indent)
	   (insert-char ?\s (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)))
		  (t

      (save-excursion
	(save-restriction
	  (narrow-to-region from to)
	  (goto-char (point-min))
	  (while (search-forward "\n" nil t)
	    (insert-char ?\s indent)))))))

;;; The `documentation-string' Widget.

(define-widget 'documentation-string 'item
  "A documentation string."

	(start (point)))
    (if (string-match "\n" doc)
	(let ((before (substring doc 0 (match-beginning 0)))
	      (after (substring doc (match-beginning 0)))
	      button)
	  (insert before ?\s)
	  (widget-documentation-link-add widget start (point))
	  (setq button
		(widget-create-child-and-convert
		 widget 'visibility
		 :help-echo "Show or hide rest of the documentation."

		 :action 'widget-parent-action
		 shown))
	  (when shown
	    (setq start (point))
	    (when (and indent (not (zerop indent)))
	      (insert-char ?\s indent))
	    (insert after)
	    (widget-documentation-link-add widget start (point)))
	  (widget-put widget :buttons (list button)))
      (insert doc)
      (widget-documentation-link-add widget start (point))))

      (widget-value-set widget answer)
      (widget-setup)
      (widget-apply widget :notify widget event))))

(defun widget-color-notify (widget child &optional event)
  "Update the sample, and notify the parent."
  (overlay-put (widget-get widget :sample-overlay)
	       'face (widget-apply widget :sample-face-get))
  (widget-default-notify widget child event))

;;; The Help Echo