Mercurial > emacs
comparison lisp/wid-edit.el @ 81430:cade0e5b26d6
(widget-default-create): Move ?h handling here...
(widget-default-format-handler): ...from here.
(widget-docstring, widget-add-documentation-string-button): New funs.
(documentation-string): Add :visibility-widget property.
(widget-documentation-string-value-create): Use it.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Thu, 14 Jun 2007 23:09:25 +0000 |
parents | d0794795863c |
children | 8429053c4496 |
comparison
equal
deleted
inserted
replaced
81429:fb627c8fac18 | 81430:cade0e5b26d6 |
---|---|
1489 (insert doc) | 1489 (insert doc) |
1490 (while (eq (preceding-char) ?\n) | 1490 (while (eq (preceding-char) ?\n) |
1491 (delete-backward-char 1)) | 1491 (delete-backward-char 1)) |
1492 (insert ?\n) | 1492 (insert ?\n) |
1493 (setq doc-end (point))))) | 1493 (setq doc-end (point))))) |
1494 ((eq escape ?h) | |
1495 (widget-add-documentation-string-button widget)) | |
1494 ((eq escape ?v) | 1496 ((eq escape ?v) |
1495 (if (and button-begin (not button-end)) | 1497 (if (and button-begin (not button-end)) |
1496 (widget-apply widget :value-create) | 1498 (widget-apply widget :value-create) |
1497 (setq value-pos (point)))) | 1499 (setq value-pos (point)))) |
1498 (t | 1500 (t |
1514 (widget-put widget :from from) | 1516 (widget-put widget :from from) |
1515 (widget-put widget :to to))) | 1517 (widget-put widget :to to))) |
1516 (widget-clear-undo)) | 1518 (widget-clear-undo)) |
1517 | 1519 |
1518 (defun widget-default-format-handler (widget escape) | 1520 (defun widget-default-format-handler (widget escape) |
1519 ;; We recognize the %h escape by default. | 1521 (error "Unknown escape `%c'" escape)) |
1520 (let* ((buttons (widget-get widget :buttons))) | |
1521 (cond ((eq escape ?h) | |
1522 (let* ((doc-property (widget-get widget :documentation-property)) | |
1523 (doc-try (cond ((widget-get widget :doc)) | |
1524 ((functionp doc-property) | |
1525 (funcall doc-property | |
1526 (widget-get widget :value))) | |
1527 ((symbolp doc-property) | |
1528 (documentation-property | |
1529 (widget-get widget :value) | |
1530 doc-property)))) | |
1531 (doc-text (and (stringp doc-try) | |
1532 (> (length doc-try) 1) | |
1533 doc-try)) | |
1534 (doc-indent (widget-get widget :documentation-indent))) | |
1535 (when doc-text | |
1536 (and (eq (preceding-char) ?\n) | |
1537 (widget-get widget :indent) | |
1538 (insert-char ?\s (widget-get widget :indent))) | |
1539 ;; The `*' in the beginning is redundant. | |
1540 (when (eq (aref doc-text 0) ?*) | |
1541 (setq doc-text (substring doc-text 1))) | |
1542 ;; Get rid of trailing newlines. | |
1543 (when (string-match "\n+\\'" doc-text) | |
1544 (setq doc-text (substring doc-text 0 (match-beginning 0)))) | |
1545 (push (widget-create-child-and-convert | |
1546 widget 'documentation-string | |
1547 :indent (cond ((numberp doc-indent ) | |
1548 doc-indent) | |
1549 ((null doc-indent) | |
1550 nil) | |
1551 (t 0)) | |
1552 doc-text) | |
1553 buttons)))) | |
1554 (t | |
1555 (error "Unknown escape `%c'" escape))) | |
1556 (widget-put widget :buttons buttons))) | |
1557 | 1522 |
1558 (defun widget-default-button-face-get (widget) | 1523 (defun widget-default-button-face-get (widget) |
1559 ;; Use :button-face or widget-button-face | 1524 ;; Use :button-face or widget-button-face |
1560 (or (widget-get widget :button-face) | 1525 (or (widget-get widget :button-face) |
1561 (let ((parent (widget-get widget :parent))) | 1526 (let ((parent (widget-get widget :parent))) |
1663 (defun widget-default-notify (widget child &optional event) | 1628 (defun widget-default-notify (widget child &optional event) |
1664 "Pass notification to parent." | 1629 "Pass notification to parent." |
1665 (widget-default-action widget event)) | 1630 (widget-default-action widget event)) |
1666 | 1631 |
1667 (defun widget-default-prompt-value (widget prompt value unbound) | 1632 (defun widget-default-prompt-value (widget prompt value unbound) |
1668 "Read an arbitrary value. Stolen from `set-variable'." | 1633 "Read an arbitrary value." |
1669 ;; (let ((initial (if unbound | |
1670 ;; nil | |
1671 ;; It would be nice if we could do a `(cons val 1)' here. | |
1672 ;; (prin1-to-string (custom-quote value)))))) | |
1673 (eval-minibuffer prompt)) | 1634 (eval-minibuffer prompt)) |
1635 | |
1636 (defun widget-docstring (widget) | |
1637 "Return the documentation string specificied by WIDGET, or nil if none. | |
1638 If WIDGET has a `:doc' property, that specifies the documentation string. | |
1639 Otherwise, try the `:documentation-property' property. If this | |
1640 is a function, call it with the widget's value as an argument; if | |
1641 it is a symbol, use this symbol together with the widget's value | |
1642 as the argument to `documentation-property'." | |
1643 (let ((doc (or (widget-get widget :doc) | |
1644 (let ((doc-prop (widget-get widget :documentation-property)) | |
1645 (value (widget-get widget :value))) | |
1646 (cond ((functionp doc-prop) | |
1647 (funcall doc-prop value)) | |
1648 ((symbolp doc-prop) | |
1649 (documentation-property value doc-prop))))))) | |
1650 (when (and (stringp doc) (> (length doc) 0)) | |
1651 ;; Remove any redundant `*' in the beginning. | |
1652 (when (eq (aref doc 0) ?*) | |
1653 (setq doc (substring doc 1))) | |
1654 ;; Remove trailing newlines. | |
1655 (when (string-match "\n+\\'" doc) | |
1656 (setq doc (substring doc 0 (match-beginning 0)))) | |
1657 doc))) | |
1674 | 1658 |
1675 ;;; The `item' Widget. | 1659 ;;; The `item' Widget. |
1676 | 1660 |
1677 (define-widget 'item 'default | 1661 (define-widget 'item 'default |
1678 "Constant items for inclusion in other widgets." | 1662 "Constant items for inclusion in other widgets." |
2911 | 2895 |
2912 (define-widget 'documentation-string 'item | 2896 (define-widget 'documentation-string 'item |
2913 "A documentation string." | 2897 "A documentation string." |
2914 :format "%v" | 2898 :format "%v" |
2915 :action 'widget-documentation-string-action | 2899 :action 'widget-documentation-string-action |
2916 :value-create 'widget-documentation-string-value-create) | 2900 :value-create 'widget-documentation-string-value-create |
2901 :visibility-widget 'visibility) | |
2917 | 2902 |
2918 (defun widget-documentation-string-value-create (widget) | 2903 (defun widget-documentation-string-value-create (widget) |
2919 ;; Insert documentation string. | 2904 ;; Insert documentation string. |
2920 (let ((doc (widget-value widget)) | 2905 (let ((doc (widget-value widget)) |
2921 (indent (widget-get widget :indent)) | 2906 (indent (widget-get widget :indent)) |
2927 button) | 2912 button) |
2928 (insert before ?\s) | 2913 (insert before ?\s) |
2929 (widget-documentation-link-add widget start (point)) | 2914 (widget-documentation-link-add widget start (point)) |
2930 (setq button | 2915 (setq button |
2931 (widget-create-child-and-convert | 2916 (widget-create-child-and-convert |
2932 widget 'visibility | 2917 widget (widget-get widget :visibility-widget) |
2933 :help-echo "Show or hide rest of the documentation." | 2918 :help-echo "Show or hide rest of the documentation." |
2934 :on "Hide Rest" | 2919 :on "Hide Rest" |
2935 :off "More" | 2920 :off "More" |
2936 :always-active t | 2921 :always-active t |
2937 :action 'widget-parent-action | 2922 :action 'widget-parent-action |
2952 (let ((parent (widget-get widget :parent))) | 2937 (let ((parent (widget-get widget :parent))) |
2953 (widget-put parent :documentation-shown | 2938 (widget-put parent :documentation-shown |
2954 (not (widget-get parent :documentation-shown)))) | 2939 (not (widget-get parent :documentation-shown)))) |
2955 ;; Redraw. | 2940 ;; Redraw. |
2956 (widget-value-set widget (widget-value widget))) | 2941 (widget-value-set widget (widget-value widget))) |
2942 | |
2943 (defun widget-add-documentation-string-button (widget &rest args) | |
2944 "Insert a new `documentation-string' widget based on WIDGET. | |
2945 The new widget becomes a child of WIDGET, and is also added to | |
2946 its `:buttons' list. The documentation string is found from | |
2947 WIDGET using the function `widget-docstring'. | |
2948 Optional ARGS specifies additional keyword arguments for the | |
2949 `documentation-string' widget." | |
2950 (let ((doc (widget-docstring widget)) | |
2951 (indent (widget-get widget :indent)) | |
2952 (doc-indent (widget-get widget :documentation-indent))) | |
2953 (when doc | |
2954 (and (eq (preceding-char) ?\n) | |
2955 indent | |
2956 (insert-char ?\s indent)) | |
2957 (unless (or (numberp doc-indent) (null doc-indent)) | |
2958 (setq doc-indent 0)) | |
2959 (setq indent (widget-get widget :documentation-indent)) | |
2960 (widget-put widget :buttons | |
2961 (cons (apply 'widget-create-child-and-convert | |
2962 widget 'documentation-string | |
2963 :indent indent | |
2964 (nconc args (list doc))) | |
2965 (widget-get widget :buttons)))))) | |
2957 | 2966 |
2958 ;;; The Sexp Widgets. | 2967 ;;; The Sexp Widgets. |
2959 | 2968 |
2960 (define-widget 'const 'item | 2969 (define-widget 'const 'item |
2961 "An immutable sexp." | 2970 "An immutable sexp." |