diff options
| author | Per Abrahamsen | 1997-07-02 15:35:18 +0000 |
|---|---|---|
| committer | Per Abrahamsen | 1997-07-02 15:35:18 +0000 |
| commit | c953515ea36cb7aab77986bb701a9b7f880b97ea (patch) | |
| tree | 5e23b7bc2689dee773f1a2db760d0950e9849775 | |
| parent | 9765a2bab66d6071f83ed61853d8cddb7bcbc060 (diff) | |
| download | emacs-c953515ea36cb7aab77986bb701a9b7f880b97ea.tar.gz emacs-c953515ea36cb7aab77986bb701a9b7f880b97ea.zip | |
Synched with 1.9942.
| -rw-r--r-- | lisp/cus-edit.el | 148 | ||||
| -rw-r--r-- | lisp/wid-edit.el | 41 |
2 files changed, 136 insertions, 53 deletions
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index d24167aaea0..156b78b793f 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el | |||
| @@ -4,7 +4,7 @@ | |||
| 4 | ;; | 4 | ;; |
| 5 | ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> | 5 | ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> |
| 6 | ;; Keywords: help, faces | 6 | ;; Keywords: help, faces |
| 7 | ;; Version: 1.9936 | 7 | ;; Version: 1.9942 |
| 8 | ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ | 8 | ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ |
| 9 | 9 | ||
| 10 | ;; This file is part of GNU Emacs. | 10 | ;; This file is part of GNU Emacs. |
| @@ -568,6 +568,11 @@ If `last', order groups after non-groups." | |||
| 568 | (const :tag "none" nil)) | 568 | (const :tag "none" nil)) |
| 569 | :group 'custom-browse) | 569 | :group 'custom-browse) |
| 570 | 570 | ||
| 571 | (defcustom custom-browse-only-groups nil | ||
| 572 | "If non-nil, show group members only within each customization group." | ||
| 573 | :type 'boolean | ||
| 574 | :group 'custom-browse) | ||
| 575 | |||
| 571 | (defcustom custom-buffer-sort-alphabetically nil | 576 | (defcustom custom-buffer-sort-alphabetically nil |
| 572 | "If non-nil, sort members of each customization group alphabetically." | 577 | "If non-nil, sort members of each customization group alphabetically." |
| 573 | :type 'boolean | 578 | :type 'boolean |
| @@ -1118,9 +1123,27 @@ Reset all values in this buffer to their standard settings." | |||
| 1118 | (switch-to-buffer (get-buffer-create name))) | 1123 | (switch-to-buffer (get-buffer-create name))) |
| 1119 | (custom-mode) | 1124 | (custom-mode) |
| 1120 | (widget-insert "\ | 1125 | (widget-insert "\ |
| 1121 | Invoke [+] below to expand items, and [-] to collapse items. | 1126 | Invoke [+] or [?] below to expand items, and [-] to collapse items.\n") |
| 1122 | Invoke the [Group], [Face], and [Option] buttons below to edit that | 1127 | (if custom-browse-only-groups |
| 1123 | item in another window.\n\n") | 1128 | (widget-insert "\ |
| 1129 | Invoke the [Group] button below to edit that item in another window.\n\n") | ||
| 1130 | (widget-insert "Invoke the ") | ||
| 1131 | (widget-create 'item | ||
| 1132 | :format "%t" | ||
| 1133 | :tag "[Group]" | ||
| 1134 | :tag-glyph "folder") | ||
| 1135 | (widget-insert ", ") | ||
| 1136 | (widget-create 'item | ||
| 1137 | :format "%t" | ||
| 1138 | :tag "[Face]" | ||
| 1139 | :tag-glyph "face") | ||
| 1140 | (widget-insert ", and ") | ||
| 1141 | (widget-create 'item | ||
| 1142 | :format "%t" | ||
| 1143 | :tag "[Option]" | ||
| 1144 | :tag-glyph "option") | ||
| 1145 | (widget-insert " buttons below to edit that | ||
| 1146 | item in another window.\n\n")) | ||
| 1124 | (let ((custom-buffer-style 'tree)) | 1147 | (let ((custom-buffer-style 'tree)) |
| 1125 | (widget-create 'custom-group | 1148 | (widget-create 'custom-group |
| 1126 | :custom-last t | 1149 | :custom-last t |
| @@ -1129,52 +1152,52 @@ item in another window.\n\n") | |||
| 1129 | :value group)) | 1152 | :value group)) |
| 1130 | (goto-char (point-min))) | 1153 | (goto-char (point-min))) |
| 1131 | 1154 | ||
| 1132 | (define-widget 'custom-tree-visibility 'item | 1155 | (define-widget 'custom-browse-visibility 'item |
| 1133 | "Control visibility of of items in the customize tree browser." | 1156 | "Control visibility of of items in the customize tree browser." |
| 1134 | :format "%[[%t]%]" | 1157 | :format "%[[%t]%]" |
| 1135 | :action 'custom-tree-visibility-action) | 1158 | :action 'custom-browse-visibility-action) |
| 1136 | 1159 | ||
| 1137 | (defun custom-tree-visibility-action (widget &rest ignore) | 1160 | (defun custom-browse-visibility-action (widget &rest ignore) |
| 1138 | (let ((custom-buffer-style 'tree)) | 1161 | (let ((custom-buffer-style 'tree)) |
| 1139 | (custom-toggle-parent widget))) | 1162 | (custom-toggle-parent widget))) |
| 1140 | 1163 | ||
| 1141 | (define-widget 'custom-tree-group-tag 'push-button | 1164 | (define-widget 'custom-browse-group-tag 'push-button |
| 1142 | "Show parent in other window when activated." | 1165 | "Show parent in other window when activated." |
| 1143 | :tag "Group" | 1166 | :tag "Group" |
| 1144 | :tag-glyph "folder" | 1167 | :tag-glyph "folder" |
| 1145 | :action 'custom-tree-group-tag-action) | 1168 | :action 'custom-browse-group-tag-action) |
| 1146 | 1169 | ||
| 1147 | (defun custom-tree-group-tag-action (widget &rest ignore) | 1170 | (defun custom-browse-group-tag-action (widget &rest ignore) |
| 1148 | (let ((parent (widget-get widget :parent))) | 1171 | (let ((parent (widget-get widget :parent))) |
| 1149 | (customize-group-other-window (widget-value parent)))) | 1172 | (customize-group-other-window (widget-value parent)))) |
| 1150 | 1173 | ||
| 1151 | (define-widget 'custom-tree-variable-tag 'push-button | 1174 | (define-widget 'custom-browse-variable-tag 'push-button |
| 1152 | "Show parent in other window when activated." | 1175 | "Show parent in other window when activated." |
| 1153 | :tag "Option" | 1176 | :tag "Option" |
| 1154 | :tag-glyph "option" | 1177 | :tag-glyph "option" |
| 1155 | :action 'custom-tree-variable-tag-action) | 1178 | :action 'custom-browse-variable-tag-action) |
| 1156 | 1179 | ||
| 1157 | (defun custom-tree-variable-tag-action (widget &rest ignore) | 1180 | (defun custom-browse-variable-tag-action (widget &rest ignore) |
| 1158 | (let ((parent (widget-get widget :parent))) | 1181 | (let ((parent (widget-get widget :parent))) |
| 1159 | (customize-variable-other-window (widget-value parent)))) | 1182 | (customize-variable-other-window (widget-value parent)))) |
| 1160 | 1183 | ||
| 1161 | (define-widget 'custom-tree-face-tag 'push-button | 1184 | (define-widget 'custom-browse-face-tag 'push-button |
| 1162 | "Show parent in other window when activated." | 1185 | "Show parent in other window when activated." |
| 1163 | :tag "Face" | 1186 | :tag "Face" |
| 1164 | :tag-glyph "face" | 1187 | :tag-glyph "face" |
| 1165 | :action 'custom-tree-face-tag-action) | 1188 | :action 'custom-browse-face-tag-action) |
| 1166 | 1189 | ||
| 1167 | (defun custom-tree-face-tag-action (widget &rest ignore) | 1190 | (defun custom-browse-face-tag-action (widget &rest ignore) |
| 1168 | (let ((parent (widget-get widget :parent))) | 1191 | (let ((parent (widget-get widget :parent))) |
| 1169 | (customize-face-other-window (widget-value parent)))) | 1192 | (customize-face-other-window (widget-value parent)))) |
| 1170 | 1193 | ||
| 1171 | (defconst custom-tree-alist '((" " "space") | 1194 | (defconst custom-browse-alist '((" " "space") |
| 1172 | (" | " "vertical") | 1195 | (" | " "vertical") |
| 1173 | ("-\\ " "top") | 1196 | ("-\\ " "top") |
| 1174 | (" |-" "middle") | 1197 | (" |-" "middle") |
| 1175 | (" `-" "bottom"))) | 1198 | (" `-" "bottom"))) |
| 1176 | 1199 | ||
| 1177 | (defun custom-tree-insert-prefix (prefix) | 1200 | (defun custom-browse-insert-prefix (prefix) |
| 1178 | "Insert PREFIX. On XEmacs convert it to line graphics." | 1201 | "Insert PREFIX. On XEmacs convert it to line graphics." |
| 1179 | (if nil ; (string-match "XEmacs" emacs-version) | 1202 | (if nil ; (string-match "XEmacs" emacs-version) |
| 1180 | (progn | 1203 | (progn |
| @@ -1183,7 +1206,7 @@ item in another window.\n\n") | |||
| 1183 | (let ((entry (substring prefix 0 3))) | 1206 | (let ((entry (substring prefix 0 3))) |
| 1184 | (setq prefix (substring prefix 3)) | 1207 | (setq prefix (substring prefix 3)) |
| 1185 | (let ((overlay (make-overlay (1- (point)) (point) nil t nil)) | 1208 | (let ((overlay (make-overlay (1- (point)) (point) nil t nil)) |
| 1186 | (name (nth 1 (assoc entry custom-tree-alist)))) | 1209 | (name (nth 1 (assoc entry custom-browse-alist)))) |
| 1187 | (overlay-put overlay 'end-glyph (widget-glyph-find name entry)) | 1210 | (overlay-put overlay 'end-glyph (widget-glyph-find name entry)) |
| 1188 | (overlay-put overlay 'start-open t) | 1211 | (overlay-put overlay 'start-open t) |
| 1189 | (overlay-put overlay 'end-open t))))) | 1212 | (overlay-put overlay 'end-open t))))) |
| @@ -1567,8 +1590,31 @@ and `face'." | |||
| 1567 | "Load all dependencies for WIDGET." | 1590 | "Load all dependencies for WIDGET." |
| 1568 | (custom-load-symbol (widget-value widget))) | 1591 | (custom-load-symbol (widget-value widget))) |
| 1569 | 1592 | ||
| 1593 | (defun custom-unloaded-symbol-p (symbol) | ||
| 1594 | "Return non-nil if the dependencies of SYMBOL has not yet been loaded." | ||
| 1595 | (let ((found nil) | ||
| 1596 | (loads (get symbol 'custom-loads)) | ||
| 1597 | load) | ||
| 1598 | (while loads | ||
| 1599 | (setq load (car loads) | ||
| 1600 | loads (cdr loads)) | ||
| 1601 | (cond ((symbolp load) | ||
| 1602 | (unless (featurep load) | ||
| 1603 | (setq found t))) | ||
| 1604 | ((assoc load load-history)) | ||
| 1605 | ((assoc (locate-library load) load-history) | ||
| 1606 | (message nil)) | ||
| 1607 | (t | ||
| 1608 | (setq found t)))) | ||
| 1609 | found)) | ||
| 1610 | |||
| 1611 | (defun custom-unloaded-widget-p (widget) | ||
| 1612 | "Return non-nil if the dependencies of WIDGET has not yet been loaded." | ||
| 1613 | (custom-unloaded-symbol-p (widget-value widget))) | ||
| 1614 | |||
| 1570 | (defun custom-toggle-hide (widget) | 1615 | (defun custom-toggle-hide (widget) |
| 1571 | "Toggle visibility of WIDGET." | 1616 | "Toggle visibility of WIDGET." |
| 1617 | (custom-load-widget widget) | ||
| 1572 | (let ((state (widget-get widget :custom-state))) | 1618 | (let ((state (widget-get widget :custom-state))) |
| 1573 | (cond ((memq state '(invalid modified)) | 1619 | (cond ((memq state '(invalid modified)) |
| 1574 | (error "There are unset changes")) | 1620 | (error "There are unset changes")) |
| @@ -1719,7 +1765,7 @@ Otherwise, look up symbol in `custom-guess-type-alist'." | |||
| 1719 | (cond ((eq custom-buffer-style 'tree) | 1765 | (cond ((eq custom-buffer-style 'tree) |
| 1720 | (insert prefix (if last " `--- " " |--- ")) | 1766 | (insert prefix (if last " `--- " " |--- ")) |
| 1721 | (push (widget-create-child-and-convert | 1767 | (push (widget-create-child-and-convert |
| 1722 | widget 'custom-tree-variable-tag) | 1768 | widget 'custom-browse-variable-tag) |
| 1723 | buttons) | 1769 | buttons) |
| 1724 | (insert " " tag "\n") | 1770 | (insert " " tag "\n") |
| 1725 | (widget-put widget :buttons buttons)) | 1771 | (widget-put widget :buttons buttons)) |
| @@ -2153,7 +2199,7 @@ Match frames with dark backgrounds.") | |||
| 2153 | (cond ((eq custom-buffer-style 'tree) | 2199 | (cond ((eq custom-buffer-style 'tree) |
| 2154 | (insert prefix (if is-last " `--- " " |--- ")) | 2200 | (insert prefix (if is-last " `--- " " |--- ")) |
| 2155 | (push (widget-create-child-and-convert | 2201 | (push (widget-create-child-and-convert |
| 2156 | widget 'custom-tree-face-tag) | 2202 | widget 'custom-browse-face-tag) |
| 2157 | buttons) | 2203 | buttons) |
| 2158 | (insert " " tag "\n") | 2204 | (insert " " tag "\n") |
| 2159 | (widget-put widget :buttons buttons)) | 2205 | (widget-put widget :buttons buttons)) |
| @@ -2506,54 +2552,56 @@ and so forth. The remaining group tags are shown with | |||
| 2506 | (tag (widget-get widget :tag)) | 2552 | (tag (widget-get widget :tag)) |
| 2507 | (symbol (widget-value widget))) | 2553 | (symbol (widget-value widget))) |
| 2508 | (cond ((and (eq custom-buffer-style 'tree) | 2554 | (cond ((and (eq custom-buffer-style 'tree) |
| 2509 | (eq state 'hidden)) | 2555 | (eq state 'hidden) |
| 2510 | (custom-tree-insert-prefix prefix) | 2556 | (or (get symbol 'custom-group) |
| 2557 | (custom-unloaded-widget-p widget))) | ||
| 2558 | (custom-browse-insert-prefix prefix) | ||
| 2511 | (push (widget-create-child-and-convert | 2559 | (push (widget-create-child-and-convert |
| 2512 | widget 'custom-tree-visibility | 2560 | widget 'custom-browse-visibility |
| 2513 | ;; :tag-glyph "plus" | 2561 | ;; :tag-glyph "plus" |
| 2514 | :tag "+") | 2562 | :tag (if (custom-unloaded-widget-p widget) "?" "+")) |
| 2515 | buttons) | 2563 | buttons) |
| 2516 | (insert "-- ") | 2564 | (insert "-- ") |
| 2517 | ;; (widget-glyph-insert nil "-- " "horizontal") | 2565 | ;; (widget-glyph-insert nil "-- " "horizontal") |
| 2518 | (push (widget-create-child-and-convert | 2566 | (push (widget-create-child-and-convert |
| 2519 | widget 'custom-tree-group-tag) | 2567 | widget 'custom-browse-group-tag) |
| 2520 | buttons) | 2568 | buttons) |
| 2521 | (insert " " tag "\n") | 2569 | (insert " " tag "\n") |
| 2522 | (widget-put widget :buttons buttons)) | 2570 | (widget-put widget :buttons buttons)) |
| 2523 | ((and (eq custom-buffer-style 'tree) | 2571 | ((and (eq custom-buffer-style 'tree) |
| 2524 | (zerop (length (get symbol 'custom-group)))) | 2572 | (zerop (length (get symbol 'custom-group)))) |
| 2525 | (custom-tree-insert-prefix prefix) | 2573 | (custom-browse-insert-prefix prefix) |
| 2526 | (insert "[ ]-- ") | 2574 | (insert "[ ]-- ") |
| 2527 | ;; (widget-glyph-insert nil "[ ]" "empty") | 2575 | ;; (widget-glyph-insert nil "[ ]" "empty") |
| 2528 | ;; (widget-glyph-insert nil "-- " "horizontal") | 2576 | ;; (widget-glyph-insert nil "-- " "horizontal") |
| 2529 | (push (widget-create-child-and-convert | 2577 | (push (widget-create-child-and-convert |
| 2530 | widget 'custom-tree-group-tag) | 2578 | widget 'custom-browse-group-tag) |
| 2531 | buttons) | 2579 | buttons) |
| 2532 | (insert " " tag "\n") | 2580 | (insert " " tag "\n") |
| 2533 | (widget-put widget :buttons buttons)) | 2581 | (widget-put widget :buttons buttons)) |
| 2534 | ((eq custom-buffer-style 'tree) | 2582 | ((eq custom-buffer-style 'tree) |
| 2535 | (custom-tree-insert-prefix prefix) | 2583 | (custom-browse-insert-prefix prefix) |
| 2536 | (custom-load-widget widget) | 2584 | (custom-load-widget widget) |
| 2537 | (if (zerop (length (get symbol 'custom-group))) | 2585 | (if (zerop (length (get symbol 'custom-group))) |
| 2538 | (progn | 2586 | (progn |
| 2539 | (custom-tree-insert-prefix prefix) | 2587 | (custom-browse-insert-prefix prefix) |
| 2540 | (insert "[ ]-- ") | 2588 | (insert "[ ]-- ") |
| 2541 | ;; (widget-glyph-insert nil "[ ]" "empty") | 2589 | ;; (widget-glyph-insert nil "[ ]" "empty") |
| 2542 | ;; (widget-glyph-insert nil "-- " "horizontal") | 2590 | ;; (widget-glyph-insert nil "-- " "horizontal") |
| 2543 | (push (widget-create-child-and-convert | 2591 | (push (widget-create-child-and-convert |
| 2544 | widget 'custom-tree-group-tag) | 2592 | widget 'custom-browse-group-tag) |
| 2545 | buttons) | 2593 | buttons) |
| 2546 | (insert " " tag "\n") | 2594 | (insert " " tag "\n") |
| 2547 | (widget-put widget :buttons buttons)) | 2595 | (widget-put widget :buttons buttons)) |
| 2548 | (push (widget-create-child-and-convert | 2596 | (push (widget-create-child-and-convert |
| 2549 | widget 'custom-tree-visibility | 2597 | widget 'custom-browse-visibility |
| 2550 | ;; :tag-glyph "minus" | 2598 | ;; :tag-glyph "minus" |
| 2551 | :tag "-") | 2599 | :tag "-") |
| 2552 | buttons) | 2600 | buttons) |
| 2553 | (insert "-\\ ") | 2601 | (insert "-\\ ") |
| 2554 | ;; (widget-glyph-insert nil "-\\ " "top") | 2602 | ;; (widget-glyph-insert nil "-\\ " "top") |
| 2555 | (push (widget-create-child-and-convert | 2603 | (push (widget-create-child-and-convert |
| 2556 | widget 'custom-tree-group-tag) | 2604 | widget 'custom-browse-group-tag) |
| 2557 | buttons) | 2605 | buttons) |
| 2558 | (insert " " tag "\n") | 2606 | (insert " " tag "\n") |
| 2559 | (widget-put widget :buttons buttons) | 2607 | (widget-put widget :buttons buttons) |
| @@ -2563,7 +2611,6 @@ and so forth. The remaining group tags are shown with | |||
| 2563 | custom-browse-order-groups)) | 2611 | custom-browse-order-groups)) |
| 2564 | (prefixes (widget-get widget :custom-prefixes)) | 2612 | (prefixes (widget-get widget :custom-prefixes)) |
| 2565 | (custom-prefix-list (custom-prefix-add symbol prefixes)) | 2613 | (custom-prefix-list (custom-prefix-add symbol prefixes)) |
| 2566 | (length (length members)) | ||
| 2567 | (extra-prefix (if (widget-get widget :custom-last) | 2614 | (extra-prefix (if (widget-get widget :custom-last) |
| 2568 | " " | 2615 | " " |
| 2569 | " | ")) | 2616 | " | ")) |
| @@ -2572,17 +2619,18 @@ and so forth. The remaining group tags are shown with | |||
| 2572 | (while members | 2619 | (while members |
| 2573 | (setq entry (car members) | 2620 | (setq entry (car members) |
| 2574 | members (cdr members)) | 2621 | members (cdr members)) |
| 2575 | (push (widget-create-child-and-convert | 2622 | (when (or (not custom-browse-only-groups) |
| 2576 | widget (nth 1 entry) | 2623 | (eq (nth 1 entry) 'custom-group)) |
| 2577 | :group widget | 2624 | (push (widget-create-child-and-convert |
| 2578 | :tag (custom-unlispify-tag-name | 2625 | widget (nth 1 entry) |
| 2579 | (nth 0 entry)) | 2626 | :group widget |
| 2580 | :custom-prefixes custom-prefix-list | 2627 | :tag (custom-unlispify-tag-name (nth 0 entry)) |
| 2581 | :custom-level (1+ level) | 2628 | :custom-prefixes custom-prefix-list |
| 2582 | :custom-last (null members) | 2629 | :custom-level (1+ level) |
| 2583 | :value (nth 0 entry) | 2630 | :custom-last (null members) |
| 2584 | :custom-prefix prefix) | 2631 | :value (nth 0 entry) |
| 2585 | children)) | 2632 | :custom-prefix prefix) |
| 2633 | children))) | ||
| 2586 | (widget-put widget :children (reverse children))) | 2634 | (widget-put widget :children (reverse children))) |
| 2587 | (message "Creating group...done"))) | 2635 | (message "Creating group...done"))) |
| 2588 | ;; Nested style. | 2636 | ;; Nested style. |
| @@ -2943,17 +2991,17 @@ Leave point at the location of the call, or after the last expression." | |||
| 2943 | (unless (string-match "XEmacs" emacs-version) | 2991 | (unless (string-match "XEmacs" emacs-version) |
| 2944 | (defconst custom-help-menu | 2992 | (defconst custom-help-menu |
| 2945 | '("Customize" | 2993 | '("Customize" |
| 2946 | ["Update menu..." Custom-menu-update t] | 2994 | ["Update menu" Custom-menu-update t] |
| 2947 | ["Browse..." (customize-browse 'emacs) t] | 2995 | ["Browse" (customize-browse 'emacs) t] |
| 2948 | ["Group..." customize-group t] | 2996 | ["Group..." customize-group t] |
| 2949 | ["Variable..." customize-variable t] | 2997 | ["Option..." customize-option t] |
| 2950 | ["Face..." customize-face t] | 2998 | ["Face..." customize-face t] |
| 2951 | ["Saved..." customize-saved t] | 2999 | ["Saved..." customize-saved t] |
| 2952 | ["Set..." customize-customized t] | 3000 | ["Set..." customize-customized t] |
| 2953 | ["--" custom-menu-sep t] | 3001 | "--" |
| 2954 | ["Apropos..." customize-apropos t] | 3002 | ["Apropos..." customize-apropos t] |
| 2955 | ["Group apropos..." customize-apropos-groups t] | 3003 | ["Group apropos..." customize-apropos-groups t] |
| 2956 | ["Variable apropos..." customize-apropos-options t] | 3004 | ["Option apropos..." customize-apropos-options t] |
| 2957 | ["Face apropos..." customize-apropos-faces t]) | 3005 | ["Face apropos..." customize-apropos-faces t]) |
| 2958 | ;; This menu should be identical to the one defined in `menu-bar.el'. | 3006 | ;; This menu should be identical to the one defined in `menu-bar.el'. |
| 2959 | "Customize menu") | 3007 | "Customize menu") |
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 98fa79a327c..d5783d07b17 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el | |||
| @@ -4,7 +4,7 @@ | |||
| 4 | ;; | 4 | ;; |
| 5 | ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> | 5 | ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> |
| 6 | ;; Keywords: extensions | 6 | ;; Keywords: extensions |
| 7 | ;; Version: 1.9936 | 7 | ;; Version: 1.9942 |
| 8 | ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ | 8 | ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ |
| 9 | 9 | ||
| 10 | ;; This file is part of GNU Emacs. | 10 | ;; This file is part of GNU Emacs. |
| @@ -54,7 +54,7 @@ | |||
| 54 | "Character position of the end of event if that exists, or nil." | 54 | "Character position of the end of event if that exists, or nil." |
| 55 | (posn-point (event-end event)))) | 55 | (posn-point (event-end event)))) |
| 56 | 56 | ||
| 57 | (defalias 'widget-read-event (if (string-match "XEmacs" emacs-version) | 57 | (defalias 'widget-read-event (if (string-match "XEmacs" emacs-version) |
| 58 | 'next-event | 58 | 'next-event |
| 59 | 'read-event)) | 59 | 'read-event)) |
| 60 | 60 | ||
| @@ -84,6 +84,14 @@ | |||
| 84 | (or (memq 'click (event-modifiers event)) | 84 | (or (memq 'click (event-modifiers event)) |
| 85 | (memq 'drag (event-modifiers event)))))) | 85 | (memq 'drag (event-modifiers event)))))) |
| 86 | 86 | ||
| 87 | (unless (fboundp 'functionp) | ||
| 88 | ;; Missing from Emacs 19.34 and earlier. | ||
| 89 | (defun functionp (object) | ||
| 90 | "Non-nil of OBJECT is a type of object that can be called as a function." | ||
| 91 | (or (subrp object) (byte-code-function-p object) | ||
| 92 | (eq (car-safe object) 'lambda) | ||
| 93 | (and (symbolp object) (fboundp object))))) | ||
| 94 | |||
| 87 | (unless (fboundp 'error-message-string) | 95 | (unless (fboundp 'error-message-string) |
| 88 | ;; Emacs function missing in XEmacs. | 96 | ;; Emacs function missing in XEmacs. |
| 89 | (defun error-message-string (obj) | 97 | (defun error-message-string (obj) |
| @@ -169,6 +177,28 @@ This exists as a variable so it can be set locally in certain buffers.") | |||
| 169 | "Face used for editable fields." | 177 | "Face used for editable fields." |
| 170 | :group 'widget-faces) | 178 | :group 'widget-faces) |
| 171 | 179 | ||
| 180 | (defface widget-single-line-field-face '((((class grayscale color) | ||
| 181 | (background light)) | ||
| 182 | (:background "gray85")) | ||
| 183 | (((class grayscale color) | ||
| 184 | (background dark)) | ||
| 185 | (:background "dim gray")) | ||
| 186 | (t | ||
| 187 | (:italic t))) | ||
| 188 | "Face used for editable fields spanning only a single line." | ||
| 189 | :group 'widget-faces) | ||
| 190 | |||
| 191 | (defvar widget-single-line-display-table | ||
| 192 | (let ((table (make-display-table))) | ||
| 193 | (aset table 9 "^I") | ||
| 194 | (aset table 10 "^J") | ||
| 195 | table) | ||
| 196 | "Display table used for single-line editable fields.") | ||
| 197 | |||
| 198 | (when (fboundp 'set-face-display-table) | ||
| 199 | (set-face-display-table 'widget-single-line-field-face | ||
| 200 | widget-single-line-display-table)) | ||
| 201 | |||
| 172 | ;;; Utility functions. | 202 | ;;; Utility functions. |
| 173 | ;; | 203 | ;; |
| 174 | ;; These are not really widget specific. | 204 | ;; These are not really widget specific. |
| @@ -206,7 +236,7 @@ Larger menus are read through the minibuffer." | |||
| 206 | :group 'widgets | 236 | :group 'widgets |
| 207 | :type 'integer) | 237 | :type 'integer) |
| 208 | 238 | ||
| 209 | (defcustom widget-menu-minibuffer-flag nil | 239 | (defcustom widget-menu-minibuffer-flag (string-match "XEmacs" emacs-version) |
| 210 | "*Control how to ask for a choice from the keyboard. | 240 | "*Control how to ask for a choice from the keyboard. |
| 211 | Non-nil means use the minibuffer; | 241 | Non-nil means use the minibuffer; |
| 212 | nil means read a single character." | 242 | nil means read a single character." |
| @@ -1816,6 +1846,9 @@ If END is omitted, it defaults to the length of LIST." | |||
| 1816 | (let ((size (widget-get widget :size)) | 1846 | (let ((size (widget-get widget :size)) |
| 1817 | (value (widget-get widget :value)) | 1847 | (value (widget-get widget :value)) |
| 1818 | (from (point)) | 1848 | (from (point)) |
| 1849 | ;; This is changed to a real overlay in `widget-setup'. We | ||
| 1850 | ;; need the end points to behave differently until | ||
| 1851 | ;; `widget-setup' is called. | ||
| 1819 | (overlay (cons (make-marker) (make-marker)))) | 1852 | (overlay (cons (make-marker) (make-marker)))) |
| 1820 | (widget-put widget :field-overlay overlay) | 1853 | (widget-put widget :field-overlay overlay) |
| 1821 | (insert value) | 1854 | (insert value) |
| @@ -2873,6 +2906,7 @@ link for that string." | |||
| 2873 | "A regular expression." | 2906 | "A regular expression." |
| 2874 | :match 'widget-regexp-match | 2907 | :match 'widget-regexp-match |
| 2875 | :validate 'widget-regexp-validate | 2908 | :validate 'widget-regexp-validate |
| 2909 | :value-face 'widget-single-line-field-face | ||
| 2876 | :tag "Regexp") | 2910 | :tag "Regexp") |
| 2877 | 2911 | ||
| 2878 | (defun widget-regexp-match (widget value) | 2912 | (defun widget-regexp-match (widget value) |
| @@ -2898,6 +2932,7 @@ It will read a file name from the minibuffer when invoked." | |||
| 2898 | :complete-function 'widget-file-complete | 2932 | :complete-function 'widget-file-complete |
| 2899 | :prompt-value 'widget-file-prompt-value | 2933 | :prompt-value 'widget-file-prompt-value |
| 2900 | :format "%{%t%}: %v" | 2934 | :format "%{%t%}: %v" |
| 2935 | :value-face 'widget-single-line-field-face | ||
| 2901 | :tag "File") | 2936 | :tag "File") |
| 2902 | 2937 | ||
| 2903 | (defun widget-file-complete () | 2938 | (defun widget-file-complete () |