X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/0b2014f9cb13efdd6ebc30627d88b9a7f3a42149..c695fb37d3d3f525918fd50878181be524cba200:/lisp/wid-edit.el diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 04a900f23c..f0054be4c8 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-2015 Free Software Foundation, Inc. +;; Copyright (C) 1996-1997, 1999-2016 Free Software Foundation, Inc. ;; ;; Author: Per Abrahamsen ;; Maintainer: emacs-devel@gnu.org @@ -241,7 +241,7 @@ minibuffer." (while items (setq choice (pop items)) (when (consp choice) - (let* ((name (car choice)) + (let* ((name (substitute-command-keys (car choice))) (function (cdr choice))) (insert (format "%c = %s\n" next-digit name)) (define-key map (vector next-digit) function) @@ -1267,7 +1267,7 @@ When not inside a field, signal an error." (defun widget-field-find (pos) "Return the field at POS. -Unlike (get-char-property POS 'field), this works with empty fields too." +Unlike (get-char-property POS \\='field), this works with empty fields too." (let ((fields widget-field-list) field found) (while fields @@ -1503,7 +1503,8 @@ The value of the :type attribute should be an unconverted widget type." (insert-char ?\s (widget-get widget :indent)))) ((eq escape ?t) (let ((image (widget-get widget :tag-glyph)) - (tag (widget-get widget :tag))) + (tag (substitute-command-keys + (widget-get widget :tag)))) (cond (image (widget-image-insert widget (or tag "image") image)) (tag @@ -1515,7 +1516,7 @@ The value of the :type attribute should be an unconverted widget type." (let ((doc (widget-get widget :doc))) (when doc (setq doc-begin (point)) - (insert doc) + (insert (substitute-command-keys doc)) (while (eq (preceding-char) ?\n) (delete-char -1)) (insert ?\n) @@ -1675,7 +1676,7 @@ as the argument to `documentation-property'." (cond ((functionp doc-prop) (funcall doc-prop value)) ((symbolp doc-prop) - (documentation-property value doc-prop))))))) + (documentation-property value doc-prop t))))))) (when (and (stringp doc) (> (length doc) 0)) ;; Remove any redundant `*' in the beginning. (when (eq (aref doc 0) ?*) @@ -1759,7 +1760,7 @@ If END is omitted, it defaults to the length of LIST." (defun widget-push-button-value-create (widget) "Insert text representing the `on' and `off' states." - (let* ((tag (or (widget-get widget :tag) + (let* ((tag (or (substitute-command-keys (widget-get widget :tag)) (widget-get widget :value))) (tag-glyph (widget-get widget :tag-glyph)) (text (concat widget-push-button-prefix @@ -2167,7 +2168,8 @@ when he invoked the menu." (defun widget-toggle-value-create (widget) "Insert text representing the `on' and `off' states." (let* ((val (widget-value widget)) - (text (widget-get widget (if val :on :off))) + (text (substitute-command-keys + (widget-get widget (if val :on :off)))) (img (widget-image-find (widget-get widget (if val :on-glyph :off-glyph))))) (widget-image-insert widget (or text "") @@ -2652,8 +2654,7 @@ Return an alist of (TYPE MATCH)." (save-excursion (let ((children (widget-get widget :children)) (inhibit-read-only t) - before-change-functions - after-change-functions) + (inhibit-modification-hooks t)) (cond (before (goto-char (widget-get before :entry-from))) (t @@ -2677,8 +2678,7 @@ Return an alist of (TYPE MATCH)." (let ((buttons (copy-sequence (widget-get widget :buttons))) button (inhibit-read-only t) - before-change-functions - after-change-functions) + (inhibit-modification-hooks t)) (while buttons (setq button (car buttons) buttons (cdr buttons)) @@ -2689,8 +2689,7 @@ Return an alist of (TYPE MATCH)." (let ((entry-from (widget-get child :entry-from)) (entry-to (widget-get child :entry-to)) (inhibit-read-only t) - before-change-functions - after-change-functions) + (inhibit-modification-hooks t)) (widget-delete child) (delete-region entry-from entry-to) (set-marker entry-from nil) @@ -2846,16 +2845,24 @@ The following properties have special meanings for this widget: (if (and (fboundp symbol) (boundp symbol)) ;; If there are two doc strings, give the user a way to pick one. (apropos (concat "\\`" (regexp-quote string) "\\'")) - (if (fboundp symbol) - (describe-function symbol) - (describe-variable symbol))))) + (cond + ((fboundp symbol) + (describe-function symbol)) + ((facep symbol) + (describe-face symbol)) + ((featurep symbol) + (describe-package symbol)) + ((or (boundp symbol) (get symbol 'variable-documentation)) + (describe-variable symbol)) + (t + (message "No documentation available for %s" symbol)))))) (defcustom widget-documentation-links t "Add hyperlinks to documentation strings when non-nil." :type 'boolean :group 'widget-documentation) -(defcustom widget-documentation-link-regexp "`\\([^\n`' ]+\\)'" +(defcustom widget-documentation-link-regexp "['`‘]\\([^\n `'‘’]+\\)['’]" "Regexp for matching potential links in documentation strings. The first group should be the link itself." :type 'regexp @@ -2906,7 +2913,7 @@ link for that string." (defun widget-documentation-string-value-create (widget) ;; Insert documentation string. - (let ((doc (widget-value widget)) + (let ((doc (substitute-command-keys (widget-value widget))) (indent (widget-get widget :indent)) (shown (widget-get (widget-get widget :parent) :documentation-shown)) (start (point))) @@ -3311,7 +3318,7 @@ It reads a directory name from an editable text field." ;; Avoid a confusing end-of-file error. (skip-syntax-forward "\\s-") (if (eobp) - (setq err "Empty sexp -- use `nil'?") + (setq err "Empty sexp -- use nil?") (unless (widget-apply widget :match (read (current-buffer))) (setq err (widget-get widget :type-error)))) ;; Allow whitespace after expression. @@ -3467,10 +3474,10 @@ 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 - (define-widget 'my-list 'choice + (define-widget \\='my-list \\='choice \"A list of sexps.\" :tag \"Sexp list\" - :args '((const nil) (cons :value (nil) sexp my-list))) + :args \\='((const nil) (cons :value (nil) sexp my-list))) Here we attempt to define my-list as a choice of either the constant nil, or a cons-cell containing a sexp and my-lisp. This will not work @@ -3479,10 +3486,10 @@ because the `choice' widget does not allow recursion. Using the `lazy' widget you can overcome this problem, as in this example: - (define-widget 'sexp-list 'lazy + (define-widget \\='sexp-list \\='lazy \"A list of sexps.\" :tag \"Sexp list\" - :type '(choice (const nil) (cons :value (nil) sexp sexp-list)))" + :type \\='(choice (const nil) (cons :value (nil) sexp sexp-list)))" :format "%{%t%}: %v" ;; We don't convert :type because we want to allow recursive ;; data structures. This is slow, so we should not create speed @@ -3696,9 +3703,9 @@ example: (widget-value-set ',(widget-get widget :parent) color) (let* ((buf (get-buffer "*Colors*")) (win (get-buffer-window buf 0))) - (bury-buffer buf) - (and win (> (length (window-list)) 1) - (delete-window win))) + (if win + (quit-window nil win) + (bury-buffer buf))) (pop-to-buffer ,(current-buffer)))))) (defun widget-color-sample-face-get (widget)