X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/136220349968063bef3f249baddba30a24b52ec2..54dd147ac382d97eb56672dec8e4e4993f80a343:/lisp/wid-edit.el diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index b6feecebde..b5598f6d14 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -1,6 +1,6 @@ ;;; 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 ;; Maintainer: FSF @@ -55,6 +55,7 @@ ;; See `widget.el'. ;;; Code: +(require 'cl-lib) ;;; Compatibility. @@ -221,7 +222,7 @@ minibuffer." ((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))) @@ -295,14 +296,6 @@ minibuffer." (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. @@ -526,7 +519,17 @@ Otherwise, just return the value." "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." @@ -2907,15 +2910,7 @@ link for that string." (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. @@ -2934,10 +2929,9 @@ link for that string." (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 @@ -2950,18 +2944,35 @@ link for that string." :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))) @@ -3451,14 +3462,14 @@ To use this type, you must define :match or :match-alternatives." ;; 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. @@ -3468,7 +3479,7 @@ not allow recursion. That is, when you define a new widget type, none 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 @@ -3491,7 +3502,7 @@ example: :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