Note that you can use "-" with --output=file in Etags.

[bpt/emacs.git] / lisp / subr.el

diff --git a/lisp/subr.el b/lisp/subr.el
index 3804624..17abc70 100644 (file)
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -10,7 +10,7 @@
 
 ;; 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
 
 ;; 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,
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,


@@ -103,7 +103,7 @@ change the list."
 When COND yields non-nil, eval BODY forms sequentially and return
 value of last one, or nil if there are none.
 
 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)))
 
   (declare (indent 1) (debug t))
   (list 'if cond (cons 'progn body)))
 


@@ -112,7 +112,7 @@ value of last one, or nil if there are none.
 When COND yields nil, eval BODY forms sequentially and return
 value of last one, or nil if there are none.
 
 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))))
 
   (declare (indent 1) (debug t))
   (cons 'if (cons cond (cons nil body))))
 


@@ -510,6 +510,7 @@ Don't call this function; it is for internal use only."
                               (if (integerp b) (< a b)
                                 t)
                             (if (integerp b) t
                               (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))))
                               (string< a b))))))
        (dolist (p list)
          (funcall function (car p) (cdr p))))


@@ -944,7 +945,7 @@ is converted into a string by expressing it in decimal."
 (make-obsolete 'focus-frame "it does nothing." "22.1")
 (defalias 'unfocus-frame 'ignore "")
 (make-obsolete 'unfocus-frame "it does nothing." "22.1")
 (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.
 
 \f
 ;;;; Obsolescence declarations for variables, and aliases.
 


@@ -988,7 +989,6 @@ to reread, so it now uses nil to mean `no event', instead of -1."
 (defalias 'search-backward-regexp (symbol-function 're-search-backward))
 (defalias 'int-to-string 'number-to-string)
 (defalias 'store-match-data 'set-match-data)
 (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)
 ;; These are the XEmacs names:
 (defalias 'point-at-eol 'line-end-position)
 (defalias 'point-at-bol 'line-beginning-position)


@@ -1628,7 +1628,7 @@ any other non-digit terminates the character code and is then used as input."))
       ;; 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)
       ;; 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))
        (if (arrayp translation)
            (setq translated (aref translation 0))))
       (cond ((null translated))


@@ -2309,6 +2309,15 @@ Wildcards and redirection are handled as usual in the shell.
     (start-process name buffer shell-file-name shell-command-switch
                   (mapconcat 'identity args " ")))))
 
     (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.
 (defun call-process-shell-command (command &optional infile buffer display
                                           &rest args)
   "Execute the shell command COMMAND synchronously in separate process.


@@ -2340,6 +2349,16 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again."
                  infile buffer display
                  shell-command-switch
                  (mapconcat 'identity (cons command args) " ")))))
                  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.
 
 \f
 ;;;; Lisp macros to do various things temporarily.
 


@@ -2388,6 +2407,23 @@ See also `with-temp-buffer'."
         (if (window-live-p save-selected-window-window)
             (select-window save-selected-window-window 'norecord))))))
 
         (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.
 (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.


@@ -2485,6 +2521,29 @@ If BODY finishes, `while-no-input' returns whatever value BODY produced."
           (or (input-pending-p)
               ,@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
 (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


@@ -2519,6 +2578,20 @@ The value returned is the value of the last form in BODY."
 \f
 ;;;; Constructing completion tables.
 
 \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,
 (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,


@@ -2540,10 +2613,7 @@ that can be used as the ALIST argument to `try-completion' and
        (with-current-buffer (let ((,win (minibuffer-selected-window)))
                               (if (window-live-p ,win) (window-buffer ,win)
                                 (current-buffer)))
        (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
 
 (defmacro lazy-completion-table (var fun)
   ;; We used to have `&rest args' where `args' were evaluated late (at the


@@ -2639,6 +2709,24 @@ STRING should be given if the last search was by `string-match' on STRING."
        (buffer-substring-no-properties (match-beginning num)
                                        (match-end num)))))
 
        (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.
 (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.


@@ -2782,11 +2870,10 @@ Modifies the match data; use `save-match-data' if necessary."
                    list)))
     (nreverse list)))
 
                    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
   "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
 Only some SEPARATORs will work properly."
   (let ((sep (or separator " ")))
     (mapconcat


@@ -2796,20 +2883,20 @@ Only some SEPARATORs will work properly."
         str))
      strings sep)))
 
         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.
   "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)))
 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)
       (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.
 
 \f
 ;;;; Replacement in strings.