commit 96cea19842b577eb4f2e057d702aea54d736233e (HEAD, refs/remotes/origin/master) Author: Glenn Morris Date: Mon Feb 20 18:30:40 2017 -0800 Ensure delayed-init custom variables get marked special * lisp/custom.el (custom-reevaluate-setting): If the variable has never been set, defvar it. (Bug#25770) diff --git a/lisp/custom.el b/lisp/custom.el index 70b6839db3..7eaff450c5 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -764,9 +764,17 @@ Return non-nil if the `customized-value' property actually changed." Use the :set function to do so. This is useful for customizable options that are defined before their standard value can really be computed. E.g. dumped variables whose default depends on run-time information." - (funcall (or (get symbol 'custom-set) 'set-default) - symbol - (eval (car (or (get symbol 'saved-value) (get symbol 'standard-value)))))) + (let ((val (car (or (get symbol 'saved-value) + (get symbol 'standard-value))))) + (if (default-boundp symbol) + (funcall (or (get symbol 'custom-set) 'set-default) symbol (eval val)) + ;; If it has never been set at all, defvar it so as to mark it + ;; special, etc (bug#25770). This ignores any :set function, + ;; but that is not supposed to be used for initialization anyway. + ;; Or we could move this branch to the start, then unconditionally + ;; call the custom-set branch. + (eval `(defvar ,symbol ,val))))) + ;;; Custom Themes commit 08c73cdc6e2436473b467e207c1a713bb271da11 Author: Glenn Morris Date: Mon Feb 20 18:08:48 2017 -0800 ; Add a new TODO item * etc/TODO: Add a new entry for :set-after. * lisp/startup.el: Related comment. diff --git a/etc/TODO b/etc/TODO index b102bdf35f..71704f07cf 100644 --- a/etc/TODO +++ b/etc/TODO @@ -968,6 +968,17 @@ addition, toolkit builds create their menu bars in toolkit-specific parts of code, bypassing xdisp.c, so those parts need to be enhanced with toolkit-specific code to display the menu bar right to left. +** Custom + +*** Extend :set-after to also mean initialize after. +If defcustom A specifies :set-after '(B), then if a user customizes +both A and B, custom will set A after B. But if the user only customizes +A, then if B is already defined, it gets left at its original setting. +Instead, if B has not been customized it should be re-initialized +(on the assumption that the default value depends on A). +See the places where we manually call custom-reevaluate-setting, +such as for mail-host-address and user-mail-address in startup.el. + ** ImageMagick support *** image-type-header-regexps priorities the jpeg loader over the diff --git a/lisp/startup.el b/lisp/startup.el index 2d48bd5df1..bc60bbd08b 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1298,7 +1298,7 @@ the `--debug-init' option to view a complete error backtrace." ;; Yes, this is ugly, but slightly less so than leaving ;; user-mail-address uninitialized during init file processing. ;; Perhaps we should make :set-after do something like this? - ;; Ie, extend it to also mean (re)initialize-after. + ;; Ie, extend it to also mean (re)initialize-after. See etc/TODO. (equal user-mail-address (let (mail-host-address) (ignore-errors commit bfd1afb3da61e31ded80ef68dc72c50e570e37ed Author: Mark Oteiza Date: Mon Feb 20 21:04:52 2017 -0500 Turn on lexical-binding in dunnet.el * lisp/play/dunnet.el: Turn on lexical-binding. Re-instate lexical byte compile warnings. diff --git a/lisp/play/dunnet.el b/lisp/play/dunnet.el index 801d14c833..f553c16d15 100644 --- a/lisp/play/dunnet.el +++ b/lisp/play/dunnet.el @@ -1,4 +1,4 @@ -;;; dunnet.el --- text adventure for Emacs +;;; dunnet.el --- text adventure for Emacs -*- lexical-binding: t -*- ;; Copyright (C) 1992-1993, 2001-2017 Free Software Foundation, Inc. @@ -3193,7 +3193,7 @@ File not found"))) (provide 'dunnet) ;; Local Variables: -;; byte-compile-warnings: (not free-vars lexical) +;; byte-compile-warnings: (not free-vars) ;; End: ;;; dunnet.el ends here commit e91cc4e1e02645dbd0eb93141fda763a34f51dc8 Author: Mark Oteiza Date: Mon Feb 20 21:00:32 2017 -0500 Make dunnet insertion functions n-ary * lisp/play/dunnet.el (dun-mprinc, dun-mprincl, dun-minsert): (dun-minsertl, dun-batch-mprinc, dun-batch-mprincl): Change to accept any number of arguments. (dun-parse, dun-describe-room, dun-quit, dun-inven, dun-shake): (dun-take, dun-go, dun-move, dun-press, dun-score): (dun-compile-save-out, dun-do-logfile): Collect arguments from multiple insertion calls into less calls with more args. diff --git a/lisp/play/dunnet.el b/lisp/play/dunnet.el index d13c967dad..801d14c833 100644 --- a/lisp/play/dunnet.el +++ b/lisp/play/dunnet.el @@ -1156,7 +1156,7 @@ treasures for points?" "4" "four") (setq line (downcase (buffer-substring beg (point)))) (princ line) (if (eq (dun-vparse dun-ignore dun-verblist line) -1) - (dun-mprinc "I don't understand that.\n"))) + (dun-mprincl "I don't understand that."))) (goto-char (point-max)) (dun-mprinc "\n"))) (dun-messages)) @@ -1200,8 +1200,7 @@ treasures for points?" "4" "four") (> room 0)) (not (string= dun-mode "long"))) nil - (dun-mprinc (car (nth (abs room) dun-rooms))) - (dun-mprinc "\n")) + (dun-mprincl (car (nth (abs room) dun-rooms)))) (when (and (not (string= dun-mode "long")) (not (member (abs room) dun-visited))) (setq dun-visited (append (list (abs room)) dun-visited))) @@ -1216,8 +1215,7 @@ treasures for points?" "4" "four") (when (and (= xobjs obj-jar) dun-jar) (dun-mprincl "The jar contains:") (dolist (x dun-jar) - (dun-mprinc " ") - (dun-mprincl (car (nth x dun-objects)))))) + (dun-mprincl " " (car (nth x dun-objects)))))) (if (and (member obj-bus (nth dun-current-room dun-room-objects)) dun-inbus) (dun-mprincl "You are on the bus.")))) @@ -1308,8 +1306,7 @@ disk bursts into flames, and disintegrates.") ;;; as we must also print what is in it. (defun dun-inven (_args) - (dun-mprinc "You currently have:") - (dun-mprinc "\n") + (dun-mprincl "You currently have:") (dolist (curobj dun-inventory) (if curobj (progn @@ -1318,8 +1315,7 @@ disk bursts into flames, and disintegrates.") (progn (dun-mprincl "The jar contains:") (dolist (x dun-jar) - (dun-mprinc " ") - (dun-mprincl (cadr (nth x dun-objects)))))))))) + (dun-mprincl " " (cadr (nth x dun-objects)))))))))) (defun dun-shake (obj) (let ((objnum (dun-objnum-from-args-std obj))) @@ -1327,10 +1323,8 @@ disk bursts into flames, and disintegrates.") (cond ((member objnum dun-inventory) ;; If shaking anything will do anything, put here. - (dun-mprinc "Shaking ") - (dun-mprinc (downcase (cadr (nth objnum dun-objects)))) - (dun-mprinc " seems to have no effect.") - (dun-mprinc "\n")) + (dun-mprinc "Shaking " (downcase (cadr (nth objnum dun-objects)))) + (dun-mprincl " seems to have no effect.")) ((and (not (member objnum (nth dun-current-room dun-room-silents))) (not (member objnum (nth dun-current-room dun-room-objects)))) (dun-mprincl "I don't see that here.")) @@ -1441,8 +1435,7 @@ For an explosive time, go to Fourth St. and Vermont.") (if (and (>= x 0) (not (= x obj-special))) (progn (setq gotsome t) - (dun-mprinc (cadr (nth x dun-objects))) - (dun-mprinc ": ") + (dun-mprinc (cadr (nth x dun-objects)) ": ") (dun-take-object x)))) (if (not gotsome) (dun-mprincl "Nothing to take.")))) @@ -1688,7 +1681,7 @@ just try dropping it.")) (if (or (not (car args)) (eq (dun-doverb dun-ignore dun-verblist (car args) (cdr (cdr args))) -1)) - (dun-mprinc "I don't understand where you want me to go.\n"))) + (dun-mprincl "I don't understand where you want me to go."))) ;;; Uses the dungeon-map to figure out where we are going. If the ;;; requested direction yields 255, we know something special is @@ -1708,7 +1701,7 @@ body.") (let (newroom) (setq newroom (nth dir (nth dun-current-room dungeon-map))) (if (eq newroom -1) - (dun-mprinc "You can't go that way.\n") + (dun-mprincl "You can't go that way.") (if (eq newroom 255) (dun-special-move dir) (setq dun-room -1) @@ -1931,9 +1924,7 @@ disk bursts into flames, and disintegrates.") (member objnum (nth dun-current-room dun-room-silents)))) (dun-mprincl "I don't see that here.")) ((not (member objnum (list obj-button obj-switch))) - (dun-mprinc "You can't ") - (dun-mprinc (car line-list)) - (dun-mprincl " that.")) + (dun-mprincl "You can't " (car line-list) " that.")) ((= objnum obj-button) (dun-mprincl "As you press the button, you notice a passageway open up, but @@ -1965,11 +1956,9 @@ to swim.") (if (not dun-endgame) (let (total) (setq total (dun-reg-score)) - (dun-mprinc "You have scored ") - (dun-mprinc total) - (dun-mprincl " out of a possible 90 points.") total) - (dun-mprinc "You have scored ") - (dun-mprinc (dun-endgame-score)) + (dun-mprincl "You have scored " total " out of a possible 90 points.") + total) + (dun-mprinc "You have scored " (dun-endgame-score)) (dun-mprincl " endgame points out of a possible 110.") (if (= (dun-endgame-score) 110) (dun-mprincl @@ -2263,17 +2252,19 @@ for a moment, then straighten yourself up. ;;; Insert something into the window buffer -(defun dun-minsert (string) - (if (stringp string) - (insert string) - (insert (prin1-to-string string)))) +(defun dun-minsert (&rest args) + (dolist (arg args) + (if (stringp arg) + (insert arg) + (insert (prin1-to-string arg))))) ;;; Print something out, in window mode -(defun dun-mprinc (string) - (if (stringp string) - (insert string) - (insert (prin1-to-string string)))) +(defun dun-mprinc (&rest args) + (dolist (arg args) + (if (stringp arg) + (insert arg) + (insert (prin1-to-string arg))))) ;;; In window mode, keep screen from jumping by keeping last line at ;;; the bottom of the screen. @@ -2286,14 +2277,14 @@ for a moment, then straighten yourself up. ;;; Insert something into the buffer, followed by newline. -(defun dun-minsertl (string) - (dun-minsert string) +(defun dun-minsertl (&rest args) + (apply #'dun-minsert args) (dun-minsert "\n")) ;;; Print something, followed by a newline. -(defun dun-mprincl (string) - (dun-mprinc string) +(defun dun-mprincl (&rest args) + (apply #'dun-mprinc args) (dun-mprinc "\n")) ;;; Function which will get an object number given the list of @@ -3052,9 +3043,7 @@ File not found"))) (defun dun-save-val (varname) (let ((value (symbol-value (intern varname)))) - (dun-minsert "(setq ") - (dun-minsert varname) - (dun-minsert " ") + (dun-minsert "(setq " varname " ") (if (or (listp value) (symbolp value)) (dun-minsert "'")) @@ -3086,30 +3075,19 @@ File not found"))) (dun-mprincl (error-message-string err)))) (when (null ferror) (goto-char (point-max)) - (dun-minsert (current-time-string)) - (dun-minsert " ") - (dun-minsert (user-login-name)) - (dun-minsert " ") + (dun-minsert (current-time-string) " " (user-login-name) " ") (if (eq type 'save) (dun-minsert "saved ") (if (= (dun-endgame-score) 110) (dun-minsert "won ") (if (not how) (dun-minsert "quit ") - (dun-minsert "killed by ") - (dun-minsert how) - (dun-minsert " ")))) - (dun-minsert "at ") - (dun-minsert (cadr (nth (abs dun-room) dun-rooms))) - (dun-minsert ". score: ") + (dun-minsert "killed by " how " ")))) + (dun-minsert "at " (cadr (nth (abs dun-room) dun-rooms)) ". score: ") (if (> (dun-endgame-score) 0) (dun-minsert (+ 90 (dun-endgame-score))) (dun-minsert (dun-reg-score))) - (dun-minsert " saves: ") - (dun-minsert dun-numsaves) - (dun-minsert " commands: ") - (dun-minsert dun-numcmds) - (dun-minsert "\n") + (dun-minsertl " saves: " dun-numsaves " commands: " dun-numcmds) (write-region 1 (point-max) dun-log-file nil 1))))) @@ -3118,19 +3096,19 @@ File not found"))) ;;;; be run in batch mode. -(defun dun-batch-mprinc (arg) - (if (stringp arg) - (send-string-to-terminal arg) - (send-string-to-terminal (prin1-to-string arg)))) +(defun dun-batch-mprinc (&rest args) + (dolist (arg args) + (if (stringp arg) + (send-string-to-terminal arg) + (send-string-to-terminal (prin1-to-string arg))))) -(defun dun-batch-mprincl (arg) - (if (stringp arg) - (progn - (send-string-to-terminal arg) - (send-string-to-terminal "\n")) - (send-string-to-terminal (prin1-to-string arg)) - (send-string-to-terminal "\n"))) +(defun dun-batch-mprincl (&rest args) + (dolist (arg args) + (if (stringp arg) + (send-string-to-terminal arg) + (send-string-to-terminal (prin1-to-string arg)))) + (send-string-to-terminal "\n")) (defun dun-batch-parse (ignore verblist line) (setq line-list (dun-listify-string (concat line " "))) commit 18c476956d552f2e6f833b74faa95c095c441541 Author: Katsumi Yamaoka Date: Tue Feb 21 00:24:05 2017 +0000 message-goto-body-1: Fix regexp so as not to match multi-line * lisp/gnus/message.el (message-goto-body-1): Fix regexp so as not to match multi-line. diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 079ed52ba5..a8f2b143f2 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -3119,7 +3119,7 @@ M-RET `message-newline-and-reformat' (break the line and reformat)." ;; hard way. (progn ;; Skip past all headers and continuation lines. - (while (looking-at "[^:]+:\\|[\t ]+[^\t ]") + (while (looking-at "[^\t\n :]+:\\|[\t ]+[^\t\n ]") (forward-line 1)) ;; We're now at the first empty line, so perhaps move past it. (when (and (eolp) commit 2f53c0c468561313dd9840e28371436c669153c2 Author: Noam Postavsky Date: Fri Aug 5 19:59:52 2016 -0400 Simplify cl-get using `plist-member' * lisp/emacs-lisp/cl-extra.el (cl-get, cl-getf, cl--set-getf): Use `plist-member' instead of explicit loop. * test/lisp/emacs-lisp/cl-extra-tests.el: New tests. diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 644c35d7b3..edd14b816f 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -593,13 +593,7 @@ too large if positive or too small if negative)." \n(fn SYMBOL PROPNAME &optional DEFAULT)" (declare (compiler-macro cl--compiler-macro-get) (gv-setter (lambda (store) (ignore def) `(put ,sym ,tag ,store)))) - (or (get sym tag) - (and def - ;; Make sure `def' is really absent as opposed to set to nil. - (let ((plist (symbol-plist sym))) - (while (and plist (not (eq (car plist) tag))) - (setq plist (cdr (cdr plist)))) - (if plist (car (cdr plist)) def))))) + (cl-getf (symbol-plist sym) tag def)) (autoload 'cl--compiler-macro-get "cl-macs") ;;;###autoload @@ -618,26 +612,20 @@ PROPLIST is a list of the sort returned by `symbol-plist'. ,(funcall setter `(cl--set-getf ,getter ,k ,val)) ,val))))))))) - (setplist '--cl-getf-symbol-- plist) - (or (get '--cl-getf-symbol-- tag) - ;; Originally we called cl-get here, - ;; but that fails, because cl-get has a compiler macro - ;; definition that uses getf! - (when def - ;; Make sure `def' is really absent as opposed to set to nil. - (while (and plist (not (eq (car plist) tag))) - (setq plist (cdr (cdr plist)))) - (if plist (car (cdr plist)) def)))) + (let ((val-tail (cdr-safe (plist-member plist tag)))) + (if val-tail (car val-tail) def))) ;;;###autoload (defun cl--set-getf (plist tag val) - (let ((p plist)) - (while (and p (not (eq (car p) tag))) (setq p (cdr (cdr p)))) - (if p (progn (setcar (cdr p) val) plist) (cl-list* tag val plist)))) + (let ((val-tail (cdr-safe (plist-member plist tag)))) + (if val-tail (progn (setcar val-tail val) plist) + (cl-list* tag val plist)))) ;;;###autoload (defun cl--do-remf (plist tag) (let ((p (cdr plist))) + ;; Can't use `plist-member' here because it goes to the cons-cell + ;; of TAG and we need the one before. (while (and (cdr p) (not (eq (car (cdr p)) tag))) (setq p (cdr (cdr p)))) (and (cdr p) (progn (setcdr p (cdr (cdr (cdr p)))) t)))) diff --git a/test/lisp/emacs-lisp/cl-extra-tests.el b/test/lisp/emacs-lisp/cl-extra-tests.el new file mode 100644 index 0000000000..3e2388acc6 --- /dev/null +++ b/test/lisp/emacs-lisp/cl-extra-tests.el @@ -0,0 +1,38 @@ +;;; cl-extra-tests.el --- tests for emacs-lisp/cl-extra.el -*- lexical-binding:t -*- + +;; Copyright (C) 2013-2017 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; This program is free software: you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation, either version 3 of the +;; License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see `http://www.gnu.org/licenses/'. + +;;; Code: + +(require 'cl-lib) +(require 'ert) + +(ert-deftest cl-get () + (put 'cl-get-test 'x 1) + (put 'cl-get-test 'y nil) + (should (eq (cl-get 'cl-get-test 'x) 1)) + (should (eq (cl-get 'cl-get-test 'y :none) nil)) + (should (eq (cl-get 'cl-get-test 'z :none) :none))) + +(ert-deftest cl-getf () + (let ((plist '(x 1 y nil))) + (should (eq (cl-getf plist 'x) 1)) + (should (eq (cl-getf plist 'y :none) nil)) + (should (eq (cl-getf plist 'z :none) :none)))) + +;;; cl-extra-tests.el ends here commit 57a8346edfbaa7a4002f2ed8cad041588dfcdd9c Author: Paul Eggert Date: Mon Feb 20 13:03:12 2017 -0800 Verify xwidget USE_LSB_TAG assumption * src/xwidget.c (Fxwidget_webkit_execute_script): Add verification. Problem reported by Andreas Schwab (Bug#25816#8). diff --git a/src/xwidget.c b/src/xwidget.c index dc705bb140..e6de5da8e6 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -720,6 +720,8 @@ argument procedure FUN.*/) GAsyncReadyCallback callback = FUNCTIONP (fun) ? webkit_javascript_finished_cb : NULL; + /* FIXME: The following hack assumes USE_LSB_TAG. */ + verify (USE_LSB_TAG); /* FIXME: This hack might lead to disaster if FUN is garbage collected before store_xwidget_js_callback_event makes it visible to Lisp again. See the FIXME in webkit_javascript_finished_cb. */ commit 160bcfeed6047b65cf8b9f00c404061b03dfe141 Author: Stefan Monnier Date: Mon Feb 20 14:05:41 2017 -0500 * src/insdel.c (make_gap): Improve comment. diff --git a/src/insdel.c b/src/insdel.c index 76af3ff9a4..5a95d41e7a 100644 --- a/src/insdel.c +++ b/src/insdel.c @@ -572,7 +572,9 @@ make_gap (ptrdiff_t nbytes_added) * With /4096 => 131s * With /∞ => gave up after 858s * Of couse, ideally we should never call set-buffer-multibyte on - * a non-empty buffer (e.g. use buffer-swa-text instead). */ + * a non-empty buffer (e.g. use buffer-swap-text instead). + * We chose /64 because it already brings almost the best performance while + * limiting the potential wasted memory to 1.5%. */ make_gap_larger (max (nbytes_added, (Z - BEG) / 64)); #if defined USE_MMAP_FOR_BUFFERS || defined REL_ALLOC || defined DOUG_LEA_MALLOC else commit 27a76829fe71efcb048686a3c42221aec1020f10 Author: Mark Oteiza Date: Mon Feb 20 13:53:41 2017 -0500 Do not use switch-to-buffer for working in a temp buffer * lisp/play/dunnet.el (dunnet): Use pop-to-buffer-same-window instead, cf. Bug#22244. (dun-load-d, dun-eval, dun-save-game, dun-do-logfile): Use with-temp-buffer instead. diff --git a/lisp/play/dunnet.el b/lisp/play/dunnet.el index e7f45659e9..d13c967dad 100644 --- a/lisp/play/dunnet.el +++ b/lisp/play/dunnet.el @@ -1176,7 +1176,7 @@ treasures for points?" "4" "four") (defun dunnet () "Switch to *dungeon* buffer and start game." (interactive) - (switch-to-buffer "*dungeon*") + (pop-to-buffer-same-window "*dungeon*") (dun-mode) (setq dun-dead nil) (setq dun-room 0) @@ -2343,20 +2343,16 @@ for a moment, then straighten yourself up. ;;; Load an encrypted file, and eval it. (defun dun-load-d (filename) - (let ((old-buffer (current-buffer)) - (result t)) - (switch-to-buffer (get-buffer-create "*loadc*")) - (erase-buffer) - (condition-case nil - (insert-file-contents filename) - (error (setq result nil))) - (when result + (let ((result t)) + (with-temp-buffer (condition-case nil - (dun-rot13) - (error (yank))) - (eval-buffer) - (kill-buffer (current-buffer))) - (switch-to-buffer old-buffer) + (insert-file-contents filename) + (error (setq result nil))) + (when result + (condition-case nil + (dun-rot13) + (error (yank))) + (eval-buffer))) result)) ;;; Functions to remove an object either from a room, or from inventory. @@ -2466,23 +2462,11 @@ for a moment, then straighten yourself up. (dun-eval varname value))))) (defun dun-eval (varname value) - (let (eval-error) - (switch-to-buffer (get-buffer-create "*dungeon-eval*")) - (erase-buffer) - (insert "(setq ") - (insert varname) - (insert " ") - (insert value) - (insert ")") - (setq eval-error nil) + (with-temp-buffer + (insert "(setq " varname " " value ")") (condition-case nil - (eval-buffer) - (error (setq eval-error t))) - (kill-buffer (current-buffer)) - (switch-to-buffer "*dungeon*") - (if eval-error - (dun-mprincl "Invalid syntax.")))) - + (eval-buffer) + (error (dun-mprincl "Invalid syntax."))))) (defun dun-unix-interface () (dun-login) @@ -3012,49 +2996,43 @@ File not found"))) (defun dun-save-game (filename) (if (not (setq filename (car filename))) (dun-mprincl "You must supply a filename for the save.") - (if (file-exists-p filename) - (delete-file filename)) + (when (file-exists-p filename) (delete-file filename)) (setq dun-numsaves (1+ dun-numsaves)) - (dun-make-save-buffer) - (dun-save-val "dun-current-room") - (dun-save-val "dun-computer") - (dun-save-val "dun-combination") - (dun-save-val "dun-visited") - (dun-save-val "dun-diggables") - (dun-save-val "dun-key-level") - (dun-save-val "dun-floppy") - (dun-save-val "dun-numsaves") - (dun-save-val "dun-numcmds") - (dun-save-val "dun-logged-in") - (dun-save-val "dungeon-mode") - (dun-save-val "dun-jar") - (dun-save-val "dun-lastdir") - (dun-save-val "dun-black") - (dun-save-val "dun-nomail") - (dun-save-val "dun-unix-verbs") - (dun-save-val "dun-hole") - (dun-save-val "dun-uncompressed") - (dun-save-val "dun-ethernet") - (dun-save-val "dun-sauna-level") - (dun-save-val "dun-room-objects") - (dun-save-val "dun-room-silents") - (dun-save-val "dun-inventory") - (dun-save-val "dun-endgame-questions") - (dun-save-val "dun-endgame") - (dun-save-val "dun-cdroom") - (dun-save-val "dun-cdpath") - (dun-save-val "dun-correct-answer") - (dun-save-val "dun-inbus") - (if (dun-compile-save-out filename) - (dun-mprincl "Error saving to file.") - (dun-do-logfile 'save nil) - (switch-to-buffer "*dungeon*") - (princ "") - (dun-mprincl "Done.")))) - -(defun dun-make-save-buffer () - (switch-to-buffer (get-buffer-create "*save-dungeon*")) - (erase-buffer)) + (with-temp-buffer + (dun-save-val "dun-current-room") + (dun-save-val "dun-computer") + (dun-save-val "dun-combination") + (dun-save-val "dun-visited") + (dun-save-val "dun-diggables") + (dun-save-val "dun-key-level") + (dun-save-val "dun-floppy") + (dun-save-val "dun-numsaves") + (dun-save-val "dun-numcmds") + (dun-save-val "dun-logged-in") + (dun-save-val "dungeon-mode") + (dun-save-val "dun-jar") + (dun-save-val "dun-lastdir") + (dun-save-val "dun-black") + (dun-save-val "dun-nomail") + (dun-save-val "dun-unix-verbs") + (dun-save-val "dun-hole") + (dun-save-val "dun-uncompressed") + (dun-save-val "dun-ethernet") + (dun-save-val "dun-sauna-level") + (dun-save-val "dun-room-objects") + (dun-save-val "dun-room-silents") + (dun-save-val "dun-inventory") + (dun-save-val "dun-endgame-questions") + (dun-save-val "dun-endgame") + (dun-save-val "dun-cdroom") + (dun-save-val "dun-cdpath") + (dun-save-val "dun-correct-answer") + (dun-save-val "dun-inbus") + (if (dun-compile-save-out filename) + (dun-mprincl "Error saving to file.") + (dun-do-logfile 'save nil))) + (princ "") + (dun-mprincl "Done."))) (defun dun-compile-save-out (filename) (let (ferror) @@ -3100,40 +3078,39 @@ File not found"))) (defun dun-do-logfile (type how) (let (ferror) - (setq ferror nil) - (switch-to-buffer (get-buffer-create "*score*")) - (erase-buffer) - (condition-case nil - (insert-file-contents dun-log-file) - (error (setq ferror t))) - (unless ferror - (goto-char (point-max)) - (dun-minsert (current-time-string)) - (dun-minsert " ") - (dun-minsert (user-login-name)) - (dun-minsert " ") - (if (eq type 'save) - (dun-minsert "saved ") - (if (= (dun-endgame-score) 110) - (dun-minsert "won ") - (if (not how) - (dun-minsert "quit ") - (dun-minsert "killed by ") - (dun-minsert how) - (dun-minsert " ")))) - (dun-minsert "at ") - (dun-minsert (cadr (nth (abs dun-room) dun-rooms))) - (dun-minsert ". score: ") - (if (> (dun-endgame-score) 0) - (dun-minsert (+ 90 (dun-endgame-score))) - (dun-minsert (dun-reg-score))) - (dun-minsert " saves: ") - (dun-minsert dun-numsaves) - (dun-minsert " commands: ") - (dun-minsert dun-numcmds) - (dun-minsert "\n") - (write-region 1 (point-max) dun-log-file nil 1)) - (kill-buffer (current-buffer)))) + (with-temp-buffer + (condition-case err + (insert-file-contents dun-log-file) + (error + (setq ferror t) + (dun-mprincl (error-message-string err)))) + (when (null ferror) + (goto-char (point-max)) + (dun-minsert (current-time-string)) + (dun-minsert " ") + (dun-minsert (user-login-name)) + (dun-minsert " ") + (if (eq type 'save) + (dun-minsert "saved ") + (if (= (dun-endgame-score) 110) + (dun-minsert "won ") + (if (not how) + (dun-minsert "quit ") + (dun-minsert "killed by ") + (dun-minsert how) + (dun-minsert " ")))) + (dun-minsert "at ") + (dun-minsert (cadr (nth (abs dun-room) dun-rooms))) + (dun-minsert ". score: ") + (if (> (dun-endgame-score) 0) + (dun-minsert (+ 90 (dun-endgame-score))) + (dun-minsert (dun-reg-score))) + (dun-minsert " saves: ") + (dun-minsert dun-numsaves) + (dun-minsert " commands: ") + (dun-minsert dun-numcmds) + (dun-minsert "\n") + (write-region 1 (point-max) dun-log-file nil 1))))) ;;;; commit e546d3d967e12741394774f2d3aeadc07cf78483 Author: Mark Oteiza Date: Mon Feb 20 13:33:48 2017 -0500 Make dun-room-shorts a defconst * lisp/play/dunnet.el (dun-room-shorts): Make defconst and collect initial value into the declaration. (dun-space-to-hyphen): Remove. diff --git a/lisp/play/dunnet.el b/lisp/play/dunnet.el index bffb38a01a..e7f45659e9 100644 --- a/lisp/play/dunnet.el +++ b/lisp/play/dunnet.el @@ -1095,7 +1095,17 @@ nil nil nil nil nil nil nil nil nil nil nil nil nil nil ;31-40 nil (list obj-platinum) nil nil nil nil nil nil nil nil)) -(defvar dun-room-shorts nil) +(defconst dun-room-shorts + (let (res str) + (dolist (x dun-rooms) + (setq str (downcase (cadr x))) + (push (mapconcat #'identity (split-string str "[ /]+") "-") res)) + (nreverse res))) + +(let ((a 0)) + (dolist (x dun-room-shorts) + (eval (list 'defconst (intern x) a)) + (setq a (+ a 1)))) (defconst dun-endgame-questions '(("What is your password on the machine called ‘pokey’?" "robert") @@ -2305,17 +2315,6 @@ for a moment, then straighten yourself up. nil result))) -;;; Take a short room description, and change spaces and slashes to dashes. - -(defun dun-space-to-hyphen (string) - (let (space) - (if (setq space (string-match "[ /]" string)) - (progn - (setq string (concat (substring string 0 space) "-" - (substring string (1+ space)))) - (dun-space-to-hyphen string)) - string))) - ;;; Given a unix style pathname, build a list of path components (recursive) (defun dun-get-path (dirstring startlist) @@ -2398,18 +2397,6 @@ for a moment, then straighten yourself up. (define-key dungeon-batch-map "\r" 'exit-minibuffer) (define-key dungeon-batch-map "\n" 'exit-minibuffer) -(dolist (x dun-rooms) - (setq dun-room-shorts - (append dun-room-shorts (list (downcase - (dun-space-to-hyphen - (cadr x))))))) - -(let (a) - (setq a 0) - (dolist (x dun-room-shorts) - (eval (list 'defconst (intern x) a)) - (setq a (+ a 1)))) - ;;;; ;;;; This section defines the UNIX emulation functions for dunnet. ;;;; commit a6e76fc7254ddac7729224a891feb8ed3f183efc Author: Paul Eggert Date: Mon Feb 20 08:53:50 2017 -0800 Port xwidget to -DCHECK_LISP_OBJECT_TYPE * src/xwidget.c (webkit_javascript_finished_cb) (Fxwidget_webkit_execute_script): Don't assume Lisp_Object is an integer. This fix is just a hack; I’ll file a bug report about the underlying problem. diff --git a/src/xwidget.c b/src/xwidget.c index 5c276b1371..dc705bb140 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -389,7 +389,10 @@ webkit_javascript_finished_cb (GObject *webview, /* Register an xwidget event here, which then runs the callback. This ensures that the callback runs in sync with the Emacs event loop. */ - store_xwidget_js_callback_event (xw, (Lisp_Object)lisp_callback, + /* FIXME: This might lead to disaster if LISP_CALLBACK’s object + was garbage collected before now. See the FIXME in + Fxwidget_webkit_execute_script. */ + store_xwidget_js_callback_event (xw, XIL ((intptr_t) lisp_callback), lisp_value); } @@ -714,8 +717,13 @@ argument procedure FUN.*/) if (!NILP (fun) && !FUNCTIONP (fun)) wrong_type_argument (Qinvalid_function, fun); - void *callback = (FUNCTIONP (fun)) ? - &webkit_javascript_finished_cb : NULL; + GAsyncReadyCallback callback + = FUNCTIONP (fun) ? webkit_javascript_finished_cb : NULL; + + /* FIXME: This hack might lead to disaster if FUN is garbage + collected before store_xwidget_js_callback_event makes it visible + to Lisp again. See the FIXME in webkit_javascript_finished_cb. */ + gpointer callback_arg = (gpointer) (intptr_t) XLI (fun); /* JavaScript execution happens asynchronously. If an elisp callback function is provided we pass it to the C callback @@ -723,8 +731,7 @@ argument procedure FUN.*/) webkit_web_view_run_javascript (WEBKIT_WEB_VIEW (xw->widget_osr), SSDATA (script), NULL, /* cancelable */ - callback, - (gpointer) fun); + callback, callback_arg); return Qnil; } commit 589bd0c22b2d55c3d0339221f67235b33be93f68 Author: Eli Zaretskii Date: Mon Feb 20 17:41:46 2017 +0200 ; * src/insdel.c: State file encoding explicitly. diff --git a/src/insdel.c b/src/insdel.c index 8b684fd278..76af3ff9a4 100644 --- a/src/insdel.c +++ b/src/insdel.c @@ -1,4 +1,4 @@ -/* Buffer insertion/deletion and gap motion for GNU Emacs. +/* Buffer insertion/deletion and gap motion for GNU Emacs. -*- coding: utf-8 -*- Copyright (C) 1985-1986, 1993-1995, 1997-2017 Free Software Foundation, Inc.