Mercurial > hg > xemacs-beta
view lisp/easymenu.el @ 5157:1fae11d56ad2
redo memory-usage mechanism, add way of dynamically initializing Lisp objects
-------------------- ChangeLog entries follow: --------------------
lisp/ChangeLog addition:
2010-03-18 Ben Wing <ben@xemacs.org>
* diagnose.el (show-memory-usage):
Rewrite to take into account API changes in memory-usage functions.
src/ChangeLog addition:
2010-03-18 Ben Wing <ben@xemacs.org>
* alloc.c:
* alloc.c (disksave_object_finalization_1):
* alloc.c (lisp_object_storage_size):
* alloc.c (listu):
* alloc.c (listn):
* alloc.c (Fobject_memory_usage_stats):
* alloc.c (compute_memusage_stats_length):
* alloc.c (Fobject_memory_usage):
* alloc.c (Ftotal_object_memory_usage):
* alloc.c (malloced_storage_size):
* alloc.c (common_init_alloc_early):
* alloc.c (reinit_alloc_objects_early):
* alloc.c (reinit_alloc_early):
* alloc.c (init_alloc_once_early):
* alloc.c (syms_of_alloc):
* alloc.c (reinit_vars_of_alloc):
* buffer.c:
* buffer.c (struct buffer_stats):
* buffer.c (compute_buffer_text_usage):
* buffer.c (compute_buffer_usage):
* buffer.c (buffer_memory_usage):
* buffer.c (buffer_objects_create):
* buffer.c (syms_of_buffer):
* buffer.c (vars_of_buffer):
* console-impl.h (struct console_methods):
* dynarr.c (Dynarr_memory_usage):
* emacs.c (main_1):
* events.c (clear_event_resource):
* extents.c:
* extents.c (compute_buffer_extent_usage):
* extents.c (extent_objects_create):
* extents.h:
* faces.c:
* faces.c (compute_face_cachel_usage):
* faces.c (face_objects_create):
* faces.h:
* general-slots.h:
* glyphs.c:
* glyphs.c (compute_glyph_cachel_usage):
* glyphs.c (glyph_objects_create):
* glyphs.h:
* lisp.h:
* lisp.h (struct usage_stats):
* lrecord.h:
* lrecord.h (enum lrecord_type):
* lrecord.h (struct lrecord_implementation):
* lrecord.h (MC_ALLOC_CALL_FINALIZER_FOR_DISKSAVE):
* lrecord.h (DEFINE_DUMPABLE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_FROB_BLOCK_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_SIZABLE_INTERNAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_FROB_BLOCK_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_INTERNAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_SIZABLE_INTERNAL_LISP_OBJECT):
* lrecord.h (MAKE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_MODULE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_MODULE_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_MODULE_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_MODULE_SIZABLE_LISP_OBJECT):
* lrecord.h (MAKE_MODULE_LISP_OBJECT):
* lrecord.h (INIT_LISP_OBJECT):
* lrecord.h (INIT_MODULE_LISP_OBJECT):
* lrecord.h (UNDEF_LISP_OBJECT):
* lrecord.h (UNDEF_MODULE_LISP_OBJECT):
* lrecord.h (DECLARE_LISP_OBJECT):
* lrecord.h (DECLARE_MODULE_API_LISP_OBJECT):
* lrecord.h (DECLARE_MODULE_LISP_OBJECT):
* lstream.c:
* lstream.c (syms_of_lstream):
* lstream.c (vars_of_lstream):
* marker.c:
* marker.c (compute_buffer_marker_usage):
* mc-alloc.c (mc_alloced_storage_size):
* mc-alloc.h:
* mule-charset.c:
* mule-charset.c (struct charset_stats):
* mule-charset.c (compute_charset_usage):
* mule-charset.c (charset_memory_usage):
* mule-charset.c (mule_charset_objects_create):
* mule-charset.c (syms_of_mule_charset):
* mule-charset.c (vars_of_mule_charset):
* redisplay.c:
* redisplay.c (compute_rune_dynarr_usage):
* redisplay.c (compute_display_block_dynarr_usage):
* redisplay.c (compute_glyph_block_dynarr_usage):
* redisplay.c (compute_display_line_dynarr_usage):
* redisplay.c (compute_line_start_cache_dynarr_usage):
* redisplay.h:
* scrollbar-gtk.c (gtk_compute_scrollbar_instance_usage):
* scrollbar-msw.c (mswindows_compute_scrollbar_instance_usage):
* scrollbar-x.c (x_compute_scrollbar_instance_usage):
* scrollbar.c (compute_scrollbar_instance_usage):
* scrollbar.h:
* symbols.c:
* symbols.c (reinit_symbol_objects_early):
* symbols.c (init_symbols_once_early):
* symbols.c (reinit_symbols_early):
* symbols.c (defsymbol_massage_name_1):
* symsinit.h:
* ui-gtk.c:
* ui-gtk.c (emacs_gtk_object_getprop):
* ui-gtk.c (emacs_gtk_object_putprop):
* ui-gtk.c (ui_gtk_objects_create):
* unicode.c (compute_from_unicode_table_size_1):
* unicode.c (compute_to_unicode_table_size_1):
* unicode.c (compute_from_unicode_table_size):
* unicode.c (compute_to_unicode_table_size):
* window.c:
* window.c (struct window_stats):
* window.c (compute_window_mirror_usage):
* window.c (compute_window_usage):
* window.c (window_memory_usage):
* window.c (window_objects_create):
* window.c (syms_of_window):
* window.c (vars_of_window):
* window.h:
Redo memory-usage mechanism, make it general; add way of dynamically
initializing Lisp object types -- OBJECT_HAS_METHOD(), similar to
CONSOLE_HAS_METHOD().
(1) Create OBJECT_HAS_METHOD(), OBJECT_HAS_PROPERTY() etc. for
specifying that a Lisp object type has a particular method or
property. Call such methods with OBJECT_METH, MAYBE_OBJECT_METH,
OBJECT_METH_OR_GIVEN; retrieve properties with OBJECT_PROPERTY.
Methods that formerly required a DEFINE_*GENERAL_LISP_OBJECT() to
specify them (getprop, putprop, remprop, plist, disksave) now
instead use the dynamic-method mechanism. The main benefit of
this is that new methods or properties can be added without
requiring that the declaration statements of all existing methods
be modified. We have to make the `struct lrecord_implementation'
non-const, but I don't think this should have any effect on speed --
the only possible method that's really speed-critical is the
mark method, and we already extract those out into a separate
(non-const) array for increased cache locality.
Object methods need to be reinitialized after pdump, so we put
them in separate functions such as face_objects_create(),
extent_objects_create() and call them appropriately from emacs.c
The only current object property (`memusage_stats_list') that
objects can specify is a Lisp object and gets staticpro()ed so it
only needs to be set during dump time, but because it references
symbols that might not exist in a syms_of_() function, we
initialize it in vars_of_(). There is also an object property
(`num_extra_memusage_stats') that is automatically initialized based
on `memusage_stats_list'; we do that in reinit_vars_of_alloc(),
which is called after all vars_of_() functions are called.
`disksaver' method was renamed `disksave' to correspond with the
name normally given to the function (e.g. disksave_lstream()).
(2) Generalize the memory-usage mechanism in `buffer-memory-usage',
`window-memory-usage', `charset-memory-usage' into an object-type-
specific mechanism called by a single function
`object-memory-usage'. (Former function `object-memory-usage'
renamed to `total-object-memory-usage'). Generalize the mechanism
of different "slices" so that we can have different "classes" of
memory described and different "slices" onto each class; `t'
separates classes, `nil' separates slices. Currently we have
three classes defined: the memory of an object itself,
non-Lisp-object memory associated with the object (e.g. arrays or
dynarrs stored as fields in the object), and Lisp-object memory
associated with the object (other internal Lisp objects stored in
the object). This isn't completely finished yet and we might need
to further separate the "other internal Lisp objects" class into
two classes.
The memory-usage mechanism uses a `struct usage_stats' (renamed
from `struct overhead_stats') to describe a malloc-view onto a set
of allocated memory (listing how much was requested and various
types of overhead) and a more general `struct generic_usage_stats'
(with a `struct usage_stats' in it) to hold all statistics about
object memory. `struct generic_usage_stats' contains an array of
32 Bytecounts, which are statistics of unspecified semantics. The
intention is that individual types declare a corresponding struct
(e.g. `struct window_stats') with the same structure but with
specific fields in place of the array, corresponding to specific
statistics. The number of such statistics is an object property
computed from the list of tags (Lisp symbols describing the
statistics) stored in `memusage_stats_list'. The idea here is to
allow particular object types to customize the number and
semantics of the statistics where completely avoiding consing.
This doesn't matter so much yet, but the intention is to have the
memory usage of all objects computed at the end of GC, at the same
time as other statistics are currently computed. The values for
all statistics for a single type would be added up to compute
aggregate values for all objects of a specific type. To make this
efficient, we can't allow any memory allocation at all.
(3) Create some additional functions for creating lists that
specify the elements directly as args rather than indirectly through
an array: listn() (number of args given), listu() (list terminated
by Qunbound).
(4) Delete a bit of remaining unused C window_config stuff, also
unused lrecord_type_popup_data.
author | Ben Wing <ben@xemacs.org> |
---|---|
date | Thu, 18 Mar 2010 10:50:06 -0500 |
parents | 012240027a21 |
children | cd167465bf69 308d34e9f07d |
line wrap: on
line source
;;; easymenu.el - Easy menu support for Emacs 19 and XEmacs. ;; Copyright (C) 1992, 1993, 1994, 1995, 2005 Free Software Foundation, Inc. ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Maintainer: XEmacs Development Team ;; Keywords: internal, extensions, dumped ;; This file is part of XEmacs. ;; XEmacs 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 2, or (at your option) ;; any later version. ;; XEmacs 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 XEmacs; if not, write to the Free Software ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA ;; 02111-1307, USA. ;;; Synched up with: Not synched with FSF but coordinated with the FSF ;;; easymenu maintainer for compatibility with FSF 20.4. ;;; Please: Coordinate changes with Inge Frick <inge@nada.kth.se> ;; Commentary: ;; This file is dumped with XEmacs. ;; Easymenu allows you to define menus for both Emacs 19 and XEmacs. ;; This file ;; The advantages of using easymenu are: ;; - Easier to use than either the Emacs 19 and XEmacs menu syntax. ;; - Common interface for Emacs 18, Emacs 19, and XEmacs. ;; (The code does nothing when run under Emacs 18). ;; The public functions are: ;; - Function: easy-menu-define SYMBOL MAPS DOC MENU ;; SYMBOL is both the name of the variable that holds the menu and ;; the name of a function that will present the menu. ;; MAPS is a list of keymaps where the menu should appear in the menubar. ;; DOC is the documentation string for the variable. ;; MENU is an XEmacs style menu description. ;; See the documentation for easy-menu-define for details. ;; - Function: easy-menu-change PATH NAME ITEMS ;; Change an existing menu. ;; The menu must already exist and be visible on the menu bar. ;; PATH is a list of strings used for locating the menu on the menu bar. ;; NAME is the name of the menu. ;; ITEMS is a list of menu items, as defined in `easy-menu-define'. ;; - Function: easy-menu-add MENU [ MAP ] ;; Add MENU to the current menubar in MAP. ;; - Function: easy-menu-remove MENU ;; Remove MENU from the current menubar. ;; - Function: easy-menu-add-item ;; Add item or submenu to existing menu ;; - Function: easy-menu-item-present-p ;; Locate item ;; - Function: easy-menu-remove-item ;; Delete item from menu. ;; Emacs 19 never uses `easy-menu-add' or `easy-menu-remove', menus ;; automatically appear and disappear when the keymaps specified by ;; the MAPS argument to `easy-menu-define' are activated. ;; XEmacs will bind the map to button3 in each MAPS, but you must ;; explicitly call `easy-menu-add' and `easy-menu-remove' to add and ;; remove menus from the menu bar. ;;; Code: ;; ;;;###autoload (defmacro easy-menu-define (symbol maps doc menu) "Define a menu bar submenu in maps MAPS, according to MENU. The arguments SYMBOL and DOC are ignored; they are present for compatibility only. SYMBOL is not evaluated. In other Emacs versions these arguments may be used as a variable to hold the menu data, and a doc string for that variable. The first element of MENU must be a string. It is the menu bar item name. The rest of the elements are menu items. A menu item is usually a vector of three elements: [NAME CALLBACK ENABLE] NAME is a string--the menu item name. CALLBACK is a command to run when the item is chosen, or a list to evaluate when the item is chosen. ENABLE is an expression; the item is enabled for selection whenever this expression's value is non-nil. Alternatively, a menu item may have the form: [ NAME CALLBACK [ KEYWORD ARG ] ... ] Where KEYWORD is one of the symbol defined below. :keys KEYS KEYS is a string; a complex keyboard equivalent to this menu item. :active ENABLE ENABLE is an expression; the item is enabled for selection whenever this expression's value is non-nil. :suffix NAME NAME is a string; the name of an argument to CALLBACK. :style STYLE STYLE is a symbol describing the type of menu item. The following are defined: toggle: A checkbox. Currently just prepend the name with the string \"Toggle \". radio: A radio button. nil: An ordinary menu item. :selected SELECTED SELECTED is an expression; the checkbox or radio button is selected whenever this expression's value is non-nil. Currently just disable radio buttons, no effect on checkboxes. A menu item can be a string. Then that string appears in the menu as unselectable text. A string consisting solely of hyphens is displayed as a solid horizontal line. A menu item can be a list. It is treated as a submenu. The first element should be the submenu name. That's used as the menu item in the top-level menu. The cdr of the submenu list is a list of menu items, as above." `(progn (defvar ,symbol nil ,doc) (easy-menu-do-define (quote ,symbol) ,maps ,doc ,menu))) (defun easy-menu-do-define (symbol maps doc menu) (when (featurep 'menubar) (set symbol menu) (fset symbol `(lambda (e) ,doc (interactive "@e") (run-hooks 'activate-menubar-hook) (setq zmacs-region-stays t) (popup-menu ,symbol))))) (defun easy-menu-change (&rest args) (when (featurep 'menubar) (apply 'add-menu args))) (defvar easy-menu-all-popups nil "This variable holds all the popup menus easy-menu knows about. This includes any menu created with `easy-menu-add' and any non-default value for `mode-popup-menu' that existed when `easy-menu-add' was first called.") (make-variable-buffer-local 'easy-menu-all-popups) (defun easy-menu-add (menu &optional map) "Add MENU to the current menu bar." ;; If you uncomment the following, do an xemacs -vanilla, type M-x ;; folding-mode RET, you'll see that this code, which theoretically has ;; *scratch* as its buffer context, can't see *scratch*'s value for ;; mode-popup-menu--the default overrides it. ;; ;; This is not specific to *scratch*--try it on ~/.xemacs/init.el--but it ;; does appear to be specific to the first time mode-popup-menu is ;; accessed as a buffer-local variable in non-interactive code (that is, ;; M-: mode-popup-menu RET gives the correct value). ;; ;; My fixing this right now isn't going to happen. Aidan Kehoe, 2006-01-03 ; (message (concat "inside easy-menu-add, menu is %s, " ; "mode-popup-menu is %s, current buffer is %s, " ; "default-value mode-popup-menu is %s, " ; "easy-menu-all-popups is %s") ; menu mode-popup-menu (current-buffer) ; (default-value 'mode-popup-menu) easy-menu-all-popups) (when (featurep 'menubar) ;; Save the existing mode-popup-menu, if it's been changed. (when (and (zerop (length easy-menu-all-popups)) (not (equal (default-value 'mode-popup-menu) mode-popup-menu))) (push mode-popup-menu easy-menu-all-popups)) ;; Add the menu to our list of all the popups for the buffer. (pushnew menu easy-menu-all-popups :test 'equal) ;; If there are multiple popup menus available, make the popup menu ;; normally shown with button-3 a menu of them. If there is just one, ;; make that button show it, and no super-menu. (setq mode-popup-menu (if (= 1 (length easy-menu-all-popups)) (car easy-menu-all-popups) (cons (easy-menu-title) (reverse easy-menu-all-popups)))) (cond ((null current-menubar) ;; Don't add it to a non-existing menubar. nil) ((assoc (car menu) current-menubar) ;; Already present. nil) ((equal current-menubar '(nil)) ;; Set at left if only contains right marker. (set-buffer-menubar (list menu nil))) (t ;; Add at right. (set-buffer-menubar (copy-sequence current-menubar)) (add-menu nil (car menu) (cdr menu)))))) (defun easy-menu-remove (menu) "Remove MENU from the current menu bar." (when (featurep 'menubar) (setq ;; Remove this menu from the list of popups we know about. easy-menu-all-popups (delq menu easy-menu-all-popups) ;; If there are multiple popup menus available, make the popup menu ;; normally shown with button-3 a menu of them. If there is just one, ;; make that button show it, and no super-menu. mode-popup-menu (if (= 1 (length easy-menu-all-popups)) (car easy-menu-all-popups) (cons (easy-menu-title) (reverse easy-menu-all-popups)))) ;; If we've just set mode-popup-menu to an empty menu, change that menu ;; to its default value (without intervention from easy-menu). (if (zerop (length easy-menu-all-popups)) (setq mode-popup-menu (default-value 'mode-popup-menu))) (and current-menubar (assoc (car menu) current-menubar) (delete-menu-item (list (car menu)))))) (defsubst easy-menu-normalize (menu) (if (symbolp menu) (symbol-value menu) menu)) (defun easy-menu-add-item (menu path item &optional before) "At the end of the submenu of MENU with path PATH, add ITEM. If ITEM is already present in this submenu, then this item will be changed. otherwise ITEM will be added at the end of the submenu, unless the optional argument BEFORE is present, in which case ITEM will instead be added before the item named BEFORE. MENU is either a symbol, which have earlier been used as the first argument in a call to `easy-menu-define', or the value of such a symbol i.e. a menu, or nil, which stands for the current menubar. PATH is a list of strings for locating the submenu where ITEM is to be added. If PATH is nil, MENU itself is used. Otherwise, the first element should be the name of a submenu directly under MENU. This submenu is then traversed recursively with the remaining elements of PATH. ITEM is either defined as in `easy-menu-define', a menu defined earlier by `easy-menu-define' or `easy-menu-create-menu' or an item returned from `easy-menu-item-present-p' or `easy-menu-remove-item'." (when (featurep 'menubar) (add-menu-button path item before (easy-menu-normalize menu)))) (defun easy-menu-item-present-p (menu path name) "In submenu of MENU with path PATH, return true iff item NAME is present. MENU and PATH are defined as in `easy-menu-add-item'. NAME should be a string, the name of the element to be looked for. The return value can be used as an argument to `easy-menu-add-item'." (if (featurep 'menubar) (car (find-menu-item (or (easy-menu-normalize menu) current-menubar) (append path (list name)))) nil)) (defun easy-menu-remove-item (menu path name) "From submenu of MENU with path PATH, remove item NAME. MENU and PATH are defined as in `easy-menu-add-item'. NAME should be a string, the name of the element to be removed. The return value can be used as an argument to `easy-menu-add-item'." (when (featurep 'menubar) (delete-menu-item (append path (list name)) (easy-menu-normalize menu)))) ;; Think up a good title for the menu. Take the major-mode of the buffer, ;; strip the -mode part, convert hyphens to spaces, and capitalize it. ;; ;; In a more ideal world, we could use `mode-name' here, which see, but that ;; turns out to be temporarily trashed by various minor modes, and this ;; value is much more trustworthy. (defun easy-menu-title () (capitalize (replace-in-string (replace-in-string (symbol-name major-mode) "-mode$" "") "-" " "))) (provide 'easymenu) ;;; easymenu.el ends here