scratch/memrep 65a3b20: Continue implementation

[Lars Ingebrigtsen]

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");