Mercurial > emacs
comparison lisp/wid-edit.el @ 64565:e4fcf58d872c
(widget-default-create, widget-after-change, widget-default-format-handler,
widget-checklist-add-item, widget-radio-add-item, widget-choose,
widget-specify-secret, widget-field-value-create, widget-field-value-get,
widget-editable-list-format-handler, widget-editable-list-entry-create,
widget-group-value-create, widget-documentation-link-add,
widget-documentation-string-value-create): "?\ " -> "?\s".
(widget-convert-text): Doc fix.
(widget-narrow-to-field, widget-field-find, widget-url-link-action,
widget-emacs-library-link-action, widget-color-notify): Fix typos in docstrings.
author | Juanma Barranquero <lekktu@gmail.com> |
---|---|
date | Thu, 21 Jul 2005 11:41:54 +0000 |
parents | 6d0e9c3f9769 |
children | 41bb365f41c4 187d6a1f84f7 |
comparison
equal
deleted
inserted
replaced
64564:4b552d6938e8 | 64565:e4fcf58d872c |
---|---|
273 (char 0) | 273 (char 0) |
274 (arg 1)) | 274 (arg 1)) |
275 (while (not (or (and (>= char ?0) (< char next-digit)) | 275 (while (not (or (and (>= char ?0) (< char next-digit)) |
276 (eq value 'keyboard-quit))) | 276 (eq value 'keyboard-quit))) |
277 ;; Unread a SPC to lead to our new menu. | 277 ;; Unread a SPC to lead to our new menu. |
278 (setq unread-command-events (cons ?\ unread-command-events)) | 278 (setq unread-command-events (cons ?\s unread-command-events)) |
279 (setq keys (read-key-sequence title)) | 279 (setq keys (read-key-sequence title)) |
280 (setq value | 280 (setq value |
281 (lookup-key overriding-terminal-local-map keys t) | 281 (lookup-key overriding-terminal-local-map keys t) |
282 char (string-to-char (substring keys 1))) | 282 char (string-to-char (substring keys 1))) |
283 (cond ((eq value 'scroll-other-window) | 283 (cond ((eq value 'scroll-other-window) |
375 (when secret | 375 (when secret |
376 (let ((begin (widget-field-start field)) | 376 (let ((begin (widget-field-start field)) |
377 (end (widget-field-end field))) | 377 (end (widget-field-end field))) |
378 (when size | 378 (when size |
379 (while (and (> end begin) | 379 (while (and (> end begin) |
380 (eq (char-after (1- end)) ?\ )) | 380 (eq (char-after (1- end)) ?\s)) |
381 (setq end (1- end)))) | 381 (setq end (1- end)))) |
382 (while (< begin end) | 382 (while (< begin end) |
383 (let ((old (char-after begin))) | 383 (let ((old (char-after begin))) |
384 (unless (eq old secret) | 384 (unless (eq old secret) |
385 (subst-char-in-region begin (1+ begin) old secret) | 385 (subst-char-in-region begin (1+ begin) old secret) |
794 | 794 |
795 (defun widget-convert-text (type from to | 795 (defun widget-convert-text (type from to |
796 &optional button-from button-to | 796 &optional button-from button-to |
797 &rest args) | 797 &rest args) |
798 "Return a widget of type TYPE with endpoint FROM TO. | 798 "Return a widget of type TYPE with endpoint FROM TO. |
799 Optional ARGS are extra keyword arguments for TYPE. | 799 No text will be inserted to the buffer, instead the text between FROM |
800 and TO will be used as the widgets end points. If optional arguments | 800 and TO will be used as the widgets end points. If optional arguments |
801 BUTTON-FROM and BUTTON-TO are given, these will be used as the widgets | 801 BUTTON-FROM and BUTTON-TO are given, these will be used as the widgets |
802 button end points. | 802 button end points. |
803 Optional ARGS are extra keyword arguments for TYPE." | 803 Optional ARGS are extra keyword arguments for TYPE." |
804 (let ((widget (apply 'widget-convert type :delete 'widget-leave-text args)) | 804 (let ((widget (apply 'widget-convert type :delete 'widget-leave-text args)) |
805 (from (copy-marker from)) | 805 (from (copy-marker from)) |
1103 :options '(ispell-complete-word complete-tag lisp-complete-symbol) | 1103 :options '(ispell-complete-word complete-tag lisp-complete-symbol) |
1104 :type 'function | 1104 :type 'function |
1105 :group 'widgets) | 1105 :group 'widgets) |
1106 | 1106 |
1107 (defun widget-narrow-to-field () | 1107 (defun widget-narrow-to-field () |
1108 "Narrow to field" | 1108 "Narrow to field." |
1109 (interactive) | 1109 (interactive) |
1110 (let ((field (widget-field-find (point)))) | 1110 (let ((field (widget-field-find (point)))) |
1111 (if field | 1111 (if field |
1112 (narrow-to-region (line-beginning-position) (line-end-position))))) | 1112 (narrow-to-region (line-beginning-position) (line-end-position))))) |
1113 | 1113 |
1211 (overlay-end overlay)) | 1211 (overlay-end overlay)) |
1212 (cdr overlay)))) | 1212 (cdr overlay)))) |
1213 | 1213 |
1214 (defun widget-field-find (pos) | 1214 (defun widget-field-find (pos) |
1215 "Return the field at POS. | 1215 "Return the field at POS. |
1216 Unlike (get-char-property POS 'field) this, works with empty fields too." | 1216 Unlike (get-char-property POS 'field), this works with empty fields too." |
1217 (let ((fields widget-field-list) | 1217 (let ((fields widget-field-list) |
1218 field found) | 1218 field found) |
1219 (while fields | 1219 (while fields |
1220 (setq field (car fields) | 1220 (setq field (car fields) |
1221 fields (cdr fields)) | 1221 fields (cdr fields)) |
1261 (end (widget-field-end field))) | 1261 (end (widget-field-end field))) |
1262 (cond ((< (- end begin) size) | 1262 (cond ((< (- end begin) size) |
1263 ;; Field too small. | 1263 ;; Field too small. |
1264 (save-excursion | 1264 (save-excursion |
1265 (goto-char end) | 1265 (goto-char end) |
1266 (insert-char ?\ (- (+ begin size) end)))) | 1266 (insert-char ?\s (- (+ begin size) end)))) |
1267 ((> (- end begin) size) | 1267 ((> (- end begin) size) |
1268 ;; Field too large and | 1268 ;; Field too large and |
1269 (if (or (< (point) (+ begin size)) | 1269 (if (or (< (point) (+ begin size)) |
1270 (> (point) end)) | 1270 (> (point) end)) |
1271 ;; Point is outside extra space. | 1271 ;; Point is outside extra space. |
1272 (setq begin (+ begin size)) | 1272 (setq begin (+ begin size)) |
1273 ;; Point is within the extra space. | 1273 ;; Point is within the extra space. |
1274 (setq begin (point))) | 1274 (setq begin (point))) |
1275 (save-excursion | 1275 (save-excursion |
1276 (goto-char end) | 1276 (goto-char end) |
1277 (while (and (eq (preceding-char) ?\ ) | 1277 (while (and (eq (preceding-char) ?\s) |
1278 (> (point) begin)) | 1278 (> (point) begin)) |
1279 (delete-backward-char 1))))))) | 1279 (delete-backward-char 1))))))) |
1280 (widget-specify-secret field)) | 1280 (widget-specify-secret field)) |
1281 (widget-apply field :notify field)))) | 1281 (widget-apply field :notify field)))) |
1282 | 1282 |
1432 ((eq escape ?\}) | 1432 ((eq escape ?\}) |
1433 (setq sample-end (point))) | 1433 (setq sample-end (point))) |
1434 ((eq escape ?n) | 1434 ((eq escape ?n) |
1435 (when (widget-get widget :indent) | 1435 (when (widget-get widget :indent) |
1436 (insert ?\n) | 1436 (insert ?\n) |
1437 (insert-char ? (widget-get widget :indent)))) | 1437 (insert-char ?\s (widget-get widget :indent)))) |
1438 ((eq escape ?t) | 1438 ((eq escape ?t) |
1439 (let ((image (widget-get widget :tag-glyph)) | 1439 (let ((image (widget-get widget :tag-glyph)) |
1440 (tag (widget-get widget :tag))) | 1440 (tag (widget-get widget :tag))) |
1441 (cond (image | 1441 (cond (image |
1442 (widget-image-insert widget (or tag "image") image)) | 1442 (widget-image-insert widget (or tag "image") image)) |
1496 doc-try)) | 1496 doc-try)) |
1497 (doc-indent (widget-get widget :documentation-indent))) | 1497 (doc-indent (widget-get widget :documentation-indent))) |
1498 (when doc-text | 1498 (when doc-text |
1499 (and (eq (preceding-char) ?\n) | 1499 (and (eq (preceding-char) ?\n) |
1500 (widget-get widget :indent) | 1500 (widget-get widget :indent) |
1501 (insert-char ? (widget-get widget :indent))) | 1501 (insert-char ?\s (widget-get widget :indent))) |
1502 ;; The `*' in the beginning is redundant. | 1502 ;; The `*' in the beginning is redundant. |
1503 (when (eq (aref doc-text 0) ?*) | 1503 (when (eq (aref doc-text 0) ?*) |
1504 (setq doc-text (substring doc-text 1))) | 1504 (setq doc-text (substring doc-text 1))) |
1505 ;; Get rid of trailing newlines. | 1505 ;; Get rid of trailing newlines. |
1506 (when (string-match "\n+\\'" doc-text) | 1506 (when (string-match "\n+\\'" doc-text) |
1749 (define-widget 'url-link 'link | 1749 (define-widget 'url-link 'link |
1750 "A link to an www page." | 1750 "A link to an www page." |
1751 :action 'widget-url-link-action) | 1751 :action 'widget-url-link-action) |
1752 | 1752 |
1753 (defun widget-url-link-action (widget &optional event) | 1753 (defun widget-url-link-action (widget &optional event) |
1754 "Open the url specified by WIDGET." | 1754 "Open the URL specified by WIDGET." |
1755 (browse-url (widget-value widget))) | 1755 (browse-url (widget-value widget))) |
1756 | 1756 |
1757 ;;; The `function-link' Widget. | 1757 ;;; The `function-link' Widget. |
1758 | 1758 |
1759 (define-widget 'function-link 'link | 1759 (define-widget 'function-link 'link |
1789 (define-widget 'emacs-library-link 'link | 1789 (define-widget 'emacs-library-link 'link |
1790 "A link to an Emacs Lisp library file." | 1790 "A link to an Emacs Lisp library file." |
1791 :action 'widget-emacs-library-link-action) | 1791 :action 'widget-emacs-library-link-action) |
1792 | 1792 |
1793 (defun widget-emacs-library-link-action (widget &optional event) | 1793 (defun widget-emacs-library-link-action (widget &optional event) |
1794 "Find the Emacs Library file specified by WIDGET." | 1794 "Find the Emacs library file specified by WIDGET." |
1795 (find-file (locate-library (widget-value widget)))) | 1795 (find-file (locate-library (widget-value widget)))) |
1796 | 1796 |
1797 ;;; The `emacs-commentary-link' Widget. | 1797 ;;; The `emacs-commentary-link' Widget. |
1798 | 1798 |
1799 (define-widget 'emacs-commentary-link 'link | 1799 (define-widget 'emacs-commentary-link 'link |
1870 (overlay (cons (make-marker) (make-marker)))) | 1870 (overlay (cons (make-marker) (make-marker)))) |
1871 (widget-put widget :field-overlay overlay) | 1871 (widget-put widget :field-overlay overlay) |
1872 (insert value) | 1872 (insert value) |
1873 (and size | 1873 (and size |
1874 (< (length value) size) | 1874 (< (length value) size) |
1875 (insert-char ?\ (- size (length value)))) | 1875 (insert-char ?\s (- size (length value)))) |
1876 (unless (memq widget widget-field-list) | 1876 (unless (memq widget widget-field-list) |
1877 (setq widget-field-new (cons widget widget-field-new))) | 1877 (setq widget-field-new (cons widget widget-field-new))) |
1878 (move-marker (cdr overlay) (point)) | 1878 (move-marker (cdr overlay) (point)) |
1879 (set-marker-insertion-type (cdr overlay) nil) | 1879 (set-marker-insertion-type (cdr overlay) nil) |
1880 (when (null size) | 1880 (when (null size) |
1903 (progn | 1903 (progn |
1904 (set-buffer buffer) | 1904 (set-buffer buffer) |
1905 (while (and size | 1905 (while (and size |
1906 (not (zerop size)) | 1906 (not (zerop size)) |
1907 (> to from) | 1907 (> to from) |
1908 (eq (char-after (1- to)) ?\ )) | 1908 (eq (char-after (1- to)) ?\s)) |
1909 (setq to (1- to))) | 1909 (setq to (1- to))) |
1910 (let ((result (buffer-substring-no-properties from to))) | 1910 (let ((result (buffer-substring-no-properties from to))) |
1911 (when secret | 1911 (when secret |
1912 (let ((index 0)) | 1912 (let ((index 0)) |
1913 (while (< (+ from index) to) | 1913 (while (< (+ from index) to) |
2184 (defun widget-checklist-add-item (widget type chosen) | 2184 (defun widget-checklist-add-item (widget type chosen) |
2185 "Create checklist item in WIDGET of type TYPE. | 2185 "Create checklist item in WIDGET of type TYPE. |
2186 If the item is checked, CHOSEN is a cons whose cdr is the value." | 2186 If the item is checked, CHOSEN is a cons whose cdr is the value." |
2187 (and (eq (preceding-char) ?\n) | 2187 (and (eq (preceding-char) ?\n) |
2188 (widget-get widget :indent) | 2188 (widget-get widget :indent) |
2189 (insert-char ? (widget-get widget :indent))) | 2189 (insert-char ?\s (widget-get widget :indent))) |
2190 (widget-specify-insert | 2190 (widget-specify-insert |
2191 (let* ((children (widget-get widget :children)) | 2191 (let* ((children (widget-get widget :children)) |
2192 (buttons (widget-get widget :buttons)) | 2192 (buttons (widget-get widget :buttons)) |
2193 (button-args (or (widget-get type :sibling-args) | 2193 (button-args (or (widget-get type :sibling-args) |
2194 (widget-get widget :button-args))) | 2194 (widget-get widget :button-args))) |
2364 (defun widget-radio-add-item (widget type) | 2364 (defun widget-radio-add-item (widget type) |
2365 "Add to radio widget WIDGET a new radio button item of type TYPE." | 2365 "Add to radio widget WIDGET a new radio button item of type TYPE." |
2366 ;; (setq type (widget-convert type)) | 2366 ;; (setq type (widget-convert type)) |
2367 (and (eq (preceding-char) ?\n) | 2367 (and (eq (preceding-char) ?\n) |
2368 (widget-get widget :indent) | 2368 (widget-get widget :indent) |
2369 (insert-char ? (widget-get widget :indent))) | 2369 (insert-char ?\s (widget-get widget :indent))) |
2370 (widget-specify-insert | 2370 (widget-specify-insert |
2371 (let* ((value (widget-get widget :value)) | 2371 (let* ((value (widget-get widget :value)) |
2372 (children (widget-get widget :children)) | 2372 (children (widget-get widget :children)) |
2373 (buttons (widget-get widget :buttons)) | 2373 (buttons (widget-get widget :buttons)) |
2374 (button-args (or (widget-get type :sibling-args) | 2374 (button-args (or (widget-get type :sibling-args) |
2542 (defun widget-editable-list-format-handler (widget escape) | 2542 (defun widget-editable-list-format-handler (widget escape) |
2543 ;; We recognize the insert button. | 2543 ;; We recognize the insert button. |
2544 ;; (let ((widget-push-button-gui widget-editable-list-gui)) | 2544 ;; (let ((widget-push-button-gui widget-editable-list-gui)) |
2545 (cond ((eq escape ?i) | 2545 (cond ((eq escape ?i) |
2546 (and (widget-get widget :indent) | 2546 (and (widget-get widget :indent) |
2547 (insert-char ?\ (widget-get widget :indent))) | 2547 (insert-char ?\s (widget-get widget :indent))) |
2548 (apply 'widget-create-child-and-convert | 2548 (apply 'widget-create-child-and-convert |
2549 widget 'insert-button | 2549 widget 'insert-button |
2550 (widget-get widget :append-button-args))) | 2550 (widget-get widget :append-button-args))) |
2551 (t | 2551 (t |
2552 (widget-default-format-handler widget escape))) | 2552 (widget-default-format-handler widget escape))) |
2654 ;; (widget-push-button-gui widget-editable-list-gui) | 2654 ;; (widget-push-button-gui widget-editable-list-gui) |
2655 child delete insert) | 2655 child delete insert) |
2656 (widget-specify-insert | 2656 (widget-specify-insert |
2657 (save-excursion | 2657 (save-excursion |
2658 (and (widget-get widget :indent) | 2658 (and (widget-get widget :indent) |
2659 (insert-char ?\ (widget-get widget :indent))) | 2659 (insert-char ?\s (widget-get widget :indent))) |
2660 (insert (widget-get widget :entry-format))) | 2660 (insert (widget-get widget :entry-format))) |
2661 ;; Parse % escapes in format. | 2661 ;; Parse % escapes in format. |
2662 (while (re-search-forward "%\\(.\\)" nil t) | 2662 (while (re-search-forward "%\\(.\\)" nil t) |
2663 (let ((escape (char-after (match-beginning 1)))) | 2663 (let ((escape (char-after (match-beginning 1)))) |
2664 (delete-backward-char 2) | 2664 (delete-backward-char 2) |
2718 args (cdr args) | 2718 args (cdr args) |
2719 answer (widget-match-inline arg value) | 2719 answer (widget-match-inline arg value) |
2720 value (cdr answer)) | 2720 value (cdr answer)) |
2721 (and (eq (preceding-char) ?\n) | 2721 (and (eq (preceding-char) ?\n) |
2722 (widget-get widget :indent) | 2722 (widget-get widget :indent) |
2723 (insert-char ?\ (widget-get widget :indent))) | 2723 (insert-char ?\s (widget-get widget :indent))) |
2724 (push (cond ((null answer) | 2724 (push (cond ((null answer) |
2725 (widget-create-child widget arg)) | 2725 (widget-create-child widget arg)) |
2726 ((widget-get arg :inline) | 2726 ((widget-get arg :inline) |
2727 (widget-create-child-value widget arg (car answer))) | 2727 (widget-create-child-value widget arg (car answer))) |
2728 (t | 2728 (t |
2857 (save-excursion | 2857 (save-excursion |
2858 (save-restriction | 2858 (save-restriction |
2859 (narrow-to-region from to) | 2859 (narrow-to-region from to) |
2860 (goto-char (point-min)) | 2860 (goto-char (point-min)) |
2861 (while (search-forward "\n" nil t) | 2861 (while (search-forward "\n" nil t) |
2862 (insert-char ?\ indent))))))) | 2862 (insert-char ?\s indent))))))) |
2863 | 2863 |
2864 ;;; The `documentation-string' Widget. | 2864 ;;; The `documentation-string' Widget. |
2865 | 2865 |
2866 (define-widget 'documentation-string 'item | 2866 (define-widget 'documentation-string 'item |
2867 "A documentation string." | 2867 "A documentation string." |
2877 (start (point))) | 2877 (start (point))) |
2878 (if (string-match "\n" doc) | 2878 (if (string-match "\n" doc) |
2879 (let ((before (substring doc 0 (match-beginning 0))) | 2879 (let ((before (substring doc 0 (match-beginning 0))) |
2880 (after (substring doc (match-beginning 0))) | 2880 (after (substring doc (match-beginning 0))) |
2881 button) | 2881 button) |
2882 (insert before ?\ ) | 2882 (insert before ?\s) |
2883 (widget-documentation-link-add widget start (point)) | 2883 (widget-documentation-link-add widget start (point)) |
2884 (setq button | 2884 (setq button |
2885 (widget-create-child-and-convert | 2885 (widget-create-child-and-convert |
2886 widget 'visibility | 2886 widget 'visibility |
2887 :help-echo "Show or hide rest of the documentation." | 2887 :help-echo "Show or hide rest of the documentation." |
2891 :action 'widget-parent-action | 2891 :action 'widget-parent-action |
2892 shown)) | 2892 shown)) |
2893 (when shown | 2893 (when shown |
2894 (setq start (point)) | 2894 (setq start (point)) |
2895 (when (and indent (not (zerop indent))) | 2895 (when (and indent (not (zerop indent))) |
2896 (insert-char ?\ indent)) | 2896 (insert-char ?\s indent)) |
2897 (insert after) | 2897 (insert after) |
2898 (widget-documentation-link-add widget start (point))) | 2898 (widget-documentation-link-add widget start (point))) |
2899 (widget-put widget :buttons (list button))) | 2899 (widget-put widget :buttons (list button))) |
2900 (insert doc) | 2900 (insert doc) |
2901 (widget-documentation-link-add widget start (point)))) | 2901 (widget-documentation-link-add widget start (point)))) |
3592 (widget-value-set widget answer) | 3592 (widget-value-set widget answer) |
3593 (widget-setup) | 3593 (widget-setup) |
3594 (widget-apply widget :notify widget event)))) | 3594 (widget-apply widget :notify widget event)))) |
3595 | 3595 |
3596 (defun widget-color-notify (widget child &optional event) | 3596 (defun widget-color-notify (widget child &optional event) |
3597 "Update the sample, and notofy the parent." | 3597 "Update the sample, and notify the parent." |
3598 (overlay-put (widget-get widget :sample-overlay) | 3598 (overlay-put (widget-get widget :sample-overlay) |
3599 'face (widget-apply widget :sample-face-get)) | 3599 'face (widget-apply widget :sample-face-get)) |
3600 (widget-default-notify widget child event)) | 3600 (widget-default-notify widget child event)) |
3601 | 3601 |
3602 ;;; The Help Echo | 3602 ;;; The Help Echo |