Merge from mainline.

13 files changed, 312 insertions, 324 deletions

diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog
index 342c7c57175..08ec4c2fef8 100644
--- a/doc/lispref/ChangeLog
+++ b/doc/lispref/ChangeLog
@@ -1,3 +1,9 @@
+2013-07-24  Paul Eggert  <eggert@cs.ucla.edu>
+
+        * eval.texi (Special Forms): Mention 'lambda'.  Also, say that
+        non-well-formed expressions result in unspecified behavior, though
+        Emacs will not crash.
+
 2013-07-22  Michael Albinus  <michael.albinus@gmx.de>
 
         * files.texi (Magic File Names): Add file-notify-add-watch,
diff --git a/doc/lispref/eval.texi b/doc/lispref/eval.texi
index 4b5ef187383..4b83d575fef 100644
--- a/doc/lispref/eval.texi
+++ b/doc/lispref/eval.texi
@@ -432,6 +432,14 @@ do.
 and which are used without evaluation.  Whether a particular argument is
 evaluated may depend on the results of evaluating other arguments.
 
+  If an expression's first symbol is that of a special form, the
+expression should follow the rules of that special form; otherwise,
+Emacs's behavior is not well-defined (though it will not crash).  For
+example, @code{((lambda (x) x . 3) 4)} contains a subexpression that
+begins with @code{lambda} but is not a well-formed @code{lambda}
+expression, so Emacs may signal an error, or may return 3 or 4 or
+@code{nil}, or may behave in other ways.
+
   Here is a list, in alphabetical order, of all of the special forms in
 Emacs Lisp with a reference to where each is described.
 
@@ -463,6 +471,9 @@ Emacs Lisp with a reference to where each is described.
 @item interactive
 @pxref{Interactive Call}
 
+@item lambda
+@pxref{Lambda Expressions}
+
 @item let
 @itemx let*
 @pxref{Local Variables}
diff --git a/etc/NEWS b/etc/NEWS
index e7d51a4033a..facadac5c1c 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -538,14 +538,6 @@ file using `set-file-extended-attributes'.
 ** `visited-file-modtime' now returns -1 for nonexistent files.
 Formerly it returned a list (-1 LOW USEC PSEC), but this was ambiguous
 in the presence of files with negative time stamps.
-
-** Special forms with implied progn now check for proper lists.
-Starting in Emacs 21.4, a special form with an implied progn of an
-improper list ignored the trailing value, treating it as nil.  For
-example, (cond (t (message "hello") . "there")) ignored the "there".
-This inadvertent change to Emacs's behavior has been reverted, and
-Emacs now signals an error for these improper forms, as it did in
-version 21.3 and earlier.
 
 * Lisp Changes in Emacs 24.4
 
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 2ff5a50e171..886c3075653 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,39 @@
+2013-07-24  Glenn Morris  <rgm@gnu.org>
+
+        * printing.el: Replace all uses of deleted ps-windows-system,
+        ps-lp-system, ps-flatten-list with lpr- versions.
+
+2013-07-24  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * emacs-lisp/pcase.el (pcase--u1): Verify if self-quoting values can be
+        checked with memq (bug#14935).
+
+        * files.el (revert-buffer-function): Use a non-nil default.
+        (revert-buffer-preserve-modes): Declare var to
+        provide access to the `preserve-modes' argument.
+        (revert-buffer): Let-bind it.
+        (revert-buffer--default): New function, extracted from revert-buffer.
+
+2013-07-24  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * lpr.el: Signal print errors more prominently.
+        (print-region-function): Don't default to nil.
+        (lpr-print-region): New function, extracted from print-region-1.
+        Check lpr's return value and signal an error in case of problem.
+        (print-region-1): Use it.
+        * ps-print.el (ps-windows-system, ps-lp-system): Remove.  Use the lpr-*
+        versions instead.
+        (ps-printer-name): Default to nil.
+        (ps-printer-name-option): Default to lpr-printer-switch.
+        (ps-print-region-function): Don't default to nil.
+        (ps-postscript-code-directory): Simplify default.
+        (ps-do-despool): Use lpr-print-region to properly check the outcome.
+        (ps-string-list, ps-eval-switch, ps-flatten-list)
+        (ps-flatten-list-1): Remove.
+        (ps-multibyte-buffer): Avoid setq.
+        * dos-w32.el (direct-print-region-helper): Use proper regexp operators.
+        (print-region-function, ps-print-region-function): Don't set them here.
+
 2013-07-24  Xue Fuqiao  <xfq.free@gmail.com>
 
         * ido.el (ido-fractionp):
diff --git a/lisp/dos-w32.el b/lisp/dos-w32.el
index ff4a3ad66f0..0573caa6c23 100644
--- a/lisp/dos-w32.el
+++ b/lisp/dos-w32.el
@@ -257,10 +257,10 @@ filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"."
 ;; Function to actually send data to the printer port.
 ;; Supports writing directly, and using various programs.
 (defun direct-print-region-helper (printer
-                                   start end
-                                   lpr-prog
-                                   _delete-text _buf _display
-                                   rest)
+                                   start end
+                                   lpr-prog
+                                   _delete-text _buf _display
+                                   rest)
   (let* (;; Ignore case when matching known external program names.
          (case-fold-search t)
          ;; Convert / to \ in printer name, for sake of external programs.
@@ -295,12 +295,14 @@ filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"."
     (unwind-protect
         (cond
          ;; nprint.exe is the standard print command on Netware
-         ((string-match-p "^nprint\\(\\.exe\\)?$" (file-name-nondirectory lpr-prog))
+         ((string-match-p "\\`nprint\\(\\.exe\\)?\\'"
+                          (file-name-nondirectory lpr-prog))
           (write-region start end tempfile nil 0)
           (call-process lpr-prog nil errbuf nil
                         tempfile (concat "P=" printer)))
          ;; print.exe is a standard command on NT
-         ((string-match-p "^print\\(\\.exe\\)?$" (file-name-nondirectory lpr-prog))
+         ((string-match-p "\\`print\\(\\.exe\\)?\\'"
+                          (file-name-nondirectory lpr-prog))
           ;; Be careful not to invoke print.exe on MS-DOS or Windows 9x
           ;; though, because it is a TSR program there (hangs Emacs).
           (or (and (eq system-type 'windows-nt)
@@ -369,7 +371,7 @@ indicates a specific program should be invoked."
          (write-region-annotate-functions
           (cons
            (lambda (_start end)
-             (if (not (char-equal (char-before end) ?\C-l))
+             (if (not (char-equal (char-before end) ?\f))
                  `((,end . "\f"))))
            write-region-annotate-functions))
          (printer (or (and (boundp 'dos-printer)
@@ -383,9 +385,7 @@ indicates a specific program should be invoked."
     (direct-print-region-helper printer start end lpr-prog
                                 delete-text buf display rest)))
 
-(defvar print-region-function)
 (defvar lpr-headers-switches)
-(setq print-region-function 'direct-print-region-function)
 
 ;; Set this to nil if you have a port of the `pr' program
 ;; (e.g., from GNU Textutils), or if you have an `lpr'
@@ -416,9 +416,6 @@ indicates a specific program should be invoked."
     (direct-print-region-helper printer start end lpr-prog
                                 delete-text buf display rest)))
 
-(defvar ps-print-region-function)
-(setq ps-print-region-function 'direct-ps-print-region-function)
-
 ;(setq ps-lpr-command "gs")
 
 ;(setq ps-lpr-switches '("-q" "-dNOPAUSE" "-sDEVICE=epson" "-r240x60"
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 511f1480099..50c92518b02 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -659,11 +659,15 @@ Otherwise, it defers to REST which is a list of branches of the form
               (memq-fine t))
           (when all
             (dolist (alt (cdr upat))
-              (unless (or (pcase--self-quoting-p alt)
-                          (and (eq (car-safe alt) '\`)
-                               (or (symbolp (cadr alt)) (integerp (cadr alt))
-                                   (setq memq-fine nil)
-                                   (stringp (cadr alt)))))
+              (unless (if (pcase--self-quoting-p alt)
+                          (progn
+                            (unless (or (symbolp alt) (integerp alt))
+                              (setq memq-fine nil))
+                            t)
+                        (and (eq (car-safe alt) '\`)
+                             (or (symbolp (cadr alt)) (integerp (cadr alt))
+                                 (setq memq-fine nil)
+                                 (stringp (cadr alt)))))
                 (setq all nil))))
           (if all
               ;; Use memq for (or `a `b `c `d) rather than a big tree.
diff --git a/lisp/files.el b/lisp/files.el
index ff4ccec2279..10d66e0b2e0 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -5246,10 +5246,12 @@ comparison."
 
 
 (put 'revert-buffer-function 'permanent-local t)
-(defvar revert-buffer-function nil
+(defvar revert-buffer-function #'revert-buffer--default
   "Function to use to revert this buffer, or nil to do the default.
 The function receives two arguments IGNORE-AUTO and NOCONFIRM,
-which are the arguments that `revert-buffer' received.")
+which are the arguments that `revert-buffer' received.
+It also has access to the `preserve-modes' argument of `revert-buffer'
+via the `revert-buffer-preserve-modes' dynamic variable.")
 
 (put 'revert-buffer-insert-file-contents-function 'permanent-local t)
 (defvar revert-buffer-insert-file-contents-function nil
@@ -5296,6 +5298,11 @@ This is true even if a `revert-buffer-function' is being used.")
 
 (defvar revert-buffer-internal-hook)
 
+;; `revert-buffer-function' was defined long ago to be a function of only
+;; 2 arguments, so we have to use a dynbind variable to pass the
+;; `preserve-modes' argument of `revert-buffer'.
+(defvar revert-buffer-preserve-modes)
+
 (defun revert-buffer (&optional ignore-auto noconfirm preserve-modes)
   "Replace current buffer text with the text of the visited file on disk.
 This undoes all changes since the file was visited or saved.
@@ -5337,112 +5344,113 @@ non-nil, it is called instead of rereading visited file contents."
   ;; reversal of the argument sense.  So I'm just changing the user
   ;; interface, but leaving the programmatic interface the same.
   (interactive (list (not current-prefix-arg)))
-  (if revert-buffer-function
-      (let ((revert-buffer-in-progress-p t))
-        (funcall revert-buffer-function ignore-auto noconfirm))
-    (with-current-buffer (or (buffer-base-buffer (current-buffer))
-                             (current-buffer))
-      (let* ((revert-buffer-in-progress-p t)
-             (auto-save-p (and (not ignore-auto)
-                               (recent-auto-save-p)
-                               buffer-auto-save-file-name
-                               (file-readable-p buffer-auto-save-file-name)
-                               (y-or-n-p
-     "Buffer has been auto-saved recently.  Revert from auto-save file? ")))
-             (file-name (if auto-save-p
-                            buffer-auto-save-file-name
-                          buffer-file-name)))
-        (cond ((null file-name)
-               (error "Buffer does not seem to be associated with any file"))
-              ((or noconfirm
-                   (and (not (buffer-modified-p))
-                        (catch 'found
-                          (dolist (regexp revert-without-query)
-                            (when (string-match regexp file-name)
-                              (throw 'found t)))))
-                   (yes-or-no-p (format "Revert buffer from file %s? "
-                                        file-name)))
-               (run-hooks 'before-revert-hook)
-               ;; If file was backed up but has changed since,
-               ;; we should make another backup.
-               (and (not auto-save-p)
-                    (not (verify-visited-file-modtime (current-buffer)))
-                    (setq buffer-backed-up nil))
-               ;; Effectively copy the after-revert-hook status,
-               ;; since after-find-file will clobber it.
-               (let ((global-hook (default-value 'after-revert-hook))
-                     (local-hook (when (local-variable-p 'after-revert-hook)
-                                   after-revert-hook))
-                     (inhibit-read-only t))
-                 (cond
-                  (revert-buffer-insert-file-contents-function
-                   (unless (eq buffer-undo-list t)
-                     ;; Get rid of all undo records for this buffer.
-                     (setq buffer-undo-list nil))
-                   ;; Don't make undo records for the reversion.
-                   (let ((buffer-undo-list t))
-                     (funcall revert-buffer-insert-file-contents-function
-                              file-name auto-save-p)))
-                  ((not (file-exists-p file-name))
-                   (error (if buffer-file-number
-                              "File %s no longer exists!"
-                            "Cannot revert nonexistent file %s")
-                          file-name))
-                  ((not (file-readable-p file-name))
-                   (error (if buffer-file-number
-                              "File %s no longer readable!"
-                            "Cannot revert unreadable file %s")
-                          file-name))
-                  (t
-                   ;; Bind buffer-file-name to nil
-                   ;; so that we don't try to lock the file.
-                   (let ((buffer-file-name nil))
-                     (or auto-save-p
-                         (unlock-buffer)))
-                   (widen)
-                   (let ((coding-system-for-read
-                          ;; Auto-saved file should be read by Emacs's
-                          ;; internal coding.
-                          (if auto-save-p 'auto-save-coding
-                            (or coding-system-for-read
-                                (and
-                                 buffer-file-coding-system-explicit
-                                 (car buffer-file-coding-system-explicit))))))
-                     (if (and (not enable-multibyte-characters)
-                              coding-system-for-read
-                              (not (memq (coding-system-base
-                                          coding-system-for-read)
-                                         '(no-conversion raw-text))))
-                         ;; As a coding system suitable for multibyte
-                         ;; buffer is specified, make the current
-                         ;; buffer multibyte.
-                         (set-buffer-multibyte t))
-
-                     ;; This force after-insert-file-set-coding
-                     ;; (called from insert-file-contents) to set
-                     ;; buffer-file-coding-system to a proper value.
-                     (kill-local-variable 'buffer-file-coding-system)
-
-                     ;; Note that this preserves point in an intelligent way.
-                     (if preserve-modes
-                         (let ((buffer-file-format buffer-file-format))
-                           (insert-file-contents file-name (not auto-save-p)
-                                                 nil nil t))
-                       (insert-file-contents file-name (not auto-save-p)
-                                             nil nil t)))))
-                 ;; Recompute the truename in case changes in symlinks
-                 ;; have changed the truename.
-                 (setq buffer-file-truename
-                       (abbreviate-file-name (file-truename buffer-file-name)))
-                 (after-find-file nil nil t nil preserve-modes)
-                 ;; Run after-revert-hook as it was before we reverted.
-                 (setq-default revert-buffer-internal-hook global-hook)
-                 (if local-hook
-                     (set (make-local-variable 'revert-buffer-internal-hook)
-                          local-hook)
-                   (kill-local-variable 'revert-buffer-internal-hook))
-                 (run-hooks 'revert-buffer-internal-hook))
-               t))))))
+  (let ((revert-buffer-in-progress-p t)
+        (revert-buffer-preserve-modes preserve-modes))
+    (funcall (or revert-buffer-function #'revert-buffer--default)
+             ignore-auto noconfirm)))
+(defun revert-buffer--default (ignore-auto noconfirm)
+  (with-current-buffer (or (buffer-base-buffer (current-buffer))
+                           (current-buffer))
+    (let* ((auto-save-p (and (not ignore-auto)
+                             (recent-auto-save-p)
+                             buffer-auto-save-file-name
+                             (file-readable-p buffer-auto-save-file-name)
+                             (y-or-n-p
+                              "Buffer has been auto-saved recently.  Revert from auto-save file? ")))
+           (file-name (if auto-save-p
+                          buffer-auto-save-file-name
+                        buffer-file-name)))
+      (cond ((null file-name)
+             (error "Buffer does not seem to be associated with any file"))
+            ((or noconfirm
+                 (and (not (buffer-modified-p))
+                      (catch 'found
+                        (dolist (regexp revert-without-query)
+                          (when (string-match regexp file-name)
+                            (throw 'found t)))))
+                 (yes-or-no-p (format "Revert buffer from file %s? "
+                                      file-name)))
+             (run-hooks 'before-revert-hook)
+             ;; If file was backed up but has changed since,
+             ;; we should make another backup.
+             (and (not auto-save-p)
+                  (not (verify-visited-file-modtime (current-buffer)))
+                  (setq buffer-backed-up nil))
+             ;; Effectively copy the after-revert-hook status,
+             ;; since after-find-file will clobber it.
+             (let ((global-hook (default-value 'after-revert-hook))
+                   (local-hook (when (local-variable-p 'after-revert-hook)
+                                 after-revert-hook))
+                   (inhibit-read-only t))
+               (cond
+                (revert-buffer-insert-file-contents-function
+                 (unless (eq buffer-undo-list t)
+                   ;; Get rid of all undo records for this buffer.
+                   (setq buffer-undo-list nil))
+                 ;; Don't make undo records for the reversion.
+                 (let ((buffer-undo-list t))
+                   (funcall revert-buffer-insert-file-contents-function
+                            file-name auto-save-p)))
+                ((not (file-exists-p file-name))
+                 (error (if buffer-file-number
+                            "File %s no longer exists!"
+                          "Cannot revert nonexistent file %s")
+                        file-name))
+                ((not (file-readable-p file-name))
+                 (error (if buffer-file-number
+                            "File %s no longer readable!"
+                          "Cannot revert unreadable file %s")
+                        file-name))
+                (t
+                 ;; Bind buffer-file-name to nil
+                 ;; so that we don't try to lock the file.
+                 (let ((buffer-file-name nil))
+                   (or auto-save-p
+                       (unlock-buffer)))
+                 (widen)
+                 (let ((coding-system-for-read
+                        ;; Auto-saved file should be read by Emacs's
+                        ;; internal coding.
+                        (if auto-save-p 'auto-save-coding
+                          (or coding-system-for-read
+                              (and
+                               buffer-file-coding-system-explicit
+                               (car buffer-file-coding-system-explicit))))))
+                   (if (and (not enable-multibyte-characters)
+                            coding-system-for-read
+                            (not (memq (coding-system-base
+                                        coding-system-for-read)
+                                       '(no-conversion raw-text))))
+                       ;; As a coding system suitable for multibyte
+                       ;; buffer is specified, make the current
+                       ;; buffer multibyte.
+                       (set-buffer-multibyte t))
+
+                   ;; This force after-insert-file-set-coding
+                   ;; (called from insert-file-contents) to set
+                   ;; buffer-file-coding-system to a proper value.
+                   (kill-local-variable 'buffer-file-coding-system)
+
+                   ;; Note that this preserves point in an intelligent way.
+                   (if revert-buffer-preserve-modes
+                       (let ((buffer-file-format buffer-file-format))
+                         (insert-file-contents file-name (not auto-save-p)
+                                               nil nil t))
+                     (insert-file-contents file-name (not auto-save-p)
+                                           nil nil t)))))
+               ;; Recompute the truename in case changes in symlinks
+               ;; have changed the truename.
+               (setq buffer-file-truename
+                     (abbreviate-file-name (file-truename buffer-file-name)))
+               (after-find-file nil nil t nil revert-buffer-preserve-modes)
+               ;; Run after-revert-hook as it was before we reverted.
+               (setq-default revert-buffer-internal-hook global-hook)
+               (if local-hook
+                   (set (make-local-variable 'revert-buffer-internal-hook)
+                        local-hook)
+                 (kill-local-variable 'revert-buffer-internal-hook))
+               (run-hooks 'revert-buffer-internal-hook))
+             t)))))
 
 (defun recover-this-file ()
   "Recover the visited file--get contents from its last auto-save file."
diff --git a/lisp/lpr.el b/lisp/lpr.el
index 0b860ed07f1..5aed3bcc484 100644
--- a/lisp/lpr.el
+++ b/lisp/lpr.el
@@ -130,10 +130,13 @@ and print the result."
                  (repeat :tag "Multiple arguments" (string :tag "Argument")))
   :group 'lpr)
 
-(defcustom print-region-function nil
+(defcustom print-region-function
+  (if (memq system-type '(ms-dos windows-nt))
+      #'direct-print-region-function
+    #'call-process-region)
   "Function to call to print the region on a printer.
 See definition of `print-region-1' for calling conventions."
-  :type '(choice (const nil) function)
+  :type 'function
   :group 'lpr)
 
 (defcustom lpr-page-header-program "pr"
@@ -212,35 +215,24 @@ for further customization of the printer command."
   (print-region-1 start end lpr-switches t))
 
 (defun print-region-1 (start end switches page-headers)
+  (and page-headers lpr-headers-switches
+       ;; It's possible to use an lpr option to get page headers.
+       (setq switches (append (if (stringp lpr-headers-switches)
+                                  (list lpr-headers-switches)
+                                lpr-headers-switches)
+                              switches)))
   ;; On some MIPS system, having a space in the job name
   ;; crashes the printer demon.  But using dashes looks ugly
   ;; and it seems to annoying to do for that MIPS system.
-  (let ((name  (concat (buffer-name) " Emacs buffer"))
-        (title (concat (buffer-name) " Emacs buffer"))
-        ;; Make pipes use the same coding system as
-        ;; writing the buffer to a file would.
-        (coding-system-for-write (or coding-system-for-write
-                                     buffer-file-coding-system))
-        (coding-system-for-read  (or coding-system-for-read
-                                     buffer-file-coding-system))
-        (width tab-width)
-        nswitches
-        switch-string)
-    (save-excursion
-      (and page-headers lpr-headers-switches
-           ;; It's possible to use an lpr option to get page headers.
-           (setq switches (append (if (stringp lpr-headers-switches)
-                                      (list lpr-headers-switches)
-                                    lpr-headers-switches)
-                                  switches)))
-      (setq nswitches     (lpr-flatten-list
-                           (mapcar 'lpr-eval-switch ; Dynamic evaluation
-                                   switches))
-            switch-string (if switches
-                              (concat " with options "
-                                      (mapconcat 'identity switches " "))
-                            ""))
-      (message "Spooling%s..." switch-string)
+  (save-excursion
+    (let ((name  (concat (buffer-name) " Emacs buffer"))
+          ;; Make pipes use the same coding system as
+          ;; writing the buffer to a file would.
+          (coding-system-for-write (or coding-system-for-write
+                                       buffer-file-coding-system))
+          (coding-system-for-read  (or coding-system-for-read
+                                       buffer-file-coding-system))
+          (width tab-width))
       (if (/= tab-width 8)
           (let ((new-coords (print-region-new-buffer start end)))
             (setq start     (car new-coords)
@@ -258,34 +250,48 @@ for further customization of the printer command."
             (let ((new-coords (print-region-new-buffer start end)))
               (apply 'call-process-region (car new-coords) (cdr new-coords)
                      lpr-page-header-program t t nil
-                     (mapcar (lambda (e) (format e title))
+                     (mapcar (lambda (e) (format e name))
                              lpr-page-header-switches)))
             (setq start (point-min)
                   end   (point-max))))
-      (let ((buf (current-buffer)))
-        (with-temp-buffer
-          (let ((tempbuf (current-buffer)))
-            (with-current-buffer buf
-              (apply (or print-region-function 'call-process-region)
-                     (nconc (list start end lpr-command
-                                  nil tempbuf nil)
-                            (and lpr-add-switches
-                                 (list "-J" name))
-                            ;; These belong in pr if we are using that.
-                            (and lpr-add-switches lpr-headers-switches
-                                 (list "-T" title))
-                            (and (stringp printer-name)
-                                 (list (concat lpr-printer-switch
-                                               printer-name)))
-                            nswitches))))
-          (if (markerp end)
-              (set-marker end nil))
-          (message "Spooling%s...done%s%s" switch-string
-                   (pcase (count-lines (point-min) (point-max))
-                     (0 "")
-                     (1 ": ")
-                     (_ ":\n"))
-                   (buffer-string)))))))
+      (lpr-print-region start end switches name))))
+
+(defun lpr-print-region (start end switches name)
+  (let ((buf (current-buffer))
+        (nswitches (lpr-flatten-list
+                    (mapcar #'lpr-eval-switch ; Dynamic evaluation
+                            switches)))
+        (switch-string (if switches
+                           (concat " with options "
+                                   (mapconcat #'identity switches " "))
+                         "")))
+    (message "Spooling%s..." switch-string)
+    (with-temp-buffer
+      (let ((retval
+             (let ((tempbuf (current-buffer)))
+               (with-current-buffer buf
+                 (apply (or print-region-function 'call-process-region)
+                        start end lpr-command
+                        nil tempbuf nil
+                        (nconc (and name lpr-add-switches
+                                    (list "-J" name))
+                               ;; These belong in pr if we are using that.
+                               (and name lpr-add-switches lpr-headers-switches
+                                    (list "-T" name))
+                               (and (stringp printer-name)
+                                    (string< "" printer-name)
+                                    (list (concat lpr-printer-switch
+                                                  printer-name)))
+                               nswitches))))))
+        (if (markerp end)
+            (set-marker end nil))
+        (funcall (if (memq retval '(nil 0)) #'message #'user-error)
+                 "Spooling%s...done%s%s" switch-string
+                 (pcase (count-lines (point-min) (point-max))
+                   (0 "")
+                   (1 ": ")
+                   (_ ":\n"))
+                 (buffer-string))))))
 
 ;; This function copies the text between start and end
 ;; into a new buffer, makes that buffer current.
@@ -325,7 +331,7 @@ The characters tab, linefeed, space, return and formfeed are not affected."
 ;; Dynamic evaluation
 (defun lpr-eval-switch (arg)
   (cond ((stringp arg) arg)
-        ((functionp arg) (apply arg nil))
+        ((functionp arg) (funcall arg))
         ((symbolp arg) (symbol-value arg))
         ((consp arg) (apply (car arg) (cdr arg)))
         (t nil)))
@@ -342,7 +348,7 @@ The characters tab, linefeed, space, return and formfeed are not affected."
 
 (defun lpr-flatten-list-1 (list)
   (cond
-   ((null list) (list))
+   ((null list) nil)
    ((consp list)
     (append (lpr-flatten-list-1 (car list))
             (lpr-flatten-list-1 (cdr list))))
diff --git a/lisp/printing.el b/lisp/printing.el
index 18b2b89363b..2c807b078f5 100644
--- a/lisp/printing.el
+++ b/lisp/printing.el
@@ -1030,7 +1030,7 @@ Please send all bug fixes and enhancements to
 
 
 (defconst pr-cygwin-system
-  (and ps-windows-system (getenv "OSTYPE")
+  (and lpr-windows-system (getenv "OSTYPE")
        (string-match "cygwin" (getenv "OSTYPE"))))
 
 
@@ -1414,7 +1414,7 @@ Used by `pr-menu-bind' and `pr-update-menus'.")
 
   (eval-and-compile
     (cond
-     (ps-windows-system
+     (lpr-windows-system
       ;; GNU Emacs for Windows 9x/NT
       (defun pr-menu-position (entry index horizontal)
         (let ((pos (cdr (mouse-pixel-position))))
@@ -1614,7 +1614,7 @@ Used by `pr-menu-bind' and `pr-update-menus'.")
   "Ensure the proper directory separator depending on the OS.
 That is, if Emacs is running on DOS/Windows, ensure dos/windows-style directory
 separator; otherwise, ensure unix-style directory separator."
-  (if (or pr-cygwin-system ps-windows-system)
+  (if (or pr-cygwin-system lpr-windows-system)
       (subst-char-in-string ?/ ?\\ path)
     (subst-char-in-string ?\\ ?/ path)))
 
@@ -1667,7 +1667,7 @@ separator; otherwise, ensure unix-style directory separator."
 
 (defcustom pr-path-style
   (if (and (not pr-cygwin-system)
-           ps-windows-system)
+           lpr-windows-system)
       'windows
     'unix)
   "Specify which path style to use for external commands.
@@ -1778,7 +1778,7 @@ function (see it for documentation) to update text printer menu."
 (defcustom pr-txt-printer-alist
   (list (list 'default lpr-command nil
               (cond ((boundp 'printer-name) printer-name)
-                    (ps-windows-system "PRN")
+                    (lpr-windows-system "PRN")
                     (t nil)
                     )))
   ;; Examples:
@@ -1923,8 +1923,8 @@ function (see it for documentation) to update PostScript printer menu."
 
 (defcustom pr-ps-printer-alist
   (list (list 'default lpr-command nil
-              (cond (ps-windows-system  nil)
-                    (ps-lp-system       "-d")
+              (cond (lpr-windows-system  nil)
+                    (lpr-lp-system       "-d")
                     (t                  "-P"))
               (or (getenv "PRINTER") (getenv "LPDEST") ps-printer-name)))
   ;; Examples:
@@ -2200,7 +2200,7 @@ Useful links:
      ;; hacked from `temporary-file-directory' variable in files.el
      (file-name-as-directory
       (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP")
-          (cond (ps-windows-system "c:/temp")
+          (cond (lpr-windows-system "c:/temp")
                 (t "/tmp")
                 )))))
   "Specify a directory for temporary files during printing.
@@ -2232,7 +2232,7 @@ See also `pr-temp-dir' and `pr-ps-temp-file'."
 
 
 (defcustom pr-gv-command
-  (if ps-windows-system
+  (if lpr-windows-system
       "gsview32.exe"
     "gv")
   "Specify path and name of the gsview/gv utility.
@@ -2273,7 +2273,7 @@ Useful links:
 
 
 (defcustom pr-gs-command
-  (if ps-windows-system
+  (if lpr-windows-system
       "gswin32.exe"
     "gs")
   "Specify path and name of the ghostscript utility.
@@ -2299,7 +2299,7 @@ Useful links:
 
 
 (defcustom pr-gs-switches
-  (if ps-windows-system
+  (if lpr-windows-system
       '("-q -dNOPAUSE -Ic:/gs/gs5.50;c:/gs/gs5.50/fonts")
     '("-q -dNOPAUSE -I/usr/share/ghostscript/5.10"))
   "Specify ghostscript switches.  See the documentation on GS for more info.
@@ -2341,7 +2341,7 @@ Useful links:
 
 
 (defcustom pr-gs-device
-  (if ps-windows-system
+  (if lpr-windows-system
       "mswinpr2"
     "uniprint")
   "Specify the ghostscript device switch value (-sDEVICE=).
@@ -4852,8 +4852,8 @@ Or choose the menu option Printing/Show Settings/printing."
       (ps-comment-string "pr-ps-printer-switch" pr-ps-printer-switch)
       (ps-comment-string "pr-ps-printer       " pr-ps-printer)
       (ps-comment-string "pr-cygwin-system    " pr-cygwin-system)
-      (ps-comment-string "ps-windows-system   " ps-windows-system)
-      (ps-comment-string "ps-lp-system        " ps-lp-system)
+      (ps-comment-string "lpr-windows-system   " lpr-windows-system)
+      (ps-comment-string "lpr-lp-system        " lpr-lp-system)
       nil
       '(14 . pr-path-style)
       '(14 . pr-path-alist)
@@ -5235,14 +5235,14 @@ If menu binding was not done, calls `pr-menu-bind'."
           pr-ps-printer        (nth 3 ps))
     (or (stringp pr-ps-command)
         (setq pr-ps-command
-              (cond (ps-windows-system "print")
-                    (ps-lp-system      "lp")
+              (cond (lpr-windows-system "print")
+                    (lpr-lp-system      "lp")
                     (t                 "lpr")
                     )))
     (or (stringp pr-ps-printer-switch)
         (setq pr-ps-printer-switch
-              (cond (ps-windows-system "/D:")
-                    (ps-lp-system      "-d")
+              (cond (lpr-windows-system "/D:")
+                    (lpr-lp-system      "-d")
                     (t                 "-P")
                     )))
     (pr-eval-alist (nthcdr 4 ps)))
@@ -5260,8 +5260,8 @@ If menu binding was not done, calls `pr-menu-bind'."
           pr-txt-printer  (nth 2 txt)))
   (or (stringp pr-txt-command)
       (setq pr-txt-command
-            (cond (ps-windows-system "print")
-                  (ps-lp-system      "lp")
+            (cond (lpr-windows-system "print")
+                  (lpr-lp-system      "lp")
                   (t                 "lpr")
                   )))
   (pr-update-mode-line))
@@ -5667,7 +5667,7 @@ If menu binding was not done, calls `pr-menu-bind'."
 (defun pr-switches (switches mess)
   (or (listp switches)
       (error "%S should have a list of strings" mess))
-  (ps-flatten-list                      ; dynamic evaluation
+  (lpr-flatten-list                     ; dynamic evaluation
    (mapcar 'ps-eval-switch switches)))
 
 
@@ -5825,7 +5825,7 @@ If menu binding was not done, calls `pr-menu-bind'."
 
 (defun pr-find-buffer-visiting (file)
   (if (not (file-directory-p file))
-      (find-buffer-visiting (if ps-windows-system
+      (find-buffer-visiting (if lpr-windows-system
                                 (downcase file)
                               file))
     (let ((truename (file-truename file))
@@ -5939,7 +5939,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
     (pr-dosify-file-name
      (or (pr-find-command command)
          (pr-path-command (cond (pr-cygwin-system  'cygwin)
-                                (ps-windows-system 'windows)
+                                (lpr-windows-system 'windows)
                                 (t                 'unix))
                           (file-name-nondirectory command)
                           nil)
@@ -5976,7 +5976,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
 
 
 (defun pr-find-command (cmd)
-  (if ps-windows-system
+  (if lpr-windows-system
       ;; windows system
       (let ((ext (cons (file-name-extension cmd t)
                        (list ".exe" ".bat" ".com")))
diff --git a/lisp/ps-mule.el b/lisp/ps-mule.el
index 059261ac0ac..7f30700bee8 100644
--- a/lisp/ps-mule.el
+++ b/lisp/ps-mule.el
@@ -1058,6 +1058,7 @@ It checks if all multi-byte characters in the region are printable or not."
              (= (skip-chars-forward "\x00-\x7F" to) to)))
       ;; All characters can be printed by normal PostScript fonts.
       (setq ps-basic-plot-string-function 'ps-basic-plot-string
+            ;; FIXME: Doesn't ps-encode-header-string-function take 2 args?
             ps-encode-header-string-function 'identity)
     (setq ps-basic-plot-string-function 'ps-mule-plot-string
           ps-encode-header-string-function 'ps-mule-encode-header-string
diff --git a/lisp/ps-print.el b/lisp/ps-print.el
index b5961064cb4..8369afcbbc7 100644
--- a/lisp/ps-print.el
+++ b/lisp/ps-print.el
@@ -1472,12 +1472,6 @@ Please send all bug fixes and enhancements to
     (error "`ps-print' only supports Emacs 23 and higher")))
 
 
-(defconst ps-windows-system
-  (memq system-type '(ms-dos windows-nt)))
-(defconst ps-lp-system
-  (memq system-type '(usg-unix-v hpux irix)))
-
-
 ;; Load XEmacs/Emacs definitions
 (require 'ps-def)
 
@@ -1676,8 +1670,7 @@ For more information about PostScript document comments, see:
   :version "20"
   :group 'ps-print-miscellany)
 
-(defcustom ps-printer-name (and (boundp 'printer-name)
-                                (symbol-value 'printer-name))
+(defcustom ps-printer-name nil
   "The name of a local printer for printing PostScript files.
 
 On Unix-like systems, a string value should be a name understood by lpr's -P
@@ -1709,12 +1702,8 @@ See also `ps-printer-name-option' for documentation."
   :group 'ps-print-printer)
 
 (defcustom ps-printer-name-option
-  (cond (ps-windows-system
-         "/D:")
-        (ps-lp-system
-         "-d")
-        (t
-         "-P" ))
+  (cond (lpr-windows-system "/D:")
+        (t lpr-printer-switch))
   "Option for `ps-printer-name' variable (see it).
 
 On Unix-like systems, if `lpr' is in use, this should be the string
@@ -1729,8 +1718,6 @@ Set this to \"\" or nil, if the utility given by `ps-lpr-command'
 needs an empty printer name option--that is, pass the printer name
 with no special option preceding it.
 
-Any value that is not a string is treated as nil.
-
 This variable is used only when `ps-printer-name' is a non-empty string."
   :type '(choice :menu-tag "Printer Name Option"
                  :tag "Printer Name Option"
@@ -1782,11 +1769,14 @@ See `ps-lpr-command'."
   :version "20"
   :group 'ps-print-printer)
 
-(defcustom ps-print-region-function nil
+(defcustom ps-print-region-function
+  (if (memq system-type '(ms-dos windows-nt))
+      #'direct-ps-print-region-function
+    #'call-process-region)
   "Specify a function to print the region on a PostScript printer.
 See definition of `call-process-region' for calling conventions.  The fourth
 and the sixth arguments are both nil."
-  :type '(choice (const nil) function)
+  :type 'function
   :version "20"
   :group 'ps-print-printer)
 
@@ -1798,7 +1788,7 @@ If it's nil, automatic feeding takes place."
   :version "20"
   :group 'ps-print-printer)
 
-(defcustom ps-end-with-control-d (and ps-windows-system t)
+(defcustom ps-end-with-control-d (and lpr-windows-system t)
   "Non-nil means insert C-d at end of PostScript file generated."
   :version "21.1"
   :type 'boolean
@@ -2636,7 +2626,7 @@ NOTE: page numbers are displayed as part of headers,
   :group 'ps-print-headers)
 
 (defcustom ps-spool-config
-  (if ps-windows-system
+  (if lpr-windows-system
       nil
     'lpr-switches)
   "Specify who is responsible for setting duplex and page size.
@@ -3389,15 +3379,12 @@ It's like the very first character of buffer (or region) is ^L (\\014)."
   :group 'ps-print-headers)
 
 (defcustom ps-postscript-code-directory
-  (or (if (featurep 'xemacs)
-          (cond ((fboundp 'locate-data-directory) ; XEmacs
-                 (funcall 'locate-data-directory "ps-print"))
-                ((boundp 'data-directory) ; XEmacs
-                 (symbol-value 'data-directory))
-                (t                      ; don't know what to do
-                 nil))
-        data-directory)                 ; Emacs
-      (error "`ps-postscript-code-directory' isn't set properly"))
+  (cond ((fboundp 'locate-data-directory) ; XEmacs
+         (locate-data-directory "ps-print"))
+        ((boundp 'data-directory)       ; XEmacs and Emacs.
+         data-directory)
+        (t                              ; don't know what to do
+         (error "`ps-postscript-code-directory' isn't set properly")))
   "Directory where it's located the PostScript prologue file used by ps-print.
 By default, this directory is the same as in the variable `data-directory'."
   :type 'directory
@@ -3646,8 +3633,7 @@ The table depends on the current ps-print setup."
               ") ps-print version " ps-print-version "\n")
       ";; internal vars"
       (ps-comment-string "emacs-version     " emacs-version)
-      (ps-comment-string "ps-windows-system " ps-windows-system)
-      (ps-comment-string "ps-lp-system      " ps-lp-system)
+      (ps-comment-string "lpr-windows-system" lpr-windows-system)
       nil
       '(25 . ps-print-color-p)
       '(25 . ps-lpr-command)
@@ -5426,8 +5412,8 @@ XSTART YSTART are the relative position for the first page in a sheet.")
      "%%Title: " (buffer-name)          ; Take job name from name of
                                         ; first buffer printed
      "\n%%Creator: ps-print v" ps-print-version
-     "\n%%For: " (user-full-name)
-     "\n%%CreationDate: " (format-time-string "%T %b %d %Y")
+     "\n%%For: " (user-full-name)       ;FIXME: may need encoding!
+     "\n%%CreationDate: " (format-time-string "%T %b %d %Y") ;FIXME: encoding!
      "\n%%Orientation: "
      (if ps-landscape-mode "Landscape" "Portrait")
      "\n%%DocumentNeededResources: font Times-Roman Times-Italic\n%%+ font "
@@ -6569,96 +6555,36 @@ If FACE is not a valid face name, use default face."
             (write-region (point-min) (point-max) filename))
           (and ps-razzle-dazzle (message "Wrote %s" filename)))
       ;; Else, spool to the printer
-      (and ps-razzle-dazzle (message "Printing..."))
       (with-current-buffer ps-spool-buffer
         (let* ((coding-system-for-write 'raw-text-unix)
-               (ps-printer-name (or ps-printer-name
-                                    (and (boundp 'printer-name)
-                                         (symbol-value 'printer-name))))
-               (ps-lpr-switches
-                (append ps-lpr-switches
-                        (and (stringp ps-printer-name)
-                             (string< "" ps-printer-name)
-                             (list (concat
-                                    (and (stringp ps-printer-name-option)
-                                         ps-printer-name-option)
-                                    ps-printer-name))))))
-          (or (stringp ps-printer-name)
-              (setq ps-printer-name nil))
-          (apply (or ps-print-region-function 'call-process-region)
-                 (point-min) (point-max) ps-lpr-command nil
-                 (and (fboundp 'start-process) 0)
-                 nil
-                 (ps-flatten-list       ; dynamic evaluation
-                  (ps-string-list
-                   (mapcar 'ps-eval-switch ps-lpr-switches))))))
-      (and ps-razzle-dazzle (message "Printing...done")))
+               (printer-name (or ps-printer-name printer-name))
+               (lpr-printer-switch ps-printer-name-option)
+               (print-region-function ps-print-region-function)
+               (lpr-command ps-lpr-command))
+          (lpr-print-region (point-min) (point-max) ps-lpr-switches nil))))
     (kill-buffer ps-spool-buffer)))
 
-(defun ps-string-list (arg)
-  (let (lstr)
-    (dolist (elm arg)
-      (cond ((stringp elm)
-             (setq lstr (cons elm lstr)))
-            ((listp elm)
-             (let ((s (ps-string-list elm)))
-               (when s
-                 (setq lstr (cons s lstr)))))
-            (t )))                      ; ignore any other value
-    (nreverse lstr)))
-
-;; Dynamic evaluation
-(defun ps-eval-switch (arg)
-  (cond ((stringp arg) arg)
-        ((functionp arg) (apply arg nil))
-        ((symbolp arg) (symbol-value arg))
-        ((consp arg) (apply (car arg) (cdr arg)))
-        (t nil)))
-
-;; `ps-flatten-list' is defined here (copied from "message.el" and
-;; enhanced to handle dotted pairs as well) until we can get some
-;; sensible autoloads, or `flatten-list' gets put somewhere decent.
-
-;; (ps-flatten-list '((a . b) c (d . e) (f g h) i . j))
-;; => (a b c d e f g h i j)
-
-(defun ps-flatten-list (&rest list)
-  (ps-flatten-list-1 list))
-
-(defun ps-flatten-list-1 (list)
-  (cond ((null list) nil)
-        ((consp list) (append (ps-flatten-list-1 (car list))
-                              (ps-flatten-list-1 (cdr list))))
-        (t (list list))))
-
 (defun ps-kill-emacs-check ()
-  (let (ps-buffer)
-    (and (setq ps-buffer (get-buffer ps-spool-buffer-name))
-         (buffer-name ps-buffer)        ; check if it's not killed
+  (let ((ps-buffer (get-buffer ps-spool-buffer-name)))
+    (and (buffer-live-p ps-buffer)
          (buffer-modified-p ps-buffer)
          (y-or-n-p "Unprinted PostScript waiting; print now? ")
-         (ps-despool))
-    (and (setq ps-buffer (get-buffer ps-spool-buffer-name))
-         (buffer-name ps-buffer)        ; check if it's not killed
+         (ps-despool)))
+  (let ((ps-buffer (get-buffer ps-spool-buffer-name)))
+    (and (buffer-live-p ps-buffer)
          (buffer-modified-p ps-buffer)
          (not (yes-or-no-p "Unprinted PostScript waiting; exit anyway? "))
          (error "Unprinted PostScript"))))
 
-(cond ((fboundp 'add-hook)
-       (unless noninteractive
-         (funcall 'add-hook 'kill-emacs-hook 'ps-kill-emacs-check)))
-      (kill-emacs-hook
-       (message "Won't override existing `kill-emacs-hook'"))
-      (t
-       (setq kill-emacs-hook 'ps-kill-emacs-check)))
+(unless noninteractive
+  (add-hook 'kill-emacs-hook #'ps-kill-emacs-check))
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; To make this file smaller, some commands go in a separate file.
 ;; But autoload them here to make the separation invisible.
 
-;;;### (autoloads (ps-mule-end-job ps-mule-begin-job ps-mule-initialize
-;;;;;;  ps-multibyte-buffer) "ps-mule" "ps-mule.el" "b39f881d3a029049994ef6aa3de93c89")
+;;;### (autoloads nil "ps-mule" "ps-mule.el" "a90e8414a27ac8fdf093251ac648d761")
 ;;; Generated autoloads from ps-mule.el
 
 (defvar ps-multibyte-buffer nil "\
diff --git a/src/ChangeLog b/src/ChangeLog
index 30cc0dcdac6..51a5da68877 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,10 @@
+2013-07-24  Paul Eggert  <eggert@cs.ucla.edu>
+
+        * eval.c (Fprogn): Do not check that BODY is a proper list.
+        This undoes the previous change.  The check slows down the
+        interpreter, and is not needed to prevent a crash.  See
+        <http://lists.gnu.org/archive/html/emacs-devel/2013-07/msg00693.html>.
+
 2013-07-23  Glenn Morris  <rgm@gnu.org>
 
         * Makefile.in ($(etc)/DOC, temacs$(EXEEXT)): Ensure etc/ exists.
diff --git a/src/eval.c b/src/eval.c
index e6ccf0bdcb5..6cb2b7a92b8 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -454,12 +454,6 @@ usage: (progn BODY...)  */)
       body = XCDR (body);
     }
 
-  if (!NILP (body))
-    {
-      /* This can happen if functions like Fcond are the caller.  */
-      wrong_type_argument (Qlistp, body);
-    }
-
   UNGCPRO;
   return val;
 }