* lisp/subr.el (with-output-to-temp-buffer): Don't change current-buffer to

standard-output while running the body.
* lisp/Makefile.in (COMPILE_FIRST): Remove pcase; it's not so important.
* lisp/startup.el: Fix up warnings, move lambda expressions
outside of quote.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index acdb301b4f05da2b86dca53e9c7e4f3e443d403d..d7246d31df30599ad75810c5bb94eca1d0910d3f 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,13 @@
+2011-03-30  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+       * subr.el (with-output-to-temp-buffer): Don't change current-buffer to
+       standard-output while running the body.
+
+       * startup.el: Fix up warnings, move lambda expressions
+       outside of quote.
+
+       * Makefile.in (COMPILE_FIRST): Remove pcase; it's not so important.
+
 2011-03-24  Stefan Monnier  <monnier@iro.umontreal.ca>
 
        * startup.el: Convert to lexical-binding.  Mark unused arguments.

diff --git a/lisp/Makefile.in b/lisp/Makefile.in
index 4db5ef4f0085b8a89187bdb86ee28bbc7f600243..ab82c99ac33d57d512490dd8deba6bc3d5abd1b3 100644 (file)
--- a/lisp/Makefile.in
+++ b/lisp/Makefile.in
@@ -85,7 +85,6 @@ BYTE_COMPILE_FLAGS = $(BIG_STACK_OPTS) $(BYTE_COMPILE_EXTRA_FLAGS)
 COMPILE_FIRST = \
        $(lisp)/emacs-lisp/bytecomp.elc \
        $(lisp)/emacs-lisp/byte-opt.elc \
-       $(lisp)/emacs-lisp/pcase.elc \
        $(lisp)/emacs-lisp/macroexp.elc \
        $(lisp)/emacs-lisp/cconv.elc \
        $(lisp)/emacs-lisp/autoload.elc

diff --git a/lisp/startup.el b/lisp/startup.el
index ebfed7027359dc2e9f756b9b770b80cdd608bec9..d21847782129e9e5de7b7241a8baca396fcf78a0 100644 (file)
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -1096,7 +1096,8 @@ the `--debug-init' option to view a complete error backtrace."
                      user-init-file
                      (get (car error) 'error-message)
                      (if (cdr error) ": " "")
-                     (mapconcat (lambda (s) (prin1-to-string s t)) (cdr error) ", "))
+                     (mapconcat (lambda (s) (prin1-to-string s t))
+                                 (cdr error) ", "))
              :warning)
             (setq init-file-had-error t))))
 
@@ -1292,25 +1293,25 @@ If this is nil, no message will be displayed."
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defconst fancy-startup-text
-  '((:face (variable-pitch (:foreground "red"))
+  `((:face (variable-pitch (:foreground "red"))
      "Welcome to "
      :link ("GNU Emacs"
-           (lambda (button) (browse-url "http://www.gnu.org/software/emacs/"))
+           ,(lambda (_button) (browse-url "http://www.gnu.org/software/emacs/"))
            "Browse http://www.gnu.org/software/emacs/")
      ", one component of the "
      :link
-     (lambda ()
+     ,(lambda ()
        (if (eq system-type 'gnu/linux)
-          '("GNU/Linux"
-            (lambda (button) (browse-url "http://www.gnu.org/gnu/linux-and-gnu.html"))
+            `("GNU/Linux"
+              ,(lambda (_button) (browse-url "http://www.gnu.org/gnu/linux-and-gnu.html"))
             "Browse http://www.gnu.org/gnu/linux-and-gnu.html")
-        '("GNU" (lambda (button) (describe-gnu-project))
+          `("GNU" ,(lambda (_button) (describe-gnu-project))
           "Display info on the GNU project")))
      " operating system.\n\n"
      :face variable-pitch
-     :link ("Emacs Tutorial" (lambda (button) (help-with-tutorial)))
+     :link ("Emacs Tutorial" ,(lambda (_button) (help-with-tutorial)))
      "\tLearn basic keystroke commands"
-     (lambda ()
+     ,(lambda ()
        (let* ((en "TUTORIAL")
              (tut (or (get-language-info current-language-environment
                                          'tutorial)
@@ -1328,19 +1329,20 @@ If this is nil, no message will be displayed."
           (concat " (" title ")"))))
      "\n"
      :link ("Emacs Guided Tour"
-           (lambda (button) (browse-url "http://www.gnu.org/software/emacs/tour/"))
+           ,(lambda (_button)
+               (browse-url "http://www.gnu.org/software/emacs/tour/"))
            "Browse http://www.gnu.org/software/emacs/tour/")
      "\tOverview of Emacs features at gnu.org\n"
-     :link ("View Emacs Manual" (lambda (button) (info-emacs-manual)))
+     :link ("View Emacs Manual" ,(lambda (_button) (info-emacs-manual)))
      "\tView the Emacs manual using Info\n"
-     :link ("Absence of Warranty" (lambda (button) (describe-no-warranty)))
+     :link ("Absence of Warranty" ,(lambda (_button) (describe-no-warranty)))
      "\tGNU Emacs comes with "
      :face (variable-pitch (:slant oblique))
      "ABSOLUTELY NO WARRANTY\n"
      :face variable-pitch
-     :link ("Copying Conditions" (lambda (button) (describe-copying)))
+     :link ("Copying Conditions" ,(lambda (_button) (describe-copying)))
      "\tConditions for redistributing and changing Emacs\n"
-     :link ("Ordering Manuals" (lambda (button) (view-order-manuals)))
+     :link ("Ordering Manuals" ,(lambda (_button) (view-order-manuals)))
      "\tPurchasing printed copies of manuals\n"
      "\n"))
   "A list of texts to show in the middle part of splash screens.
@@ -1348,61 +1350,62 @@ Each element in the list should be a list of strings or pairs
 `:face FACE', like `fancy-splash-insert' accepts them.")
 
 (defconst fancy-about-text
-  '((:face (variable-pitch (:foreground "red"))
+  `((:face (variable-pitch (:foreground "red"))
      "This is "
      :link ("GNU Emacs"
-           (lambda (button) (browse-url "http://www.gnu.org/software/emacs/"))
+           ,(lambda (_button) (browse-url "http://www.gnu.org/software/emacs/"))
            "Browse http://www.gnu.org/software/emacs/")
      ", one component of the "
      :link
-     (lambda ()
+     ,(lambda ()
        (if (eq system-type 'gnu/linux)
-          '("GNU/Linux"
-            (lambda (button) (browse-url "http://www.gnu.org/gnu/linux-and-gnu.html"))
+          `("GNU/Linux"
+            ,(lambda (_button)
+                (browse-url "http://www.gnu.org/gnu/linux-and-gnu.html"))
             "Browse http://www.gnu.org/gnu/linux-and-gnu.html")
-        '("GNU" (lambda (button) (describe-gnu-project))
+        `("GNU" ,(lambda (_button) (describe-gnu-project))
           "Display info on the GNU project.")))
      " operating system.\n"
-     :face (lambda ()
+     :face ,(lambda ()
             (list 'variable-pitch
                   (list :foreground
                         (if (eq (frame-parameter nil 'background-mode) 'dark)
                             "cyan" "darkblue"))))
      "\n"
-     (lambda () (emacs-version))
+     ,(lambda () (emacs-version))
      "\n"
      :face (variable-pitch (:height 0.8))
-     (lambda () emacs-copyright)
+     ,(lambda () emacs-copyright)
      "\n\n"
      :face variable-pitch
      :link ("Authors"
-           (lambda (button)
+           ,(lambda (_button)
              (view-file (expand-file-name "AUTHORS" data-directory))
              (goto-char (point-min))))
      "\tMany people have contributed code included in GNU Emacs\n"
      :link ("Contributing"
-           (lambda (button)
+           ,(lambda (_button)
              (view-file (expand-file-name "CONTRIBUTE" data-directory))
              (goto-char (point-min))))
      "\tHow to contribute improvements to Emacs\n"
      "\n"
-     :link ("GNU and Freedom" (lambda (button) (describe-gnu-project)))
+     :link ("GNU and Freedom" ,(lambda (_button) (describe-gnu-project)))
      "\tWhy we developed GNU Emacs, and the GNU operating system\n"
-     :link ("Absence of Warranty" (lambda (button) (describe-no-warranty)))
+     :link ("Absence of Warranty" ,(lambda (_button) (describe-no-warranty)))
      "\tGNU Emacs comes with "
      :face (variable-pitch (:slant oblique))
      "ABSOLUTELY NO WARRANTY\n"
      :face variable-pitch
-     :link ("Copying Conditions" (lambda (button) (describe-copying)))
+     :link ("Copying Conditions" ,(lambda (_button) (describe-copying)))
      "\tConditions for redistributing and changing Emacs\n"
-     :link ("Getting New Versions" (lambda (button) (describe-distribution)))
+     :link ("Getting New Versions" ,(lambda (_button) (describe-distribution)))
      "\tHow to obtain the latest version of Emacs\n"
-     :link ("Ordering Manuals" (lambda (button) (view-order-manuals)))
+     :link ("Ordering Manuals" ,(lambda (_button) (view-order-manuals)))
      "\tBuying printed manuals from the FSF\n"
      "\n"
-     :link ("Emacs Tutorial" (lambda (button) (help-with-tutorial)))
+     :link ("Emacs Tutorial" ,(lambda (_button) (help-with-tutorial)))
      "\tLearn basic Emacs keystroke commands"
-     (lambda ()
+     ,(lambda ()
        (let* ((en "TUTORIAL")
              (tut (or (get-language-info current-language-environment
                                          'tutorial)
@@ -1420,7 +1423,8 @@ Each element in the list should be a list of strings or pairs
           (concat " (" title ")"))))
      "\n"
      :link ("Emacs Guided Tour"
-           (lambda (button) (browse-url "http://www.gnu.org/software/emacs/tour/"))
+           ,(lambda (_button)
+               (browse-url "http://www.gnu.org/software/emacs/tour/"))
            "Browse http://www.gnu.org/software/emacs/tour/")
      "\tSee an overview of Emacs features at gnu.org"
      ))
@@ -1539,16 +1543,16 @@ a face or button specification."
       (fancy-splash-insert
        :face 'variable-pitch
        "\nTo start...     "
-       :link '("Open a File"
-              (lambda (_button) (call-interactively 'find-file))
+       :link `("Open a File"
+              ,(lambda (_button) (call-interactively 'find-file))
               "Specify a new file's name, to edit the file")
        "     "
-       :link '("Open Home Directory"
-              (lambda (_button) (dired "~"))
+       :link `("Open Home Directory"
+              ,(lambda (_button) (dired "~"))
               "Open your home directory, to operate on its files")
        "     "
-       :link '("Customize Startup"
-              (lambda (_button) (customize-group 'initialization))
+       :link `("Customize Startup"
+              ,(lambda (_button) (customize-group 'initialization))
               "Change initialization settings including this screen")
        "\n"))
     (fancy-splash-insert
@@ -1587,15 +1591,15 @@ a face or button specification."
     (when concise
       (fancy-splash-insert
        :face 'variable-pitch "\n"
-       :link '("Dismiss this startup screen"
-              (lambda (_button)
-                (when startup-screen-inhibit-startup-screen
-                  (customize-set-variable 'inhibit-startup-screen t)
-                  (customize-mark-to-save 'inhibit-startup-screen)
-                  (custom-save-all))
-                (let ((w (get-buffer-window "*GNU Emacs*")))
-                  (and w (not (one-window-p)) (delete-window w)))
-                (kill-buffer "*GNU Emacs*")))
+       :link `("Dismiss this startup screen"
+              ,(lambda (_button)
+                  (when startup-screen-inhibit-startup-screen
+                    (customize-set-variable 'inhibit-startup-screen t)
+                    (customize-mark-to-save 'inhibit-startup-screen)
+                    (custom-save-all))
+                  (let ((w (get-buffer-window "*GNU Emacs*")))
+                    (and w (not (one-window-p)) (delete-window w)))
+                  (kill-buffer "*GNU Emacs*")))
        "  ")
       (when (or user-init-file custom-file)
        (let ((checked (create-image "checked.xpm"
@@ -1938,36 +1942,36 @@ If you have no Meta key, you may instead type ESC followed by the character.)")
         "
 GNU Emacs comes with ABSOLUTELY NO WARRANTY; type C-h C-w for ")
        (insert-button "full details"
-                      'action (lambda (button) (describe-no-warranty))
+                      'action (lambda (_button) (describe-no-warranty))
                       'follow-link t)
        (insert ".
 Emacs is Free Software--Free as in Freedom--so you can redistribute copies
 of Emacs and modify it; type C-h C-c to see ")
        (insert-button "the conditions"
-                      'action (lambda (button) (describe-copying))
+                      'action (lambda (_button) (describe-copying))
                       'follow-link t)
        (insert ".
 Type C-h C-d for information on ")
        (insert-button "getting the latest version"
-                      'action (lambda (button) (describe-distribution))
+                      'action (lambda (_button) (describe-distribution))
                       'follow-link t)
        (insert "."))
     (insert (substitute-command-keys
             "
 GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for "))
     (insert-button "full details"
-                  'action (lambda (button) (describe-no-warranty))
+                  'action (lambda (_button) (describe-no-warranty))
                   'follow-link t)
     (insert (substitute-command-keys ".
 Emacs is Free Software--Free as in Freedom--so you can redistribute copies
 of Emacs and modify it; type \\[describe-copying] to see "))
     (insert-button "the conditions"
-                  'action (lambda (button) (describe-copying))
+                  'action (lambda (_button) (describe-copying))
                   'follow-link t)
     (insert (substitute-command-keys".
 Type \\[describe-distribution] for information on "))
     (insert-button "getting the latest version"
-                  'action (lambda (button) (describe-distribution))
+                  'action (lambda (_button) (describe-distribution))
                   'follow-link t)
     (insert ".")))
 

diff --git a/lisp/subr.el b/lisp/subr.el
index 9f4e35fcbe0bde050a9560af25e654b310959d97..c5fedae2bfc6cc7c042de0686511d5616be9a875 100644 (file)
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -2871,22 +2871,23 @@ temporarily selected.  But it doesn't run `temp-buffer-show-hook'
 if it uses `temp-buffer-show-function'."
   (let ((old-dir (make-symbol "old-dir"))
         (buf (make-symbol "buf")))
-    `(let ((,old-dir default-directory))
-       (with-current-buffer (get-buffer-create ,bufname)
-         (kill-all-local-variables)
-         ;; FIXME: delete_all_overlays
-         (setq default-directory ,old-dir)
-         (setq buffer-read-only nil)
-         (setq buffer-file-name nil)
-         (setq buffer-undo-list t)
-         (let ((,buf (current-buffer)))
-           (let ((inhibit-read-only t)
-                 (inhibit-modification-hooks t))
-             (erase-buffer)
-             (run-hooks 'temp-buffer-setup-hook))
-           (let ((standard-output ,buf))
-             (prog1 (progn ,@body)
-               (internal-temp-output-buffer-show ,buf))))))))
+    `(let* ((,old-dir default-directory)
+            (,buf
+             (with-current-buffer (get-buffer-create ,bufname)
+               (prog1 (current-buffer)
+                 (kill-all-local-variables)
+                 ;; FIXME: delete_all_overlays
+                 (setq default-directory ,old-dir)
+                 (setq buffer-read-only nil)
+                 (setq buffer-file-name nil)
+                 (setq buffer-undo-list t)
+                 (let ((inhibit-read-only t)
+                       (inhibit-modification-hooks t))
+                   (erase-buffer)
+                   (run-hooks 'temp-buffer-setup-hook)))))
+            (standard-output ,buf))
+       (prog1 (progn ,@body)
+         (internal-temp-output-buffer-show ,buf)))))
 
 (defmacro with-temp-file (file &rest body)
   "Create a new buffer, evaluate BODY there, and write the buffer to FILE.