diff lisp/subr.el @ 83310:e58cb448e07c

Merged from [e-mail]--gnu-2005 (patch 80-82, 350-422) Patches applied: * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-350 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-351 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-352 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-353 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-354 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-355 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-356 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-357 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-358 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-359 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-360 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-361 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-362 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-363 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-364 Remove "-face" suffix from widget faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-365 Remove "-face" suffix from custom faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-366 Remove "-face" suffix from change-log faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-367 Remove "-face" suffix from compilation faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-368 Remove "-face" suffix from diff-mode faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-369 lisp/longlines.el (longlines-visible-face): Face removed * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-370 Remove "-face" suffix from woman faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-371 Remove "-face" suffix from whitespace-highlight face * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-372 Remove "-face" suffix from ruler-mode faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-373 Remove "-face" suffix from show-paren faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-374 Remove "-face" suffix from log-view faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-375 Remove "-face" suffix from smerge faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-376 Remove "-face" suffix from show-tabs faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-377 Remove "-face" suffix from highlight-changes faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-378 Remove "-face" suffix from and downcase info faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-379 Remove "-face" suffix from pcvs faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-380 Update uses of renamed pcvs faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-381 Tweak ChangeLog * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-382 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-383 Remove "-face" suffix from strokes-char face * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-384 Remove "-face" suffix from compare-windows face * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-385 Remove "-face" suffix from calendar faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-386 Remove "-face" suffix from diary-button face * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-387 Remove "-face" suffix from testcover faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-388 Remove "-face" suffix from viper faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-389 Remove "-face" suffix from org faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-390 Remove "-face" suffix from sgml-namespace face * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-391 Remove "-face" suffix from table-cell face * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-392 Remove "-face" suffix from tex-mode faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-393 Remove "-face" suffix from texinfo-heading face * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-394 Remove "-face" suffix from flyspell faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-395 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-396 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-397 Remove "-face" suffix from gomoku faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-398 Remove "-face" suffix from mpuz faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-399 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-400 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-401 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-402 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-403 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-404 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-405 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-406 Merge from gnus--rel--5.10 * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-407 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-408 Remove "-face" suffix from Buffer-menu-buffer face * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-409 Remove "-face" suffix from antlr-mode faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-410 Remove "-face" suffix from ebrowse faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-411 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-412 Remove "-face" suffix from flymake faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-413 Remove "-face" suffix from idlwave faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-414 Remove "-face" suffix from sh-script faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-415 Remove "-face" suffix from vhdl-mode faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-416 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-417 Remove "-face" suffix from which-func face * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-418 Remove "-face" suffix from cperl-mode faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-419 Remove "-face" suffix from ld-script faces * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-420 Fix cperl-mode font-lock problem * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-421 Tweak which-func face * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-422 Update from CVS * [e-mail]--gnu-2005/gnus--rel--5.10--patch-80 Merge from emacs--cvs-trunk--0 * [e-mail]--gnu-2005/gnus--rel--5.10--patch-81 Update from CVS * [e-mail]--gnu-2005/gnus--rel--5.10--patch-82 Update from CVS git-archimport-id: [e-mail]--2004/emacs--multi-tty--0--patch-350

--- a/lisp/subr.el	Fri Jun 03 05:49:26 2005 +0000
+++ b/lisp/subr.el	Wed Jun 15 12:57:51 2005 +0000
@@ -957,6 +957,43 @@
 	     (append (symbol-value list-var) (list element))
 	   (cons element (symbol-value list-var))))))
 
+
+(defun add-to-ordered-list (list-var element &optional order)
+  "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet.
+The test for presence of ELEMENT is done with `equal'.
+
+The resulting list is reordered so that the elements are in the
+order given by each element's numeric list order.  Elements which
+are not symbols, and symbol elements without a numeric list order
+are placed at the end of the list.
+
+If the third optional argument ORDER is non-nil and ELEMENT is
+a symbol, set the symbol's list order to the given value.
+
+The list order for each symbol is stored in LIST-VAR's
+`list-order' property.
+
+The return value is the new value of LIST-VAR."
+  (let* ((ordering (get list-var 'list-order))
+	 (cur (and (symbolp element) (assq element ordering))))
+    (when order
+      (unless (symbolp element)
+	(error "cannot specify order for non-symbols"))
+      (if cur
+	  (setcdr cur order)
+	(setq cur (cons element order))
+	(setq ordering (cons cur ordering))
+	(put list-var 'list-order ordering)))
+    (add-to-list list-var element)
+    (set list-var (sort (symbol-value list-var)
+			(lambda (a b)
+			  (let ((oa (and (symbolp a) (assq a ordering)))
+				(ob (and (symbolp b) (assq b ordering))))
+			    (cond
+			     ((not oa) nil)
+			     ((not ob) t)
+			     (t (< (cdr oa) (cdr ob))))))))))
+
 
 ;;; Load history
 
@@ -1561,7 +1598,7 @@
 `yank-excluded-properties'.  Otherwise just like (insert STRING).
 
 If STRING has a non-nil `yank-handler' property on the first character,
-the normal insert behaviour is modified in various ways.  The value of
+the normal insert behavior is modified in various ways.  The value of
 the yank-handler property must be a list with one to five elements
 with the following format:  (FUNCTION PARAM NOEXCLUDE UNDO).
 When FUNCTION is present and non-nil, it is called instead of `insert'
@@ -1935,6 +1972,7 @@
 The result of the `dynamic-completion-table' form is a function
 that can be used as the ALIST argument to `try-completion' and
 `all-completion'.  See Info node `(elisp)Programmed Completion'."
+  (declare (debug (lambda-expr)))
   (let ((win (make-symbol "window"))
         (string (make-symbol "string"))
         (predicate (make-symbol "predicate"))
@@ -1956,12 +1994,29 @@
 If completion is requested in the minibuffer, FUN will be called in the buffer
 from which the minibuffer was entered.  The return value of
 `lazy-completion-table' must be used to initialize the value of VAR."
+  (declare (debug (symbol lambda-expr def-body)))
   (let ((str (make-symbol "string")))
     `(dynamic-completion-table
       (lambda (,str)
         (unless (listp ,var)
-          (setq ,var (funcall ',fun ,@args)))
+          (setq ,var (,fun ,@args)))
         ,var))))
+
+(defmacro complete-in-turn (a b)
+  "Create a completion table that first tries completion in A and then in B.
+A and B should not be costly (or side-effecting) expressions."
+  (declare (debug (def-form def-form)))
+  `(lambda (string predicate mode)
+     (cond
+      ((eq mode t)
+       (or (all-completions string ,a predicate)
+	   (all-completions string ,b predicate)))
+      ((eq mode nil)
+       (or (try-completion string ,a predicate)
+	   (try-completion string ,b predicate)))
+      (t
+       (or (test-completion string ,a predicate)
+	   (test-completion string ,b predicate))))))
 
 ;;; Matching and substitution
 
@@ -1982,7 +2037,7 @@
 	'((save-match-data-internal (match-data)))
 	(list 'unwind-protect
 	      (cons 'progn body)
-	      '(set-match-data save-match-data-internal))))
+	      '(set-match-data save-match-data-internal 'evaporate))))
 
 (defun match-string (num &optional string)
   "Return string of text matched by last search.