diff lisp/subr.el @ 83542:2d56e13fd23d

Merged from [e-mail] Patches applied: * [e-mail]/emacs--devo--0--patch-413 Update from CVS * [e-mail]/emacs--devo--0--patch-414 Update from CVS * [e-mail]/emacs--devo--0--patch-415 Update from CVS * [e-mail]/emacs--devo--0--patch-416 Update from CVS * [e-mail]/emacs--devo--0--patch-417 Update from CVS * [e-mail]/emacs--devo--0--patch-418 Merge from gnus--rel--5.10 * [e-mail]/emacs--devo--0--patch-419 Update from CVS * [e-mail]/emacs--devo--0--patch-420 Update from CVS * [e-mail]/emacs--devo--0--patch-421 Merge from gnus--rel--5.10 * [e-mail]/emacs--devo--0--patch-422 Update from CVS * [e-mail]/emacs--devo--0--patch-423 Update from CVS * [e-mail]/emacs--devo--0--patch-424 Merge from gnus--rel--5.10 * [e-mail]/emacs--devo--0--patch-425 Update from CVS * [e-mail]/emacs--devo--0--patch-426 Update from CVS * [e-mail]/emacs--devo--0--patch-427 Update from CVS * [e-mail]/emacs--devo--0--patch-428 Merge from gnus--rel--5.10 * [e-mail]/emacs--devo--0--patch-429 Update from CVS * [e-mail]/emacs--devo--0--patch-430 Update from CVS * [e-mail]/emacs--devo--0--patch-431 Merge from gnus--rel--5.10 * [e-mail]/emacs--devo--0--patch-432 Update from CVS * [e-mail]/emacs--devo--0--patch-433 Update from CVS * [e-mail]/emacs--devo--0--patch-434 Update from CVS * [e-mail]/emacs--devo--0--patch-435 Update from CVS * [e-mail]/emacs--devo--0--patch-436 Update from CVS * [e-mail]/emacs--devo--0--patch-437 Update from CVS * [e-mail]/emacs--devo--0--patch-438 Update from CVS * [e-mail]/emacs--devo--0--patch-439 Update from CVS * [e-mail]/emacs--devo--0--patch-440 Update from CVS * [e-mail]/emacs--devo--0--patch-441 lisp/url/url-methods.el: Fix format error when http_proxy is empty string * [e-mail]/emacs--devo--0--patch-442 Update from CVS * [e-mail]/emacs--devo--0--patch-443 Update from CVS * [e-mail]/emacs--devo--0--patch-444 Update from CVS * [e-mail]/emacs--devo--0--patch-445 Update from CVS * [e-mail]/emacs--devo--0--patch-446 Merge from gnus--rel--5.10 * [e-mail]/emacs--devo--0--patch-447 Update from CVS * [e-mail]/emacs--devo--0--patch-448 Update from CVS * [e-mail]/emacs--devo--0--patch-449 Update from CVS * [e-mail]/emacs--devo--0--patch-450 Update from CVS * [e-mail]/emacs--devo--0--patch-451 Update from CVS * [e-mail]/emacs--devo--0--patch-452 Update from CVS * [e-mail]/emacs--devo--0--patch-453 Update from CVS * [e-mail]/emacs--devo--0--patch-454 Update from CVS * [e-mail]/emacs--devo--0--patch-455 Update from CVS * [e-mail]/emacs--devo--0--patch-456 Update from CVS * [e-mail]/emacs--devo--0--patch-457 Update from CVS * [e-mail]/emacs--devo--0--patch-458 Update from CVS * [e-mail]/emacs--devo--0--patch-459 Merge from gnus--rel--5.10 * [e-mail]/emacs--devo--0--patch-460 Update from CVS * [e-mail]/emacs--devo--0--patch-461 Update from CVS * [e-mail]/emacs--devo--0--patch-462 Update from CVS * [e-mail]/emacs--devo--0--patch-463 Update from CVS * [e-mail]/emacs--devo--0--patch-464 Update from CVS * [e-mail]/emacs--devo--0--patch-465 Update from CVS * [e-mail]/emacs--devo--0--patch-466 Merge from gnus--rel--5.10 * [e-mail]/emacs--devo--0--patch-467 Update from CVS * [e-mail]/emacs--devo--0--patch-468 Merge from gnus--rel--5.10 * [e-mail]/emacs--devo--0--patch-469 Update from CVS * [e-mail]/emacs--devo--0--patch-470 Update from CVS * [e-mail]/emacs--devo--0--patch-471 Update from CVS * [e-mail]/emacs--devo--0--patch-472 Update from CVS * [e-mail]/emacs--devo--0--patch-473 Update from CVS * [e-mail]/gnus--rel--5.10--patch-128 Update from CVS * [e-mail]/gnus--rel--5.10--patch-129 Merge from emacs--devo--0 * [e-mail]/gnus--rel--5.10--patch-130 Update from CVS * [e-mail]/gnus--rel--5.10--patch-131 Update from CVS * [e-mail]/gnus--rel--5.10--patch-132 Update from CVS * [e-mail]/gnus--rel--5.10--patch-133 Update from CVS * [e-mail]/gnus--rel--5.10--patch-134 Merge from emacs--devo--0 * [e-mail]/gnus--rel--5.10--patch-135 Update from CVS * [e-mail]/gnus--rel--5.10--patch-136 Update from CVS * [e-mail]/gnus--rel--5.10--patch-137 Update from CVS * [e-mail]/gnus--rel--5.10--patch-138 Update from CVS * [e-mail]/gnus--rel--5.10--patch-139 Update from CVS * [e-mail]/gnus--rel--5.10--patch-140 Update from CVS * [e-mail]/gnus--rel--5.10--patch-141 Merge from emacs--devo--0 * [e-mail]/gnus--rel--5.10--patch-142 Update from CVS * [e-mail]/gnus--rel--5.10--patch-143 Update from CVS * [e-mail]/gnus--rel--5.10--patch-144 Update from CVS * [e-mail]/gnus--rel--5.10--patch-145 Merge from emacs--devo--0 * [e-mail]/gnus--rel--5.10--patch-146 Update from CVS * [e-mail]/gnus--rel--5.10--patch-147 Update from CVS * [e-mail]/gnus--rel--5.10--patch-148 Update from CVS * [e-mail]/gnus--rel--5.10--patch-149 Update from CVS git-archimport-id: [e-mail]--2004/emacs--multi-tty--0--patch-582

--- a/lisp/subr.el	Sat Oct 14 16:56:21 2006 +0000
+++ b/lisp/subr.el	Sat Oct 14 17:36:28 2006 +0000
@@ -1085,9 +1085,10 @@
 	    (kill-local-variable hook)
 	  (set hook hook-value))))))
 
-(defun add-to-list (list-var element &optional append)
+(defun add-to-list (list-var element &optional append compare-fn)
   "Add ELEMENT to the value of LIST-VAR if it isn't there yet.
-The test for presence of ELEMENT is done with `equal'.
+The test for presence of ELEMENT is done with `equal',
+or with COMPARE-FN if that's non-nil.
 If ELEMENT is added, it is added at the beginning of the list,
 unless the optional argument APPEND is non-nil, in which case
 ELEMENT is added at the end.
@@ -1099,7 +1100,13 @@
 into a hook function that will be run only after loading the package.
 `eval-after-load' provides one way to do this.  In some cases
 other hooks, such as major mode hooks, can do the job."
-  (if (member element (symbol-value list-var))
+  (if (if compare-fn
+	  (let (present)
+	    (dolist (elt (symbol-value list-var))
+	      (if (funcall compare-fn element elt)
+		  (setq present t)))
+	    present)
+	(member element (symbol-value list-var)))
       (symbol-value list-var)
     (set list-var
 	 (if append
@@ -1733,13 +1740,20 @@
   (when (or obsolete (numberp nodisp))
     (setq seconds (+ seconds (* 1e-3 nodisp)))
     (setq nodisp obsolete))
-  (if noninteractive
-      (progn (sleep-for seconds) t)
-    (unless nodisp (redisplay))
-    (or (<= seconds 0)
-	(let ((read (read-event nil nil seconds)))
-	  (or (null read)
-	      (progn (push read unread-command-events) nil))))))
+  (cond
+   (noninteractive
+    (sleep-for seconds)
+    t)
+   ((input-pending-p)
+    nil)
+   ((<= seconds 0)
+    (or nodisp (redisplay)))
+   (t
+    (or nodisp (redisplay))
+    (let ((read (read-event nil nil seconds)))
+      (or (null read)
+	  (progn (push read unread-command-events)
+		 nil))))))
 
 ;;; Atomic change groups.
 
@@ -2039,7 +2053,8 @@
 
 (defun shell-quote-argument (argument)
   "Quote an argument for passing as argument to an inferior shell."
-  (if (eq system-type 'ms-dos)
+  (if (or (eq system-type 'ms-dos)
+          (and (eq system-type 'windows-nt) (w32-shell-dos-semantics)))
       ;; Quote using double quotes, but escape any existing quotes in
       ;; the argument with backslashes.
       (let ((result "")
@@ -2053,19 +2068,17 @@
 				   "\\" (substring argument end (1+ end)))
 		    start (1+ end))))
 	(concat "\"" result (substring argument start) "\""))
-    (if (eq system-type 'windows-nt)
-	(concat "\"" argument "\"")
-      (if (equal argument "")
-	  "''"
-	;; Quote everything except POSIX filename characters.
-	;; This should be safe enough even for really weird shells.
-	(let ((result "") (start 0) end)
-	  (while (string-match "[^-0-9a-zA-Z_./]" argument start)
-	    (setq end (match-beginning 0)
-		  result (concat result (substring argument start end)
-				 "\\" (substring argument end (1+ end)))
-		  start (1+ end)))
-	  (concat result (substring argument start)))))))
+    (if (equal argument "")
+        "''"
+      ;; Quote everything except POSIX filename characters.
+      ;; This should be safe enough even for really weird shells.
+      (let ((result "") (start 0) end)
+        (while (string-match "[^-0-9a-zA-Z_./]" argument start)
+          (setq end (match-beginning 0)
+                result (concat result (substring argument start end)
+                               "\\" (substring argument end (1+ end)))
+                start (1+ end)))
+        (concat result (substring argument start))))))
 
 (defun string-or-null-p (object)
   "Return t if OBJECT is a string or nil.
@@ -2154,11 +2167,32 @@
   (let* ((handler (and (stringp string)
 		       (get-text-property 0 'yank-handler string)))
 	 (param (or (nth 1 handler) string))
-	 (opoint (point)))
+	 (opoint (point))
+	 end)
+
     (setq yank-undo-function t)
     (if (nth 0 handler) ;; FUNCTION
 	(funcall (car handler) param)
       (insert param))
+    (setq end (point))
+
+    ;; What should we do with `font-lock-face' properties?
+    (if font-lock-defaults
+	;; No, just wipe them.
+	(remove-list-of-text-properties opoint end '(font-lock-face))
+      ;; Convert them to `face'.
+      (save-excursion
+	(goto-char opoint)
+	(while (< (point) end)
+	  (let ((face (get-text-property (point) 'font-lock-face))
+		run-end)
+	    (setq run-end
+		  (next-single-property-change (point) 'font-lock-face nil end))
+	    (when face
+	      (remove-text-properties (point) run-end '(font-lock-face nil))
+	      (put-text-property (point) run-end 'face face))
+	    (goto-char run-end)))))
+
     (unless (nth 2 handler) ;; NOEXCLUDE
       (remove-yank-excluded-properties opoint (point)))
     (if (eq yank-undo-function t)  ;; not set by FUNCTION
@@ -2201,7 +2235,9 @@
  BUFFER may be also nil, meaning that this process is not associated
  with any buffer
 COMMAND is the name of a shell command.
-Remaining arguments are the arguments for the command.
+Remaining arguments are the arguments for the command; they are all
+spliced together with blanks separating between each two of them, before
+passing the command to the shell.
 Wildcards and redirection are handled as usual in the shell.
 
 \(fn NAME BUFFER COMMAND &rest COMMAND-ARGS)"
@@ -2404,8 +2440,8 @@
     `(with-local-quit
        (catch ',catch-sym
 	 (let ((throw-on-input ',catch-sym))
-	   (or (not (sit-for 0 0 t))
-	     ,@body))))))
+	   (or (input-pending-p)
+	       ,@body))))))
 
 (defmacro combine-after-change-calls (&rest body)
   "Execute BODY, but don't call the after-change functions till the end.
@@ -3109,8 +3145,8 @@
 
 (defvar version-regexp-alist
   '(("^[-_+ ]?a\\(lpha\\)?$"   . -3)
-    ("^[-_+]$" . -3)	; treat "1.2.3-20050920" and "1.2-3" as alpha releases
-    ("^[-_+ ]cvs$" . -3)	; treat "1.2.3-CVS" as alpha release
+    ("^[-_+]$"                 . -3)	; treat "1.2.3-20050920" and "1.2-3" as alpha releases
+    ("^[-_+ ]cvs$"             . -3)	; treat "1.2.3-CVS" as alpha release
     ("^[-_+ ]?b\\(eta\\)?$"    . -2)
     ("^[-_+ ]?\\(pre\\|rc\\)$" . -1))
   "*Specify association between non-numeric version part and a priority.