[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/memrep 65a3b20: Continue implementation
From: |
Lars Ingebrigtsen |
Subject: |
scratch/memrep 65a3b20: Continue implementation |
Date: |
Thu, 10 Dec 2020 05:27:41 -0500 (EST) |
branch: scratch/memrep
commit 65a3b2002693c0cdb64b56e8f94b63ce08d66efb
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>
Continue implementation
---
lisp/emacs-lisp/memory-report.el | 18 ++++++++++--------
src/fns.c | 32 ++++++++++++++++++++++++++++++++
2 files changed, 42 insertions(+), 8 deletions(-)
diff --git a/lisp/emacs-lisp/memory-report.el b/lisp/emacs-lisp/memory-report.el
index 498c677..4c69c53 100644
--- a/lisp/emacs-lisp/memory-report.el
+++ b/lisp/emacs-lisp/memory-report.el
@@ -23,6 +23,8 @@
;;; Code:
+(require 'seq)
+
;;;###autoload
(defun memory-report ()
"Generate a report of how Emacs is using memory."
@@ -127,14 +129,13 @@
(setf (gethash value counted) t)
(memory-report--variable-size-1 counted value)))
-(cl-defgeneric memory-report--variable-size-1 (counted value)
+(cl-defgeneric memory-report--variable-size-1 (_counted _value)
(memory-report--size 'object))
(cl-defmethod memory-report--variable-size-1 (counted (value string))
(+ (memory-report--size 'string)
(string-bytes value)
- ;; string text properties? how
- ))
+ (memory-report--variable-size counted (object-intervals value))))
(cl-defmethod memory-report--variable-size-1 (counted (value list))
(let ((total 0)
@@ -172,7 +173,7 @@
value)
total))
-(cl-defmethod memory-report--variable-size-1 (counted (value float))
+(cl-defmethod memory-report--variable-size-1 (_ (_value float))
(memory-report--size 'float))
(defun memory-report--format (bytes)
@@ -189,7 +190,7 @@
(defun memory-report--buffers ()
(let ((buffers (mapcar (lambda (buffer)
- (cons buffer (memory-usage--buffer buffer)))
+ (cons buffer (memory-report--buffer buffer)))
(buffer-list))))
(insert "Total Memory Usage In Buffers: "
(memory-report--format (seq-reduce #'+ (mapcar #'cdr buffers) 0))
@@ -220,9 +221,10 @@
0))
(buffer-local-variables buffer))
0)
- ;; Text properties
- ;; Overlays
- )))
+ (memory-report--variable-size (make-hash-table :test #'eq)
+ (object-intervals buffer))
+ (memory-report--variable-size (make-hash-table :test #'eq)
+ (overlay-lists)))))
(provide 'memory-report)
diff --git a/src/fns.c b/src/fns.c
index e9b6a96..b6f7101 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -5573,6 +5573,37 @@ 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 should be a buffer or a string. */)
+ (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 +5645,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");
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- scratch/memrep 65a3b20: Continue implementation,
Lars Ingebrigtsen <=