aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2011-03-29 23:27:56 -0400
committerStefan Monnier2011-03-29 23:27:56 -0400
commit9dba2c644978f9c51ad38da97134fca7d8cf29e2 (patch)
tree39d758fb7dfcaa19c343a019ee1ad270dd2dcecb
parent06788a55302c7da6566c7efe8d8d800538a22c0a (diff)
downloademacs-9dba2c644978f9c51ad38da97134fca7d8cf29e2.tar.gz
emacs-9dba2c644978f9c51ad38da97134fca7d8cf29e2.zip
* 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.
-rw-r--r--lisp/ChangeLog10
-rw-r--r--lisp/Makefile.in1
-rw-r--r--lisp/startup.el112
-rw-r--r--lisp/subr.el33
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 @@
12011-03-30 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * subr.el (with-output-to-temp-buffer): Don't change current-buffer to
4 standard-output while running the body.
5
6 * startup.el: Fix up warnings, move lambda expressions
7 outside of quote.
8
9 * Makefile.in (COMPILE_FIRST): Remove pcase; it's not so important.
10
12011-03-24 Stefan Monnier <monnier@iro.umontreal.ca> 112011-03-24 Stefan Monnier <monnier@iro.umontreal.ca>
2 12
3 * startup.el: Convert to lexical-binding. Mark unused arguments. 13 * 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)
85COMPILE_FIRST = \ 85COMPILE_FIRST = \
86 $(lisp)/emacs-lisp/bytecomp.elc \ 86 $(lisp)/emacs-lisp/bytecomp.elc \
87 $(lisp)/emacs-lisp/byte-opt.elc \ 87 $(lisp)/emacs-lisp/byte-opt.elc \
88 $(lisp)/emacs-lisp/pcase.elc \
89 $(lisp)/emacs-lisp/macroexp.elc \ 88 $(lisp)/emacs-lisp/macroexp.elc \
90 $(lisp)/emacs-lisp/cconv.elc \ 89 $(lisp)/emacs-lisp/cconv.elc \
91 $(lisp)/emacs-lisp/autoload.elc 90 $(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."
1096 user-init-file 1096 user-init-file
1097 (get (car error) 'error-message) 1097 (get (car error) 'error-message)
1098 (if (cdr error) ": " "") 1098 (if (cdr error) ": " "")
1099 (mapconcat (lambda (s) (prin1-to-string s t)) (cdr error) ", ")) 1099 (mapconcat (lambda (s) (prin1-to-string s t))
1100 (cdr error) ", "))
1100 :warning) 1101 :warning)
1101 (setq init-file-had-error t)))) 1102 (setq init-file-had-error t))))
1102 1103
@@ -1292,25 +1293,25 @@ If this is nil, no message will be displayed."
1292;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1293;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1293 1294
1294(defconst fancy-startup-text 1295(defconst fancy-startup-text
1295 '((:face (variable-pitch (:foreground "red")) 1296 `((:face (variable-pitch (:foreground "red"))
1296 "Welcome to " 1297 "Welcome to "
1297 :link ("GNU Emacs" 1298 :link ("GNU Emacs"
1298 (lambda (button) (browse-url "http://www.gnu.org/software/emacs/")) 1299 ,(lambda (_button) (browse-url "http://www.gnu.org/software/emacs/"))
1299 "Browse http://www.gnu.org/software/emacs/") 1300 "Browse http://www.gnu.org/software/emacs/")
1300 ", one component of the " 1301 ", one component of the "
1301 :link 1302 :link
1302 (lambda () 1303 ,(lambda ()
1303 (if (eq system-type 'gnu/linux) 1304 (if (eq system-type 'gnu/linux)
1304 '("GNU/Linux" 1305 `("GNU/Linux"
1305 (lambda (button) (browse-url "http://www.gnu.org/gnu/linux-and-gnu.html")) 1306 ,(lambda (_button) (browse-url "http://www.gnu.org/gnu/linux-and-gnu.html"))
1306 "Browse http://www.gnu.org/gnu/linux-and-gnu.html") 1307 "Browse http://www.gnu.org/gnu/linux-and-gnu.html")
1307 '("GNU" (lambda (button) (describe-gnu-project)) 1308 `("GNU" ,(lambda (_button) (describe-gnu-project))
1308 "Display info on the GNU project"))) 1309 "Display info on the GNU project")))
1309 " operating system.\n\n" 1310 " operating system.\n\n"
1310 :face variable-pitch 1311 :face variable-pitch
1311 :link ("Emacs Tutorial" (lambda (button) (help-with-tutorial))) 1312 :link ("Emacs Tutorial" ,(lambda (_button) (help-with-tutorial)))
1312 "\tLearn basic keystroke commands" 1313 "\tLearn basic keystroke commands"
1313 (lambda () 1314 ,(lambda ()
1314 (let* ((en "TUTORIAL") 1315 (let* ((en "TUTORIAL")
1315 (tut (or (get-language-info current-language-environment 1316 (tut (or (get-language-info current-language-environment
1316 'tutorial) 1317 'tutorial)
@@ -1328,19 +1329,20 @@ If this is nil, no message will be displayed."
1328 (concat " (" title ")")))) 1329 (concat " (" title ")"))))
1329 "\n" 1330 "\n"
1330 :link ("Emacs Guided Tour" 1331 :link ("Emacs Guided Tour"
1331 (lambda (button) (browse-url "http://www.gnu.org/software/emacs/tour/")) 1332 ,(lambda (_button)
1333 (browse-url "http://www.gnu.org/software/emacs/tour/"))
1332 "Browse http://www.gnu.org/software/emacs/tour/") 1334 "Browse http://www.gnu.org/software/emacs/tour/")
1333 "\tOverview of Emacs features at gnu.org\n" 1335 "\tOverview of Emacs features at gnu.org\n"
1334 :link ("View Emacs Manual" (lambda (button) (info-emacs-manual))) 1336 :link ("View Emacs Manual" ,(lambda (_button) (info-emacs-manual)))
1335 "\tView the Emacs manual using Info\n" 1337 "\tView the Emacs manual using Info\n"
1336 :link ("Absence of Warranty" (lambda (button) (describe-no-warranty))) 1338 :link ("Absence of Warranty" ,(lambda (_button) (describe-no-warranty)))
1337 "\tGNU Emacs comes with " 1339 "\tGNU Emacs comes with "
1338 :face (variable-pitch (:slant oblique)) 1340 :face (variable-pitch (:slant oblique))
1339 "ABSOLUTELY NO WARRANTY\n" 1341 "ABSOLUTELY NO WARRANTY\n"
1340 :face variable-pitch 1342 :face variable-pitch
1341 :link ("Copying Conditions" (lambda (button) (describe-copying))) 1343 :link ("Copying Conditions" ,(lambda (_button) (describe-copying)))
1342 "\tConditions for redistributing and changing Emacs\n" 1344 "\tConditions for redistributing and changing Emacs\n"
1343 :link ("Ordering Manuals" (lambda (button) (view-order-manuals))) 1345 :link ("Ordering Manuals" ,(lambda (_button) (view-order-manuals)))
1344 "\tPurchasing printed copies of manuals\n" 1346 "\tPurchasing printed copies of manuals\n"
1345 "\n")) 1347 "\n"))
1346 "A list of texts to show in the middle part of splash screens. 1348 "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
1348`:face FACE', like `fancy-splash-insert' accepts them.") 1350`:face FACE', like `fancy-splash-insert' accepts them.")
1349 1351
1350(defconst fancy-about-text 1352(defconst fancy-about-text
1351 '((:face (variable-pitch (:foreground "red")) 1353 `((:face (variable-pitch (:foreground "red"))
1352 "This is " 1354 "This is "
1353 :link ("GNU Emacs" 1355 :link ("GNU Emacs"
1354 (lambda (button) (browse-url "http://www.gnu.org/software/emacs/")) 1356 ,(lambda (_button) (browse-url "http://www.gnu.org/software/emacs/"))
1355 "Browse http://www.gnu.org/software/emacs/") 1357 "Browse http://www.gnu.org/software/emacs/")
1356 ", one component of the " 1358 ", one component of the "
1357 :link 1359 :link
1358 (lambda () 1360 ,(lambda ()
1359 (if (eq system-type 'gnu/linux) 1361 (if (eq system-type 'gnu/linux)
1360 '("GNU/Linux" 1362 `("GNU/Linux"
1361 (lambda (button) (browse-url "http://www.gnu.org/gnu/linux-and-gnu.html")) 1363 ,(lambda (_button)
1364 (browse-url "http://www.gnu.org/gnu/linux-and-gnu.html"))
1362 "Browse http://www.gnu.org/gnu/linux-and-gnu.html") 1365 "Browse http://www.gnu.org/gnu/linux-and-gnu.html")
1363 '("GNU" (lambda (button) (describe-gnu-project)) 1366 `("GNU" ,(lambda (_button) (describe-gnu-project))
1364 "Display info on the GNU project."))) 1367 "Display info on the GNU project.")))
1365 " operating system.\n" 1368 " operating system.\n"
1366 :face (lambda () 1369 :face ,(lambda ()
1367 (list 'variable-pitch 1370 (list 'variable-pitch
1368 (list :foreground 1371 (list :foreground
1369 (if (eq (frame-parameter nil 'background-mode) 'dark) 1372 (if (eq (frame-parameter nil 'background-mode) 'dark)
1370 "cyan" "darkblue")))) 1373 "cyan" "darkblue"))))
1371 "\n" 1374 "\n"
1372 (lambda () (emacs-version)) 1375 ,(lambda () (emacs-version))
1373 "\n" 1376 "\n"
1374 :face (variable-pitch (:height 0.8)) 1377 :face (variable-pitch (:height 0.8))
1375 (lambda () emacs-copyright) 1378 ,(lambda () emacs-copyright)
1376 "\n\n" 1379 "\n\n"
1377 :face variable-pitch 1380 :face variable-pitch
1378 :link ("Authors" 1381 :link ("Authors"
1379 (lambda (button) 1382 ,(lambda (_button)
1380 (view-file (expand-file-name "AUTHORS" data-directory)) 1383 (view-file (expand-file-name "AUTHORS" data-directory))
1381 (goto-char (point-min)))) 1384 (goto-char (point-min))))
1382 "\tMany people have contributed code included in GNU Emacs\n" 1385 "\tMany people have contributed code included in GNU Emacs\n"
1383 :link ("Contributing" 1386 :link ("Contributing"
1384 (lambda (button) 1387 ,(lambda (_button)
1385 (view-file (expand-file-name "CONTRIBUTE" data-directory)) 1388 (view-file (expand-file-name "CONTRIBUTE" data-directory))
1386 (goto-char (point-min)))) 1389 (goto-char (point-min))))
1387 "\tHow to contribute improvements to Emacs\n" 1390 "\tHow to contribute improvements to Emacs\n"
1388 "\n" 1391 "\n"
1389 :link ("GNU and Freedom" (lambda (button) (describe-gnu-project))) 1392 :link ("GNU and Freedom" ,(lambda (_button) (describe-gnu-project)))
1390 "\tWhy we developed GNU Emacs, and the GNU operating system\n" 1393 "\tWhy we developed GNU Emacs, and the GNU operating system\n"
1391 :link ("Absence of Warranty" (lambda (button) (describe-no-warranty))) 1394 :link ("Absence of Warranty" ,(lambda (_button) (describe-no-warranty)))
1392 "\tGNU Emacs comes with " 1395 "\tGNU Emacs comes with "
1393 :face (variable-pitch (:slant oblique)) 1396 :face (variable-pitch (:slant oblique))
1394 "ABSOLUTELY NO WARRANTY\n" 1397 "ABSOLUTELY NO WARRANTY\n"
1395 :face variable-pitch 1398 :face variable-pitch
1396 :link ("Copying Conditions" (lambda (button) (describe-copying))) 1399 :link ("Copying Conditions" ,(lambda (_button) (describe-copying)))
1397 "\tConditions for redistributing and changing Emacs\n" 1400 "\tConditions for redistributing and changing Emacs\n"
1398 :link ("Getting New Versions" (lambda (button) (describe-distribution))) 1401 :link ("Getting New Versions" ,(lambda (_button) (describe-distribution)))
1399 "\tHow to obtain the latest version of Emacs\n" 1402 "\tHow to obtain the latest version of Emacs\n"
1400 :link ("Ordering Manuals" (lambda (button) (view-order-manuals))) 1403 :link ("Ordering Manuals" ,(lambda (_button) (view-order-manuals)))
1401 "\tBuying printed manuals from the FSF\n" 1404 "\tBuying printed manuals from the FSF\n"
1402 "\n" 1405 "\n"
1403 :link ("Emacs Tutorial" (lambda (button) (help-with-tutorial))) 1406 :link ("Emacs Tutorial" ,(lambda (_button) (help-with-tutorial)))
1404 "\tLearn basic Emacs keystroke commands" 1407 "\tLearn basic Emacs keystroke commands"
1405 (lambda () 1408 ,(lambda ()
1406 (let* ((en "TUTORIAL") 1409 (let* ((en "TUTORIAL")
1407 (tut (or (get-language-info current-language-environment 1410 (tut (or (get-language-info current-language-environment
1408 'tutorial) 1411 'tutorial)
@@ -1420,7 +1423,8 @@ Each element in the list should be a list of strings or pairs
1420 (concat " (" title ")")))) 1423 (concat " (" title ")"))))
1421 "\n" 1424 "\n"
1422 :link ("Emacs Guided Tour" 1425 :link ("Emacs Guided Tour"
1423 (lambda (button) (browse-url "http://www.gnu.org/software/emacs/tour/")) 1426 ,(lambda (_button)
1427 (browse-url "http://www.gnu.org/software/emacs/tour/"))
1424 "Browse http://www.gnu.org/software/emacs/tour/") 1428 "Browse http://www.gnu.org/software/emacs/tour/")
1425 "\tSee an overview of Emacs features at gnu.org" 1429 "\tSee an overview of Emacs features at gnu.org"
1426 )) 1430 ))
@@ -1539,16 +1543,16 @@ a face or button specification."
1539 (fancy-splash-insert 1543 (fancy-splash-insert
1540 :face 'variable-pitch 1544 :face 'variable-pitch
1541 "\nTo start... " 1545 "\nTo start... "
1542 :link '("Open a File" 1546 :link `("Open a File"
1543 (lambda (_button) (call-interactively 'find-file)) 1547 ,(lambda (_button) (call-interactively 'find-file))
1544 "Specify a new file's name, to edit the file") 1548 "Specify a new file's name, to edit the file")
1545 " " 1549 " "
1546 :link '("Open Home Directory" 1550 :link `("Open Home Directory"
1547 (lambda (_button) (dired "~")) 1551 ,(lambda (_button) (dired "~"))
1548 "Open your home directory, to operate on its files") 1552 "Open your home directory, to operate on its files")
1549 " " 1553 " "
1550 :link '("Customize Startup" 1554 :link `("Customize Startup"
1551 (lambda (_button) (customize-group 'initialization)) 1555 ,(lambda (_button) (customize-group 'initialization))
1552 "Change initialization settings including this screen") 1556 "Change initialization settings including this screen")
1553 "\n")) 1557 "\n"))
1554 (fancy-splash-insert 1558 (fancy-splash-insert
@@ -1587,15 +1591,15 @@ a face or button specification."
1587 (when concise 1591 (when concise
1588 (fancy-splash-insert 1592 (fancy-splash-insert
1589 :face 'variable-pitch "\n" 1593 :face 'variable-pitch "\n"
1590 :link '("Dismiss this startup screen" 1594 :link `("Dismiss this startup screen"
1591 (lambda (_button) 1595 ,(lambda (_button)
1592 (when startup-screen-inhibit-startup-screen 1596 (when startup-screen-inhibit-startup-screen
1593 (customize-set-variable 'inhibit-startup-screen t) 1597 (customize-set-variable 'inhibit-startup-screen t)
1594 (customize-mark-to-save 'inhibit-startup-screen) 1598 (customize-mark-to-save 'inhibit-startup-screen)
1595 (custom-save-all)) 1599 (custom-save-all))
1596 (let ((w (get-buffer-window "*GNU Emacs*"))) 1600 (let ((w (get-buffer-window "*GNU Emacs*")))
1597 (and w (not (one-window-p)) (delete-window w))) 1601 (and w (not (one-window-p)) (delete-window w)))
1598 (kill-buffer "*GNU Emacs*"))) 1602 (kill-buffer "*GNU Emacs*")))
1599 " ") 1603 " ")
1600 (when (or user-init-file custom-file) 1604 (when (or user-init-file custom-file)
1601 (let ((checked (create-image "checked.xpm" 1605 (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.)")
1938 " 1942 "
1939GNU Emacs comes with ABSOLUTELY NO WARRANTY; type C-h C-w for ") 1943GNU Emacs comes with ABSOLUTELY NO WARRANTY; type C-h C-w for ")
1940 (insert-button "full details" 1944 (insert-button "full details"
1941 'action (lambda (button) (describe-no-warranty)) 1945 'action (lambda (_button) (describe-no-warranty))
1942 'follow-link t) 1946 'follow-link t)
1943 (insert ". 1947 (insert ".
1944Emacs is Free Software--Free as in Freedom--so you can redistribute copies 1948Emacs is Free Software--Free as in Freedom--so you can redistribute copies
1945of Emacs and modify it; type C-h C-c to see ") 1949of Emacs and modify it; type C-h C-c to see ")
1946 (insert-button "the conditions" 1950 (insert-button "the conditions"
1947 'action (lambda (button) (describe-copying)) 1951 'action (lambda (_button) (describe-copying))
1948 'follow-link t) 1952 'follow-link t)
1949 (insert ". 1953 (insert ".
1950Type C-h C-d for information on ") 1954Type C-h C-d for information on ")
1951 (insert-button "getting the latest version" 1955 (insert-button "getting the latest version"
1952 'action (lambda (button) (describe-distribution)) 1956 'action (lambda (_button) (describe-distribution))
1953 'follow-link t) 1957 'follow-link t)
1954 (insert ".")) 1958 (insert "."))
1955 (insert (substitute-command-keys 1959 (insert (substitute-command-keys
1956 " 1960 "
1957GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for ")) 1961GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for "))
1958 (insert-button "full details" 1962 (insert-button "full details"
1959 'action (lambda (button) (describe-no-warranty)) 1963 'action (lambda (_button) (describe-no-warranty))
1960 'follow-link t) 1964 'follow-link t)
1961 (insert (substitute-command-keys ". 1965 (insert (substitute-command-keys ".
1962Emacs is Free Software--Free as in Freedom--so you can redistribute copies 1966Emacs is Free Software--Free as in Freedom--so you can redistribute copies
1963of Emacs and modify it; type \\[describe-copying] to see ")) 1967of Emacs and modify it; type \\[describe-copying] to see "))
1964 (insert-button "the conditions" 1968 (insert-button "the conditions"
1965 'action (lambda (button) (describe-copying)) 1969 'action (lambda (_button) (describe-copying))
1966 'follow-link t) 1970 'follow-link t)
1967 (insert (substitute-command-keys". 1971 (insert (substitute-command-keys".
1968Type \\[describe-distribution] for information on ")) 1972Type \\[describe-distribution] for information on "))
1969 (insert-button "getting the latest version" 1973 (insert-button "getting the latest version"
1970 'action (lambda (button) (describe-distribution)) 1974 'action (lambda (_button) (describe-distribution))
1971 'follow-link t) 1975 'follow-link t)
1972 (insert "."))) 1976 (insert ".")))
1973 1977
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'
2871if it uses `temp-buffer-show-function'." 2871if it uses `temp-buffer-show-function'."
2872 (let ((old-dir (make-symbol "old-dir")) 2872 (let ((old-dir (make-symbol "old-dir"))
2873 (buf (make-symbol "buf"))) 2873 (buf (make-symbol "buf")))
2874 `(let ((,old-dir default-directory)) 2874 `(let* ((,old-dir default-directory)
2875 (with-current-buffer (get-buffer-create ,bufname) 2875 (,buf
2876 (kill-all-local-variables) 2876 (with-current-buffer (get-buffer-create ,bufname)
2877 ;; FIXME: delete_all_overlays 2877 (prog1 (current-buffer)
2878 (setq default-directory ,old-dir) 2878 (kill-all-local-variables)
2879 (setq buffer-read-only nil) 2879 ;; FIXME: delete_all_overlays
2880 (setq buffer-file-name nil) 2880 (setq default-directory ,old-dir)
2881 (setq buffer-undo-list t) 2881 (setq buffer-read-only nil)
2882 (let ((,buf (current-buffer))) 2882 (setq buffer-file-name nil)
2883 (let ((inhibit-read-only t) 2883 (setq buffer-undo-list t)
2884 (inhibit-modification-hooks t)) 2884 (let ((inhibit-read-only t)
2885 (erase-buffer) 2885 (inhibit-modification-hooks t))
2886 (run-hooks 'temp-buffer-setup-hook)) 2886 (erase-buffer)
2887 (let ((standard-output ,buf)) 2887 (run-hooks 'temp-buffer-setup-hook)))))
2888 (prog1 (progn ,@body) 2888 (standard-output ,buf))
2889 (internal-temp-output-buffer-show ,buf)))))))) 2889 (prog1 (progn ,@body)
2890 (internal-temp-output-buffer-show ,buf)))))
2890 2891
2891(defmacro with-temp-file (file &rest body) 2892(defmacro with-temp-file (file &rest body)
2892 "Create a new buffer, evaluate BODY there, and write the buffer to FILE. 2893 "Create a new buffer, evaluate BODY there, and write the buffer to FILE.