Mercurial > emacs

comparison lisp/subr.el @ 83542:2d56e13fd23d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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
author Karoly Lorentey <lorentey@elte.hu>
date Sat, 14 Oct 2006 17:36:28 +0000
parents 02e39decdc84 d62e39d56ebb
children 58cf725f5330
comparison
equal deleted inserted replaced
83541:694bbb62a75d 83542:2d56e13fd23d
1083 (set-default hook hook-value) 1083 (set-default hook hook-value)
1084 (if (equal hook-value '(t)) 1084 (if (equal hook-value '(t))
1085 (kill-local-variable hook) 1085 (kill-local-variable hook)
1086 (set hook hook-value)))))) 1086 (set hook hook-value))))))
1087 1087
1088 (defun add-to-list (list-var element &optional append) 1088 (defun add-to-list (list-var element &optional append compare-fn)
1089 "Add ELEMENT to the value of LIST-VAR if it isn't there yet. 1089 "Add ELEMENT to the value of LIST-VAR if it isn't there yet.
1090 The test for presence of ELEMENT is done with `equal'. 1090 The test for presence of ELEMENT is done with `equal',
1091 or with COMPARE-FN if that's non-nil.
1091 If ELEMENT is added, it is added at the beginning of the list, 1092 If ELEMENT is added, it is added at the beginning of the list,
1092 unless the optional argument APPEND is non-nil, in which case 1093 unless the optional argument APPEND is non-nil, in which case
1093 ELEMENT is added at the end. 1094 ELEMENT is added at the end.
1094 1095
1095 The return value is the new value of LIST-VAR. 1096 The return value is the new value of LIST-VAR.
1097 If you want to use `add-to-list' on a variable that is not defined 1098 If you want to use `add-to-list' on a variable that is not defined
1098 until a certain package is loaded, you should put the call to `add-to-list' 1099 until a certain package is loaded, you should put the call to `add-to-list'
1099 into a hook function that will be run only after loading the package. 1100 into a hook function that will be run only after loading the package.
1100 `eval-after-load' provides one way to do this. In some cases 1101 `eval-after-load' provides one way to do this. In some cases
1101 other hooks, such as major mode hooks, can do the job." 1102 other hooks, such as major mode hooks, can do the job."
1102 (if (member element (symbol-value list-var)) 1103 (if (if compare-fn
1104 (let (present)
1105 (dolist (elt (symbol-value list-var))
1106 (if (funcall compare-fn element elt)
1107 (setq present t)))
1108 present)
1109 (member element (symbol-value list-var)))
1103 (symbol-value list-var) 1110 (symbol-value list-var)
1104 (set list-var 1111 (set list-var
1105 (if append 1112 (if append
1106 (append (symbol-value list-var) (list element)) 1113 (append (symbol-value list-var) (list element))
1107 (cons element (symbol-value list-var)))))) 1114 (cons element (symbol-value list-var))))))
1731 1738
1732 \(fn SECONDS &optional NODISP)" 1739 \(fn SECONDS &optional NODISP)"
1733 (when (or obsolete (numberp nodisp)) 1740 (when (or obsolete (numberp nodisp))
1734 (setq seconds (+ seconds (* 1e-3 nodisp))) 1741 (setq seconds (+ seconds (* 1e-3 nodisp)))
1735 (setq nodisp obsolete)) 1742 (setq nodisp obsolete))
1736 (if noninteractive 1743 (cond
1737 (progn (sleep-for seconds) t) 1744 (noninteractive
1738 (unless nodisp (redisplay)) 1745 (sleep-for seconds)
1739 (or (<= seconds 0) 1746 t)
1740 (let ((read (read-event nil nil seconds))) 1747 ((input-pending-p)
1741 (or (null read) 1748 nil)
1742 (progn (push read unread-command-events) nil)))))) 1749 ((<= seconds 0)
1750 (or nodisp (redisplay)))
1751 (t
1752 (or nodisp (redisplay))
1753 (let ((read (read-event nil nil seconds)))
1754 (or (null read)
1755 (progn (push read unread-command-events)
1756 nil))))))
1743 1757
1744 ;;; Atomic change groups. 1758 ;;; Atomic change groups.
1745 1759
1746 (defmacro atomic-change-group (&rest body) 1760 (defmacro atomic-change-group (&rest body)
1747 "Perform BODY as an atomic change group. 1761 "Perform BODY as an atomic change group.
2037 (play-sound-internal sound) 2051 (play-sound-internal sound)
2038 (error "This Emacs binary lacks sound support"))) 2052 (error "This Emacs binary lacks sound support")))
2039 2053
2040 (defun shell-quote-argument (argument) 2054 (defun shell-quote-argument (argument)
2041 "Quote an argument for passing as argument to an inferior shell." 2055 "Quote an argument for passing as argument to an inferior shell."
2042 (if (eq system-type 'ms-dos) 2056 (if (or (eq system-type 'ms-dos)
2057 (and (eq system-type 'windows-nt) (w32-shell-dos-semantics)))
2043 ;; Quote using double quotes, but escape any existing quotes in 2058 ;; Quote using double quotes, but escape any existing quotes in
2044 ;; the argument with backslashes. 2059 ;; the argument with backslashes.
2045 (let ((result "") 2060 (let ((result "")
2046 (start 0) 2061 (start 0)
2047 end) 2062 end)
2051 (setq end (match-beginning 0) 2066 (setq end (match-beginning 0)
2052 result (concat result (substring argument start end) 2067 result (concat result (substring argument start end)
2053 "\\" (substring argument end (1+ end))) 2068 "\\" (substring argument end (1+ end)))
2054 start (1+ end)))) 2069 start (1+ end))))
2055 (concat "\"" result (substring argument start) "\"")) 2070 (concat "\"" result (substring argument start) "\""))
2056 (if (eq system-type 'windows-nt) 2071 (if (equal argument "")
2057 (concat "\"" argument "\"") 2072 "''"
2058 (if (equal argument "") 2073 ;; Quote everything except POSIX filename characters.
2059 "''" 2074 ;; This should be safe enough even for really weird shells.
2060 ;; Quote everything except POSIX filename characters. 2075 (let ((result "") (start 0) end)
2061 ;; This should be safe enough even for really weird shells. 2076 (while (string-match "[^-0-9a-zA-Z_./]" argument start)
2062 (let ((result "") (start 0) end) 2077 (setq end (match-beginning 0)
2063 (while (string-match "[^-0-9a-zA-Z_./]" argument start) 2078 result (concat result (substring argument start end)
2064 (setq end (match-beginning 0) 2079 "\\" (substring argument end (1+ end)))
2065 result (concat result (substring argument start end) 2080 start (1+ end)))
2066 "\\" (substring argument end (1+ end))) 2081 (concat result (substring argument start))))))
2067 start (1+ end)))
2068 (concat result (substring argument start)))))))
2069 2082
2070 (defun string-or-null-p (object) 2083 (defun string-or-null-p (object)
2071 "Return t if OBJECT is a string or nil. 2084 "Return t if OBJECT is a string or nil.
2072 Otherwise, return nil." 2085 Otherwise, return nil."
2073 (or (stringp object) (null object))) 2086 (or (stringp object) (null object)))
2152 called with two arguments, the start and end of the current region. 2165 called with two arguments, the start and end of the current region.
2153 FUNCTION may set `yank-undo-function' to override the UNDO value." 2166 FUNCTION may set `yank-undo-function' to override the UNDO value."
2154 (let* ((handler (and (stringp string) 2167 (let* ((handler (and (stringp string)
2155 (get-text-property 0 'yank-handler string))) 2168 (get-text-property 0 'yank-handler string)))
2156 (param (or (nth 1 handler) string)) 2169 (param (or (nth 1 handler) string))
2157 (opoint (point))) 2170 (opoint (point))
2171 end)
2172
2158 (setq yank-undo-function t) 2173 (setq yank-undo-function t)
2159 (if (nth 0 handler) ;; FUNCTION 2174 (if (nth 0 handler) ;; FUNCTION
2160 (funcall (car handler) param) 2175 (funcall (car handler) param)
2161 (insert param)) 2176 (insert param))
2177 (setq end (point))
2178
2179 ;; What should we do with `font-lock-face' properties?
2180 (if font-lock-defaults
2181 ;; No, just wipe them.
2182 (remove-list-of-text-properties opoint end '(font-lock-face))
2183 ;; Convert them to `face'.
2184 (save-excursion
2185 (goto-char opoint)
2186 (while (< (point) end)
2187 (let ((face (get-text-property (point) 'font-lock-face))
2188 run-end)
2189 (setq run-end
2190 (next-single-property-change (point) 'font-lock-face nil end))
2191 (when face
2192 (remove-text-properties (point) run-end '(font-lock-face nil))
2193 (put-text-property (point) run-end 'face face))
2194 (goto-char run-end)))))
2195
2162 (unless (nth 2 handler) ;; NOEXCLUDE 2196 (unless (nth 2 handler) ;; NOEXCLUDE
2163 (remove-yank-excluded-properties opoint (point))) 2197 (remove-yank-excluded-properties opoint (point)))
2164 (if (eq yank-undo-function t) ;; not set by FUNCTION 2198 (if (eq yank-undo-function t) ;; not set by FUNCTION
2165 (setq yank-undo-function (nth 3 handler))) ;; UNDO 2199 (setq yank-undo-function (nth 3 handler))) ;; UNDO
2166 (if (nth 4 handler) ;; COMMAND 2200 (if (nth 4 handler) ;; COMMAND
2199 Process output goes at end of that buffer, unless you specify 2233 Process output goes at end of that buffer, unless you specify
2200 an output stream or filter function to handle the output. 2234 an output stream or filter function to handle the output.
2201 BUFFER may be also nil, meaning that this process is not associated 2235 BUFFER may be also nil, meaning that this process is not associated
2202 with any buffer 2236 with any buffer
2203 COMMAND is the name of a shell command. 2237 COMMAND is the name of a shell command.
2204 Remaining arguments are the arguments for the command. 2238 Remaining arguments are the arguments for the command; they are all
2239 spliced together with blanks separating between each two of them, before
2240 passing the command to the shell.
2205 Wildcards and redirection are handled as usual in the shell. 2241 Wildcards and redirection are handled as usual in the shell.
2206 2242
2207 \(fn NAME BUFFER COMMAND &rest COMMAND-ARGS)" 2243 \(fn NAME BUFFER COMMAND &rest COMMAND-ARGS)"
2208 (cond 2244 (cond
2209 ((eq system-type 'vax-vms) 2245 ((eq system-type 'vax-vms)
2402 (declare (debug t) (indent 0)) 2438 (declare (debug t) (indent 0))
2403 (let ((catch-sym (make-symbol "input"))) 2439 (let ((catch-sym (make-symbol "input")))
2404 `(with-local-quit 2440 `(with-local-quit
2405 (catch ',catch-sym 2441 (catch ',catch-sym
2406 (let ((throw-on-input ',catch-sym)) 2442 (let ((throw-on-input ',catch-sym))
2407 (or (not (sit-for 0 0 t)) 2443 (or (input-pending-p)
2408 ,@body)))))) 2444 ,@body))))))
2409 2445
2410 (defmacro combine-after-change-calls (&rest body) 2446 (defmacro combine-after-change-calls (&rest body)
2411 "Execute BODY, but don't call the after-change functions till the end. 2447 "Execute BODY, but don't call the after-change functions till the end.
2412 If BODY makes changes in the buffer, they are recorded 2448 If BODY makes changes in the buffer, they are recorded
2413 and the functions on `after-change-functions' are called several times 2449 and the functions on `after-change-functions' are called several times
3107 Usually the separator is \".\", but it can be any other string.") 3143 Usually the separator is \".\", but it can be any other string.")
3108 3144
3109 3145
3110 (defvar version-regexp-alist 3146 (defvar version-regexp-alist
3111 '(("^[-_+ ]?a\\(lpha\\)?$" . -3) 3147 '(("^[-_+ ]?a\\(lpha\\)?$" . -3)
3112 ("^[-_+]$" . -3) ; treat "1.2.3-20050920" and "1.2-3" as alpha releases 3148 ("^[-_+]$" . -3) ; treat "1.2.3-20050920" and "1.2-3" as alpha releases
3113 ("^[-_+ ]cvs$" . -3) ; treat "1.2.3-CVS" as alpha release 3149 ("^[-_+ ]cvs$" . -3) ; treat "1.2.3-CVS" as alpha release
3114 ("^[-_+ ]?b\\(eta\\)?$" . -2) 3150 ("^[-_+ ]?b\\(eta\\)?$" . -2)
3115 ("^[-_+ ]?\\(pre\\|rc\\)$" . -1)) 3151 ("^[-_+ ]?\\(pre\\|rc\\)$" . -1))
3116 "*Specify association between non-numeric version part and a priority. 3152 "*Specify association between non-numeric version part and a priority.
3117 3153
3118 This association is used to handle version string like \"1.0pre2\", 3154 This association is used to handle version string like \"1.0pre2\",