;;; wid-edit.el --- Functions for creating and using widgets -*-byte-compile-dynamic: t; lexical-binding:t -*-
;;
-;; Copyright (C) 1996-1997, 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1997, 1999-2013 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Maintainer: FSF
(error "Canceled"))
value))))
-(defun widget-remove-if (predictate list)
+(defun widget-remove-if (predicate list)
(let (result (tail list))
(while tail
- (or (funcall predictate (car tail))
+ (or (funcall predicate (car tail))
(setq result (cons (car tail) result)))
(setq tail (cdr tail)))
(nreverse result)))
"Map FUNCTION over the buttons in BUFFER.
FUNCTION is called with the arguments WIDGET and MAPARG.
-If FUNCTION returns non-nil, the walk is cancelled.
+If FUNCTION returns non-nil, the walk is canceled.
The arguments MAPARG, and BUFFER default to nil and (current-buffer),
respectively."
(kill-region (point) end)
(call-interactively 'kill-line))))
-(defcustom widget-complete-field (lookup-key global-map "\M-\t")
- "Default function to call for completion inside fields."
- :options '(ispell-complete-word complete-tag lisp-complete-symbol)
- :type 'function
- :group 'widgets)
-
(defun widget-narrow-to-field ()
"Narrow to field."
(interactive)
(completion-in-region (nth 0 data) (nth 1 data) (nth 2 data)
(plist-get completion-extra-properties
:predicate))))
- ((widget-field-find (point))
- ;; This defaulting used to be performed in widget-default-complete, but
- ;; it seems more appropriate here than in widget-default-completions.
- (call-interactively 'widget-complete-field))
(t
(error "Not in an editable field")))))
;; We may want to use widget completion in buffers where the major mode
(eval-minibuffer prompt))
(defun widget-docstring (widget)
- "Return the documentation string specificied by WIDGET, or nil if none.
+ "Return the documentation string specified by WIDGET, or nil if none.
If WIDGET has a `:doc' property, that specifies the documentation string.
Otherwise, try the `:documentation-property' property. If this
is a function, call it with the widget's value as an argument; if
(when (overlayp overlay)
(delete-overlay overlay))))
-(defun widget-field-value-get (widget)
- "Return current text in editing field."
+(defun widget-field-value-get (widget &optional no-truncate)
+ "Return current text in editing field.
+Normally, trailing spaces within the editing field are truncated.
+But if NO-TRUNCATE is non-nil, include them."
(let ((from (widget-field-start widget))
- (to (widget-field-text-end widget))
+ (to (if no-truncate
+ (widget-field-end widget)
+ (widget-field-text-end widget)))
(buffer (widget-field-buffer widget))
(secret (widget-get widget :secret))
(old (current-buffer)))
result))
(defun widget-checklist-validate (widget)
- ;; Ticked chilren must be valid.
+ ;; Ticked children must be valid.
(let ((children (widget-get widget :children))
child button found)
(while (and children (not found))
(push (widget-convert-button widget-documentation-link-type
begin end :value name)
buttons)))))
- (widget-put widget :buttons buttons)))
- (let ((indent (widget-get widget :indent)))
- (when (and indent (not (zerop indent)))
- (save-excursion
- (save-restriction
- (narrow-to-region from to)
- (goto-char (point-min))
- (while (search-forward "\n" nil t)
- (insert-char ?\s indent)))))))
+ (widget-put widget :buttons buttons))))
;;; The `documentation-string' Widget.
(start (point)))
(if (string-match "\n" doc)
(let ((before (substring doc 0 (match-beginning 0)))
- (after (substring doc (match-beginning 0)))
- button)
- (when (and indent (not (zerop indent)))
- (insert-char ?\s indent))
+ (after (substring doc (match-end 0)))
+ button end)
+ (widget-documentation-string-indent-to indent)
(insert before ?\s)
(widget-documentation-link-add widget start (point))
(setq button
:action 'widget-parent-action
shown))
(when shown
+ (insert ?\n)
(setq start (point))
(when (and indent (not (zerop indent)))
(insert-char ?\s indent))
(insert after)
- (widget-documentation-link-add widget start (point)))
+ (setq end (point))
+ (widget-documentation-link-add widget start end)
+ ;; Indent the subsequent lines.
+ (when (and indent (> indent 0))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-min))
+ (while (search-forward "\n" nil t)
+ (widget-documentation-string-indent-to indent))))))
(widget-put widget :buttons (list button)))
- (when (and indent (not (zerop indent)))
- (insert-char ?\s indent))
+ (widget-documentation-string-indent-to indent)
(insert doc)
(widget-documentation-link-add widget start (point))))
(insert ?\n))
+(defun widget-documentation-string-indent-to (col)
+ (when (and (numberp col)
+ (> col 0))
+ (let ((opoint (point)))
+ (indent-to col)
+ (put-text-property opoint (point)
+ 'display `(space :align-to ,col)))))
+
(defun widget-documentation-string-action (widget &rest _ignore)
;; Toggle documentation.
(let ((parent (widget-get widget :parent)))
:format "%{%t%}: %v\n"
:valid-regexp "\\`.\\'"
:error "This field should contain a single character"
+ :value-get (lambda (w) (widget-field-value-get w t))
:value-to-internal (lambda (_widget value)
(if (stringp value)
value
HCoop / bpt / emacs.git / blobdiff