diff options
| author | Richard M. Stallman | 1997-05-31 01:37:15 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 1997-05-31 01:37:15 +0000 |
| commit | e5dfabb4897fc40ec5f3a282981f40b3e8049539 (patch) | |
| tree | 7b2887acf205009bbc8df7dc12c76c618dc27076 | |
| parent | 6d1ab9d4d67b291df337a404a93fd065bf426359 (diff) | |
| download | emacs-e5dfabb4897fc40ec5f3a282981f40b3e8049539.tar.gz emacs-e5dfabb4897fc40ec5f3a282981f40b3e8049539.zip | |
(widget-default-format-handler): Don't use push.
(widget-push-button-value-create): Likewise.
(widget-group-value-create): Likewise.
(widget-sublist): New function.
(widget-item-match-inline): Use widget-subllist.
(widget-remove-if): New function.
(widget-choose): Use widget-remove-if.
| -rw-r--r-- | lisp/wid-edit.el | 73 |
1 files changed, 48 insertions, 25 deletions
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 561c7efb42b..6de406f4c4c 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el | |||
| @@ -31,7 +31,6 @@ | |||
| 31 | ;;; Code: | 31 | ;;; Code: |
| 32 | 32 | ||
| 33 | (require 'widget) | 33 | (require 'widget) |
| 34 | (require 'cl) | ||
| 35 | 34 | ||
| 36 | ;;; Compatibility. | 35 | ;;; Compatibility. |
| 37 | 36 | ||
| @@ -225,7 +224,7 @@ minibuffer." | |||
| 225 | (car (event-object val)))) | 224 | (car (event-object val)))) |
| 226 | (cdr (assoc val items)))) | 225 | (cdr (assoc val items)))) |
| 227 | (t | 226 | (t |
| 228 | (setq items (remove-if 'stringp items)) | 227 | (setq items (widget-remove-if 'stringp items)) |
| 229 | (let ((val (completing-read (concat title ": ") items nil t))) | 228 | (let ((val (completing-read (concat title ": ") items nil t))) |
| 230 | (if (stringp val) | 229 | (if (stringp val) |
| 231 | (let ((try (try-completion val items))) | 230 | (let ((try (try-completion val items))) |
| @@ -234,6 +233,14 @@ minibuffer." | |||
| 234 | (cdr (assoc val items))) | 233 | (cdr (assoc val items))) |
| 235 | nil))))) | 234 | nil))))) |
| 236 | 235 | ||
| 236 | (defun widget-remove-if (predictate list) | ||
| 237 | (let (result (tail list)) | ||
| 238 | (while tail | ||
| 239 | (or (funcall predictate (car tail)) | ||
| 240 | (setq result (cons (car tail) result))) | ||
| 241 | (setq tail (cdr tail))) | ||
| 242 | (nreverse result))) | ||
| 243 | |||
| 237 | ;;; Widget text specifications. | 244 | ;;; Widget text specifications. |
| 238 | ;; | 245 | ;; |
| 239 | ;; These functions are for specifying text properties. | 246 | ;; These functions are for specifying text properties. |
| @@ -1306,19 +1313,20 @@ Optional EVENT is the event that triggered the action." | |||
| 1306 | ;; Get rid of trailing newlines. | 1313 | ;; Get rid of trailing newlines. |
| 1307 | (when (string-match "\n+\\'" doc-text) | 1314 | (when (string-match "\n+\\'" doc-text) |
| 1308 | (setq doc-text (substring doc-text 0 (match-beginning 0)))) | 1315 | (setq doc-text (substring doc-text 0 (match-beginning 0)))) |
| 1309 | (push (if (string-match "\n." doc-text) | 1316 | (setq buttons |
| 1310 | ;; Allow multiline doc to be hiden. | 1317 | (cons (if (string-match "\n." doc-text) |
| 1311 | (widget-create-child-and-convert | 1318 | ;; Allow multiline doc to be hiden. |
| 1312 | widget 'widget-help | 1319 | (widget-create-child-and-convert |
| 1313 | :doc (progn | 1320 | widget 'widget-help |
| 1314 | (string-match "\\`.*" doc-text) | 1321 | :doc (progn |
| 1315 | (match-string 0 doc-text)) | 1322 | (string-match "\\`.*" doc-text) |
| 1316 | :widget-doc doc-text | 1323 | (match-string 0 doc-text)) |
| 1317 | "?") | 1324 | :widget-doc doc-text |
| 1318 | ;; A single line is just inserted. | 1325 | "?") |
| 1319 | (widget-create-child-and-convert | 1326 | ;; A single line is just inserted. |
| 1320 | widget 'item :format "%d" :doc doc-text nil)) | 1327 | (widget-create-child-and-convert |
| 1321 | buttons))) | 1328 | widget 'item :format "%d" :doc doc-text nil)) |
| 1329 | buttons)))) | ||
| 1322 | (t | 1330 | (t |
| 1323 | (error "Unknown escape `%c'" escape))) | 1331 | (error "Unknown escape `%c'" escape))) |
| 1324 | (widget-put widget :buttons buttons))) | 1332 | (widget-put widget :buttons buttons))) |
| @@ -1423,9 +1431,22 @@ Optional EVENT is the event that triggered the action." | |||
| 1423 | (let ((value (widget-get widget :value))) | 1431 | (let ((value (widget-get widget :value))) |
| 1424 | (and (listp value) | 1432 | (and (listp value) |
| 1425 | (<= (length value) (length values)) | 1433 | (<= (length value) (length values)) |
| 1426 | (let ((head (subseq values 0 (length value)))) | 1434 | (let ((head (widget-sublist values 0 (length value)))) |
| 1427 | (and (equal head value) | 1435 | (and (equal head value) |
| 1428 | (cons head (subseq values (length value)))))))) | 1436 | (cons head (widget-sublist values (length value)))))))) |
| 1437 | |||
| 1438 | (defun widget-sublist (list start &optional end) | ||
| 1439 | "Return the sublist of LIST from START to END. | ||
| 1440 | If END is omitted, it defaults to the length of LIST." | ||
| 1441 | (let (len) | ||
| 1442 | (if (> start 0) (setq list (nthcdr start list))) | ||
| 1443 | (if end | ||
| 1444 | (if (<= end start) | ||
| 1445 | nil | ||
| 1446 | (setq list (copy-sequence list)) | ||
| 1447 | (setcdr (nthcdr (- end start 1) list) nil) | ||
| 1448 | list) | ||
| 1449 | (copy-sequence list)))) | ||
| 1429 | 1450 | ||
| 1430 | (defun widget-item-action (widget &optional event) | 1451 | (defun widget-item-action (widget &optional event) |
| 1431 | ;; Just notify itself. | 1452 | ;; Just notify itself. |
| @@ -1474,7 +1495,8 @@ Optional EVENT is the event that triggered the action." | |||
| 1474 | (progn | 1495 | (progn |
| 1475 | (unless gui | 1496 | (unless gui |
| 1476 | (setq gui (make-gui-button tag 'widget-gui-action widget)) | 1497 | (setq gui (make-gui-button tag 'widget-gui-action widget)) |
| 1477 | (push (cons tag gui) widget-push-button-cache)) | 1498 | (setq widget-push-button-cache |
| 1499 | (cons (cons tag gui) widget-push-button-cache))) | ||
| 1478 | (widget-glyph-insert-glyph widget | 1500 | (widget-glyph-insert-glyph widget |
| 1479 | (make-glyph | 1501 | (make-glyph |
| 1480 | (list (nth 0 (aref gui 1)) | 1502 | (list (nth 0 (aref gui 1)) |
| @@ -2429,13 +2451,14 @@ when he invoked the menu." | |||
| 2429 | (and (eq (preceding-char) ?\n) | 2451 | (and (eq (preceding-char) ?\n) |
| 2430 | (widget-get widget :indent) | 2452 | (widget-get widget :indent) |
| 2431 | (insert-char ? (widget-get widget :indent))) | 2453 | (insert-char ? (widget-get widget :indent))) |
| 2432 | (push (cond ((null answer) | 2454 | (setq children |
| 2433 | (widget-create-child widget arg)) | 2455 | (cons (cond ((null answer) |
| 2434 | ((widget-get arg :inline) | 2456 | (widget-create-child widget arg)) |
| 2435 | (widget-create-child-value widget arg (car answer))) | 2457 | ((widget-get arg :inline) |
| 2436 | (t | 2458 | (widget-create-child-value widget arg (car answer))) |
| 2437 | (widget-create-child-value widget arg (car (car answer))))) | 2459 | (t |
| 2438 | children)) | 2460 | (widget-create-child-value widget arg (car (car answer))))) |
| 2461 | children))) | ||
| 2439 | (widget-put widget :children (nreverse children)))) | 2462 | (widget-put widget :children (nreverse children)))) |
| 2440 | 2463 | ||
| 2441 | (defun widget-group-match (widget values) | 2464 | (defun widget-group-match (widget values) |