(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.
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
;; or C-q C-x might not return immediately since ESC or C-x might be
;; bound to some prefix in function-key-map or key-translation-map.
(setq translated char)
- (let ((translation (lookup-key function-key-map (vector char))))
+ (let ((translation (lookup-key local-function-key-map (vector char))))
(if (arrayp translation)
(setq translated (aref translation 0))))
(cond ((null translated))
(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 ((timer (timer-create))
- (echo-keystrokes 0))
- (if (catch 'sit-for-timeout
- (timer-set-time timer (timer-relative-time
- (current-time) seconds))
- (timer-set-function timer 'with-timeout-handler
- '(sit-for-timeout))
- (timer-activate timer)
- (push (read-event) unread-command-events)
- nil)
- t
- (cancel-timer timer)
- 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))))))
\f
;;; Atomic change groups.
(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 "")
"\\" (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.
(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
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)"
(if (window-live-p save-selected-window-window)
(select-window save-selected-window-window 'norecord))))))
+(defmacro with-selected-frame (frame &rest body)
+ "Execute the forms in BODY with FRAME as the selected frame.
+The value returned is the value of the last form in BODY.
+See also `with-temp-buffer'."
+ (declare (indent 1) (debug t))
+ (let ((old-frame (make-symbol "old-frame"))
+ (old-buffer (make-symbol "old-buffer")))
+ `(let ((,old-frame (selected-frame))
+ (,old-buffer (current-buffer)))
+ (unwind-protect
+ (progn (select-frame ,frame)
+ ,@body)
+ (if (frame-live-p ,old-frame)
+ (select-frame ,old-frame))
+ (if (buffer-live-p ,old-buffer)
+ (set-buffer ,old-buffer))))))
+
(defmacro with-temp-file (file &rest body)
"Create a new buffer, evaluate BODY there, and write the buffer to FILE.
The value returned is the value of the last form in BODY.
`(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.
(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.
HCoop / bpt / emacs.git / blobdiff