;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
When COND yields non-nil, eval BODY forms sequentially and return
value of last one, or nil if there are none.
-\(fn COND BODY ...)"
+\(fn COND BODY...)"
(declare (indent 1) (debug t))
(list 'if cond (cons 'progn body)))
When COND yields nil, eval BODY forms sequentially and return
value of last one, or nil if there are none.
-\(fn COND BODY ...)"
+\(fn COND BODY...)"
(declare (indent 1) (debug t))
(cons 'if (cons cond (cons nil body))))
(if (integerp b) (< a b)
t)
(if (integerp b) t
+ ;; string< also accepts symbols.
(string< a b))))))
(dolist (p list)
(funcall function (car p) (cdr p))))
(make-obsolete 'focus-frame "it does nothing." "22.1")
(defalias 'unfocus-frame 'ignore "")
(make-obsolete 'unfocus-frame "it does nothing." "22.1")
-
+(make-obsolete 'make-variable-frame-local "use a frame-parameter instead" "22.2")
\f
;;;; Obsolescence declarations for variables, and aliases.
(defalias 'search-backward-regexp (symbol-function 're-search-backward))
(defalias 'int-to-string 'number-to-string)
(defalias 'store-match-data 'set-match-data)
-(defalias 'make-variable-frame-localizable 'make-variable-frame-local)
;; These are the XEmacs names:
(defalias 'point-at-eol 'line-end-position)
(defalias 'point-at-bol 'line-beginning-position)
;; 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))
(start-process name buffer shell-file-name shell-command-switch
(mapconcat 'identity args " ")))))
+(defun start-file-process-shell-command (name buffer &rest args)
+ "Start a program in a subprocess. Return the process object for it.
+Similar to `start-process-shell-command', but calls `start-file-process'."
+ (start-file-process
+ name buffer
+ (if (file-remote-p default-directory) "/bin/sh" shell-file-name)
+ (if (file-remote-p default-directory) "-c" shell-command-switch)
+ (mapconcat 'identity args " ")))
+
(defun call-process-shell-command (command &optional infile buffer display
&rest args)
"Execute the shell command COMMAND synchronously in separate process.
infile buffer display
shell-command-switch
(mapconcat 'identity (cons command args) " ")))))
+
+(defun process-file-shell-command (command &optional infile buffer display
+ &rest args)
+ "Process files synchronously in a separate process.
+Similar to `call-process-shell-command', but calls `process-file'."
+ (process-file
+ (if (file-remote-p default-directory) "/bin/sh" shell-file-name)
+ infile buffer display
+ (if (file-remote-p default-directory) "-c" shell-command-switch)
+ (mapconcat 'identity (cons command args) " ")))
\f
;;;; Lisp macros to do various things temporarily.
(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.
(or (input-pending-p)
,@body))))))
+(defmacro condition-case-no-debug (var bodyform &rest handlers)
+ "Like `condition-case' except that it does not catch anything when debugging.
+More specifically if `debug-on-error' is set, then it does not catch any signal."
+ (declare (debug condition-case) (indent 2))
+ (let ((bodysym (make-symbol "body")))
+ `(let ((,bodysym (lambda () ,bodyform)))
+ (if debug-on-error
+ (funcall ,bodysym)
+ (condition-case ,var
+ (funcall ,bodysym)
+ ,@handlers)))))
+
+(defmacro with-demoted-errors (&rest body)
+ "Run BODY and demote any errors to simple messages.
+If `debug-on-error' is non-nil, run BODY without catching its errors.
+This is to be used around code which is not expected to signal an error
+but which should be robust in the unexpected case that an error is signalled."
+ (declare (debug t) (indent 0))
+ (let ((err (make-symbol "err")))
+ `(condition-case-no-debug ,err
+ (progn ,@body)
+ (error (message "Error: %s" ,err) nil))))
+
(defmacro combine-after-change-calls (&rest body)
"Execute BODY, but don't call the after-change functions till the end.
If BODY makes changes in the buffer, they are recorded
\f
;;;; Constructing completion tables.
+(defun complete-with-action (action table string pred)
+ "Perform completion ACTION.
+STRING is the string to complete.
+TABLE is the completion table, which should not be a function.
+PRED is a completion predicate.
+ACTION can be one of nil, t or `lambda'."
+ ;; (assert (not (functionp table)))
+ (funcall
+ (cond
+ ((null action) 'try-completion)
+ ((eq action t) 'all-completions)
+ (t 'test-completion))
+ string table pred))
+
(defmacro dynamic-completion-table (fun)
"Use function FUN as a dynamic completion table.
FUN is called with one argument, the string for which completion is required,
(with-current-buffer (let ((,win (minibuffer-selected-window)))
(if (window-live-p ,win) (window-buffer ,win)
(current-buffer)))
- (cond
- ((eq ,mode t) (all-completions ,string (,fun ,string) ,predicate))
- ((not ,mode) (try-completion ,string (,fun ,string) ,predicate))
- (t (test-completion ,string (,fun ,string) ,predicate)))))))
+ (complete-with-action ,mode (,fun ,string) ,string ,predicate)))))
(defmacro lazy-completion-table (var fun)
;; We used to have `&rest args' where `args' were evaluated late (at the
(buffer-substring-no-properties (match-beginning num)
(match-end num)))))
+
+(defun match-substitute-replacement (replacement
+ &optional fixedcase literal string subexp)
+ "Return REPLACEMENT as it will be inserted by `replace-match'.
+In other words, all back-references in the form `\\&' and `\\N'
+are substituted with actual strings matched by the last search.
+Optional FIXEDCASE, LITERAL, STRING and SUBEXP have the same
+meaning as for `replace-match'."
+ (let ((match (match-string 0 string)))
+ (save-match-data
+ (set-match-data (mapcar (lambda (x)
+ (if (numberp x)
+ (- x (match-beginning 0))
+ x))
+ (match-data t)))
+ (replace-match replacement fixedcase literal match subexp))))
+
+
(defun looking-back (regexp &optional limit greedy)
"Return non-nil if text before point matches regular expression REGEXP.
Like `looking-at' except matches before point, and is slower.
list)))
(nreverse list)))
-;; (string->strings (strings->string X)) == X
-(defun strings->string (strings &optional separator)
+(defun combine-and-quote-strings (strings &optional separator)
"Concatenate the STRINGS, adding the SEPARATOR (default \" \").
This tries to quote the strings to avoid ambiguity such that
- (string->strings (strings->string strs)) == strs
+ (split-string-and-unquote (combine-and-quote-strings strs)) == strs
Only some SEPARATORs will work properly."
(let ((sep (or separator " ")))
(mapconcat
str))
strings sep)))
-;; (string->strings (strings->string X)) == X
-(defun string->strings (string &optional separator)
+(defun split-string-and-unquote (string &optional separator)
"Split the STRING into a list of strings.
-It understands elisp style quoting within STRING such that
- (string->strings (strings->string strs)) == strs
+It understands Emacs Lisp quoting within STRING, such that
+ (split-string-and-unquote (combine-and-quote-strings strs)) == strs
The SEPARATOR regexp defaults to \"\\s-+\"."
(let ((sep (or separator "\\s-+"))
(i (string-match "[\"]" string)))
- (if (null i) (split-string string sep t) ; no quoting: easy
+ (if (null i)
+ (split-string string sep t) ; no quoting: easy
(append (unless (eq i 0) (split-string (substring string 0 i) sep t))
(let ((rfs (read-from-string string i)))
(cons (car rfs)
- (string->strings (substring string (cdr rfs))
- sep)))))))
+ (split-string-and-unquote (substring string (cdr rfs))
+ sep)))))))
\f
;;;; Replacement in strings.
HCoop / bpt / emacs.git / blobdiff