(follow-mode): Don't run hooks twice. Use `when'.

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

diff --git a/lisp/subr.el b/lisp/subr.el
index 84f216b..bce8096 100644 (file)
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -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))))


@@ -1219,7 +1220,8 @@ if it is empty or a duplicate."
 Execution is delayed if `delay-mode-hooks' is non-nil.
 If `delay-mode-hooks' is nil, run `after-change-major-mode-hook'
 after running the mode hooks.
 Execution is delayed if `delay-mode-hooks' is non-nil.
 If `delay-mode-hooks' is nil, run `after-change-major-mode-hook'
 after running the mode hooks.

-Major mode functions should use this."
+Major mode functions should use this instead of `run-hooks' when running their
+FOO-mode-hook."

   (if delay-mode-hooks
       ;; Delaying case.
       (dolist (hook hooks)
   (if delay-mode-hooks
       ;; Delaying case.
       (dolist (hook hooks)


@@ -1627,7 +1629,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))


@@ -2041,6 +2043,15 @@ On other systems, this variable is normally always nil.")
 (put 'cl-assertion-failed 'error-conditions '(error))
 (put 'cl-assertion-failed 'error-message "Assertion failed")
 
 (put 'cl-assertion-failed 'error-conditions '(error))
 (put 'cl-assertion-failed 'error-message "Assertion failed")
 

+(defconst user-emacs-directory
+  (if (eq system-type 'ms-dos)
+      ;; MS-DOS cannot have initial dot.
+      "~/_emacs.d/"
+    "~/.emacs.d/")
+  "Directory beneath which additional per-user Emacs-specific files are placed.
+Various programs in Emacs store information in this directory.
+Note that this should end with a directory separator.")
+

 \f
 ;;;; Misc. useful functions.
 
 \f
 ;;;; Misc. useful functions.
 


@@ -2299,6 +2310,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.


@@ -2330,6 +2350,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.
 


@@ -2378,6 +2408,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.


@@ -2475,6 +2522,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


@@ -2509,6 +2579,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,


@@ -2530,10 +2614,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


@@ -2658,6 +2739,18 @@ of a match for REGEXP."
            (looking-at (concat "\\(?:"  regexp "\\)\\'")))))
     (not (null pos))))
 
            (looking-at (concat "\\(?:"  regexp "\\)\\'")))))
     (not (null pos))))
 

+(defsubst looking-at-p (regexp)
+  "\
+Same as `looking-at' except this function does not change the match data."
+  (let ((inhibit-changing-match-data t))
+    (looking-at regexp)))
+
+(defsubst string-match-p (regexp string &optional start)
+  "\
+Same as `string-match' except this function does not change the match data."
+  (let ((inhibit-changing-match-data t))
+    (string-match regexp string start)))
+

 (defun subregexp-context-p (regexp pos &optional start)
   "Return non-nil if POS is in a normal subregexp context in REGEXP.
 A subregexp context is one where a sub-regexp can appear.
 (defun subregexp-context-p (regexp pos &optional start)
   "Return non-nil if POS is in a normal subregexp context in REGEXP.
 A subregexp context is one where a sub-regexp can appear.


@@ -2760,11 +2853,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


@@ -2774,20 +2866,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.