(follow-mode): Don't run hooks twice. Use `when'.
[bpt/emacs.git] / lisp / subr.el
index 84f216b..bce8096 100644 (file)
@@ -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
+                               ;; string< also accepts symbols.
                               (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.
-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)
@@ -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)
-      (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))
@@ -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")
 
+(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.
 
@@ -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 " ")))))
 
+(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.
@@ -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) " ")))))
+
+(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.
 
@@ -2378,6 +2408,23 @@ See also `with-temp-buffer'."
         (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.
@@ -2475,6 +2522,29 @@ If BODY finishes, `while-no-input' returns whatever value BODY produced."
           (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
@@ -2509,6 +2579,20 @@ The value returned is the value of the last form in BODY."
 \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,
@@ -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)))
-         (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
@@ -2658,6 +2739,18 @@ of a match for REGEXP."
            (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.
@@ -2760,11 +2853,10 @@ Modifies the match data; use `save-match-data' if necessary."
                    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
@@ -2774,20 +2866,20 @@ Only some SEPARATORs will work properly."
         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.