Merge from trunk
[bpt/emacs.git] / lisp / simple.el
index a2dda5f..a414fc7 100644 (file)
@@ -28,8 +28,7 @@
 
 ;;; Code:
 
-;; This is for lexical-let in apply-partially.
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl))       ;For define-minor-mode.
 
 (declare-function widget-convert "wid-edit" (type &rest args))
 (declare-function shell-mode "shell" ())
@@ -637,7 +636,9 @@ If the region is active, only delete whitespace within the region."
             (if (looking-at ".*\f")
                 (goto-char (match-end 0))))
           (delete-region (point) (match-end 0)))
-        (set-marker end-marker nil)))))
+        (set-marker end-marker nil))))
+  ;; Return nil for the benefit of `write-file-functions'.
+  nil)
 
 (defun newline-and-indent ()
   "Insert a newline, then indent according to major mode.
@@ -998,7 +999,7 @@ When called interactively, the word count is printed in echo area."
         (goto-char (point-min))
         (while (forward-word 1)
           (setq count (1+ count)))))
-    (if (interactive-p)
+    (if (called-interactively-p 'interactive)
         (message "Region has %d words" count))
     count))
 
@@ -1218,12 +1219,12 @@ this command arranges for all errors to enter the debugger."
         current-prefix-arg))
 
   (if (null eval-expression-debug-on-error)
-      (setq values (cons (eval eval-expression-arg) values))
+      (push (eval eval-expression-arg lexical-binding) values)
     (let ((old-value (make-symbol "t")) new-value)
       ;; Bind debug-on-error to something unique so that we can
       ;; detect when evaled code changes it.
       (let ((debug-on-error old-value))
-       (setq values (cons (eval eval-expression-arg) values))
+       (push (eval eval-expression-arg lexical-binding) values)
        (setq new-value debug-on-error))
       ;; If evaled code has changed the value of debug-on-error,
       ;; propagate that change to the global binding.
@@ -2628,7 +2629,7 @@ specifies the value of ERROR-BUFFER."
   (with-output-to-string
     (with-current-buffer
       standard-output
-      (call-process shell-file-name nil t nil shell-command-switch command))))
+      (process-file shell-file-name nil t nil shell-command-switch command))))
 
 (defun process-file (program &optional infile buffer display &rest args)
   "Process files synchronously in a separate process.
@@ -2827,51 +2828,6 @@ These commands include \\[set-mark-command] and \\[start-kbd-macro]."
   (reset-this-command-lengths)
   (restore-overriding-map))
 \f
-;; This function is here rather than in subr.el because it uses CL.
-(defmacro with-wrapper-hook (var args &rest body)
-  "Run BODY wrapped with the VAR hook.
-VAR is a special hook: its functions are called with a first argument
-which is the \"original\" code (the BODY), so the hook function can wrap
-the original function, or call it any number of times (including not calling
-it at all).  This is similar to an `around' advice.
-VAR is normally a symbol (a variable) in which case it is treated like
-a hook, with a buffer-local and a global part.  But it can also be an
-arbitrary expression.
-ARGS is a list of variables which will be passed as additional arguments
-to each function, after the initial argument, and which the first argument
-expects to receive when called."
-  (declare (indent 2) (debug t))
-  ;; We need those two gensyms because CL's lexical scoping is not available
-  ;; for function arguments :-(
-  (let ((funs (make-symbol "funs"))
-        (global (make-symbol "global"))
-        (argssym (make-symbol "args")))
-    ;; Since the hook is a wrapper, the loop has to be done via
-    ;; recursion: a given hook function will call its parameter in order to
-    ;; continue looping.
-    `(labels ((runrestofhook (,funs ,global ,argssym)
-                 ;; `funs' holds the functions left on the hook and `global'
-                 ;; holds the functions left on the global part of the hook
-                 ;; (in case the hook is local).
-                 (lexical-let ((funs ,funs)
-                               (global ,global))
-                   (if (consp funs)
-                       (if (eq t (car funs))
-                           (runrestofhook
-                            (append global (cdr funs)) nil ,argssym)
-                         (apply (car funs)
-                                (lambda (&rest ,argssym)
-                                 (runrestofhook (cdr funs) global ,argssym))
-                                ,argssym))
-                     ;; Once there are no more functions on the hook, run
-                     ;; the original body.
-                     (apply (lambda ,args ,@body) ,argssym)))))
-       (runrestofhook ,var
-                      ;; The global part of the hook, if any.
-                      ,(if (symbolp var)
-                           `(if (local-variable-p ',var)
-                                (default-value ',var)))
-                      (list ,@args)))))
 
 (defvar filter-buffer-substring-functions nil
   "Wrapper hook around `filter-buffer-substring'.
@@ -3390,16 +3346,16 @@ and KILLP is t if a prefix arg was specified."
                (delete-char 1)))
          (forward-char -1)
          (setq count (1- count))))))
-  (delete-backward-char
-   (let ((skip (cond ((eq backward-delete-char-untabify-method 'hungry) " \t")
+  (let* ((skip (cond ((eq backward-delete-char-untabify-method 'hungry) " \t")
                      ((eq backward-delete-char-untabify-method 'all)
-                      " \t\n\r"))))
-     (if skip
-         (let ((wh (- (point) (save-excursion (skip-chars-backward skip)
-                                           (point)))))
-        (+ arg (if (zerop wh) 0 (1- wh))))
-         arg))
-   killp))
+                      " \t\n\r")))
+         (n (if skip
+                (let ((wh (- (point) (save-excursion (skip-chars-backward skip)
+                                                     (point)))))
+                  (+ arg (if (zerop wh) 0 (1- wh))))
+              arg)))
+    ;; Avoid warning about delete-backward-char
+    (with-no-warnings (delete-backward-char n killp))))
 
 (defun zap-to-char (arg char)
   "Kill up to and including ARGth occurrence of CHAR.
@@ -6650,37 +6606,25 @@ saving the value of `buffer-invisibility-spec' and setting it to nil."
         buffer-invisibility-spec)
     (setq buffer-invisibility-spec nil)))
 \f
-;; Partial application of functions (similar to "currying").
-;; This function is here rather than in subr.el because it uses CL.
-(defun apply-partially (fun &rest args)
-  "Return a function that is a partial application of FUN to ARGS.
-ARGS is a list of the first N arguments to pass to FUN.
-The result is a new function which does the same as FUN, except that
-the first N arguments are fixed at the values with which this function
-was called."
-  (lexical-let ((fun fun) (args1 args))
-    (lambda (&rest args2) (apply fun (append args1 args2)))))
-\f
 ;; Minibuffer prompt stuff.
 
-;(defun minibuffer-prompt-modification (start end)
-;  (error "You cannot modify the prompt"))
-;
-;
-;(defun minibuffer-prompt-insertion (start end)
-;  (let ((inhibit-modification-hooks t))
-;    (delete-region start end)
-;    ;; Discard undo information for the text insertion itself
-;    ;; and for the text deletion.above.
-;    (when (consp buffer-undo-list)
-;      (setq buffer-undo-list (cddr buffer-undo-list)))
-;    (message "You cannot modify the prompt")))
-;
-;
-;(setq minibuffer-prompt-properties
-;  (list 'modification-hooks '(minibuffer-prompt-modification)
-;      'insert-in-front-hooks '(minibuffer-prompt-insertion)))
-;
+;;(defun minibuffer-prompt-modification (start end)
+;;  (error "You cannot modify the prompt"))
+;;
+;;
+;;(defun minibuffer-prompt-insertion (start end)
+;;  (let ((inhibit-modification-hooks t))
+;;    (delete-region start end)
+;;    ;; Discard undo information for the text insertion itself
+;;    ;; and for the text deletion.above.
+;;    (when (consp buffer-undo-list)
+;;      (setq buffer-undo-list (cddr buffer-undo-list)))
+;;    (message "You cannot modify the prompt")))
+;;
+;;
+;;(setq minibuffer-prompt-properties
+;;  (list 'modification-hooks '(minibuffer-prompt-modification)
+;;     'insert-in-front-hooks '(minibuffer-prompt-insertion)))
 
 \f
 ;;;; Problematic external packages.