summaryrefslogtreecommitdiff
path: root/lisp/subr.el
diff options
context:
space:
mode:
authorKaroly Lorentey <lorentey@elte.hu>2006-10-14 17:36:28 +0000
committerKaroly Lorentey <lorentey@elte.hu>2006-10-14 17:36:28 +0000
commit12b6af5c7ed2cfdb9783312bf890cf1e6c80c67a (patch)
tree1775f9fd1c92defd8b61304a08ec00da95bc4539 /lisp/subr.el
parent3f87f67ee215ffeecbd2f53bd7f342cdf03f47df (diff)
parentf763da8d0808af7c80d72bc586bf4fcf50b37ddd (diff)
downloademacs-12b6af5c7ed2cfdb9783312bf890cf1e6c80c67a.tar.gz
emacs-12b6af5c7ed2cfdb9783312bf890cf1e6c80c67a.tar.bz2
emacs-12b6af5c7ed2cfdb9783312bf890cf1e6c80c67a.zip
Merged from emacs@sv.gnu.org
Patches applied: * emacs@sv.gnu.org/emacs--devo--0--patch-413 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-414 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-415 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-416 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-417 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-418 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-419 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-420 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-421 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-422 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-423 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-424 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-425 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-426 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-427 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-428 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-429 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-430 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-431 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-432 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-433 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-434 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-435 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-436 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-437 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-438 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-439 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-440 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-441 lisp/url/url-methods.el: Fix format error when http_proxy is empty string * emacs@sv.gnu.org/emacs--devo--0--patch-442 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-443 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-444 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-445 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-446 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-447 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-448 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-449 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-450 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-451 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-452 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-453 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-454 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-455 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-456 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-457 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-458 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-459 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-460 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-461 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-462 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-463 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-464 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-465 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-466 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-467 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-468 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-469 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-470 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-471 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-472 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-473 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-128 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-129 Merge from emacs--devo--0 * emacs@sv.gnu.org/gnus--rel--5.10--patch-130 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-131 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-132 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-133 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-134 Merge from emacs--devo--0 * emacs@sv.gnu.org/gnus--rel--5.10--patch-135 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-136 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-137 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-138 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-139 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-140 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-141 Merge from emacs--devo--0 * emacs@sv.gnu.org/gnus--rel--5.10--patch-142 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-143 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-144 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-145 Merge from emacs--devo--0 * emacs@sv.gnu.org/gnus--rel--5.10--patch-146 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-147 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-148 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-149 Update from CVS git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-582
Diffstat (limited to 'lisp/subr.el')
-rw-r--r--lisp/subr.el96
1 files changed, 66 insertions, 30 deletions
diff --git a/lisp/subr.el b/lisp/subr.el
index 6d35171bf04..ad3e732c6c6 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1085,9 +1085,10 @@ the hook's buffer-local value rather than its default value."
(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 @@ until a certain package is loaded, you should put the call to `add-to-list'
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 @@ floating point support.
(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 @@ a system-dependent default device name is used."
(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 @@ a system-dependent default device name is used."
"\\" (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 @@ If UNDO is present and non-nil, it is a function that will be called
(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 is the buffer (or buffer name) to associate with the process.
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 @@ If BODY finishes, `while-no-input' returns whatever value BODY produced."
`(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 @@ Usually the separator is \".\", but it can be any other string.")
(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.