commit 7660d0359e637301651fe4433c2b9851840db120 (HEAD, refs/remotes/origin/master) Author: Stefan Monnier Date: Fri Dec 11 19:26:43 2020 -0500 * lisp/emacs-lisp/thunk.el (thunk-let*): Don't modify `bindings` diff --git a/lisp/emacs-lisp/thunk.el b/lisp/emacs-lisp/thunk.el index c8e483e9a4..cd42152527 100644 --- a/lisp/emacs-lisp/thunk.el +++ b/lisp/emacs-lisp/thunk.el @@ -122,7 +122,7 @@ Using `thunk-let' and `thunk-let*' requires `lexical-binding'." (declare (indent 1) (debug let)) (cl-reduce (lambda (expr binding) `(thunk-let (,binding) ,expr)) - (nreverse bindings) + (reverse bindings) :initial-value (macroexp-progn body))) ;; (defalias 'lazy-let #'thunk-let) commit 78607f21b51cef7456d8075e67e3a1de5cf47483 Author: Stefan Monnier Date: Fri Dec 11 19:06:55 2020 -0500 * lisp/play/dunnet.el: Make it so loading the file is harmless Move comments into docstrings while at it. (dun-batch): New function. diff --git a/etc/NEWS b/etc/NEWS index 33cc2c30a0..26e4b8514f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -292,6 +292,10 @@ the buffer cycles the whole buffer between "only top-level headings", * Changes in Specialized Modes and Packages in Emacs 28.1 +** Loading dunnet.el in batch mode doesn't start the game any more +Instead you need to do 'emacs -f dun-batch' to start the game in +batch mode. + ** Emacs Server +++ diff --git a/lisp/play/dunnet.el b/lisp/play/dunnet.el index 1df28a0f37..45afb51041 100644 --- a/lisp/play/dunnet.el +++ b/lisp/play/dunnet.el @@ -46,10 +46,10 @@ ;;;; ;;;; This section defines the globals that are used in dunnet. -;;;; -;;;; IMPORTANT -;;;; All globals which can change must be saved from 'save-game. Add -;;;; all new globals to bottom of this section. +;; +;; IMPORTANT +;; All globals which can change must be saved from 'save-game. +;; Add all new globals to bottom of this section. (defvar dun-visited '(27)) (defvar dun-current-room 1) @@ -771,7 +771,6 @@ A hole leads north." ) -;;; How the user references *all* objects, permanent and regular. (defconst dun-objnames '((shovel . 0) (lamp . 1) @@ -831,7 +830,8 @@ A hole leads north." (ladder . -27) (subway . -28) (train . -28) (pc . -29) (drive . -29) (coconut . -30) (coconuts . -30) - (lake . -32) (water . -32))) + (lake . -32) (water . -32)) + "How the user references *all* objects, permanent and regular.") (dolist (x dun-objnames) (let (name) @@ -840,13 +840,6 @@ A hole leads north." (defconst obj-special 255) -;;; The initial setup of what objects are in each room. -;;; Regular objects have whole numbers lower than 255. -;;; Objects that cannot be taken but might move and are -;;; described during room description are negative. -;;; Stuff that is described and might change are 255, and are -;;; handled specially by 'dun-describe-room. - (defvar dun-room-objects (list nil (list obj-shovel) ;; treasure-room @@ -899,10 +892,13 @@ A hole leads north." nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil -nil)) - -;;; These are objects in a room that are only described in the -;;; room description. They are permanent. +nil) + "The initial setup of what objects are in each room. +Regular objects have whole numbers lower than 255. +Objects that cannot be taken but might move and are +described during room description are negative. +Stuff that is described and might change are 255, and are +handled specially by 'dun-describe-room.") (defconst dun-room-silents (list nil (list obj-tree obj-coconut) ;; dead-end @@ -947,12 +943,11 @@ nil)) nil nil nil nil nil nil nil nil (list obj-pc) ;; pc-area nil nil nil nil nil nil -)) + ) + "These are objects in a room that are only described in the +room description. They are permanent.") (defvar dun-inventory '(1)) -;;; Descriptions of objects, as they appear in the room description, and -;;; the inventory. - (defconst dun-objects '(("There is a shovel here." "A shovel") ;0 ("There is a lamp nearby." "A lamp") ;1 @@ -982,26 +977,24 @@ nil)) ("There is a valuable amethyst here." "An amethyst") ;24 ("The Mona Lisa is here." "The Mona Lisa") ;25 ("There is a 100 dollar bill here." "A $100 bill") ;26 - ("There is a floppy disk here." "A floppy disk"))) ;27 - -;;; Weight of objects + ("There is a floppy disk here." "A floppy disk")) ;27 + "Descriptions of objects, as they appear in the room description, and +the inventory.") (defconst dun-object-lbs - '(2 1 1 1 1 0 2 2 10 3 1 1 1 0 1 1 0 1 1 1 1 0 0 2 2 1 0 0)) + '(2 1 1 1 1 0 2 2 10 3 1 1 1 0 1 1 0 1 1 1 1 0 0 2 2 1 0 0) + "Weight of objects.") (defconst dun-object-pts '(0 0 0 0 0 0 0 10 0 0 10 10 10 0 0 10 0 10 10 0 0 0 0 10 10 10 10 0)) -;;; Unix representation of objects. (defconst dun-objfiles '("shovel.o" "lamp.o" "cpu.o" "food.o" "key.o" "paper.o" "rms.o" "diamond.o" "weight.o" "preserver.o" "bracelet.o" "gold.o" "platinum.o" "towel.o" "axe.o" "silver.o" "license.o" "coins.o" "egg.o" "jar.o" "bone.o" "nitric.o" "glycerine.o" - "ruby.o" "amethyst.o")) - -;;; These are the descriptions for the negative numbered objects from -;;; dun-room-objects + "ruby.o" "amethyst.o") + "Unix representation of objects.") (defconst dun-perm-objects '(nil @@ -1016,12 +1009,11 @@ nil)) ("There is a box with a slit in it, bolted to the wall here.") nil nil ("There is a bus here.") - nil nil nil)) + nil nil nil) + "These are the descriptions for the negative numbered objects from +`dun-room-objects'.") -;;; These are the descriptions the user gets when regular objects are -;;; examined. - (defconst dun-physobj-desc '( "It is a normal shovel with a price tag attached that says $19.99." "The lamp is hand-crafted by Geppetto." @@ -1043,10 +1035,8 @@ nil nil "They are old coins from the 19th century." "It is a valuable Fabrege egg." "It is a plain glass jar." -nil nil nil nil nil)) - -;;; These are the descriptions the user gets when non-regular objects -;;; are examined. +nil nil nil nil nil) + "The descriptions the user gets when regular objects are examined.") (defconst dun-permobj-desc '(nil @@ -1087,7 +1077,8 @@ it. It is very big, though." nil nil nil nil "It is a normal ladder that is permanently attached to the hole." "It is a passenger train that is ready to go." -"It is a personal computer that has only one floppy disk drive.")) +"It is a personal computer that has only one floppy disk drive.") + "The descriptions the user gets when non-regular objects are examined.") (defconst dun-diggables (list nil nil nil (list obj-cpu) nil nil nil nil nil nil nil @@ -1189,10 +1180,9 @@ treasures for points?" "4" "four") ;;;; This section contains all of the verbs and commands. ;;;; -;;; Give long description of room if haven't been there yet. Otherwise -;;; short. Also give long if we were called with negative room number. - (defun dun-describe-room (room) + "Give long description of room if haven't been there yet. +Otherwise short. Also give long if we were called with negative room number." (if (and (not (member (abs room) dun-light-rooms)) (not (member obj-lamp dun-inventory)) (not (member obj-lamp (nth dun-current-room dun-room-objects)))) @@ -1222,10 +1212,9 @@ treasures for points?" "4" "four") (if (and (member obj-bus (nth dun-current-room dun-room-objects)) dun-inbus) (dun-mprincl "You are on the bus.")))) -;;; There is a special object in the room. This object's description, -;;; or lack thereof, depends on certain conditions. - (defun dun-special-object () + "There is a special object in the room. This object's description, +or lack thereof, depends on certain conditions." (cond ((= dun-current-room computer-room) (if dun-computer @@ -1298,10 +1287,9 @@ disk bursts into flames, and disintegrates.") (defun dun-quit (_args) (dun-die nil)) -;;; Print every object in player's inventory. Special case for the jar, -;;; as we must also print what is in it. - (defun dun-inven (_args) + "Print every object in player's inventory. +Special case for the jar, as we must also print what is in it." (dun-mprincl "You currently have:") (dolist (curobj dun-inventory) (when curobj @@ -1352,9 +1340,8 @@ on your head.") (if (member objnum (list obj-food obj-weight obj-jar)) (dun-drop-check objnum))))))) -;;; Dropping certain things causes things to happen. - (defun dun-drop-check (objnum) + "Dropping certain things causes things to happen." (cond ((and (= objnum obj-food) (= dun-room bear-hangout) (member obj-bear (nth bear-hangout dun-room-objects))) @@ -1381,9 +1368,8 @@ through."))) ((and (= objnum obj-weight) (= dun-current-room maze-button-room)) (dun-mprincl "A passageway opens.")))) -;;; Give long description of current room, or an object. - (defun dun-examine (obj) + "Give long description of current room, or an object." (let ((objnum (dun-objnum-from-args obj))) (cond ((eq objnum obj-special) @@ -1474,10 +1460,9 @@ For an explosive time, go to Fourth St. and Vermont.") (setq total (+ total (nth x dun-object-lbs)))) total)) -;;; We try to take an object that is untakable. Print a message -;;; depending on what it is. - (defun dun-try-take (_obj) + "We try to take an object that is untakable. +Print a message depending on what it is." (dun-mprinc "You cannot take that.")) (defun dun-dig (_args) @@ -1670,15 +1655,15 @@ just try dropping it.")) (defun dun-go (args) (if (or (not (car args)) (eq (dun-doverb dun-ignore dun-verblist (car args) - (cdr (cdr args))) -1)) + (cdr (cdr args))) + -1)) (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 -;;; supposed to happen, or perhaps you can't go that way unless -;;; certain conditions are met. - (defun dun-move (dir) + ;; Uses the dungeon-map to figure out where we are going. If the + ;; requested direction yields 255, we know something special is + ;; supposed to happen, or perhaps you can't go that way unless + ;; certain conditions are met. (if (and (not (member dun-current-room dun-light-rooms)) (not (member obj-lamp dun-inventory)) (not (member obj-lamp (nth dun-current-room dun-room-objects)))) @@ -1709,17 +1694,17 @@ body.") (list obj-bus))))) (setq dun-current-room newroom))))))) -;;; Movement in this direction causes something special to happen if the -;;; right conditions exist. It may be that you can't go this way unless -;;; you have a key, or a passage has been opened. +(defun dun-special-move (dir) + ;; Movement in this direction causes something special to happen if the + ;; right conditions exist. It may be that you can't go this way unless + ;; you have a key, or a passage has been opened. -;;; coding note: Each check of the current room is on the same 'if' level, -;;; i.e. there aren't else's. If two rooms next to each other have -;;; specials, and they are connected by specials, this could cause -;;; a problem. Be careful when adding them to consider this, and -;;; perhaps use else's. + ;; coding note: Each check of the current room is on the same 'if' level, + ;; i.e. there aren't else's. If two rooms next to each other have + ;; specials, and they are connected by specials, this could cause + ;; a problem. Be careful when adding them to consider this, and + ;; perhaps use else's. -(defun dun-special-move (dir) (if (= dun-current-room building-front) (if (not (member obj-key dun-inventory)) (dun-mprincl "You don't have a key that can open this door.") @@ -2152,10 +2137,10 @@ for a moment, then straighten yourself up.\n") ;;;; -;;; Function which takes a verb and a list of other words. Calls proper -;;; function associated with the verb, and passes along the other words. - (defun dun-doverb (ignore verblist verb rest) + "Take a verb and a list of other words. +Calls proper function associated with the verb, and passes along the +other words." (when verb (if (member (intern verb) ignore) (if (not (car rest)) -1 @@ -2165,9 +2150,8 @@ for a moment, then straighten yourself up.\n") (funcall (cdr (assq (intern verb) verblist)) rest))))) -;;; Function to take a string and change it into a list of lowercase words. - (defun dun-listify-string (strin) + "Take a string and change it into a list of lowercase words." (let (pos ret-list end-pos) (setq pos 0) (setq ret-list nil) @@ -2177,7 +2161,8 @@ for a moment, then straighten yourself up.\n") (setq ret-list (append ret-list (list (downcase (substring strin pos end-pos)))))) - (setq pos (+ end-pos 1))) ret-list)) + (setq pos (+ end-pos 1))) + ret-list)) (defun dun-listify-string2 (strin) (let (pos ret-list end-pos) @@ -2194,10 +2179,8 @@ for a moment, then straighten yourself up.\n") (defun dun-replace (list n number) (rplaca (nthcdr n list) number)) - -;;; Get the first non-ignored word from a list. - (defun dun-firstword (list) + "Get the first non-ignored word from a list." (when (car list) (while (and list (memq (intern (car list)) dun-ignore)) (setq list (cdr list))) @@ -2209,10 +2192,9 @@ for a moment, then straighten yourself up.\n") (setq list (cdr list))) list)) -;;; parse a line passed in as a string Call the proper verb with the -;;; rest of the line passed in as a list. - (defun dun-vparse (ignore verblist line) + "Parse a line passed in as a string. +Call the proper verb with the rest of the line passed in as a list." (dun-mprinc "\n") (setq dun-line-list (dun-listify-string (concat line " "))) (dun-doverb ignore verblist (car dun-line-list) (cdr dun-line-list))) @@ -2222,54 +2204,47 @@ for a moment, then straighten yourself up.\n") (setq dun-line-list (dun-listify-string2 (concat line " "))) (dun-doverb ignore verblist (car dun-line-list) (cdr dun-line-list))) -;;; Read a line, in window mode - (defun dun-read-line () + "Read a line, in window mode." (let ((line (read-string ""))) (dun-mprinc line) line)) -;;; Insert something into the window buffer - (defun dun-minsert (&rest args) + "Insert something into the window buffer." (dolist (arg args) (if (stringp arg) (insert arg) (insert (prin1-to-string arg))))) -;;; Print something out, in window mode - (defun dun-mprinc (&rest args) + "Print something out, in window mode." (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. - (defun dun-fix-screen () + "In window mode, keep screen from jumping by keeping last line at +the bottom of the screen." (interactive) (forward-line (- 0 (- (window-height) 2 ))) (set-window-start (selected-window) (point)) (goto-char (point-max))) -;;; Insert something into the buffer, followed by newline. - (defun dun-minsertl (&rest args) + "Insert something into the buffer, followed by newline." (apply #'dun-minsert args) (dun-minsert "\n")) -;;; Print something, followed by a newline. - (defun dun-mprincl (&rest args) + "Print something, followed by a newline." (apply #'dun-mprinc args) (dun-mprinc "\n")) -;;; Function which will get an object number given the list of -;;; words in the command, except for the verb. - (defun dun-objnum-from-args (obj) + "Get an object number given the list of words in the command, +except for the verb." (setq obj (dun-firstword obj)) (if (not obj) obj-special @@ -2285,9 +2260,8 @@ for a moment, then straighten yourself up.\n") nil result))) -;;; Given a unix style pathname, build a list of path components (recursive) - (defun dun-get-path (dirstring startlist) + "Given a unix style pathname, build a list of path components (recursive)" (let (slash) (if (= (length dirstring) 0) startlist @@ -2299,10 +2273,9 @@ for a moment, then straighten yourself up.\n") (append startlist (list (substring dirstring 0 slash))))))))) -;;; Function to put objects in the treasure room. Also prints current -;;; score to let user know he has scored. - (defun dun-put-objs-in-treas (objlist) + "Put objects in the treasure room. +Also prints current score to let user know he has scored." (let (oscore newscore) (setq oscore (dun-reg-score)) (dun-replace dun-room-objects 0 (append (nth 0 dun-room-objects) objlist)) @@ -2310,9 +2283,8 @@ for a moment, then straighten yourself up.\n") (if (not (= oscore newscore)) (dun-score nil)))) -;;; Load an encrypted file, and eval it. - (defun dun-load-d (filename) + "Load an encrypted file, and eval it." (let ((result t)) (with-temp-buffer (condition-case nil @@ -3154,14 +3126,16 @@ File not found"))) (dun-mprinc "\n") (dun-batch-loop)) -(when noninteractive - (fset 'dun-mprinc 'dun-batch-mprinc) - (fset 'dun-mprincl 'dun-batch-mprincl) - (fset 'dun-vparse 'dun-batch-parse) - (fset 'dun-parse2 'dun-batch-parse2) - (fset 'dun-read-line 'dun-batch-read-line) - (fset 'dun-dos-interface 'dun-batch-dos-interface) - (fset 'dun-unix-interface 'dun-batch-unix-interface) +;;;###autoload +(defun dun-batch () + "Start `dunnet' in batch mode." + (fset 'dun-mprinc #'dun-batch-mprinc) + (fset 'dun-mprincl #'dun-batch-mprincl) + (fset 'dun-vparse #'dun-batch-parse) + (fset 'dun-parse2 #'dun-batch-parse2) + (fset 'dun-read-line #'dun-batch-read-line) + (fset 'dun-dos-interface #'dun-batch-dos-interface) + (fset 'dun-unix-interface #'dun-batch-unix-interface) (dun-mprinc "\n") (setq dun-batch-mode t) (dun-batch-loop)) commit 3ed3a33cb1ef92a290eeb934ba3dea33c3576ff5 Author: Lars Ingebrigtsen Date: Fri Dec 11 23:18:01 2020 +0100 Fix copyright line diff --git a/test/lisp/emacs-lisp/memory-report-tests.el b/test/lisp/emacs-lisp/memory-report-tests.el index 01bcf18423..b67ec6c010 100644 --- a/test/lisp/emacs-lisp/memory-report-tests.el +++ b/test/lisp/emacs-lisp/memory-report-tests.el @@ -1,6 +1,6 @@ -;;; memory-report-tests.el --- tests for memory-report.el -*- lexical-binding: t -*- +;;; memory-report-tests.el --- tests for memory-report.el -*- lexical-binding: t -*- -;; Copyright (C) 2016-2020 Free Software Foundation, Inc. +;; Copyright (C) 2020 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. @@ -21,6 +21,9 @@ (require 'memory-report) (defun setup-memory-report-tests () + ;; Set the sizes on things based on a 64-bit architecture. (We're + ;; hard-coding this to be able to write simple tests that'll work on + ;; all architectures.) (memory-report--set-size '((conses 16 499173 99889) (symbols 48 22244 3) commit 70f7f0b1fd6576752f4cfef8f2e597f3e8a56123 Author: Lars Ingebrigtsen Date: Fri Dec 11 21:30:25 2020 +0100 button-buttonize doc string clarification * lisp/button.el (button-buttonize): Clarify what happens when DATA isn't present. diff --git a/lisp/button.el b/lisp/button.el index 8dbb763281..a6f70436f7 100644 --- a/lisp/button.el +++ b/lisp/button.el @@ -615,7 +615,9 @@ button at point is the button to describe." (defun button-buttonize (string callback &optional data) "Make STRING into a button and return it. -When clicked, CALLBACK will be called with the optional DATA parameter." +When clicked, CALLBACK will be called with the DATA as the +function argument. If DATA isn't present (or is nil), the button +itself will be used instead as the function argument." (propertize string 'face 'button 'button t commit 711e7bf29cd405a69466feddb5ff9b9a5dfd2a03 Author: Lars Ingebrigtsen Date: Fri Dec 11 21:16:04 2020 +0100 Fix image-cache-size crash * src/image.c (image_frame_cache_size): Ensure that img->pixmap is in use before trying to access it. diff --git a/src/image.c b/src/image.c index 8607b33a7a..0dd108a96b 100644 --- a/src/image.c +++ b/src/image.c @@ -1795,8 +1795,9 @@ which is then usually a filename. */) static int image_frame_cache_size (struct frame *f) { - struct image_cache *c = FRAME_IMAGE_CACHE (f); int total = 0; +#ifdef USE_CAIRO + struct image_cache *c = FRAME_IMAGE_CACHE (f); if (!c) return 0; @@ -1805,12 +1806,11 @@ image_frame_cache_size (struct frame *f) { struct image *img = c->images[i]; -#ifdef USE_CAIRO - if (img) + if (img && img->pixmap && img->pixmap != NO_PIXMAP) total += img->pixmap->width * img->pixmap->height * img->pixmap->bits_per_pixel / 8; -#endif } +#endif return total; } commit 6864dc1dffee558430c8ef8739585dac10a1ee44 Author: Stefan Kangas Date: Fri Dec 11 20:08:24 2020 +0100 * src/fns.c (Fbuffer_hash): Doc fix. (Bug#45178) diff --git a/src/fns.c b/src/fns.c index a0c4a1fbf1..f77092972a 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5440,7 +5440,8 @@ disregarding any coding systems. If nil, use the current buffer. This function is useful for comparing two buffers running in the same Emacs, but is not guaranteed to return the same hash between different -Emacs versions. +Emacs versions. It should be somewhat more efficient on larger +buffers than `secure-hash' is, and should not allocate more memory. It should not be used for anything security-related. See `secure-hash' for these applications. */ ) commit dc5e8759305a6fcd47d6039d257d4c28a00a9ddf Author: Harald Jörg Date: Fri Dec 11 17:48:30 2020 +0100 ; cperl-mode: Eliminate fallbacks if font-lock isn't loaded * lisp/progmodes/cperl-mode.el (cperl-find-pods-heres): Eliminate conditionals which always evaluate to true if font-lock is preloaded (since Emacs 22.1). (Bug#45183) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index ed9b234d69..ae839a6622 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -3473,49 +3473,18 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', (font-lock-string-face (if (boundp 'font-lock-string-face) font-lock-string-face 'font-lock-string-face)) - (my-cperl-delimiters-face (if (boundp 'font-lock-constant-face) - font-lock-constant-face - 'font-lock-constant-face)) + (my-cperl-delimiters-face + font-lock-constant-face) (my-cperl-REx-spec-char-face ; [] ^.$ and wrapper-of ({}) - (if (boundp 'font-lock-function-name-face) - font-lock-function-name-face - 'font-lock-function-name-face)) - (font-lock-variable-name-face ; interpolated vars and ({})-code - (if (boundp 'font-lock-variable-name-face) - font-lock-variable-name-face - 'font-lock-variable-name-face)) - (font-lock-function-name-face ; used in `cperl-find-sub-attrs' - (if (boundp 'font-lock-function-name-face) - font-lock-function-name-face - 'font-lock-function-name-face)) - (font-lock-constant-face ; used in `cperl-find-sub-attrs' - (if (boundp 'font-lock-constant-face) - font-lock-constant-face - 'font-lock-constant-face)) + font-lock-function-name-face) (my-cperl-REx-0length-face ; 0-length, (?:)etc, non-literal \ - (if (boundp 'font-lock-builtin-face) - font-lock-builtin-face - 'font-lock-builtin-face)) - (font-lock-comment-face - (if (boundp 'font-lock-comment-face) - font-lock-comment-face - 'font-lock-comment-face)) - (font-lock-warning-face - (if (boundp 'font-lock-warning-face) - font-lock-warning-face - 'font-lock-warning-face)) + font-lock-builtin-face) (my-cperl-REx-ctl-face ; (|) - (if (boundp 'font-lock-keyword-face) - font-lock-keyword-face - 'font-lock-keyword-face)) + font-lock-keyword-face) (my-cperl-REx-modifiers-face ; //gims - (if (boundp 'cperl-nonoverridable-face) - cperl-nonoverridable-face - 'cperl-nonoverridable-face)) + 'cperl-nonoverridable-face) (my-cperl-REx-length1-face ; length=1 escaped chars, POSIX classes - (if (boundp 'font-lock-type-face) - font-lock-type-face - 'font-lock-type-face)) + font-lock-type-face) (stop-point (if ignore-max (point-max) max)) commit b04f322a9bd0e5376eca0d4c2961a8a076eeb9bb Author: Lars Ingebrigtsen Date: Fri Dec 11 18:58:41 2020 +0100 Also sort the totals section by size * lisp/emacs-lisp/memory-report.el (memory-report): Sort the totals by size, too. diff --git a/lisp/emacs-lisp/memory-report.el b/lisp/emacs-lisp/memory-report.el index 0184c7ed8a..c88d9f2768 100644 --- a/lisp/emacs-lisp/memory-report.el +++ b/lisp/emacs-lisp/memory-report.el @@ -59,7 +59,9 @@ by counted more than once." (if (listp report) (push report summaries) (push report details))) - (dolist (summary (nreverse summaries)) + (dolist (summary (seq-sort (lambda (e1 e2) + (> (cdr e1) (cdr e2))) + summaries)) (insert (format "%s %s\n" (memory-report--format (cdr summary)) (car summary)))) commit c7c261ebdf0232cc9263e8f8cbcc851a933076e0 Author: Lars Ingebrigtsen Date: Fri Dec 11 18:48:44 2020 +0100 Tweak memory-report--format * lisp/emacs-lisp/memory-report.el (memory-report--format): Make everything line up, even when there's "1023.4kB". diff --git a/lisp/emacs-lisp/memory-report.el b/lisp/emacs-lisp/memory-report.el index 58555fa9f0..0184c7ed8a 100644 --- a/lisp/emacs-lisp/memory-report.el +++ b/lisp/emacs-lisp/memory-report.el @@ -234,7 +234,7 @@ by counted more than once." (while (>= bytes 1024) (setq bytes (/ bytes 1024.0)) (setq units (cdr units))) - (format "%5.1f%s" bytes (car units)))) + (format "%6.1f%s" bytes (car units)))) (defun memory-report--gc-elem (elems type) (* (nth 1 (assq type elems)) commit abc8d6b9465fecb989170426756c7ee4b133fd40 Author: F. Jason Park Date: Fri Dec 11 16:36:02 2020 +0100 Append incremental message segments in socks-filter * lisp/net/socks.el (socks-filter): Preserve the order data arrive instead of semi-reversing it (bug#45162). Copyright-paperwork-exempt: yes diff --git a/lisp/net/socks.el b/lisp/net/socks.el index 9b22a5083f..cb50a0adbe 100644 --- a/lisp/net/socks.el +++ b/lisp/net/socks.el @@ -260,7 +260,7 @@ (setq state (process-get proc 'socks-state)) (cond ((= state socks-state-waiting-for-auth) - (cl-callf (lambda (s) (setq string (concat string s))) + (cl-callf (lambda (s) (setq string (concat s string))) (process-get proc 'socks-scratch)) (if (< (length string) 2) nil ; We need to spin some more @@ -272,7 +272,7 @@ ((= state socks-state-authenticated) ) ((= state socks-state-waiting) - (cl-callf (lambda (s) (setq string (concat string s))) + (cl-callf (lambda (s) (setq string (concat s string))) (process-get proc 'socks-scratch)) (setq version (process-get proc 'socks-server-protocol)) (cond @@ -542,7 +542,7 @@ service)) (process-put proc 'socks-buffer buffer) (process-put proc 'socks-host host) - (process-put proc 'socks-service host) + (process-put proc 'socks-service service) (set-process-filter proc nil) (set-process-buffer proc (if buffer (get-buffer-create buffer))) proc)))) commit fec05bc6679361909dfd1dbe1abdc944591ec840 Author: Pankaj Jangid Date: Fri Dec 11 16:31:48 2020 +0100 docstring: If FRAME is nil, it defaults to selected frame. * src/frame.c (Fset_frame_size): Clarify what a nil FRAME parameter means (bug#45170). diff --git a/src/frame.c b/src/frame.c index 17ec455d2d..164c05cae8 100644 --- a/src/frame.c +++ b/src/frame.c @@ -3577,7 +3577,9 @@ window managers may refuse to honor a HEIGHT that is not an integer multiple of the default frame font height. When called interactively, HEIGHT is the numeric prefix and the -currently selected frame will be set to this height. */) +currently selected frame will be set to this height. + +If FRAME is nil, it defaults to the selected frame. */) (Lisp_Object frame, Lisp_Object height, Lisp_Object pretend, Lisp_Object pixelwise) { struct frame *f = decode_live_frame (frame); @@ -3600,7 +3602,9 @@ window managers may refuse to honor a WIDTH that is not an integer multiple of the default frame font width. When called interactively, WIDTH is the numeric prefix and the -currently selected frame will be set to this width. */) +currently selected frame will be set to this width. + +If FRAME is nil, it defaults to the selected frame. */) (Lisp_Object frame, Lisp_Object width, Lisp_Object pretend, Lisp_Object pixelwise) { struct frame *f = decode_live_frame (frame); @@ -3616,7 +3620,9 @@ Optional argument PIXELWISE non-nil means to measure in pixels. Note: When `frame-resize-pixelwise' is nil, some window managers may refuse to honor a WIDTH that is not an integer multiple of the default frame font width or a HEIGHT that is not an integer multiple of the default frame -font height. */) +font height. + +If FRAME is nil, it defaults to the selected frame. */) (Lisp_Object frame, Lisp_Object width, Lisp_Object height, Lisp_Object pixelwise) { struct frame *f = decode_live_frame (frame); commit ec1651875367964b9668c914a5145a3f247bfb26 Author: Lars Ingebrigtsen Date: Fri Dec 11 16:17:31 2020 +0100 Clarify fortran-beginning-of-subprogram doc string after change * lisp/progmodes/fortran.el (fortran-beginning-of-subprogram): Clarify doc string (bug#33208). diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el index 90eda441fb..1142c323dc 100644 --- a/lisp/progmodes/fortran.el +++ b/lisp/progmodes/fortran.el @@ -1220,7 +1220,8 @@ Auto-indent does not happen if a numeric ARG is used." ;; FIXME push-mark? (defun fortran-beginning-of-subprogram (&optional arg) "Move point to the beginning of the current Fortran subprogram. -If ARG is negative, go to the beginning of the next instead." +If ARG is negative, and point is between subprograms, the +\"current\" subprogram is the next one." (interactive) (if (and arg (< arg 0)) commit af2695b045df0432d471de34a9dffde27f9c2369 Author: Stefan Kangas Date: Fri Dec 11 16:16:36 2020 +0100 * lisp/progmodes/python.el: Bump version. diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index e9c3b3986a..c761c95a96 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -4,7 +4,7 @@ ;; Author: Fabián E. Gallina ;; URL: https://github.com/fgallina/python.el -;; Version: 0.27 +;; Version: 0.27.1 ;; Package-Requires: ((emacs "24.1") (cl-lib "1.0")) ;; Maintainer: emacs-devel@gnu.org ;; Created: Jul 2010 commit eebb7c8a699614934e0b054536d9c6f102b59e34 Author: Lars Ingebrigtsen Date: Fri Dec 11 16:02:50 2020 +0100 Fix compilation of image.c on non-Cairo systems * src/image.c (image_frame_cache_size): pixmap->width etc is only defined on Cairo. Return 0 for now on other systems. diff --git a/src/image.c b/src/image.c index 38887ced25..8607b33a7a 100644 --- a/src/image.c +++ b/src/image.c @@ -1805,9 +1805,11 @@ image_frame_cache_size (struct frame *f) { struct image *img = c->images[i]; +#ifdef USE_CAIRO if (img) total += img->pixmap->width * img->pixmap->height * img->pixmap->bits_per_pixel / 8; +#endif } return total; } commit 4a700a2f79d5cca64602b7cad30d6485cfe0e449 Author: Roland Winkler Date: Fri Dec 11 09:00:26 2020 -0600 bibtex-autokey-get-year: Follow iso8601 * lisp/textmodes/bibtex.el (bibtex-autokey-get-year): Follow iso8601 (bug#36252). diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index 0a0a58244d..a78219e3f6 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -40,6 +40,8 @@ ;;; Code: +(require 'iso8601) + ;; User Options: @@ -2761,12 +2763,16 @@ and `bibtex-autokey-names-stretch'." (defun bibtex-autokey-get-year () "Return year field contents as a string obeying `bibtex-autokey-year-length'." - (let ((yearfield (bibtex-autokey-get-field '("year" "date")))) - ;; biblatex date field has format yyyy-mm-dd - (if (< 4 (length yearfield)) - (setq yearfield (substring yearfield 0 4))) - (substring yearfield (max 0 (- (length yearfield) - bibtex-autokey-year-length))))) + (let* ((str (bibtex-autokey-get-field '("date" "year"))) ; possibly "" + (year (or (and (iso8601-valid-p str) + (let ((year (decoded-time-year (iso8601-parse str)))) + (and year (number-to-string year)))) + ;; BibTeX permits a year field "(about 1984)", where only + ;; the last four nonpunctuation characters must be numerals. + (and (string-match "\\([0-9][0-9][0-9][0-9]\\)[^[:alnum:]]*\\'" str) + (match-string 1 str)) + (user-error "Year or date field `%s' invalid" str)))) + (substring year (max 0 (- (length year) bibtex-autokey-year-length))))) (defun bibtex-autokey-get-title () "Get title field contents up to a terminator. @@ -2849,12 +2855,12 @@ The name part: The year part: 1. Build the year part of the key by truncating the content of the year - field to the rightmost `bibtex-autokey-year-length' digits (useful - values are 2 and 4). - 2. If the year field (or any other field required to generate the key) - is absent, but the entry has a valid crossref field and - `bibtex-autokey-use-crossref' is non-nil, use the field of the - crossreferenced entry instead. + component of the date or year field to the rightmost + `bibtex-autokey-year-length' digits (useful values are 2 and 4). + 2. If both the year and date fields are absent, but the entry has a + valid crossref field and `bibtex-autokey-use-crossref' is + non-nil, use the date or year field of the crossreferenced entry + instead. The title part 1. Change the content of the title field according to commit 49a4f06b0675a4a27db1ce5380c02b5043e2d322 Author: Lars Ingebrigtsen Date: Fri Dec 11 15:21:44 2020 +0100 Fix object-interval tests * test/src/fns-tests.el (object-intervals): Fix tests. diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index 14c0437d5f..eaa569e0d9 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -986,10 +986,10 @@ (ert-deftest object-intervals () (should (equal (object-intervals (propertize "foo" 'bar 'zot)) - ((0 3 (bar zot))))) + '((0 3 (bar zot))))) (should (equal (object-intervals (concat (propertize "foo" 'bar 'zot) (propertize "foo" 'gazonk "gazonk"))) - ((0 3 (bar zot)) (3 6 (gazonk "gazonk"))))) + '((0 3 (bar zot)) (3 6 (gazonk "gazonk"))))) (should (equal (with-temp-buffer (insert "foobar") @@ -997,5 +997,5 @@ (put-text-property 3 6 'bar 2) (put-text-property 2 5 'zot 3) (object-intervals (current-buffer))) - ((0 1 (foo 1)) (1 2 (zot 3 foo 1)) (2 4 (zot 3 bar 2)) - (4 5 (bar 2)) (5 6 nil))))) + '((0 1 (foo 1)) (1 2 (zot 3 foo 1)) (2 4 (zot 3 bar 2)) + (4 5 (bar 2)) (5 6 nil))))) commit 72bcc6f988350329f3c0eb2f86af17f3ed97cf40 Author: Lars Ingebrigtsen Date: Fri Dec 11 15:16:05 2020 +0100 Fix parsing error in exif * lisp/image/exif.el (exif--parse-exif-chunk): The offset is a four-byte number. Reported by Alan Light . diff --git a/lisp/image/exif.el b/lisp/image/exif.el index 6aeb52c726..e328fcce5a 100644 --- a/lisp/image/exif.el +++ b/lisp/image/exif.el @@ -165,7 +165,7 @@ If the orientation isn't present in the data, return nil." ;; Another magical number. (unless (= (exif--read-number 2 le) #x002a) (signal 'exif-error "Invalid TIFF header length")) - (let ((offset (exif--read-number 2 le))) + (let ((offset (exif--read-number 4 le))) ;; Jump to where the IFD (directory) starts and parse it. (when (> (1+ offset) (point-max)) (signal 'exif-error "Invalid IFD (directory) offset")) commit 004d7e97e2c54c1089a776055ffd173d132fe5ae Author: Lars Ingebrigtsen Date: Fri Dec 11 14:49:53 2020 +0100 Add a new command `memory-report' * doc/lispref/internals.texi (Garbage Collection): Document it. * lisp/emacs-lisp/memory-report.el: New package. diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index bb25983aa4..fb24544c91 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -615,6 +615,19 @@ during garbage collection so far in this Emacs session, as a floating-point number. @end defvar +@defun memory-report +It can sometimes be useful to see where Emacs is using memory (in +various variables, buffers, and caches). This command will open a new +buffer (called @samp{"*Memory Report*"}) that will give an overview, +in addition to listing the ``largest'' buffers and variables. + +All the data here is approximate, because there's really no consistent +way to compute the size of a variable. For instance, two variables +may share parts of a data structure, and this will be counted twice, +but this command may still give a useful high-level overview of which +parts of Emacs is using memory. +@end defun + @node Stack-allocated Objects @section Stack-allocated Objects diff --git a/etc/NEWS b/etc/NEWS index 1640e27798..33cc2c30a0 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -275,6 +275,11 @@ preserving markers, properties and overlays. The new variable number of seconds that 'revert-buffer-with-fine-grain' should spend trying to be non-destructive. ++++ +** New command 'memory-report'. +This command opens a new buffer called "*Memory Report*" and gives a +summary of where Emacs is using memory currently. + ** Outline +++ diff --git a/lisp/emacs-lisp/memory-report.el b/lisp/emacs-lisp/memory-report.el new file mode 100644 index 0000000000..58555fa9f0 --- /dev/null +++ b/lisp/emacs-lisp/memory-report.el @@ -0,0 +1,299 @@ +;;; memory-report.el --- Short function summaries -*- lexical-binding: t -*- + +;; Copyright (C) 2020 Free Software Foundation, Inc. + +;; Keywords: lisp, help + +;; This file is part of GNU Emacs. + +;; GNU Emacs 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. + +;; GNU Emacs 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 GNU Emacs. If not, see . + +;;; Commentary: + +;; Todo (possibly): Font cache, regexp cache, bidi cache, various +;; buffer caches (newline cache, free_region_cache, etc), composition +;; cache, face cache. + +;;; Code: + +(require 'seq) +(require 'subr-x) +(eval-when-compile (require 'cl-lib)) + +(defvar memory-report--type-size (make-hash-table)) + +;;;###autoload +(defun memory-report () + "Generate a report of how Emacs is using memory. + +This report is approximate, and will commonly over-count memory +usage by variables, because shared data structures will usually +by counted more than once." + (interactive) + (pop-to-buffer "*Memory Report*") + (special-mode) + (button-mode 1) + (setq truncate-lines t) + (message "Gathering data...") + (let ((reports (append (memory-report--garbage-collect) + (memory-report--image-cache) + (memory-report--buffers) + (memory-report--largest-variables))) + (inhibit-read-only t) + summaries details) + (message "Gathering data...done") + (erase-buffer) + (insert (propertize "Estimated Emacs Memory Usage\n\n" 'face 'bold)) + (dolist (report reports) + (if (listp report) + (push report summaries) + (push report details))) + (dolist (summary (nreverse summaries)) + (insert (format "%s %s\n" + (memory-report--format (cdr summary)) + (car summary)))) + (insert "\n") + (dolist (detail (nreverse details)) + (insert detail "\n"))) + (goto-char (point-min))) + +(defun memory-report-object-size (object) + "Return the size of OBJECT in bytes." + (unless memory-report--type-size + (memory-report--garbage-collect)) + (memory-report--object-size (make-hash-table :test #'eq) object)) + +(defun memory-report--size (type) + (or (gethash type memory-report--type-size) + (gethash 'object memory-report--type-size))) + +(defun memory-report--set-size (elems) + (setf (gethash 'string memory-report--type-size) + (cadr (assq 'strings elems))) + (setf (gethash 'cons memory-report--type-size) + (cadr (assq 'conses elems))) + (setf (gethash 'symbol memory-report--type-size) + (cadr (assq 'symbols elems))) + (setf (gethash 'object memory-report--type-size) + (cadr (assq 'vectors elems))) + (setf (gethash 'float memory-report--type-size) + (cadr (assq 'floats elems))) + (setf (gethash 'buffer memory-report--type-size) + (cadr (assq 'buffers elems)))) + +(defun memory-report--garbage-collect () + (let ((elems (garbage-collect))) + (memory-report--set-size elems) + (let ((data (list + (list 'strings + (+ (memory-report--gc-elem elems 'strings) + (memory-report--gc-elem elems 'string-bytes))) + (list 'vectors + (+ (memory-report--gc-elem elems 'vectors) + (memory-report--gc-elem elems 'vector-slots))) + (list 'floats (memory-report--gc-elem elems 'floats)) + (list 'conses (memory-report--gc-elem elems 'conses)) + (list 'symbols (memory-report--gc-elem elems 'symbols)) + (list 'intervals (memory-report--gc-elem elems 'intervals)) + (list 'buffer-objects + (memory-report--gc-elem elems 'buffers))))) + (list (cons "Overall Object Memory Usage" + (seq-reduce #'+ (mapcar (lambda (elem) + (* (nth 1 elem) (nth 2 elem))) + elems) + 0)) + (cons "Reserved (But Unused) Object Memory" + (seq-reduce #'+ (mapcar (lambda (elem) + (if (nth 3 elem) + (* (nth 1 elem) (nth 3 elem)) + 0)) + elems) + 0)) + (with-temp-buffer + (insert (propertize "Object Storage\n\n" 'face 'bold)) + (dolist (object (seq-sort (lambda (e1 e2) + (> (cadr e1) (cadr e2))) + data)) + (insert (format "%s %s\n" + (memory-report--format (cadr object)) + (capitalize (symbol-name (car object)))))) + (buffer-string)))))) + +(defun memory-report--largest-variables () + (let ((variables nil)) + (mapatoms + (lambda (symbol) + (when (boundp symbol) + (let ((size (memory-report--object-size + (make-hash-table :test #'eq) + (symbol-value symbol)))) + (when (> size 1000) + (push (cons symbol size) variables))))) + obarray) + (list + (cons (propertize "Memory Used By Global Variables" + 'help-echo "Upper bound; mutually overlapping data from different variables are counted several times") + (seq-reduce #'+ (mapcar #'cdr variables) 0)) + (with-temp-buffer + (insert (propertize "Largest Variables\n\n" 'face 'bold)) + (cl-loop for i from 1 upto 20 + for (symbol . size) in (seq-sort (lambda (e1 e2) + (> (cdr e1) (cdr e2))) + variables) + do (insert (memory-report--format size) + " " + (symbol-name symbol) + "\n")) + (buffer-string))))) + +(defun memory-report--object-size (counted value) + (if (gethash value counted) + 0 + (setf (gethash value counted) t) + (memory-report--object-size-1 counted value))) + +(cl-defgeneric memory-report--object-size-1 (_counted _value) + 0) + +(cl-defmethod memory-report--object-size-1 (_ (value symbol)) + ;; Don't count global symbols -- makes sizes of lists of symbols too + ;; heavey. + (if (intern-soft value obarray) + 0 + (memory-report--size 'symbol))) + +(cl-defmethod memory-report--object-size-1 (_ (_value buffer)) + (memory-report--size 'buffer)) + +(cl-defmethod memory-report--object-size-1 (counted (value string)) + (+ (memory-report--size 'string) + (string-bytes value) + (memory-report--interval-size counted (object-intervals value)))) + +(defun memory-report--interval-size (counted intervals) + ;; We get a list back of intervals, but only count the "inner list" + ;; (i.e., the actual text properties), and add the size of the + ;; intervals themselves. + (+ (* (memory-report--size 'interval) (length intervals)) + (seq-reduce #'+ (mapcar + (lambda (interval) + (memory-report--object-size counted (nth 2 interval))) + intervals) + 0))) + +(cl-defmethod memory-report--object-size-1 (counted (value list)) + (let ((total 0) + (size (memory-report--size 'cons))) + (while value + (cl-incf total size) + (setf (gethash value counted) t) + (when (car value) + (cl-incf total (memory-report--object-size counted (car value)))) + (if (cdr value) + (if (consp (cdr value)) + (setq value (cdr value)) + (cl-incf total (memory-report--object-size counted (cdr value))) + (setq value nil)) + (setq value nil))) + total)) + +(cl-defmethod memory-report--object-size-1 (counted (value vector)) + (let ((total (+ (memory-report--size 'vector) + (* (memory-report--size 'object) (length value))))) + (cl-loop for elem across value + do (setf (gethash elem counted) t) + (cl-incf total (memory-report--object-size counted elem))) + total)) + +(cl-defmethod memory-report--object-size-1 (counted (value hash-table)) + (let ((total (+ (memory-report--size 'vector) + (* (memory-report--size 'object) (hash-table-size value))))) + (maphash + (lambda (key elem) + (setf (gethash key counted) t) + (setf (gethash elem counted) t) + (cl-incf total (memory-report--object-size counted key)) + (cl-incf total (memory-report--object-size counted elem))) + value) + total)) + +(defun memory-report--format (bytes) + (setq bytes (/ bytes 1024.0)) + (let ((units '("kB" "MB" "GB" "TB"))) + (while (>= bytes 1024) + (setq bytes (/ bytes 1024.0)) + (setq units (cdr units))) + (format "%5.1f%s" bytes (car units)))) + +(defun memory-report--gc-elem (elems type) + (* (nth 1 (assq type elems)) + (nth 2 (assq type elems)))) + +(defun memory-report--buffers () + (let ((buffers (mapcar (lambda (buffer) + (cons buffer (memory-report--buffer buffer))) + (buffer-list)))) + (list (cons "Total Buffer Memory Usage" + (seq-reduce #'+ (mapcar #'cdr buffers) 0)) + (with-temp-buffer + (insert (propertize "Largest Buffers\n\n" 'face 'bold)) + (cl-loop for i from 1 upto 20 + for (buffer . size) in (seq-sort (lambda (e1 e2) + (> (cdr e1) (cdr e2))) + buffers) + do (insert (memory-report--format size) + " " + (button-buttonize + (buffer-name buffer) + #'memory-report--buffer-details buffer) + "\n")) + (buffer-string))))) + +(defun memory-report--buffer-details (buffer) + (with-current-buffer buffer + (apply + #'message + "Buffer text: %s; variables: %s; text properties: %s; overlays: %s" + (mapcar #'string-trim (mapcar #'memory-report--format + (memory-report--buffer-data buffer)))))) + +(defun memory-report--buffer (buffer) + (seq-reduce #'+ (memory-report--buffer-data buffer) 0)) + +(defun memory-report--buffer-data (buffer) + (with-current-buffer buffer + (list (save-restriction + (widen) + (+ (position-bytes (point-max)) + (- (position-bytes (point-min))) + (gap-size))) + (seq-reduce #'+ (mapcar (lambda (elem) + (if (cdr elem) + (memory-report--object-size + (make-hash-table :test #'eq) + (cdr elem)) + 0)) + (buffer-local-variables buffer)) + 0) + (memory-report--object-size (make-hash-table :test #'eq) + (object-intervals buffer)) + (memory-report--object-size (make-hash-table :test #'eq) + (overlay-lists))))) + +(defun memory-report--image-cache () + (list (cons "Total Image Cache Size" (image-cache-size)))) + +(provide 'memory-report) + +;;; memory-report.el ends here diff --git a/test/lisp/emacs-lisp/memory-report-tests.el b/test/lisp/emacs-lisp/memory-report-tests.el new file mode 100644 index 0000000000..01bcf18423 --- /dev/null +++ b/test/lisp/emacs-lisp/memory-report-tests.el @@ -0,0 +1,54 @@ +;;; memory-report-tests.el --- tests for memory-report.el -*- lexical-binding: t -*- + +;; Copyright (C) 2016-2020 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs 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. + +;; GNU Emacs 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 GNU Emacs. If not, see . + +(require 'ert) +(require 'memory-report) + +(defun setup-memory-report-tests () + (memory-report--set-size + '((conses 16 499173 99889) + (symbols 48 22244 3) + (strings 32 92719 4559) + (string-bytes 1 40402011) + (vectors 16 31919) + (vector-slots 8 385148 149240) + (floats 8 434 4519) + (intervals 56 24499 997) + (buffers 984 33)))) + +(ert-deftest memory-report-sizes () + (setup-memory-report-tests) + (should (equal (memory-report-object-size (cons nil nil)) 16)) + (should (equal (memory-report-object-size (cons 1 2)) 16)) + + (should (equal (memory-report-object-size (list 1 2)) 32)) + (should (equal (memory-report-object-size (list 1)) 16)) + + (should (equal (memory-report-object-size (list 'foo)) 16)) + + (should (equal (memory-report-object-size (vector 1 2 3 4)) 80)) + + (should (equal (memory-report-object-size "") 32)) + (should (equal (memory-report-object-size "a") 33)) + (should (equal (memory-report-object-size (propertize "a" 'face 'foo)) + 81))) + +(provide 'memory-report-tests) + +;;; memory-report-tests.el ends here commit aa7e5ce651b1872180e8da94ac80fbc25e33eec0 Author: Lars Ingebrigtsen Date: Fri Dec 11 14:40:20 2020 +0100 Add new function `object-intervals' * doc/lispref/text.texi (Examining Properties): Document it. * src/fns.c (Fobject_intervals): New defun. (collect_interval): New function. diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index c6ca4eed2e..b712768a21 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -2931,6 +2931,22 @@ used instead. Here is an example: @end example @end defvar +@defun object-intervals OBJECT +This function returns a copy of the intervals (i.e., text properties) +in @var{object} as a list of intervals. @var{object} must be a string +or a buffer. Altering the structure of this list does not change the +intervals in the object. + +@example +(object-intervals (propertize "foo" 'face 'bold)) + @result{} ((0 3 (face bold))) +@end example + +Each element in the returned list represents one interval. Each +interval has three parts: The first is the start, the second is the +end, and the third part is the text property itself. +@end defun + @node Changing Properties @subsection Changing Text Properties @cindex changing text properties diff --git a/etc/NEWS b/etc/NEWS index befcf08cec..1640e27798 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1389,6 +1389,12 @@ that makes it a valid button. ** Miscellaneous ++++ +*** New function 'object-intervals'. +This function returns a copy of the list of intervals (i.e., text +properties) in the object in question (which must either be a string +or a buffer). + --- *** 'hexl-mode' scrolling commands now heed 'next-screen-context-lines'. Previously, 'hexl-scroll-down' and 'hexl-scroll-up' would scroll diff --git a/src/fns.c b/src/fns.c index e9b6a96f34..a0c4a1fbf1 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5573,6 +5573,40 @@ Case is always significant and text properties are ignored. */) return make_int (string_byte_to_char (haystack, res - SSDATA (haystack))); } + +static void +collect_interval (INTERVAL interval, Lisp_Object collector) +{ + nconc2 (collector, + list1(list3 (make_fixnum (interval->position), + make_fixnum (interval->position + LENGTH (interval)), + interval->plist))); +} + +DEFUN ("object-intervals", Fobject_intervals, Sobject_intervals, 1, 1, 0, + doc: /* Return a copy of the text properties of OBJECT. +OBJECT must be a buffer or a string. + +Altering this copy does not change the layout of the text properties +in OBJECT. */) + (register Lisp_Object object) +{ + Lisp_Object collector = Fcons (Qnil, Qnil); + INTERVAL intervals; + + if (STRINGP (object)) + intervals = string_intervals (object); + else if (BUFFERP (object)) + intervals = buffer_intervals (XBUFFER (object)); + else + wrong_type_argument (Qbuffer_or_string_p, object); + + if (! intervals) + return Qnil; + + traverse_intervals (intervals, 0, collect_interval, collector); + return CDR (collector); +} void @@ -5614,6 +5648,7 @@ syms_of_fns (void) defsubr (&Smaphash); defsubr (&Sdefine_hash_table_test); defsubr (&Sstring_search); + defsubr (&Sobject_intervals); /* Crypto and hashing stuff. */ DEFSYM (Qiv_auto, "iv-auto"); diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index 86b8d655d2..14c0437d5f 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -983,3 +983,19 @@ (should (equal (string-search (string-to-multibyte "o\303\270") "foo\303\270") 2)) (should (equal (string-search "\303\270" "foo\303\270") 3))) + +(ert-deftest object-intervals () + (should (equal (object-intervals (propertize "foo" 'bar 'zot)) + ((0 3 (bar zot))))) + (should (equal (object-intervals (concat (propertize "foo" 'bar 'zot) + (propertize "foo" 'gazonk "gazonk"))) + ((0 3 (bar zot)) (3 6 (gazonk "gazonk"))))) + (should (equal + (with-temp-buffer + (insert "foobar") + (put-text-property 1 3 'foo 1) + (put-text-property 3 6 'bar 2) + (put-text-property 2 5 'zot 3) + (object-intervals (current-buffer))) + ((0 1 (foo 1)) (1 2 (zot 3 foo 1)) (2 4 (zot 3 bar 2)) + (4 5 (bar 2)) (5 6 nil))))) commit 9d598ef93cbebe59f1d3a91f4fda35d3e00f36a9 Author: Lars Ingebrigtsen Date: Fri Dec 11 14:30:44 2020 +0100 Add new function 'image-cache-size' * src/image.c (Fimage_cache_size): New defun. (image_frame_cache_size): New function. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 590b54668f..b9b05a2a42 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -6577,6 +6577,12 @@ except when you explicitly clear it. This mode can be useful for debugging. @end defvar +@defun image-cache-size +This function returns the total size of the current image cache, in +bytes. An image of size 200x100 with 24 bits per color will have a +cache size of 60000 bytes, for instance. +@end defun + @node Xwidgets @section Embedded Native Widgets @cindex xwidget diff --git a/etc/NEWS b/etc/NEWS index f2772843e7..befcf08cec 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1089,6 +1089,10 @@ If 'shr-width' is non-nil, it overrides this variable. ** Images ++++ +*** New function 'image-cache-size'. +This function returns the size of the current image cache, in bytes. + --- *** Animated images stop automatically under high CPU pressure sooner. Previously, an animated image would stop animating if any single image diff --git a/src/image.c b/src/image.c index 522a4cf7c0..38887ced25 100644 --- a/src/image.c +++ b/src/image.c @@ -1792,6 +1792,40 @@ which is then usually a filename. */) return Qnil; } +static int +image_frame_cache_size (struct frame *f) +{ + struct image_cache *c = FRAME_IMAGE_CACHE (f); + int total = 0; + + if (!c) + return 0; + + for (ptrdiff_t i = 0; i < c->used; ++i) + { + struct image *img = c->images[i]; + + if (img) + total += img->pixmap->width * img->pixmap->height * + img->pixmap->bits_per_pixel / 8; + } + return total; +} + +DEFUN ("image-cache-size", Fimage_cache_size, Simage_cache_size, 0, 0, 0, + doc: /* Return the size of the image cache. */) + (void) +{ + Lisp_Object tail, frame; + int total = 0; + + FOR_EACH_FRAME (tail, frame) + if (FRAME_WINDOW_P (XFRAME (frame))) + total += image_frame_cache_size (XFRAME (frame)); + + return make_int (total); +} + DEFUN ("image-flush", Fimage_flush, Simage_flush, 1, 2, 0, @@ -10703,6 +10737,7 @@ non-numeric, there is no explicit limit on the size of images. */); defsubr (&Simage_size); defsubr (&Simage_mask_p); defsubr (&Simage_metadata); + defsubr (&Simage_cache_size); #ifdef GLYPH_DEBUG defsubr (&Simagep); commit 14ffab8263eb219fe0c49ad4e0a3476316c542c0 Author: Lars Ingebrigtsen Date: Fri Dec 11 14:25:20 2020 +0100 Add a new function `button-buttonize' * doc/lispref/display.texi (Manipulating Buttons): Document it. * lisp/button.el (button-buttonize): Implement it. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index ed26ae8808..590b54668f 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -6881,6 +6881,16 @@ This inserts a button with the label @var{label} at point, using text properties. @end defun +@defun button-buttonize string callback &optional data +Sometimes it's more convenient to make a string into a button without +inserting it into a buffer immediately, for instance when creating +data structures that may then, later, be inserted into a buffer. This +function makes @var{string} into such a string, and @var{callback} +will be called when the user clicks on the button. The optional +@var{data} parameter will be used as the parameter when @var{callback} +is called. If @code{nil}, the button is used as the parameter instead. +@end defun + @node Manipulating Buttons @subsection Manipulating Buttons @cindex manipulating buttons diff --git a/etc/NEWS b/etc/NEWS index 83fe7a349e..f2772843e7 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1368,6 +1368,21 @@ This face is used for error messages from 'diff'. *** New command 'diff-refresh-hunk'. This new command (bound to 'C-c C-l') regenerates the current hunk. +** Buttons + ++++ +*** New minor mode 'button-mode'. +This minor mode does nothing else than install 'button-buffer-map' as +a minor mode map (which binds the 'TAB' / 'S-TAB' key bindings to navigate +to buttons), and can be used in any view-mode-like buffer that has +buttons in it. + ++++ +*** New utility function 'button-buttonize'. +This function takes a string and returns a string propertized in a way +that makes it a valid button. + + ** Miscellaneous --- @@ -1480,13 +1495,6 @@ both modes are on). This works like 'report-emacs-bug', but is more geared towards sending patches to the Emacs issue tracker. -+++ -*** New minor mode 'button-mode'. -This minor mode does nothing else than install 'button-buffer-map' as -a minor mode map (which binds the 'TAB' / 'S-TAB' key bindings to navigate -to buttons), and can be used in any view-mode-like buffer that has -buttons in it. - --- *** 'icomplete-show-matches-on-no-input' behavior change. Previously, choosing a different completion with commands like 'C-.' diff --git a/lisp/button.el b/lisp/button.el index ba0682348d..8dbb763281 100644 --- a/lisp/button.el +++ b/lisp/button.el @@ -613,6 +613,18 @@ button at point is the button to describe." (button--describe props) t))) +(defun button-buttonize (string callback &optional data) + "Make STRING into a button and return it. +When clicked, CALLBACK will be called with the optional DATA parameter." + (propertize string + 'face 'button + 'button t + 'follow-link t + 'category t + 'button-data data + 'keymap button-map + 'action callback)) + (provide 'button) ;;; button.el ends here commit df769c2effabb62afcf9fdf02185b1dc2638818c Author: Michael Albinus Date: Fri Dec 11 11:31:10 2020 +0100 * lisp/battery.el (battery--upower-devices): Protect the D-Bus call. (Bug#45163) diff --git a/lisp/battery.el b/lisp/battery.el index e568ab5246..f59ad12479 100644 --- a/lisp/battery.el +++ b/lisp/battery.el @@ -661,10 +661,12 @@ Intended as a UPower PropertiesChanged signal handler." (cond ((stringp battery-upower-device) (list battery-upower-device)) (battery-upower-device) - ((dbus-call-method :system battery-upower-service - battery-upower-path - battery-upower-interface - "EnumerateDevices")))) + ((dbus-ignore-errors + (dbus-call-method :system battery-upower-service + battery-upower-path + battery-upower-interface + "EnumerateDevices" + :timeout 1000))))) (defun battery--upower-state (props state) "Merge the UPower battery state in PROPS with STATE.