changeset 18056:f8591273bf79

(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.
author Richard M. Stallman <rms@gnu.org>
date Sat, 31 May 1997 01:37:15 +0000
parents 9e0c7dffc231
children 07e0112aa8f5
files lisp/wid-edit.el
diffstat 1 files changed, 48 insertions(+), 25 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/wid-edit.el	Sat May 31 01:22:39 1997 +0000
+++ b/lisp/wid-edit.el	Sat May 31 01:37:15 1997 +0000
@@ -31,7 +31,6 @@
 ;;; Code:
 
 (require 'widget)
-(require 'cl)
 
 ;;; Compatibility.
 
@@ -225,7 +224,7 @@
 			  (car (event-object val))))
 	   (cdr (assoc val items))))
 	(t
-	 (setq items (remove-if 'stringp items))
+	 (setq items (widget-remove-if 'stringp items))
 	 (let ((val (completing-read (concat title ": ") items nil t)))
 	   (if (stringp val)
 	       (let ((try (try-completion val items)))
@@ -234,6 +233,14 @@
 		 (cdr (assoc val items)))
 	     nil)))))
 
+(defun widget-remove-if (predictate list)
+  (let (result (tail list))
+    (while tail
+      (or (funcall predictate (car tail))
+	  (setq result (cons (car tail) result)))
+      (setq tail (cdr tail)))
+    (nreverse result)))
+
 ;;; Widget text specifications.
 ;; 
 ;; These functions are for specifying text properties. 
@@ -1306,19 +1313,20 @@
 	     ;; Get rid of trailing newlines.
 	     (when (string-match "\n+\\'" doc-text)
 	       (setq doc-text (substring doc-text 0 (match-beginning 0))))
-	     (push (if (string-match "\n." doc-text)
-		       ;; Allow multiline doc to be hiden.
-		       (widget-create-child-and-convert
-			widget 'widget-help 
-			:doc (progn
-			       (string-match "\\`.*" doc-text)
-			       (match-string 0 doc-text))
-			:widget-doc doc-text
-			"?")
-		     ;; A single line is just inserted.
-		     (widget-create-child-and-convert
-		      widget 'item :format "%d" :doc doc-text nil))
-		   buttons)))
+	     (setq buttons
+		   (cons (if (string-match "\n." doc-text)
+			     ;; Allow multiline doc to be hiden.
+			     (widget-create-child-and-convert
+			      widget 'widget-help 
+			      :doc (progn
+				     (string-match "\\`.*" doc-text)
+				     (match-string 0 doc-text))
+			      :widget-doc doc-text
+			      "?")
+			   ;; A single line is just inserted.
+			   (widget-create-child-and-convert
+			    widget 'item :format "%d" :doc doc-text nil))
+			 buttons))))
 	  (t 
 	   (error "Unknown escape `%c'" escape)))
     (widget-put widget :buttons buttons)))
@@ -1423,9 +1431,22 @@
   (let ((value (widget-get widget :value)))
     (and (listp value)
 	 (<= (length value) (length values))
-	 (let ((head (subseq values 0 (length value))))
+	 (let ((head (widget-sublist values 0 (length value))))
 	   (and (equal head value)
-		(cons head (subseq values (length value))))))))
+		(cons head (widget-sublist values (length value))))))))
+
+(defun widget-sublist (list start &optional end)
+  "Return the sublist of LIST from START to END.
+If END is omitted, it defaults to the length of LIST."
+  (let (len)
+    (if (> start 0) (setq list (nthcdr start list)))
+    (if end
+	(if (<= end start)
+	    nil
+	  (setq list (copy-sequence list))
+	  (setcdr (nthcdr (- end start 1) list) nil)
+	  list)
+      (copy-sequence list))))
 
 (defun widget-item-action (widget &optional event)
   ;; Just notify itself.
@@ -1474,7 +1495,8 @@
 	(progn 
 	  (unless gui
 	    (setq gui (make-gui-button tag 'widget-gui-action widget))
-	    (push (cons tag gui) widget-push-button-cache))
+	    (setq widget-push-button-cache
+		  (cons (cons tag gui) widget-push-button-cache)))
 	  (widget-glyph-insert-glyph widget
 				     (make-glyph
 				      (list (nth 0 (aref gui 1))
@@ -2429,13 +2451,14 @@
       (and (eq (preceding-char) ?\n)
 	   (widget-get widget :indent)
 	   (insert-char ?  (widget-get widget :indent)))
-      (push (cond ((null answer)
-		   (widget-create-child widget arg))
-		  ((widget-get arg :inline)
-		   (widget-create-child-value widget arg  (car answer)))
-		  (t
-		   (widget-create-child-value widget arg  (car (car answer)))))
-	    children))
+      (setq children
+	    (cons (cond ((null answer)
+			 (widget-create-child widget arg))
+			((widget-get arg :inline)
+			 (widget-create-child-value widget arg  (car answer)))
+			(t
+			 (widget-create-child-value widget arg  (car (car answer)))))
+		  children)))
     (widget-put widget :children (nreverse children))))
 
 (defun widget-group-match (widget values)