;;; wid-edit.el --- Functions for creating and using widgets -*-byte-compile-dynamic: t; lexical-binding:t -*-
;;
-;; Copyright (C) 1996-1997, 1999-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1997, 1999-2014 Free Software Foundation, Inc.
;;
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
;; Keywords: extensions
;; Package: emacs
;; See `widget.el'.
;;; Code:
+(require 'cl-lib)
;;; Compatibility.
((or widget-menu-minibuffer-flag
(> (length items) widget-menu-max-shortcuts))
;; Read the choice of name from the minibuffer.
- (setq items (widget-remove-if 'stringp items))
+ (setq items (cl-remove-if 'stringp items))
(let ((val (completing-read (concat title ": ") items nil t)))
(if (stringp val)
(let ((try (try-completion val items)))
(error "Canceled"))
value))))
-(defun widget-remove-if (predicate list)
- (let (result (tail list))
- (while tail
- (or (funcall predicate (car tail))
- (setq result (cons (car tail) result)))
- (setq tail (cdr tail)))
- (nreverse result)))
-
;;; Widget text specifications.
;;
;; These functions are for specifying text properties.
"Extract the default external value of WIDGET."
(widget-apply widget :value-to-external
(or (widget-get widget :value)
- (widget-apply widget :default-get))))
+ (progn
+ (when (widget-get widget :args)
+ (setq widget (widget-copy widget))
+ (let (args)
+ (dolist (arg (widget-get widget :args))
+ (setq args (append args
+ (if (widget-get arg :inline)
+ (widget-get arg :args)
+ (list arg)))))
+ (widget-put widget :args args)))
+ (widget-apply widget :default-get)))))
(defun widget-match-inline (widget vals)
"In WIDGET, match the start of VALS."
(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
(let* ((value (widget-get widget :value))
(type (nth 0 (widget-get widget :args)))
children)
- (widget-put widget :value-pos (copy-marker (point)))
+ (widget-put widget :value-pos (point-marker))
(set-marker-insertion-type (widget-get widget :value-pos) t)
(while value
(let ((answer (widget-match-inline type value)))
(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)))
;; Recursive datatypes.
(define-widget 'lazy 'default
- "Base widget for recursive datastructures.
+ "Base widget for recursive data structures.
The `lazy' widget will, when instantiated, contain a single inferior
widget, of the widget type specified by the :type parameter. The
value of the `lazy' widget is the same as the value of the inferior
widget. When deriving a new widget from the 'lazy' widget, the :type
parameter is allowed to refer to the widget currently being defined,
-thus allowing recursive datastructures to be described.
+thus allowing recursive data structures to be described.
The :type parameter takes the same arguments as the defcustom
parameter with the same name.
of the inferior widgets may be of the same type you are currently
defining.
-In Lisp, however, it is custom to define datastructures in terms of
+In Lisp, however, it is custom to define data structures in terms of
themselves. A list, for example, is defined as either nil, or a cons
cell whose cdr itself is a list. The obvious way to translate this
into a widget type would be
:type '(choice (const nil) (cons :value (nil) sexp sexp-list)))"
:format "%{%t%}: %v"
;; We don't convert :type because we want to allow recursive
- ;; datastructures. This is slow, so we should not create speed
+ ;; data structures. This is slow, so we should not create speed
;; critical widgets by deriving from this.
:convert-widget 'widget-value-convert-widget
:value-create 'widget-type-value-create
HCoop / bpt / emacs.git / blobdiff