From 9dba2c644978f9c51ad38da97134fca7d8cf29e2 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 29 Mar 2011 23:27:56 -0400 Subject: [PATCH] * 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. --- lisp/ChangeLog | 10 +++++ lisp/Makefile.in | 1 - lisp/startup.el | 112 ++++++++++++++++++++++++++++--------------------------- lisp/subr.el | 33 ++++++++-------- 4 files changed, 85 insertions(+), 71 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index acdb301b4f0..d7246d31df3 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,13 @@ +2011-03-30 Stefan Monnier + + * 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 * startup.el: Convert to lexical-binding. Mark unused arguments. diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 4db5ef4f008..ab82c99ac33 100644 --- 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 ebfed702735..d2184778212 100644 --- 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 9f4e35fcbe0..c5fedae2bfc 100644 --- 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. -- 2.11.4.GIT