Mercurial > emacs
changeset 28523:47e1a131eef3
*** empty log message ***
| author | Gerd Moellmann <gerd@gnu.org> |
|---|---|
| date | Sun, 09 Apr 2000 11:15:57 +0000 |
| parents | 7fcfdde7365a |
| children | 98e34e5245c9 |
| files | lib-src/ChangeLog lib-src/ebrowse.c lisp/ChangeLog lisp/cus-load.el lisp/loaddefs.el lisp/progmodes/ebrowse.el src/ChangeLog |
| diffstat | 7 files changed, 8448 insertions(+), 53 deletions(-) [+] |
line wrap: on
line diff
--- a/lib-src/ChangeLog Sun Apr 09 10:59:46 2000 +0000 +++ b/lib-src/ChangeLog Sun Apr 09 11:15:57 2000 +0000 @@ -1,3 +1,10 @@ +2000-04-09 Gerd Moellmann <gerd@gnu.org> + + * Makefile.in (INSTALLABLES): Add ebrowse. + (ebrowse): New target. + + * ebrowse.c: New file. + 2000-03-29 Andreas Schwab <schwab@suse.de> * make-docfile.c (scan_lisp_file): Also look for `defsubst'.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lib-src/ebrowse.c Sun Apr 09 11:15:57 2000 +0000 @@ -0,0 +1,3702 @@ +/* ebrowse.c --- parsing files for the ebrowse C++ browser + + Copyright (C) 1992-1999, 2000 Free Software Foundation Inc. + + Author: Gerd Moellmann <gerd@gnu.org> + Maintainer: FSF + + 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 2, 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; see the file COPYING. If not, write to + the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ + +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include <ctype.h> +#include <assert.h> +#include "getopt.h" + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +/* Conditionalize function prototypes. */ + +#ifdef PROTOTYPES /* From config.h. */ +#define P_(x) x +#else +#define P_(x) () +#endif + +/* Value is non-zero if strings X and Y compare equal. */ + +#define streq(X, Y) (*(X) == *(Y) && strcmp ((X) + 1, (Y) + 1) == 0) + +/* The ubiquitous `max' and `min' macros. */ + +#ifndef max +#define max(X, Y) ((X) > (Y) ? (X) : (Y)) +#define min(X, Y) ((X) < (Y) ? (X) : (Y)) +#endif + +/* Files are read in chunks of this number of bytes. */ + +#define READ_CHUNK_SIZE (100 * 1024) + +/* The character used as a separator in path lists (like $PATH). */ + +#define PATH_LIST_SEPARATOR ':' + +/* The default output file name. */ + +#define DEFAULT_OUTFILE "EBROWSE" + +/* A version string written to the output file. Change this whenever + the structure of the output file changes. */ + +#define EBROWSE_FILE_VERSION "ebrowse 5.0" + +/* The output file consists of a tree of Lisp objects, with major + nodes built out of Lisp structures. These are the heads of the + Lisp structs with symbols identifying their type. */ + +#define TREE_HEADER_STRUCT "[ebrowse-hs " +#define TREE_STRUCT "[ebrowse-ts " +#define MEMBER_STRUCT "[ebrowse-ms " +#define BROWSE_STRUCT "[ebrowse-bs " +#define CLASS_STRUCT "[ebrowse-cs " + +/* The name of the symbol table entry for global functions, variables, + defines etc. This name also appears in the browser display. */ + +#define GLOBALS_NAME "*Globals*" + +/* Token definitions. */ + +enum token +{ + YYEOF = 0, /* end of file */ + CSTRING = 256, /* string constant */ + CCHAR, /* character constant */ + CINT, /* integral constant */ + CFLOAT, /* real constant */ + + ELLIPSIS, /* ... */ + LSHIFTASGN, /* <<= */ + RSHIFTASGN, /* >>= */ + ARROWSTAR, /* ->* */ + IDENT, /* identifier */ + DIVASGN, /* /= */ + INC, /* ++ */ + ADDASGN, /* += */ + DEC, /* -- */ + ARROW, /* -> */ + SUBASGN, /* -= */ + MULASGN, /* *= */ + MODASGN, /* %= */ + LOR, /* || */ + ORASGN, /* |= */ + LAND, /* && */ + ANDASGN, /* &= */ + XORASGN, /* ^= */ + POINTSTAR, /* .* */ + DCOLON, /* :: */ + EQ, /* == */ + NE, /* != */ + LE, /* <= */ + LSHIFT, /* << */ + GE, /* >= */ + RSHIFT, /* >> */ + +/* Keywords. The undef's are there because these + three symbols are very likely to be defined somewhere. */ +#undef BOOL +#undef TRUE +#undef FALSE + + ASM, /* asm */ + AUTO, /* auto */ + BREAK, /* break */ + CASE, /* case */ + CATCH, /* catch */ + CHAR, /* char */ + CLASS, /* class */ + CONST, /* const */ + CONTINUE, /* continue */ + DEFAULT, /* default */ + DELETE, /* delete */ + DO, /* do */ + DOUBLE, /* double */ + ELSE, /* else */ + ENUM, /* enum */ + EXTERN, /* extern */ + FLOAT, /* float */ + FOR, /* for */ + FRIEND, /* friend */ + GOTO, /* goto */ + IF, /* if */ + T_INLINE, /* inline */ + INT, /* int */ + LONG, /* long */ + NEW, /* new */ + OPERATOR, /* operator */ + PRIVATE, /* private */ + PROTECTED, /* protected */ + PUBLIC, /* public */ + REGISTER, /* register */ + RETURN, /* return */ + SHORT, /* short */ + SIGNED, /* signed */ + SIZEOF, /* sizeof */ + STATIC, /* static */ + STRUCT, /* struct */ + SWITCH, /* switch */ + TEMPLATE, /* template */ + THIS, /* this */ + THROW, /* throw */ + TRY, /* try */ + TYPEDEF, /* typedef */ + UNION, /* union */ + UNSIGNED, /* unsigned */ + VIRTUAL, /* virtual */ + VOID, /* void */ + VOLATILE, /* volatile */ + WHILE, /* while */ + MUTABLE, /* mutable */ + BOOL, /* bool */ + TRUE, /* true */ + FALSE, /* false */ + SIGNATURE, /* signature (GNU extension) */ + NAMESPACE, /* namespace */ + EXPLICIT, /* explicit */ + TYPENAME, /* typename */ + CONST_CAST, /* const_cast */ + DYNAMIC_CAST, /* dynamic_cast */ + REINTERPRET_CAST, /* reinterpret_cast */ + STATIC_CAST, /* static_cast */ + TYPEID, /* typeid */ + USING, /* using */ + WCHAR /* wchar_t */ +}; + +/* Storage classes, in a wider sense. */ + +enum sc +{ + SC_UNKNOWN, + SC_MEMBER, /* Is an instance member. */ + SC_STATIC, /* Is static member. */ + SC_FRIEND, /* Is friend function. */ + SC_TYPE /* Is a type definition. */ +}; + +/* Member visibility. */ + +enum visibility +{ + V_PUBLIC, + V_PROTECTED, + V_PRIVATE +}; + +/* Member flags. */ + +#define F_VIRTUAL 1 /* Is virtual function. */ +#define F_INLINE 2 /* Is inline function. */ +#define F_CONST 4 /* Is const. */ +#define F_PURE 8 /* Is pure virtual function. */ +#define F_MUTABLE 16 /* Is mutable. */ +#define F_TEMPLATE 32 /* Is a template. */ +#define F_EXPLICIT 64 /* Is explicit constructor. */ +#define F_THROW 128 /* Has a throw specification. */ +#define F_EXTERNC 256 /* Is declared extern "C". */ +#define F_DEFINE 512 /* Is a #define. */ + +/* Two macros to set and test a bit in an int. */ + +#define SET_FLAG(F, FLAG) ((F) |= (FLAG)) +#define HAS_FLAG(F, FLAG) (((F) & (FLAG)) != 0) + +/* Structure describing a class member. */ + +struct member +{ + struct member *next; /* Next in list of members. */ + struct member *anext; /* Collision chain in member_table. */ + struct member **list; /* Pointer to list in class. */ + unsigned param_hash; /* Hash value for parameter types. */ + int vis; /* Visibility (public, ...). */ + int flags; /* See F_* above. */ + char *regexp; /* Matching regular expression. */ + char *filename; /* Don't free this shared string. */ + int pos; /* Buffer position of occurrence. */ + char *def_regexp; /* Regular expression matching definition. */ + char *def_filename; /* File name of definition. */ + int def_pos; /* Buffer position of definition. */ + char name[1]; /* Member name. */ +}; + +/* Structures of this type are used to connect class structures with + their super and subclasses. */ + +struct link +{ + struct sym *sym; /* The super or subclass. */ + struct link *next; /* Next in list or NULL. */ +}; + +/* Structure used to record namespace aliases. */ + +struct alias +{ + struct alias *next; /* Next in list. */ + char name[1]; /* Alias name. */ +}; + +/* The structure used to describe a class in the symbol table, + or a namespace in all_namespaces. */ + +struct sym +{ + int flags; /* Is class a template class?. */ + unsigned char visited; /* Used to find circles. */ + struct sym *next; /* Hash collision list. */ + struct link *subs; /* List of subclasses. */ + struct link *supers; /* List of superclasses. */ + struct member *vars; /* List of instance variables. */ + struct member *fns; /* List of instance functions. */ + struct member *static_vars; /* List of static variables. */ + struct member *static_fns; /* List of static functions. */ + struct member *friends; /* List of friend functions. */ + struct member *types; /* List of local types. */ + char *regexp; /* Matching regular expression. */ + int pos; /* Buffer position. */ + char *filename; /* File in which it can be found. */ + char *sfilename; /* File in which members can be found. */ + struct sym *namesp; /* Namespace in which defined. . */ + struct alias *namesp_aliases; /* List of aliases for namespaces. */ + char name[1]; /* Name of the class. */ +}; + +/* Experimental: Print info for `--position-info'. We print + '(CLASS-NAME SCOPE MEMBER-NAME). */ + +#define P_DEFN 1 +#define P_DECL 2 + +int info_where; +struct sym *info_cls = NULL; +struct member *info_member = NULL; + +/* Experimental. For option `--position-info', the buffer position we + are interested in. When this position is reached, print out + information about what we know about that point. */ + +int info_position = -1; + +/* Command line options structure for getopt_long. */ + +struct option options[] = +{ + {"append", no_argument, NULL, 'a'}, + {"files", required_argument, NULL, 'f'}, + {"help", no_argument, NULL, -2}, + {"min-regexp-length", required_argument, NULL, 'm'}, + {"max-regexp-length", required_argument, NULL, 'M'}, + {"no-nested-classes", no_argument, NULL, 'n'}, + {"no-regexps", no_argument, NULL, 'x'}, + {"no-structs-or-unions", no_argument, NULL, 's'}, + {"output-file", required_argument, NULL, 'o'}, + {"position-info", required_argument, NULL, 'p'}, + {"search-path", required_argument, NULL, 'I'}, + {"verbose", no_argument, NULL, 'v'}, + {"version", no_argument, NULL, -3}, + {"very-verbose", no_argument, NULL, 'V'}, + {NULL, 0, NULL, 0} +}; + +/* Semantic values of tokens. Set by yylex.. */ + +unsigned yyival; /* Set for token CINT. */ +char *yytext; /* Set for token IDENT. */ +char *yytext_end; + +/* Output file. */ + +FILE *yyout; + +/* Current line number. */ + +int yyline; + +/* The name of the current input file. */ + +char *filename; + +/* Three character class vectors, and macros to test membership + of characters. */ + +char is_ident[255]; +char is_digit[255]; +char is_white[255]; + +#define IDENTP(C) is_ident[(unsigned char) (C)] +#define DIGITP(C) is_digit[(unsigned char) (C)] +#define WHITEP(C) is_white[(unsigned char) (C)] + +/* Command line flags. */ + +int f_append; +int f_verbose; +int f_very_verbose; +int f_structs = 1; +int f_regexps = 1; +int f_nested_classes = 1; + +/* Maximum and minimum lengths of regular expressions matching a + member, class etc., for writing them to the output file. These are + overridable from the command line. */ + +int min_regexp = 5; +int max_regexp = 50; + +/* Input buffer. */ + +char *inbuffer; +char *in; +int inbuffer_size; + +/* Return the current buffer position in the input file. */ + +#define BUFFER_POS() (in - inbuffer) + +/* If current lookahead is CSTRING, the following points to the + first character in the string constant. Used for recognizing + extern "C". */ + +char *string_start; + +/* The size of the hash tables for classes.and members. Should be + prime. */ + +#define TABLE_SIZE 1001 + +/* The hash table for class symbols. */ + +struct sym *class_table[TABLE_SIZE]; + +/* Hash table containing all member structures. This is generally + faster for member lookup than traversing the member lists of a + `struct sym'. */ + +struct member *member_table[TABLE_SIZE]; + +/* The special class symbol used to hold global functions, + variables etc. */ + +struct sym *global_symbols; + +/* The current namespace. */ + +struct sym *current_namespace; + +/* The list of all known namespaces. */ + +struct sym *all_namespaces; + +/* Stack of namespaces we're currently nested in, during the parse. */ + +struct sym **namespace_stack; +int namespace_stack_size; +int namespace_sp; + +/* The current lookahead token. */ + +int tk = -1; + +/* Structure describing a keyword. */ + +struct kw +{ + char *name; /* Spelling. */ + int tk; /* Token value. */ + struct kw *next; /* Next in collision chain. */ +}; + +/* Keywords are lookup up in a hash table of their own. */ + +#define KEYWORD_TABLE_SIZE 1001 +struct kw *keyword_table[KEYWORD_TABLE_SIZE]; + +/* Search path. */ + +struct search_path +{ + char *path; + struct search_path *next; +}; + +struct search_path *search_path; +struct search_path *search_path_tail; + +/* Function prototypes. */ + +int yylex P_ ((void)); +void yyparse P_ ((void)); +void re_init_parser P_ ((void)); +char *token_string P_ ((int)); +char *matching_regexp P_ ((void)); +void init_sym P_ ((void)); +struct sym *add_sym P_ ((char *, struct sym *)); +void add_link P_ ((struct sym *, struct sym *)); +void add_member_defn P_ ((struct sym *, char *, char *, + int, unsigned, int, int, int)); +void add_member_decl P_ ((struct sym *, char *, char *, int, + unsigned, int, int, int, int)); +void dump_roots P_ ((FILE *)); +void *xmalloc P_ ((int)); +void add_global_defn P_ ((char *, char *, int, unsigned, int, int, int)); +void add_global_decl P_ ((char *, char *, int, unsigned, int, int, int)); +void add_define P_ ((char *, char *, int)); +void mark_inherited_virtual P_ ((void)); +void leave_namespace P_ ((void)); +void enter_namespace P_ ((char *)); +void register_namespace_alias P_ ((char *, char *)); +void insert_keyword P_ ((char *, int)); +void re_init_scanner P_ ((void)); +void init_scanner P_ ((void)); +void usage P_ ((int)); +void version P_ ((void)); +void process_file P_ ((char *)); +void add_search_path P_ ((char *)); +FILE *open_file P_ ((char *)); +int process_pp_line P_ ((void)); +int dump_members P_ ((FILE *, struct member *)); +void dump_sym P_ ((FILE *, struct sym *)); +int dump_tree P_ ((FILE *, struct sym *)); +struct member *find_member P_ ((struct sym *, char *, int, int, unsigned)); +struct member *add_member P_ ((struct sym *, char *, int, int, unsigned)); +void mark_virtual P_ ((struct sym *)); +void mark_virtual P_ ((struct sym *)); +struct sym *make_namespace P_ ((char *)); +char *sym_scope P_ ((struct sym *)); +char *sym_scope_1 P_ ((struct sym *)); +int skip_to P_ ((int)); +void skip_matching P_ ((void)); +void member P_ ((struct sym *, int)); +void class_body P_ ((struct sym *, int)); +void class_definition P_ ((struct sym *, int, int, int)); +void declaration P_ ((int, int)); +unsigned parm_list P_ ((int *)); +char *operator_name P_ ((int *)); +struct sym *parse_classname P_ ((void)); +struct sym *parse_qualified_ident_or_type P_ ((char **)); +void parse_qualified_param_ident_or_type P_ ((char **)); +int globals P_ ((int)); + + + +/*********************************************************************** + Utilities + ***********************************************************************/ + +/* Print an error in a printf-like style with the current input file + name and line number. */ + +void +yyerror (format, a1, a2, a3, a4, a5) + char *format; + int a1, a2, a3, a4, a5; +{ + fprintf (stderr, "%s:%d: ", filename, yyline); + fprintf (stderr, format, a1, a2, a3, a4, a5); + putc ('\n', stderr); +} + + +/* Like malloc but print an error and exit if not enough memory is + available. */ + +void * +xmalloc (nbytes) + int nbytes; +{ + void *p = malloc (nbytes); + if (p) + return p; + yyerror ("out of memory"); + exit (1); +} + + +/* Like realloc but print an error and exit if out of memory. */ + +void * +xrealloc (p, sz) + void *p; + int sz; +{ + p = realloc (p, sz); + if (p) + return p; + yyerror ("out of memory"); + exit (1); +} + + +/* Like strdup, but print an error and exit if not enough memory is + available.. If S is null, return null. */ + +char * +xstrdup (s) + char *s; +{ + if (s) + s = strcpy (xmalloc (strlen (s) + 1), s); + return s; +} + + + +/*********************************************************************** + Symbols + ***********************************************************************/ + +/* Initialize the symbol table. This currently only sets up the + special symbol for globals (`*Globals*'). */ + +void +init_sym () +{ + global_symbols = add_sym (GLOBALS_NAME, NULL); +} + + +/* Add a symbol for class NAME to the symbol table. NESTED_IN_CLASS + is the class in which class NAME was found. If it is null, + this means the scope of NAME is the current namespace. + + If a symbol for NAME already exists, return that. Otherwise + create a new symbol and set it to default values. */ + +struct sym * +add_sym (name, nested_in_class) + char *name; + struct sym *nested_in_class; +{ + struct sym *sym; + unsigned h; + char *s; + struct sym *scope = nested_in_class ? nested_in_class : current_namespace; + + for (s = name, h = 0; *s; ++s) + h = (h << 1) ^ *s; + h %= TABLE_SIZE; + + for (sym = class_table[h]; sym; sym = sym->next) + if (streq (name, sym->name) && sym->namesp == scope) + break; + + if (sym == NULL) + { + if (f_very_verbose) + { + putchar ('\t'); + puts (name); + } + + sym = (struct sym *) xmalloc (sizeof *sym + strlen (name)); + bzero (sym, sizeof *sym); + strcpy (sym->name, name); + sym->namesp = scope; + sym->next = class_table[h]; + class_table[h] = sym; + } + + return sym; +} + + +/* Add links between superclass SUPER and subclass SUB. */ + +void +add_link (super, sub) + struct sym *super, *sub; +{ + struct link *lnk, *lnk2, *p, *prev; + + /* See if a link already exists. */ + for (p = super->subs, prev = NULL; + p && strcmp (sub->name, p->sym->name) > 0; + prev = p, p = p->next) + ; + + /* Avoid duplicates. */ + if (p == NULL || p->sym != sub) + { + lnk = (struct link *) xmalloc (sizeof *lnk); + lnk2 = (struct link *) xmalloc (sizeof *lnk2); + + lnk->sym = sub; + lnk->next = p; + + if (prev) + prev->next = lnk; + else + super->subs = lnk; + + lnk2->sym = super; + lnk2->next = sub->supers; + sub->supers = lnk2; + } +} + + +/* Find in class CLS member NAME. + + VAR non-zero means look for a member variable; otherwise a function + is searched. SC specifies what kind of member is searched---a + static, or per-instance member etc. HASH is a hash code for the + parameter types of functions. Value is a pointer to the member + found or null if not found. */ + +struct member * +find_member (cls, name, var, sc, hash) + struct sym *cls; + char *name; + int var, sc; + unsigned hash; +{ + struct member **list; + struct member *p; + unsigned name_hash = 0; + char *s; + int i; + + switch (sc) + { + case SC_FRIEND: + list = &cls->friends; + break; + + case SC_TYPE: + list = &cls->types; + break; + + case SC_STATIC: + list = var ? &cls->static_vars : &cls->static_fns; + break; + + default: + list = var ? &cls->vars : &cls->fns; + break; + } + + for (s = name; *s; ++s) + name_hash = (name_hash << 1) ^ *s; + i = name_hash % TABLE_SIZE; + + for (p = member_table[i]; p; p = p->anext) + if (p->list == list && p->param_hash == hash && streq (name, p->name)) + break; + + return p; +} + + +/* Add to class CLS information for the declaration of member NAME. + REGEXP is a regexp matching the declaration, if non-null. POS is + the position in the source where the declaration is found. HASH is + a hash code for the parameter list of the member, if it's a + function. VAR non-zero means member is a variable or type. SC + specifies the type of member (instance member, static, ...). VIS + is the member's visibility (public, protected, private). FLAGS is + a bit set giving additional information about the member (see the + F_* defines). */ + +void +add_member_decl (cls, name, regexp, pos, hash, var, sc, vis, flags) + struct sym *cls; + char *name; + char *regexp; + int pos; + unsigned hash; + int var; + int sc; + int vis; + int flags; +{ + struct member *m; + + m = find_member (cls, name, var, sc, hash); + if (m == NULL) + m = add_member (cls, name, var, sc, hash); + + /* Have we seen a new filename? If so record that. */ + if (!cls->filename || !streq (cls->filename, filename)) + m->filename = filename; + + m->regexp = regexp; + m->pos = pos; + m->flags = flags; + + switch (vis) + { + case PRIVATE: + m->vis = V_PRIVATE; + break; + + case PROTECTED: + m->vis = V_PROTECTED; + break; + + case PUBLIC: + m->vis = V_PUBLIC; + break; + } + + info_where = P_DECL; + info_cls = cls; + info_member = m; +} + + +/* Add to class CLS information for the definition of member NAME. + REGEXP is a regexp matching the declaration, if non-null. POS is + the position in the source where the declaration is found. HASH is + a hash code for the parameter list of the member, if it's a + function. VAR non-zero means member is a variable or type. SC + specifies the type of member (instance member, static, ...). VIS + is the member's visibility (public, protected, private). FLAGS is + a bit set giving additional information about the member (see the + F_* defines). */ + +void +add_member_defn (cls, name, regexp, pos, hash, var, sc, flags) + struct sym *cls; + char *name; + char *regexp; + int pos; + unsigned hash; + int var; + int sc; + int flags; +{ + struct member *m; + + if (sc == SC_UNKNOWN) + { + m = find_member (cls, name, var, SC_MEMBER, hash); + if (m == NULL) + { + m = find_member (cls, name, var, SC_STATIC, hash); + if (m == NULL) + m = add_member (cls, name, var, sc, hash); + } + } + else + { + m = find_member (cls, name, var, sc, hash); + if (m == NULL) + m = add_member (cls, name, var, sc, hash); + } + + if (!cls->sfilename) + cls->sfilename = filename; + + if (!streq (cls->sfilename, filename)) + m->def_filename = filename; + + m->def_regexp = regexp; + m->def_pos = pos; + m->flags |= flags; + + info_where = P_DEFN; + info_cls = cls; + info_member = m; +} + + +/* Add a symbol for a define named NAME to the symbol table. + REGEXP is a regular expression matching the define in the source, + if it is non-null. POS is the position in the file. */ + +void +add_define (name, regexp, pos) + char *name, *regexp; + int pos; +{ + add_global_defn (name, regexp, pos, 0, 1, SC_FRIEND, F_DEFINE); + add_global_decl (name, regexp, pos, 0, 1, SC_FRIEND, F_DEFINE); +} + + +/* Add information for the global definition of NAME. + REGEXP is a regexp matching the declaration, if non-null. POS is + the position in the source where the declaration is found. HASH is + a hash code for the parameter list of the member, if it's a + function. VAR non-zero means member is a variable or type. SC + specifies the type of member (instance member, static, ...). VIS + is the member's visibility (public, protected, private). FLAGS is + a bit set giving additional information about the member (see the + F_* defines). */ + +void +add_global_defn (name, regexp, pos, hash, var, sc, flags) + char *name, *regexp; + int pos; + unsigned hash; + int var; + int sc; + int flags; +{ + int i; + struct sym *sym; + + /* Try to find out for which classes a function is a friend, and add + what we know about it to them. */ + if (!var) + for (i = 0; i < TABLE_SIZE; ++i) + for (sym = class_table[i]; sym; sym = sym->next) + if (sym != global_symbols && sym->friends) + if (find_member (sym, name, 0, SC_FRIEND, hash)) + add_member_defn (sym, name, regexp, pos, hash, 0, + SC_FRIEND, flags); + + /* Add to global symbols. */ + add_member_defn (global_symbols, name, regexp, pos, hash, var, sc, flags); +} + + +/* Add information for the global declaration of NAME. + REGEXP is a regexp matching the declaration, if non-null. POS is + the position in the source where the declaration is found. HASH is + a hash code for the parameter list of the member, if it's a + function. VAR non-zero means member is a variable or type. SC + specifies the type of member (instance member, static, ...). VIS + is the member's visibility (public, protected, private). FLAGS is + a bit set giving additional information about the member (see the + F_* defines). */ + +void +add_global_decl (name, regexp, pos, hash, var, sc, flags) + char *name, *regexp; + int pos; + unsigned hash; + int var; + int sc; + int flags; +{ + /* Add declaration only if not already declared. Header files must + be processed before source files for this to have the right effect. + I do not want to handle implicit declarations at the moment. */ + struct member *m; + struct member *found; + + m = found = find_member (global_symbols, name, var, sc, hash); + if (m == NULL) + m = add_member (global_symbols, name, var, sc, hash); + + /* Definition already seen => probably last declaration implicit. + Override. This means that declarations must always be added to + the symbol table before definitions. */ + if (!found) + { + if (!global_symbols->filename + || !streq (global_symbols->filename, filename)) + m->filename = filename; + + m->regexp = regexp; + m->pos = pos; + m->vis = V_PUBLIC; + m->flags = flags; + + info_where = P_DECL; + info_cls = global_symbols; + info_member = m; + } +} + + +/* Add a symbol for member NAME to class CLS. + VAR non-zero means it's a variable. SC specifies the kind of + member. HASH is a hash code for the parameter types of a function. + Value is a pointer to the member's structure. */ + +struct member * +add_member (cls, name, var, sc, hash) + struct sym *cls; + char *name; + int var; + int sc; + unsigned hash; +{ + struct member *m = (struct member *) xmalloc (sizeof *m + strlen (name)); + struct member **list; + struct member *p; + struct member *prev; + unsigned name_hash = 0; + int i; + char *s; + + strcpy (m->name, name); + m->param_hash = hash; + + m->vis = 0; + m->flags = 0; + m->regexp = NULL; + m->filename = NULL; + m->pos = 0; + m->def_regexp = NULL; + m->def_filename = NULL; + m->def_pos = 0; + + assert (cls != NULL); + + switch (sc) + { + case SC_FRIEND: + list = &cls->friends; + break; + + case SC_TYPE: + list = &cls->types; + break; + + case SC_STATIC: + list = var ? &cls->static_vars : &cls->static_fns; + break; + + default: + list = var ? &cls->vars : &cls->fns; + break; + } + + for (s = name; *s; ++s) + name_hash = (name_hash << 1) ^ *s; + i = name_hash % TABLE_SIZE; + m->anext = member_table[i]; + member_table[i] = m; + m->list = list; + + /* Keep the member list sorted. It's cheaper to do it here than to + sort them in Lisp. */ + for (prev = NULL, p = *list; + p && strcmp (name, p->name) > 0; + prev = p, p = p->next) + ; + + m->next = p; + if (prev) + prev->next = m; + else + *list = m; + return m; +} + + +/* Given the root R of a class tree, step through all subclasses + recursively, marking functions as virtual that are declared virtual + in base classes. */ + +void +mark_virtual (r) + struct sym *r; +{ + struct link *p; + struct member *m, *m2; + + for (p = r->subs; p; p = p->next) + { + for (m = r->fns; m; m = m->next) + if (HAS_FLAG (m->flags, F_VIRTUAL)) + { + for (m2 = p->sym->fns; m2; m2 = m2->next) + if (m->param_hash == m2->param_hash && streq (m->name, m2->name)) + SET_FLAG (m2->flags, F_VIRTUAL); + } + + mark_virtual (p->sym); + } +} + + +/* For all roots of the class tree, mark functions as virtual that + are virtual because of a virtual declaration in a base class. */ + +void +mark_inherited_virtual () +{ + struct sym *r; + int i; + + for (i = 0; i < TABLE_SIZE; ++i) + for (r = class_table[i]; r; r = r->next) + if (r->supers == NULL) + mark_virtual (r); +} + + +/* Create and return a symbol for a namespace with name NAME. */ + +struct sym * +make_namespace (name) + char *name; +{ + struct sym *s = (struct sym *) xmalloc (sizeof *s + strlen (name)); + bzero (s, sizeof *s); + strcpy (s->name, name); + s->next = all_namespaces; + s->namesp = current_namespace; + all_namespaces = s; + return s; +} + + +/* Find the symbol for namespace NAME. If not found, add a new symbol + for NAME to all_namespaces. */ + +struct sym * +find_namespace (name) + char *name; +{ + struct sym *p; + + for (p = all_namespaces; p; p = p->next) + { + if (streq (p->name, name)) + break; + else + { + struct alias *p2; + for (p2 = p->namesp_aliases; p2; p2 = p2->next) + if (streq (p2->name, name)) + break; + if (p2) + break; + } + } + + if (p == NULL) + p = make_namespace (name); + + return p; +} + + +/* Register the name NEW_NAME as an alias for namespace OLD_NAME. */ + +void +register_namespace_alias (new_name, old_name) + char *new_name, *old_name; +{ + struct sym *p = find_namespace (old_name); + struct alias *al; + + /* Is it already in the list of aliases? */ + for (al = p->namesp_aliases; al; al = al->next) + if (streq (new_name, p->name)) + return; + + al = (struct alias *) xmalloc (sizeof *al + strlen (new_name)); + strcpy (al->name, new_name); + al->next = p->namesp_aliases; + p->namesp_aliases = al; +} + + +/* Enter namespace with name NAME. */ + +void +enter_namespace (name) + char *name; +{ + struct sym *p = find_namespace (name); + + if (namespace_sp == namespace_stack_size) + { + int size = max (10, 2 * namespace_stack_size); + namespace_stack = (struct sym **) xrealloc (namespace_stack, size); + namespace_stack_size = size; + } + + namespace_stack[namespace_sp++] = current_namespace; + current_namespace = p; +} + + +/* Leave the current namespace. */ + +void +leave_namespace () +{ + assert (namespace_sp > 0); + current_namespace = namespace_stack[--namespace_sp]; +} + + + +/*********************************************************************** + Writing the Output File + ***********************************************************************/ + +/* Write string S to the output file FP in a Lisp-readable form. + If S is null, write out `()'. */ + +#define PUTSTR(s, fp) \ + do { \ + if (!s) \ + { \ + putc ('(', fp); \ + putc (')', fp); \ + putc (' ', fp); \ + } \ + else \ + { \ + putc ('"', fp); \ + fputs (s, fp); \ + putc ('"', fp); \ + putc (' ', fp); \ + } \ + } while (0) + +/* A dynamically allocated buffer for constructing a scope name. */ + +char *scope_buffer; +int scope_buffer_size; +int scope_buffer_len; + + +/* Make sure scope_buffer has enough room to add LEN chars to it. */ + +void +ensure_scope_buffer_room (len) + int len; +{ + if (scope_buffer_len + len >= scope_buffer_size) + { + int new_size = max (2 * scope_buffer_size, scope_buffer_len + len); + scope_buffer = (char *) xrealloc (new_size); + scope_buffer_size = new_size; + } +} + + +/* Recursively add the scope names of symbol P and the scopes of its + namespaces to scope_buffer. Value is a pointer to the complete + scope name constructed. */ + +char * +sym_scope_1 (p) + struct sym *p; +{ + int len; + + if (p->namesp) + sym_scope_1 (p->namesp); + + if (*scope_buffer) + { + ensure_scope_buffer_room (3); + strcat (scope_buffer, "::"); + scope_buffer_len += 2; + } + + len = strlen (p->name); + ensure_scope_buffer_room (len + 1); + strcat (scope_buffer, p->name); + scope_buffer_len += len; + + if (HAS_FLAG (p->flags, F_TEMPLATE)) + { + ensure_scope_buffer_room (3); + strcat (scope_buffer, "<>"); + scope_buffer_len += 2; + } + + return scope_buffer; +} + + +/* Return the scope of symbol P in printed representation, i.e. + as it would appear in a C*+ source file. */ + +char * +sym_scope (p) + struct sym *p; +{ + if (!scope_buffer) + { + scope_buffer_size = 1024; + scope_buffer = (char *) xmalloc (scope_buffer_size); + } + + *scope_buffer = '\0'; + scope_buffer_len = 0; + + if (p->namesp) + sym_scope_1 (p->namesp); + + return scope_buffer; +} + + +/* Dump the list of members M to file FP. Value is the length of the + list. */ + +int +dump_members (fp, m) + FILE *fp; + struct member *m; +{ + int n; + + putc ('(', fp); + + for (n = 0; m; m = m->next, ++n) + { + fputs (MEMBER_STRUCT, fp); + PUTSTR (m->name, fp); + PUTSTR (NULL, fp); /* FIXME? scope for globals */ + fprintf (fp, "%u ", (unsigned) m->flags); + PUTSTR (m->filename, fp); + PUTSTR (m->regexp, fp); + fprintf (fp, "%u ", (unsigned) m->pos); + fprintf (fp, "%u ", (unsigned) m->vis); + putc (' ', fp); + PUTSTR (m->def_filename, fp); + PUTSTR (m->def_regexp, fp); + fprintf (fp, "%u", (unsigned) m->def_pos); + putc (']', fp); + putc ('\n', fp); + } + + putc (')', fp); + putc ('\n', fp); + return n; +} + + +/* Dump class ROOT to stream FP. */ + +void +dump_sym (fp, root) + FILE *fp; + struct sym *root; +{ + fputs (CLASS_STRUCT, fp); + PUTSTR (root->name, fp); + + /* Print scope, if any. */ + if (root->namesp) + PUTSTR (sym_scope (root), fp); + else + PUTSTR (NULL, fp); + + /* Print flags. */ + fprintf (fp, "%u", root->flags); + PUTSTR (root->filename, fp); + PUTSTR (root->regexp, fp); + fprintf (fp, "%u", (unsigned) root->pos); + PUTSTR (root->sfilename, fp); + putc (']', fp); + putc ('\n', fp); +} + + +/* Dump class ROOT and its subclasses to file FP. Value is the + number of classes written. */ + +int +dump_tree (fp, root) + FILE *fp; + struct sym *root; +{ + struct link *lk; + unsigned n = 0; + + dump_sym (fp, root); + + if (f_verbose) + { + putchar ('+'); + fflush (stdout); + } + + putc ('(', fp); + + for (lk = root->subs; lk; lk = lk->next) + { + fputs (TREE_STRUCT, fp); + n += dump_tree (fp, lk->sym); + putc (']', fp); + } + + putc (')', fp); + + dump_members (fp, root->vars); + n += dump_members (fp, root->fns); + dump_members (fp, root->static_vars); + n += dump_members (fp, root->static_fns); + n += dump_members (fp, root->friends); + dump_members (fp, root->types); + + /* Superclasses. */ + putc ('(', fp); + putc (')', fp); + + /* Mark slot. */ + putc ('(', fp); + putc (')', fp); + + putc ('\n', fp); + return n; +} + + +/* Dump the entire class tree to file FP. */ + +void +dump_roots (fp) + FILE *fp; +{ + int i, n = 0; + struct sym *r; + + /* Output file header containing version string, command line + options etc. */ + if (!f_append) + { + fputs (TREE_HEADER_STRUCT, fp); + PUTSTR (EBROWSE_FILE_VERSION, fp); + + putc ('\"', fp); + if (!f_structs) + fputs (" -s", fp); + if (f_regexps) + fputs (" -x", fp); + putc ('\"', fp); + fputs (" ()", fp); + fputs (" ()", fp); + putc (']', fp); + } + + /* Mark functions as virtual that are so because of functions + declared virtual in base classes. */ + mark_inherited_virtual (); + + /* Dump the roots of the graph. */ + for (i = 0; i < TABLE_SIZE; ++i) + for (r = class_table[i]; r; r = r->next) + if (!r->supers) + { + fputs (TREE_STRUCT, fp); + n += dump_tree (fp, r); + putc (']', fp); + } + + if (f_verbose) + putchar ('\n'); +} + + + +/*********************************************************************** + Scanner + ***********************************************************************/ + +#ifdef DEBUG +#define INCREMENT_LINENO \ +do { \ + if (f_very_verbose) \ + { \ + ++yyline; \ + printf ("%d:\n", yyline); \ + } \ + else \ + ++yyline; \ +} while (0) +#else +#define INCREMENT_LINENO ++yyline +#endif + +/* Define two macros for accessing the input buffer (current input + file). GET(C) sets C to the next input character and advances the + input pointer. UNGET retracts the input pointer. */ + +#define GET(C) ((C) = *in++) +#define UNGET() (--in) + + +/* Process a preprocessor line. Value is the next character from the + input buffer not consumed. */ + +int +process_pp_line () +{ + int in_comment = 0; + int c; + char *p = yytext; + + /* Skip over white space. The `#' has been consumed already. */ + while (WHITEP (GET (c))) + ; + + /* Read the preprocessor command (if any). */ + while (IDENTP (c)) + { + *p++ = c; + GET (c); + } + + /* Is it a `define'? */ + *p = '\0'; + + if (*yytext && streq (yytext, "define")) + { + p = yytext; + while (WHITEP (c)) + GET (c); + while (IDENTP (c)) + { + *p++ = c; + GET (c); + } + + *p = '\0'; + + if (*yytext) + { + char *regexp = matching_regexp (); + int pos = BUFFER_POS (); + add_define (yytext, regexp, pos); + } + } + + while (c && (c != '\n' || in_comment)) + { + if (c == '\\') + GET (c); + else if (c == '/' && !in_comment) + { + if (GET (c) == '*') + in_comment = 1; + } + else if (c == '*' && in_comment) + { + if (GET (c) == '/') + in_comment = 0; + } + + if (c == '\n') + INCREMENT_LINENO; + + GET (c); + } + + return c; +} + + +/* Value is the next token from the input buffer. */ + +int +yylex () +{ + int c; + char end_char; + char *p; + + for (;;) + { + while (WHITEP (GET (c))) + ; + + switch (c) + { + case '\n': + INCREMENT_LINENO; + break; + + case '\r': + break; + + case 0: + /* End of file. */ + return YYEOF; + + case '\\': + GET (c); + break; + + case '"': + case '\'': + /* String and character constants. */ + end_char = c; + string_start = in; + while (GET (c) && c != end_char) + { + switch (c) + { + case '\\': + /* Escape sequences. */ + if (!GET (c)) + { + if (end_char == '\'') + yyerror ("EOF in character constant"); + else + yyerror ("EOF in string constant"); + goto end_string; + } + else switch (c) + { + case '\n': + case 'a': + case 'b': + case 'f': + case 'n': + case 'r': + case 't': + case 'v': + break; + + case 'x': + { + /* Hexadecimal escape sequence. */ + int i; + for (i = 0; i < 2; ++i) + { + GET (c); + + if (c >= '0' && c <= '7') + ; + else if (c >= 'a' && c <= 'f') + ; + else if (c >= 'A' && c <= 'F') + ; + else + { + UNGET (); + break; + } + } + } + break; + + case '0': + { + /* Octal escape sequence. */ + int i; + for (i = 0; i < 3; ++i) + { + GET (c); + + if (c >= '0' && c <= '7') + ; + else + { + UNGET (); + break; + } + } + } + break; + + default: + break; + } + break; + + case '\n': + if (end_char == '\'') + yyerror ("newline in character constant"); + else + yyerror ("newline in string constant"); + INCREMENT_LINENO; + goto end_string; + + default: + break; + } + } + + end_string: + return end_char == '\'' ? CCHAR : CSTRING; + + case 'a': case 'b': case 'c': case 'd': case 'e': case 'f': case 'g': + case 'h': case 'i': case 'j': case 'k': case 'l': case 'm': case 'n': + case 'o': case 'p': case 'q': case 'r': case 's': case 't': case 'u': + case 'v': case 'w': case 'x': case 'y': case 'z': + case 'A': case 'B': case 'C': case 'D': case 'E': case 'F': case 'G': + case 'H': case 'I': case 'J': case 'K': case 'L': case 'M': case 'N': + case 'O': case 'P': case 'Q': case 'R': case 'S': case 'T': case 'U': + case 'V': case 'W': case 'X': case 'Y': case 'Z': case '_': + { + /* Identifier and keywords. */ + unsigned hash; + struct kw *k; + + p = yytext; + *p++ = hash = c; + + while (IDENTP (GET (*p))) + { + hash = (hash << 1) ^ *p++; + if (p == yytext_end - 1) + { + int size = yytext_end - yytext; + yytext = (char *) xrealloc (yytext, 2 * size); + yytext_end = yytext + 2 * size; + p = yytext + size - 1; + } + } + + UNGET (); + *p = 0; + + for (k = keyword_table[hash % KEYWORD_TABLE_SIZE]; k; k = k->next) + if (streq (k->name, yytext)) + return k->tk; + + return IDENT; + } + + case '/': + /* C and C++ comments, '/' and '/='. */ + switch (GET (c)) + { + case '*': + while (GET (c)) + { + switch (c) + { + case '*': + if (GET (c) == '/') + goto comment_end; + UNGET (); + break; + case '\\': + GET (c); + break; + case '\n': + INCREMENT_LINENO; + break; + } + } + comment_end:; + break; + + case '=': + return DIVASGN; + + case '/': + while (GET (c) && c != '\n') + ; + INCREMENT_LINENO; + break; + + default: + UNGET (); + return '/'; + } + break; + + case '+': + if (GET (c) == '+') + return INC; + else if (c == '=') + return ADDASGN; + UNGET (); + return '+'; + + case '-': + switch (GET (c)) + { + case '-': + return DEC; + case '>': + if (GET (c) == '*') + return ARROWSTAR; + UNGET (); + return ARROW; + case '=': + return SUBASGN; + } + UNGET (); + return '-'; + + case '*': + if (GET (c) == '=') + return MULASGN; + UNGET (); + return '*'; + + case '%': + if (GET (c) == '=') + return MODASGN; + UNGET (); + return '%'; + + case '|': + if (GET (c) == '|') + return LOR; + else if (c == '=') + return ORASGN; + UNGET (); + return '|'; + + case '&': + if (GET (c) == '&') + return LAND; + else if (c == '=') + return ANDASGN; + UNGET (); + return '&'; + + case '^': + if (GET (c) == '=') + return XORASGN; + UNGET (); + return '^'; + + case '.': + if (GET (c) == '*') + return POINTSTAR; + else if (c == '.') + { + if (GET (c) != '.') + yyerror ("invalid token '..' ('...' assumed)"); + UNGET (); + return ELLIPSIS; + } + else if (!DIGITP (c)) + { + UNGET (); + return '.'; + } + goto mantissa; + + case ':': + if (GET (c) == ':') + return DCOLON; + UNGET (); + return ':'; + + case '=': + if (GET (c) == '=') + return EQ; + UNGET (); + return '='; + + case '!': + if (GET (c) == '=') + return NE; + UNGET (); + return '!'; + + case '<': + switch (GET (c)) + { + case '=': + return LE; + case '<': + if (GET (c) == '=') + return LSHIFTASGN; + UNGET (); + return LSHIFT; + } + UNGET (); + return '<'; + + case '>': + switch (GET (c)) + { + case '=': + return GE; + case '>': + if (GET (c) == '=') + return RSHIFTASGN; + UNGET (); + return RSHIFT; + } + UNGET (); + return '>'; + + case '#': + c = process_pp_line (); + if (c == 0) + return YYEOF; + break; + + case '(': case ')': case '[': case ']': case '{': case '}': + case ';': case ',': case '?': case '~': + return c; + + case '0': + yyival = 0; + + if (GET (c) == 'x' || c == 'X') + { + while (GET (c)) + { + if (DIGITP (c)) + yyival = yyival * 16 + c - '0'; + else if (c >= 'a' && c <= 'f') + yyival = yyival * 16 + c - 'a' + 10; + else if (c >= 'A' && c <= 'F') + yyival = yyival * 16 + c - 'A' + 10; + else + break; + } + + goto int_suffixes; + } + else if (c == '.') + goto mantissa; + + while (c >= '0' && c <= '7') + { + yyival = (yyival << 3) + c - '0'; + GET (c); + } + + int_suffixes: + /* Integer suffixes. */ + while (isalpha (c)) + GET (c); + UNGET (); + return CINT; + + case '1': case '2': case '3': case '4': case '5': case '6': + case '7': case '8': case '9': + /* Integer or floating constant, part before '.'. */ + yyival = c - '0'; + + while (GET (c) && DIGITP (c)) + yyival = 10 * yyival + c - '0'; + + if (c != '.') + goto int_suffixes; + + mantissa: + /* Digits following '.'. */ + while (DIGITP (c)) + GET (c); + + /* Optional exponent. */ + if (c == 'E' || c == 'e') + { + if (GET (c) == '-' || c == '+') + GET (c); + + while (DIGITP (c)) + GET (c); + } + + /* Optional type suffixes. */ + while (isalpha (c)) + GET (c); + UNGET (); + return CFLOAT; + + default: + break; + } + } +} + + +/* Value is the string from the start of the line to the current + position in the input buffer, or maybe a bit more if that string is + shorter than min_regexp. */ + +char * +matching_regexp () +{ + char *p; + char *s; + char *t; + static char *buffer, *end_buf; + + if (!f_regexps) + return NULL; + + if (buffer == NULL) + { + buffer = (char *) xmalloc (max_regexp); + end_buf = &buffer[max_regexp] - 1; + } + + /* Scan back to previous newline of buffer start. */ + for (p = in - 1; p > inbuffer && *p != '\n'; --p) + ; + + if (*p == '\n') + { + while (in - p < min_regexp && p > inbuffer) + { + /* Line probably not significant enough */ + for (--p; p >= inbuffer && *p != '\n'; --p) + ; + } + if (*p == '\n') + ++p; + } + + /* Copy from end to make sure significant portions are included. + This implies that in the browser a regular expressing of the form + `^.*{regexp}' has to be used. */ + for (s = end_buf - 1, t = in; s > buffer && t > p;) + { + *--s = *--t; + + if (*s == '"') + *--s = '\\'; + } + + *(end_buf - 1) = '\0'; + return xstrdup (s); +} + + +/* Return a printable representation of token T. */ + +char * +token_string (t) + int t; +{ + static char b[3]; + + switch (t) + { + case CSTRING: return "string constant"; + case CCHAR: return "char constant"; + case CINT: return "int constant"; + case CFLOAT: return "floating constant"; + case ELLIPSIS: return "..."; + case LSHIFTASGN: return "<<="; + case RSHIFTASGN: return ">>="; + case ARROWSTAR: return "->*"; + case IDENT: return "identifier"; + case DIVASGN: return "/="; + case INC: return "++"; + case ADDASGN: return "+="; + case DEC: return "--"; + case ARROW: return "->"; + case SUBASGN: return "-="; + case MULASGN: return "*="; + case MODASGN: return "%="; + case LOR: return "||"; + case ORASGN: return "|="; + case LAND: return "&&"; + case ANDASGN: return "&="; + case XORASGN: return "^="; + case POINTSTAR: return ".*"; + case DCOLON: return "::"; + case EQ: return "=="; + case NE: return "!="; + case LE: return "<="; + case LSHIFT: return "<<"; + case GE: return ">="; + case RSHIFT: return ">>"; + case ASM: return "asm"; + case AUTO: return "auto"; + case BREAK: return "break"; + case CASE: return "case"; + case CATCH: return "catch"; + case CHAR: return "char"; + case CLASS: return "class"; + case CONST: return "const"; + case CONTINUE: return "continue"; + case DEFAULT: return "default"; + case DELETE: return "delete"; + case DO: return "do"; + case DOUBLE: return "double"; + case ELSE: return "else"; + case ENUM: return "enum"; + case EXTERN: return "extern"; + case FLOAT: return "float"; + case FOR: return "for"; + case FRIEND: return "friend"; + case GOTO: return "goto"; + case IF: return "if"; + case T_INLINE: return "inline"; + case INT: return "int"; + case LONG: return "long"; + case NEW: return "new"; + case OPERATOR: return "operator"; + case PRIVATE: return "private"; + case PROTECTED: return "protected"; + case PUBLIC: return "public"; + case REGISTER: return "register"; + case RETURN: return "return"; + case SHORT: return "short"; + case SIGNED: return "signed"; + case SIZEOF: return "sizeof"; + case STATIC: return "static"; + case STRUCT: return "struct"; + case SWITCH: return "switch"; + case TEMPLATE: return "template"; + case THIS: return "this"; + case THROW: return "throw"; + case TRY: return "try"; + case TYPEDEF: return "typedef"; + case UNION: return "union"; + case UNSIGNED: return "unsigned"; + case VIRTUAL: return "virtual"; + case VOID: return "void"; + case VOLATILE: return "volatile"; + case WHILE: return "while"; + case YYEOF: return "EOF"; + } + + assert (t < 255); + b[0] = t; + b[1] = '\0'; + return b; +} + + +/* Reinitialize the scanner for a new input file. */ + +void +re_init_scanner () +{ + in = inbuffer; + yyline = 1; + + if (yytext == NULL) + { + int size = 256; + yytext = (char *) xmalloc (size * sizeof *yytext); + yytext_end = yytext + size; + } +} + + +/* Insert a keyword NAME with token value TK into the keyword hash + table. */ + +void +insert_keyword (name, tk) + char *name; + int tk; +{ + char *s; + unsigned h = 0; + struct kw *k = (struct kw *) xmalloc (sizeof *k); + + for (s = name; *s; ++s) + h = (h << 1) ^ *s; + + h %= KEYWORD_TABLE_SIZE; + k->name = name; + k->tk = tk; + k->next = keyword_table[h]; + keyword_table[h] = k; +} + + +/* Initialize the scanner for the first file. This sets up the + character class vectors and fills the keyword hash table. */ + +void +init_scanner () +{ + int i; + + /* Allocate the input buffer */ + inbuffer_size = READ_CHUNK_SIZE + 1; + inbuffer = in = (char *) xmalloc (inbuffer_size); + yyline = 1; + + /* Set up character class vectors. */ + for (i = 0; i < sizeof is_ident; ++i) + { + if (i == '_' || isalnum (i)) + is_ident[i] = 1; + + if (i >= '0' && i <= '9') + is_digit[i] = 1; + + if (i == ' ' || i == '\t' || i == '\f' || i == '\v') + is_white[i] = 1; + } + + /* Fill keyword hash table. */ + insert_keyword ("and", LAND); + insert_keyword ("and_eq", ANDASGN); + insert_keyword ("asm", ASM); + insert_keyword ("auto", AUTO); + insert_keyword ("bitand", '&'); + insert_keyword ("bitor", '|'); + insert_keyword ("bool", BOOL); + insert_keyword ("break", BREAK); + insert_keyword ("case", CASE); + insert_keyword ("catch", CATCH); + insert_keyword ("char", CHAR); + insert_keyword ("class", CLASS); + insert_keyword ("compl", '~'); + insert_keyword ("const", CONST); + insert_keyword ("const_cast", CONST_CAST); + insert_keyword ("continue", CONTINUE); + insert_keyword ("default", DEFAULT); + insert_keyword ("delete", DELETE); + insert_keyword ("do", DO); + insert_keyword ("double", DOUBLE); + insert_keyword ("dynamic_cast", DYNAMIC_CAST); + insert_keyword ("else", ELSE); + insert_keyword ("enum", ENUM); + insert_keyword ("explicit", EXPLICIT); + insert_keyword ("extern", EXTERN); + insert_keyword ("false", FALSE); + insert_keyword ("float", FLOAT); + insert_keyword ("for", FOR); + insert_keyword ("friend", FRIEND); + insert_keyword ("goto", GOTO); + insert_keyword ("if", IF); + insert_keyword ("inline", T_INLINE); + insert_keyword ("int", INT); + insert_keyword ("long", LONG); + insert_keyword ("mutable", MUTABLE); + insert_keyword ("namespace", NAMESPACE); + insert_keyword ("new", NEW); + insert_keyword ("not", '!'); + insert_keyword ("not_eq", NE); + insert_keyword ("operator", OPERATOR); + insert_keyword ("or", LOR); + insert_keyword ("or_eq", ORASGN); + insert_keyword ("private", PRIVATE); + insert_keyword ("protected", PROTECTED); + insert_keyword ("public", PUBLIC); + insert_keyword ("register", REGISTER); + insert_keyword ("reinterpret_cast", REINTERPRET_CAST); + insert_keyword ("return", RETURN); + insert_keyword ("short", SHORT); + insert_keyword ("signed", SIGNED); + insert_keyword ("sizeof", SIZEOF); + insert_keyword ("static", STATIC); + insert_keyword ("static_cast", STATIC_CAST); + insert_keyword ("struct", STRUCT); + insert_keyword ("switch", SWITCH); + insert_keyword ("template", TEMPLATE); + insert_keyword ("this", THIS); + insert_keyword ("throw", THROW); + insert_keyword ("true", TRUE); + insert_keyword ("try", TRY); + insert_keyword ("typedef", TYPEDEF); + insert_keyword ("typeid", TYPEID); + insert_keyword ("typename", TYPENAME); + insert_keyword ("union", UNION); + insert_keyword ("unsigned", UNSIGNED); + insert_keyword ("using", USING); + insert_keyword ("virtual", VIRTUAL); + insert_keyword ("void", VOID); + insert_keyword ("volatile", VOLATILE); + insert_keyword ("wchar_t", WCHAR); + insert_keyword ("while", WHILE); + insert_keyword ("xor", '^'); + insert_keyword ("xor_eq", XORASGN); +} + + + +/*********************************************************************** + Parser + ***********************************************************************/ + +/* Match the current lookahead token and set it to the next token. */ + +#define MATCH() (tk = yylex ()) + +/* Return the lookahead token. If current lookahead token is cleared, + read a new token. */ + +#define LA1 (tk == -1 ? (tk = yylex ()) : tk) + +/* Is the current lookahead equal to the token T? */ + +#define LOOKING_AT(T) (tk == (T)) + +/* Is the current lookahead one of T1 or T2? */ + +#define LOOKING_AT2(T1, T2) (tk == (T1) || tk == (T2)) + +/* Is the current lookahead one of T1, T2 or T3? */ + +#define LOOKING_AT3(T1, T2, T3) (tk == (T1) || tk == (T2) || tk == (T3)) + +/* Is the current lookahead one of T1...T4? */ + +#define LOOKING_AT4(T1, T2, T3, T4) \ + (tk == (T1) || tk == (T2) || tk == (T3) || tk == (T4)) + +/* Match token T if current lookahead is T. */ + +#define MATCH_IF(T) if (LOOKING_AT (T)) MATCH (); else ((void) 0) + +/* Skip to matching token if current token is T. */ + +#define SKIP_MATCHING_IF(T) \ + if (LOOKING_AT (T)) skip_matching (); else ((void) 0) + + +/* Skip forward until a given token TOKEN or YYEOF is seen and return + the current lookahead token after skipping. */ + +int +skip_to (token) + int token; +{ + while (!LOOKING_AT2 (YYEOF, token)) + MATCH (); + return tk; +} + + +/* Skip over pairs of tokens (parentheses, square brackets, + angle brackets, curly brackets) matching the current lookahead. */ + +void +skip_matching () +{ + int open, close, n; + + switch (open = LA1) + { + case '{': + close = '}'; + break; + + case '(': + close = ')'; + break; + + case '<': + close = '>'; + break; + + case '[': + close = ']'; + break; + + default: + abort (); + } + + for (n = 0;;) + { + if (LOOKING_AT (open)) + ++n; + else if (LOOKING_AT (close)) + --n; + else if (LOOKING_AT (YYEOF)) + break; + + MATCH (); + + if (n == 0) + break; + } +} + + +/* Re-initialize the parser by resetting the lookahead token. */ + +void +re_init_parser () +{ + tk = -1; +} + + +/* Parse a parameter list, including the const-specifier, + pure-specifier, and throw-list that may follow a parameter list. + Return in FLAGS what was seen following the parameter list. + Returns a hash code for the parameter types. This value is used to + distinguish between overloaded functions. */ + +unsigned +parm_list (flags) + int *flags; +{ + unsigned hash = 0; + int type_seen = 0; + + while (!LOOKING_AT2 (YYEOF, ')')) + { + switch (LA1) + { + /* Skip over grouping parens or parameter lists in parameter + declarations. */ + case '(': + skip_matching (); + break; + + /* Next parameter. */ + case ',': + MATCH (); + type_seen = 0; + break; + + /* Ignore the scope part of types, if any. This is because + some types need scopes when defined outside of a class body, + and don't need them inside the class body. This means that + we have to look for the last IDENT in a sequence of + IDENT::IDENT::... */ + case IDENT: + if (!type_seen) + { + char *s; + unsigned ident_type_hash = 0; + + parse_qualified_param_ident_or_type (&s); + for (; *s; ++s) + ident_type_hash = (ident_type_hash << 1) ^ *s; + hash = (hash << 1) ^ ident_type_hash; + type_seen = 1; + } + else + MATCH (); + break; + + case VOID: + /* This distinction is made to make `func (void)' equivalent + to `func ()'. */ + type_seen = 1; + MATCH (); + if (!LOOKING_AT (')')) + hash = (hash << 1) ^ VOID; + break; + + case BOOL: case CHAR: case CLASS: case CONST: + case DOUBLE: case ENUM: case FLOAT: case INT: + case LONG: case SHORT: case SIGNED: case STRUCT: + case UNION: case UNSIGNED: case VOLATILE: case WCHAR: + case ELLIPSIS: + type_seen = 1; + hash = (hash << 1) ^ LA1; + MATCH (); + break; + + case '*': case '&': case '[': case ']': + hash = (hash << 1) ^ LA1; + MATCH (); + break; + + default: + MATCH (); + break; + } + } + + if (LOOKING_AT (')')) + { + MATCH (); + + if (LOOKING_AT (CONST)) + { + /* We can overload the same function on `const' */ + hash = (hash << 1) ^ CONST; + SET_FLAG (*flags, F_CONST); + MATCH (); + } + + if (LOOKING_AT (THROW)) + { + MATCH (); + SKIP_MATCHING_IF ('('); + SET_FLAG (*flags, F_THROW); + } + + if (LOOKING_AT ('=')) + { + MATCH (); + if (LOOKING_AT (CINT) && yyival == 0) + { + MATCH (); + SET_FLAG (*flags, F_PURE); + } + } + } + + return hash; +} + + +/* Print position info to stdout. */ + +void +print_info () +{ + if (info_position >= 0 && BUFFER_POS () <= info_position) + if (info_cls) + printf ("(\"%s\" \"%s\" \"%s\" %d)\n", + info_cls->name, sym_scope (info_cls), + info_member->name, info_where); +} + + +/* Parse a member declaration within the class body of CLS. VIS is + the access specifier for the member (private, protected, + public). */ + +void +member (cls, vis) + struct sym *cls; + int vis; +{ + char *id = NULL; + int sc = SC_MEMBER; + char *regexp = NULL; + int pos; + int is_constructor; + int anonymous = 0; + int flags = 0; + int class_tag; + int type_seen = 0; + int paren_seen = 0; + unsigned hash = 0; + int tilde = 0; + + while (!LOOKING_AT4 (';', '{', '}', YYEOF)) + { + switch (LA1) + { + default: + MATCH (); + break; + + /* A function or class may follow. */ + case TEMPLATE: + MATCH(); + SET_FLAG (flags, F_TEMPLATE); + /* Skip over template argument list */ + SKIP_MATCHING_IF ('<'); + break; + + case EXPLICIT: + SET_FLAG (flags, F_EXPLICIT); + goto typeseen; + + case MUTABLE: + SET_FLAG (flags, F_MUTABLE); + goto typeseen; + + case T_INLINE: + SET_FLAG (flags, F_INLINE); + goto typeseen; + + case VIRTUAL: + SET_FLAG (flags, F_VIRTUAL); + goto typeseen; + + case '[': + skip_matching (); + break; + + case ENUM: + sc = SC_TYPE; + goto typeseen; + + case TYPEDEF: + sc = SC_TYPE; + goto typeseen; + + case FRIEND: + sc = SC_FRIEND; + goto typeseen; + + case STATIC: + sc = SC_STATIC; + goto typeseen; + + case '~': + tilde = 1; + MATCH (); + break; + + case IDENT: + /* Remember IDENTS seen so far. Among these will be the member + name. */ + id = (char *) alloca (strlen (yytext) + 2); + if (tilde) + { + *id = '~'; + strcpy (id + 1, yytext); + } + else + strcpy (id, yytext); + MATCH (); + break; + + case OPERATOR: + id = operator_name (&sc); + break; + + case '(': + /* Most probably the beginning of a parameter list. */ + MATCH (); + paren_seen = 1; + + if (id && cls) + { + if (!(is_constructor = streq (id, cls->name))) + regexp = matching_regexp (); + } + else + is_constructor = 0; + + pos = BUFFER_POS (); + hash = parm_list (&flags); + + if (is_constructor) + regexp = matching_regexp (); + + if (id && cls != NULL) + add_member_decl (cls, id, regexp, pos, hash, 0, sc, vis, flags); + + while (!LOOKING_AT3 (';', '{', YYEOF)) + MATCH (); + + if (LOOKING_AT ('{') && id && cls) + add_member_defn (cls, id, regexp, pos, hash, 0, sc, flags); + + id = NULL; + sc = SC_MEMBER; + break; + + case STRUCT: case UNION: case CLASS: + /* Nested class */ + class_tag = LA1; + type_seen = 1; + MATCH (); + anonymous = 1; + + /* More than one ident here to allow for MS-DOS specialties + like `_export class' etc. The last IDENT seen counts + as the class name. */ + while (!LOOKING_AT4 (YYEOF, ';', ':', '{')) + { + if (LOOKING_AT (IDENT)) + anonymous = 0; + MATCH (); + } + + if (LOOKING_AT2 (':', '{')) + class_definition (anonymous ? NULL : cls, class_tag, flags, 1); + else + skip_to (';'); + break; + + case INT: case CHAR: case LONG: case UNSIGNED: + case SIGNED: case CONST: case DOUBLE: case VOID: + case SHORT: case VOLATILE: case BOOL: case WCHAR: + case TYPENAME: + typeseen: + type_seen = 1; + MATCH (); + break; + } + } + + if (LOOKING_AT (';')) + { + /* The end of a member variable, a friend declaration or an access + declaration. We don't want to add friend classes as members. */ + if (id && sc != SC_FRIEND && cls) + { + regexp = matching_regexp (); + pos = BUFFER_POS (); + + if (cls != NULL) + { + if (type_seen || !paren_seen) + add_member_decl (cls, id, regexp, pos, 0, 1, sc, vis, 0); + else + add_member_decl (cls, id, regexp, pos, hash, 0, sc, vis, 0); + } + } + + MATCH (); + print_info (); + } + else if (LOOKING_AT ('{')) + { + /* A named enum. */ + if (sc == SC_TYPE && id && cls) + { + regexp = matching_regexp (); + pos = BUFFER_POS (); + + if (cls != NULL) + { + add_member_decl (cls, id, regexp, pos, 0, 1, sc, vis, 0); + add_member_defn (cls, id, regexp, pos, 0, 1, sc, 0); + } + } + + skip_matching (); + print_info (); + } +} + + +/* Parse the body of class CLS. TAG is the tag of the class (struct, + union, class). */ + +void +class_body (cls, tag) + struct sym *cls; + int tag; +{ + int vis = tag == CLASS ? PRIVATE : PUBLIC; + int temp; + + while (!LOOKING_AT2 (YYEOF, '}')) + { + switch (LA1) + { + case PRIVATE: case PROTECTED: case PUBLIC: + temp = LA1; + MATCH (); + + if (LOOKING_AT (':')) + { + vis = temp; + MATCH (); + } + else + { + /* Probably conditional compilation for inheritance list. + We don't known whether there comes more of this. + This is only a crude fix that works most of the time. */ + do + { + MATCH (); + } + while (LOOKING_AT2 (IDENT, ',') + || LOOKING_AT3 (PUBLIC, PROTECTED, PRIVATE)); + } + break; + + case TYPENAME: + case USING: + skip_to (';'); + break; + + /* Try to synchronize */ + case CHAR: case CLASS: case CONST: + case DOUBLE: case ENUM: case FLOAT: case INT: + case LONG: case SHORT: case SIGNED: case STRUCT: + case UNION: case UNSIGNED: case VOID: case VOLATILE: + case TYPEDEF: case STATIC: case T_INLINE: case FRIEND: + case VIRTUAL: case TEMPLATE: case IDENT: case '~': + case BOOL: case WCHAR: case EXPLICIT: case MUTABLE: + member (cls, vis); + break; + + default: + MATCH (); + break; + } + } +} + + +/* Parse a qualified identifier. Current lookahead is IDENT. A + qualified ident has the form `X<..>::Y<...>::T<...>. Returns a + symbol for that class. */ + +struct sym * +parse_classname () +{ + struct sym *last_class = NULL; + + while (LOOKING_AT (IDENT)) + { + last_class = add_sym (yytext, last_class); + MATCH (); + + if (LOOKING_AT ('<')) + { + skip_matching (); + SET_FLAG (last_class->flags, F_TEMPLATE); + } + + if (!LOOKING_AT (DCOLON)) + break; + + MATCH (); + } + + return last_class; +} + + +/* Parse an operator name. Add the `static' flag to *SC if an + implicitly static operator has been parsed. Value is a pointer to + a static buffer holding the constructed operator name string. */ + +char * +operator_name (sc) + int *sc; +{ + static int id_size = 0; + static char *id = NULL; + char *s; + int len; + + MATCH (); + + if (LOOKING_AT2 (NEW, DELETE)) + { + /* `new' and `delete' are implicitly static. */ + if (*sc != SC_FRIEND) + *sc = SC_STATIC; + + s = token_string (LA1); + MATCH (); + + len = strlen (s) + 10; + if (len > id_size) + { + int new_size = max (len, 2 * id_size); + id = (char *) xrealloc (id, new_size); + id_size = new_size; + } + strcpy (id, s); + + /* Vector new or delete? */ + if (LOOKING_AT ('[')) + { + strcat (id, "["); + MATCH (); + + if (LOOKING_AT (']')) + { + strcat (id, "]"); + MATCH (); + } + } + } + else + { + int tokens_matched = 0; + + len = 20; + if (len > id_size) + { + int new_size = max (len, 2 * id_size); + id = (char *) xrealloc (id, new_size); + id_size = new_size; + } + strcpy (id, "operator"); + + /* Beware access declarations of the form "X::f;" Beware of + `operator () ()'. Yet another difficulty is found in + GCC 2.95's STL: `operator == __STL_NULL_TMPL_ARGS (...'. */ + while (!(LOOKING_AT ('(') && tokens_matched) + && !LOOKING_AT2 (';', YYEOF)) + { + s = token_string (LA1); + len += strlen (s) + 2; + if (len > id_size) + { + int new_size = max (len, 2 * id_size); + id = (char *) xrealloc (id, new_size); + id_size = new_size; + } + + if (*s != ')' && *s != ']') + strcat (id, " "); + strcat (id, s); + MATCH (); + + /* If this is a simple operator like `+', stop now. */ + if (!isalpha (*s) && *s != '(' && *s != '[') + break; + + ++tokens_matched; + } + } + + return id; +} + + +/* This one consumes the last IDENT of a qualified member name like + `X::Y::z'. This IDENT is returned in LAST_ID. Value if the + symbol structure for the ident. */ + +struct sym * +parse_qualified_ident_or_type (last_id) + char **last_id; +{ + struct sym *cls = NULL; + static char *id = NULL; + static int id_size = 0; + + while (LOOKING_AT (IDENT)) + { + int len = strlen (yytext) + 1; + if (len > id_size) + { + id = (char *) xrealloc (id, len); + id_size = len; + } + strcpy (id, yytext); + *last_id = id; + MATCH (); + + SKIP_MATCHING_IF ('<'); + + if (LOOKING_AT (DCOLON)) + { + cls = add_sym (id, cls); + *last_id = NULL; + MATCH (); + } + else + break; + } + + return cls; +} + + +/* This one consumes the last IDENT of a qualified member name like + `X::Y::z'. This IDENT is returned in LAST_ID. Value if the + symbol structure for the ident. */ + +void +parse_qualified_param_ident_or_type (last_id) + char **last_id; +{ + struct sym *cls = NULL; + static char *id = NULL; + static int id_size = 0; + + while (LOOKING_AT (IDENT)) + { + int len = strlen (yytext) + 1; + if (len > id_size) + { + id = (char *) xrealloc (id, len); + id_size = len; + } + strcpy (id, yytext); + *last_id = id; + MATCH (); + + SKIP_MATCHING_IF ('<'); + + if (LOOKING_AT (DCOLON)) + { + cls = add_sym (id, cls); + *last_id = NULL; + MATCH (); + } + else + break; + } +} + + +/* Parse a class definition. + + CONTAINING is the class containing the class being parsed or null. + This may also be null if NESTED != 0 if the containing class is + anonymous. TAG is the tag of the class (struct, union, class). + NESTED is non-zero if we are parsing a nested class. + + Current lookahead is the class name. */ + +void +class_definition (containing, tag, flags, nested) + struct sym *containing; + int tag; + int flags; + int nested; +{ + register int token; + struct sym *current; + struct sym *base_class; + + /* Set CURRENT to null if no entry has to be made for the class + parsed. This is the case for certain command line flag + settings. */ + if ((tag != CLASS && !f_structs) || (nested && !f_nested_classes)) + current = NULL; + else + { + current = add_sym (yytext, containing); + current->pos = BUFFER_POS (); + current->regexp = matching_regexp (); + current->filename = filename; + current->flags = flags; + } + + /* If at ':', base class list follows. */ + if (LOOKING_AT (':')) + { + int done = 0; + MATCH (); + + while (!done) + { + switch (token = LA1) + { + case VIRTUAL: case PUBLIC: case PROTECTED: case PRIVATE: + MATCH (); + break; + + case IDENT: + base_class = parse_classname (); + if (base_class && current && base_class != current) + add_link (base_class, current); + break; + + /* The `,' between base classes or the end of the base + class list. Add the previously found base class. + It's done this way to skip over sequences of + `A::B::C' until we reach the end. + + FIXME: it is now possible to handle `class X : public B::X' + because we have enough information. */ + case ',': + MATCH (); + break; + + default: + /* A syntax error, possibly due to preprocessor constructs + like + + #ifdef SOMETHING + class A : public B + #else + class A : private B. + + MATCH until we see something like `;' or `{'. */ + while (!LOOKING_AT3 (';', YYEOF, '{')) + MATCH (); + done = 1; + + case '{': + done = 1; + break; + } + } + } + + /* Parse the class body if there is one. */ + if (LOOKING_AT ('{')) + { + if (tag != CLASS && !f_structs) + skip_matching (); + else + { + MATCH (); + class_body (current, tag); + + if (LOOKING_AT ('}')) + { + MATCH (); + if (LOOKING_AT (';') && !nested) + MATCH (); + } + } + } +} + + +/* Parse a declaration. */ + +void +declaration (is_extern, flags) + int is_extern; + int flags; +{ + char *id = NULL; + struct sym *cls = NULL; + char *regexp = NULL; + int pos = 0; + unsigned hash = 0; + int is_constructor; + int sc = 0; + + while (!LOOKING_AT3 (';', '{', YYEOF)) + { + switch (LA1) + { + default: + MATCH (); + break; + + case '[': + skip_matching (); + break; + + case ENUM: + case TYPEDEF: + sc = SC_TYPE; + MATCH (); + break; + + case STATIC: + sc = SC_STATIC; + MATCH (); + break; + + case INT: case CHAR: case LONG: case UNSIGNED: + case SIGNED: case CONST: case DOUBLE: case VOID: + case SHORT: case VOLATILE: case BOOL: case WCHAR: + MATCH (); + break; + + case CLASS: case STRUCT: case UNION: + /* This is for the case `STARTWRAP class X : ...' or + `declare (X, Y)\n class A : ...'. */ + if (id) + return; + + case '=': + /* Assumed to be the start of an initialization in this context. + Skip over everything up to ';'. */ + skip_to (';'); + break; + + case OPERATOR: + id = operator_name (&sc); + break; + + case T_INLINE: + SET_FLAG (flags, F_INLINE); + MATCH (); + break; + + case '~': + MATCH (); + if (LOOKING_AT (IDENT)) + { + id = (char *) alloca (strlen (yytext) + 2); + *id = '~'; + strcpy (id + 1, yytext); + MATCH (); + } + break; + + case IDENT: + cls = parse_qualified_ident_or_type (&id); + break; + + case '(': + /* Most probably the beginning of a parameter list. */ + if (cls) + { + MATCH (); + + if (id && cls) + { + if (!(is_constructor = streq (id, cls->name))) + regexp = matching_regexp (); + } + else + is_constructor = 0; + + pos = BUFFER_POS (); + hash = parm_list (&flags); + + if (is_constructor) + regexp = matching_regexp (); + + if (id && cls) + add_member_defn (cls, id, regexp, pos, hash, 0, + SC_UNKNOWN, flags); + } + else + { + /* This may be a C functions, but also a macro + call of the form `declare (A, B)' --- such macros + can be found in some class libraries. */ + MATCH (); + + if (id) + { + regexp = matching_regexp (); + pos = BUFFER_POS (); + hash = parm_list (&flags); + add_global_decl (id, regexp, pos, hash, 0, sc, flags); + } + + /* This is for the case that the function really is + a macro with no `;' following it. If a CLASS directly + follows, we would miss it otherwise. */ + if (LOOKING_AT3 (CLASS, STRUCT, UNION)) + return; + } + + while (!LOOKING_AT3 (';', '{', YYEOF)) + MATCH (); + + if (!cls && id && LOOKING_AT ('{')) + add_global_defn (id, regexp, pos, hash, 0, sc, flags); + id = NULL; + break; + } + } + + if (LOOKING_AT (';')) + { + /* The end of a member variable or of an access declaration + `X::f'. To distinguish between them we have to know whether + type information has been seen. */ + if (id) + { + char *regexp = matching_regexp (); + int pos = BUFFER_POS (); + + if (cls) + add_member_defn (cls, id, regexp, pos, 0, 1, SC_UNKNOWN, flags); + else + add_global_defn (id, regexp, pos, 0, 1, sc, flags); + } + + MATCH (); + print_info (); + } + else if (LOOKING_AT ('{')) + { + if (sc == SC_TYPE && id) + { + /* A named enumeration. */ + regexp = matching_regexp (); + pos = BUFFER_POS (); + add_global_defn (id, regexp, pos, 0, 1, sc, flags); + } + + skip_matching (); + print_info (); + } +} + + +/* Parse a list of top-level declarations/definitions. START_FLAGS + says in which context we are parsing. If it is F_EXTERNC, we are + parsing in an `extern "C"' block. Value is 1 if EOF is reached, 0 + otherwise. */ + +int +globals (start_flags) + int start_flags; +{ + int anonymous; + int class_tk; + int flags = start_flags; + + for (;;) + { + char *prev_in = in; + + switch (LA1) + { + case NAMESPACE: + { + MATCH (); + + if (LOOKING_AT (IDENT)) + { + char *namespace_name + = (char *) alloca (strlen (yytext) + 1); + strcpy (namespace_name, yytext); + MATCH (); + + if (LOOKING_AT ('=')) + { + if (skip_to (';') == ';') + MATCH (); + register_namespace_alias (namespace_name, yytext); + } + else if (LOOKING_AT ('{')) + { + MATCH (); + enter_namespace (namespace_name); + globals (0); + leave_namespace (); + MATCH_IF ('}'); + } + } + } + break; + + case EXTERN: + MATCH (); + if (LOOKING_AT (CSTRING) && *string_start == 'C' + && *(string_start + 1) == '"') + { + /* This is `extern "C"'. */ + MATCH (); + + if (LOOKING_AT ('{')) + { + MATCH (); + globals (F_EXTERNC); + MATCH_IF ('}'); + } + else + SET_FLAG (flags, F_EXTERNC); + } + break; + + case TEMPLATE: + MATCH (); + SKIP_MATCHING_IF ('<'); + SET_FLAG (flags, F_TEMPLATE); + break; + + case CLASS: case STRUCT: case UNION: + class_tk = LA1; + MATCH (); + anonymous = 1; + + /* More than one ident here to allow for MS-DOS and OS/2 + specialties like `far', `_Export' etc. Some C++ libs + have constructs like `_OS_DLLIMPORT(_OS_CLIENT)' in front + of the class name. */ + while (!LOOKING_AT4 (YYEOF, ';', ':', '{')) + { + if (LOOKING_AT (IDENT)) + anonymous = 0; + MATCH (); + } + + /* Don't add anonymous unions. */ + if (LOOKING_AT2 (':', '{') && !anonymous) + class_definition (NULL, class_tk, flags, 0); + else + { + if (skip_to (';') == ';') + MATCH (); + } + + flags = start_flags; + break; + + case YYEOF: + return 1; + + case '}': + return 0; + + default: + declaration (0, flags); + flags = start_flags; + break; + } + + if (prev_in == in) + yyerror ("parse error"); + } +} + + +/* Parse the current input file. */ + +void +yyparse () +{ + while (globals (0) == 0) + MATCH_IF ('}'); +} + + + +/*********************************************************************** + Main Program + ***********************************************************************/ + +/* Add the list of paths PATH_LIST to the current search path for + input files. */ + +void +add_search_path (path_list) + char *path_list; +{ + while (*path_list) + { + char *start = path_list; + struct search_path *p; + + while (*path_list && *path_list != PATH_LIST_SEPARATOR) + ++path_list; + + p = (struct search_path *) xmalloc (sizeof *p); + p->path = (char *) xmalloc (path_list - start + 1); + memcpy (p->path, start, path_list - start); + p->path[path_list - start] = '\0'; + p->next = NULL; + + if (search_path_tail) + { + search_path_tail->next = p; + search_path_tail = p; + } + else + search_path = search_path_tail = p; + + while (*path_list == PATH_LIST_SEPARATOR) + ++path_list; + } +} + + +/* Open FILE and return a file handle for it, or -1 if FILE cannot be + opened. Try to find FILE in search_path first, then try the + unchanged file name. */ + +FILE * +open_file (file) + char *file; +{ + FILE *fp = NULL; + static char *buffer; + static int buffer_size; + struct search_path *path; + + filename = xstrdup (file); + + for (path = search_path; path && fp == NULL; path = path->next) + { + int len = strlen (path->path); + + if (len + 1 >= buffer_size) + { + buffer_size = max (len + 1, 2 * buffer_size); + buffer = (char *) xrealloc (buffer, buffer_size); + } + + strcpy (buffer, path->path); + strcat (buffer, "/"); + strcat (buffer, file); + fp = fopen (buffer, "r"); + } + + /* Try the original file name. */ + if (fp == NULL) + fp = fopen (file, "r"); + + if (fp == NULL) + yyerror ("cannot open"); + + return fp; +} + + +/* Display usage information and exit program. */ + +#define USAGE "\ +Usage: ebrowse [options] {files}\n\ +\n\ + -a, --append append output\n\ + -f, --files=FILES read input file names from FILE\n\ + -I, --search-path=LIST set search path for input files\n\ + -m, --min-regexp-length=N set minimum regexp length to N\n\ + -M, --max-regexp-length=N set maximum regexp length to N\n\ + -n, --no-nested-classes exclude nested classes\n\ + -o, --output-file=FILE set output file name to FILE\n\ + -p, --position-info print info about position in file\n\ + -s, --no-structs-or-unions don't record structs or unions\n\ + -v, --verbose be verbose\n\ + -V, --very-verbose be very verbose\n\ + -x, --no-regexps don't record regular expressions\n\ + --help display this help\n\ + --version display version info\n\ +" + +void +usage (error) + int error; +{ + puts (USAGE); + exit (error ? 1 : 0); +} + + +/* Display version and copyright info. The VERSION macro is set + from the Makefile and contains the Emacs version. */ + +void +version () +{ + printf ("ebrowse %s\n", VERSION); + puts ("Copyright (C) 1992-1999, 2000 Free Software Foundation, Inc."); + puts ("This program is distributed under the same terms as Emacs."); + exit (0); +} + + +/* Parse one input file FILE, adding classes and members to the symbol + table. */ + +void +process_file (file) + char *file; +{ + FILE *fp; + + fp = open_file (file); + if (fp) + { + int nread, nbytes; + + /* Give a progress indication if needed. */ + if (f_very_verbose) + { + puts (filename); + fflush (stdout); + } + else if (f_verbose) + { + putchar ('.'); + fflush (stdout); + } + + /* Read file to inbuffer. */ + for (nread = 0;;) + { + if (nread + READ_CHUNK_SIZE >= inbuffer_size) + { + inbuffer_size = nread + READ_CHUNK_SIZE + 1; + inbuffer = (char *) xrealloc (inbuffer, inbuffer_size); + } + + nbytes = fread (inbuffer + nread, 1, READ_CHUNK_SIZE, fp); + nread += nbytes; + if (nbytes < READ_CHUNK_SIZE) + break; + } + inbuffer[nread] = '\0'; + + /* Reinitialize scanner and parser for the new input file. */ + re_init_scanner (); + re_init_parser (); + + /* Parse it and close the file. */ + yyparse (); + fclose (fp); + } +} + + +/* Read a line from stream FP and return a pointer to a static buffer + containing its contents without the terminating newline. Value + is null when EOF is reached. */ + +char * +read_line (fp) + FILE *fp; +{ + static char *buffer; + static int buffer_size; + int i = 0, c; + + while ((c = getc (fp)) != EOF && c != '\n') + { + if (i >= buffer_size) + { + buffer_size = max (100, buffer_size * 2); + buffer = (char *) xrealloc (buffer, buffer_size); + } + + buffer[i++] = c; + } + + if (c == EOF && i == 0) + return NULL; + + if (i == buffer_size) + { + buffer_size = max (100, buffer_size * 2); + buffer = (char *) xrealloc (buffer, buffer_size); + } + + buffer[i] = '\0'; + return buffer; +} + + +/* Main entry point. */ + +int +main (argc, argv) + int argc; + char **argv; +{ + int i; + int any_inputfiles = 0; + static char *out_filename = DEFAULT_OUTFILE; + static char **input_filenames = NULL; + static int input_filenames_size = 0; + static int n_input_files; + + filename = "command line"; + yyout = stdout; + + while ((i = getopt_long (argc, argv, "af:I:m:M:no:p:svVx", + options, NULL)) != EOF) + { + switch (i) + { + /* Experimental. */ + case 'p': + info_position = atoi (optarg); + break; + + case 'n': + f_nested_classes = 0; + break; + + case 'x': + f_regexps = 0; + break; + + /* Add the name of a file containing more input files. */ + case 'f': + if (n_input_files == input_filenames_size) + { + input_filenames_size = max (10, 2 * input_filenames_size); + input_filenames = (char **) xrealloc (input_filenames, + input_filenames_size); + } + input_filenames[n_input_files++] = xstrdup (optarg); + break; + + /* Append new output to output file instead of truncating it. */ + case 'a': + f_append = 1; + break; + + /* Include structs in the output */ + case 's': + f_structs = 0; + break; + + /* Be verbose (give a progress indication). */ + case 'v': + f_verbose = 1; + break; + + /* Be very verbose (print file names as they are processed). */ + case 'V': + f_verbose = 1; + f_very_verbose = 1; + break; + + /* Change the name of the output file. */ + case 'o': + out_filename = optarg; + break; + + /* Set minimum length for regular expression strings + when recorded in the output file. */ + case 'm': + min_regexp = atoi (optarg); + break; + + /* Set maximum length for regular expression strings + when recorded in the output file. */ + case 'M': + max_regexp = atoi (optarg); + break; + + /* Add to search path. */ + case 'I': + add_search_path (optarg); + break; + + /* Display help */ + case -2: + usage (0); + break; + + case -3: + version (); + break; + } + } + + /* Call init_scanner after command line flags have been processed to be + able to add keywords depending on command line (not yet + implemented). */ + init_scanner (); + init_sym (); + + /* Open output file */ + if (*out_filename) + { + yyout = fopen (out_filename, f_append ? "a" : "w"); + if (yyout == NULL) + { + yyerror ("cannot open output file `%s'", out_filename); + exit (1); + } + } + + /* Process input files specified on the command line. */ + while (optind < argc) + { + process_file (argv[optind++]); + any_inputfiles = 1; + } + + /* Process files given on stdin if no files specified. */ + if (!any_inputfiles && n_input_files == 0) + { + char *file; + while ((file = read_line (stdin)) != NULL) + process_file (file); + } + else + { + /* Process files from `--files=FILE'. Every line in FILE names + one input file to process. */ + for (i = 0; i < n_input_files; ++i) + { + FILE *fp = fopen (input_filenames[i], "r"); + + if (fp == NULL) + yyerror ("cannot open input file `%s'", input_filenames[i]); + else + { + char *file; + while ((file = read_line (fp)) != NULL) + process_file (file); + fclose (fp); + } + } + } + + /* Write output file. */ + dump_roots (yyout); + + /* Close output file. */ + if (yyout != stdout) + fclose (yyout); + + return 0; +} + + +/* ebrowse.c ends here. */
--- a/lisp/ChangeLog Sun Apr 09 10:59:46 2000 +0000 +++ b/lisp/ChangeLog Sun Apr 09 11:15:57 2000 +0000 @@ -1,3 +1,20 @@ +2000-04-09 Gerd Moellmann <gerd@gnu.org> + + * mail/rfc2368.el: Correct author's email address. + + * progmodes/ebrowse.el: New file. + + * emacs-lisp/easymenu.el (easy-menu-create-menu): Process menu + item help string. + (easy-menu-do-add-item): Ditto. + (easy-menu-define): Extend doc string. + + * jit-lock.el (with-buffer-unmodified): Use + restore-buffer-modified-p. + (with-buffer-prepared-for-font-lock): Use with-buffer-unmodified. + (jit-lock-function, jit-lock-stealth-fontify): Don't use + with-buffer-unmodified. + 2000-04-08 Dave Love <fx@gnu.org> * emacs-lisp/edebug.el: Fix specs for dolist, dotimes, push, pop,
--- a/lisp/cus-load.el Sun Apr 09 10:59:46 2000 +0000 +++ b/lisp/cus-load.el Sun Apr 09 11:15:57 2000 +0000 @@ -38,6 +38,7 @@ (put 'nnmail-procmail 'custom-loads '("nnmail")) (put 'desktop 'custom-loads '("desktop")) (put 'cperl-help-system 'custom-loads '("cperl-mode")) +(put 'ps-print-miscellany 'custom-loads '("ps-print")) (put 'comint-completion 'custom-loads '("comint")) (put 'gnus-score-kill 'custom-loads '("gnus-kill" "gnus")) (put 'ldap 'custom-loads '("ldap")) @@ -84,6 +85,7 @@ (put 'gnus-various 'custom-loads '("gnus-sum" "gnus")) (put 'elide-head 'custom-loads '("elide-head")) (put 'vhdl-compile 'custom-loads '("vhdl-mode")) +(put 'ebrowse-tree 'custom-loads '("ebrowse")) (put 'font-lock-highlighting-faces 'custom-loads '("font-lock" "vhdl-mode")) (put 'flyspell 'custom-loads '("flyspell")) (put 'ange-ftp 'custom-loads '("ange-ftp")) @@ -267,7 +269,7 @@ (put 'ebnf-optimization 'custom-loads '("ebnf2ps")) (put 'apropos 'custom-loads '("apropos")) (put 'gomoku 'custom-loads '("gomoku")) -(put 'tools 'custom-loads '("add-log" "calculator" "compare-w" "diff-mode" "diff" "ediff" "elide-head" "emerge" "gud" "pcvs-defs" "smerge-mode" "speedbar" "tempo" "tooltip" "vc" "which-func" "copyright" "compile" "etags" "glasses" "make-mode" "rcompile")) +(put 'tools 'custom-loads '("add-log" "calculator" "compare-w" "diff-mode" "diff" "ediff" "elide-head" "emerge" "gud" "pcvs-defs" "smerge-mode" "speedbar" "tempo" "tooltip" "vc" "which-func" "copyright" "compile" "ebrowse" "etags" "glasses" "make-mode" "rcompile")) (put 'gnus-topic 'custom-loads '("gnus-topic")) (put 'sgml 'custom-loads '("sgml-mode")) (put 'keyboard 'custom-loads '("simple" "chistory" "type-break")) @@ -278,6 +280,7 @@ (put 'rmail-summary 'custom-loads '("rmail" "rmailsum")) (put 'metamail 'custom-loads '("metamail")) (put 'winner 'custom-loads '("winner")) +(put 'ebrowse-faces 'custom-loads '("ebrowse")) (put 'wp 'custom-loads '("cus-edit" "enriched" "lpr" "ps-print" "view" "ebnf2ps" "bib-mode" "nroff-mode" "refbib" "refer" "scribe" "tildify")) (put 'reftex-citation-support 'custom-loads '("reftex-vars")) (put 'gnus-summary-choose 'custom-loads '("gnus-sum")) @@ -385,6 +388,7 @@ (put 'ebnf-repeat 'custom-loads '("ebnf2ps")) (put 'supercite 'custom-loads '("supercite")) (put 'font-selection 'custom-loads '("faces")) +(put 'ps-print-headers 'custom-loads '("ps-print")) (put 'gnus-summary-marks 'custom-loads '("gnus-sum" "gnus")) (put 'bibtex-autokey 'custom-loads '("bibtex")) (put 'eudc 'custom-loads '("eudc-vars")) @@ -409,6 +413,7 @@ (put 'fill-comments 'custom-loads '("simple")) (put 'gnus-summary-various 'custom-loads '("gnus-sum")) (put 'applications 'custom-loads '("calendar" "cus-edit" "uniquify" "spell")) +(put 'ebrowse-member 'custom-loads '("ebrowse")) (put 'terminal 'custom-loads '("terminal")) (put 'shadow 'custom-loads '("shadowfile" "shadow")) (put 'hl-line 'custom-loads '("hl-line")) @@ -439,7 +444,7 @@ (put 'hanoi 'custom-loads '("hanoi")) (put 'reftex-index-support 'custom-loads '("reftex-vars")) (put 'pascal 'custom-loads '("pascal")) -(put 'rmail-retrieve 'custom-loads '("rmail")) +(put 'rmail-retrieve 'custom-loads '("rmail" "rmailsum")) (put 'data 'custom-loads '("text-mode" "arc-mode" "forms" "hexl" "jka-compr" "saveplace" "sort" "tar-mode" "time-stamp" "snmp-mode")) (put 'mail 'custom-loads '("simple" "startup" "time" "gnus" "message" "emacsbug" "feedmail" "mail-extr" "mail-hist" "mail-utils" "mailalias" "metamail" "mh-e" "mspools" "rmail" "sendmail" "smtpmail" "supercite" "uce" "fortune" "eudc-vars")) (put 'paren-blinking 'custom-loads '("simple")) @@ -451,9 +456,9 @@ (put 'dired 'custom-loads '("files" "dired-aux" "dired-x" "dired" "find-dired")) (put 'recentf 'custom-loads '("recentf")) (put 'fill 'custom-loads '("simple" "fill" "align")) -(put 'ps-print-header 'custom-loads '("ps-print")) (put 'outlines 'custom-loads '("allout" "outline")) (put 'paragraphs 'custom-loads '("paragraphs")) +(put 'ebrowse 'custom-loads '("ebrowse")) (put 'nnmail-split 'custom-loads '("nnmail")) (put 'makefile 'custom-loads '("make-mode")) (put 'supercite-attr 'custom-loads '("supercite")) @@ -502,12 +507,11 @@ (put 'ps-print-zebra 'custom-loads '("ps-print")) (put 'hideshow 'custom-loads '("hideshow")) (put 'viper-search 'custom-loads '("viper-init")) -(put 'C 'custom-loads '("cpp")) (put 'mule 'custom-loads '("mule-cmds")) (put 'glasses 'custom-loads '("glasses")) (put 'vhdl-style 'custom-loads '("vhdl-mode")) (put 'tempo 'custom-loads '("tempo")) -(put 'c 'custom-loads '("tooltip" "cc-vars" "cmacexp" "hideif")) +(put 'c 'custom-loads '("tooltip" "cc-vars" "cmacexp" "cpp" "hideif")) (put 'nnmail-prepare 'custom-loads '("nnmail")) (put 'processes 'custom-loads '("comint" "cus-edit" "shell" "term" "metamail" "compile" "executable" "sql" "flyspell" "rcompile" "rlogin")) (put 'ebnf2ps 'custom-loads '("ebnf2ps")) @@ -693,6 +697,8 @@ (custom-put-if-not 'border 'group-documentation nil) (custom-put-if-not 'hl-line 'custom-version "21.1") (custom-put-if-not 'hl-line 'group-documentation "Highliight the current line.") +(custom-put-if-not 'find-file-wildcards 'custom-version "20.4") +(custom-put-if-not 'find-file-wildcards 'standard-value t) (custom-put-if-not 'custom-comment-face 'custom-version "21.1") (custom-put-if-not 'custom-comment-face 'group-documentation nil) (custom-put-if-not 'custom-raised-buttons 'custom-version "21.1") @@ -727,6 +733,8 @@ (custom-put-if-not 'hscroll-global-mode 'standard-value t) (custom-put-if-not 'tags-apropos-verbose 'custom-version "21.1") (custom-put-if-not 'tags-apropos-verbose 'standard-value t) +(custom-put-if-not 'dabbrev-ignored-regexps 'custom-version "21.1") +(custom-put-if-not 'dabbrev-ignored-regexps 'standard-value t) (custom-put-if-not 'find-variable-regexp 'custom-version "20.3") (custom-put-if-not 'find-variable-regexp 'standard-value t) (custom-put-if-not 'header-line 'custom-version "21.1") @@ -744,7 +752,7 @@ (custom-put-if-not 'eval-expression-print-level 'custom-version "21.1") (custom-put-if-not 'eval-expression-print-level 'standard-value t) -(defvar custom-versions-load-alist '(("20.3.3" "dos-vars") (21.1 "ange-ftp") ("20.4" "sh-script" "help" "compile") ("21.1" "debug" "paths" "sgml-mode" "fortran" "etags" "cus-edit" "add-log" "find-func" "simple") ("20.3" "desktop" "easymenu" "hscroll" "dabbrev" "ffap" "rmail" "paren" "mailabbrev" "frame" "uce" "mouse" "diary-lib" "sendmail" "debug" "hexl" "vcursor" "vc" "compile" "etags" "help" "browse-url" "add-log" "find-func" "vc-hooks" "cus-edit" "replace")) +(defvar custom-versions-load-alist '(("20.3.3" "dos-vars") (21.1 "ange-ftp") ("20.4" "files" "sh-script" "help" "compile") ("21.1" "debug" "dabbrev" "paths" "sgml-mode" "fortran" "etags" "cus-edit" "add-log" "find-func" "simple") ("20.3" "desktop" "easymenu" "hscroll" "dabbrev" "ffap" "rmail" "paren" "mailabbrev" "frame" "uce" "mouse" "diary-lib" "sendmail" "debug" "hexl" "vcursor" "vc" "compile" "etags" "help" "browse-url" "add-log" "find-func" "vc-hooks" "cus-edit" "replace")) "For internal use by custom.") (provide 'cus-load)
--- a/lisp/loaddefs.el Sun Apr 09 10:59:46 2000 +0000 +++ b/lisp/loaddefs.el Sun Apr 09 11:15:57 2000 +0000 @@ -119,7 +119,7 @@ ;;;### (autoloads (change-log-merge add-log-current-defun change-log-mode ;;;;;; add-change-log-entry-other-window add-change-log-entry find-change-log ;;;;;; prompt-for-change-log-name add-log-mailing-address add-log-full-name) -;;;;;; "add-log" "add-log.el" (14525 5303)) +;;;;;; "add-log" "add-log.el" (14565 55609)) ;;; Generated autoloads from add-log.el (defvar add-log-full-name nil "\ @@ -192,11 +192,11 @@ Return name of function definition point is in, or nil. Understands C, Lisp, LaTeX (\"functions\" are chapters, sections, ...), -Texinfo (@node titles), Perl, and Fortran. +Texinfo (@node titles) and Perl. Other modes are handled by a heuristic that looks in the 10K before point for uppercase headings starting in the first column or -identifiers followed by `:' or `=', see variables +identifiers followed by `:' or `='. See variables `add-log-current-defun-header-regexp' and `add-log-current-defun-function' @@ -417,7 +417,7 @@ ;;;### (autoloads (appt-make-list appt-delete appt-add appt-display-diary ;;;;;; appt-display-duration appt-msg-window appt-display-mode-line ;;;;;; appt-visible appt-audible appt-message-warning-time appt-issue-message) -;;;;;; "appt" "calendar/appt.el" (14517 9487)) +;;;;;; "appt" "calendar/appt.el" (14563 8413)) ;;; Generated autoloads from calendar/appt.el (defvar appt-issue-message t "\ @@ -448,13 +448,23 @@ This will occur at midnight when the appointment list is updated.") (autoload (quote appt-add) "appt" "\ -Add an appointment for the day at TIME and issue MESSAGE. +Add an appointment for the day at NEW-APPT-TIME and issue message NEW-APPT-MSG. The time should be in either 24 hour format or am/pm format." t nil) (autoload (quote appt-delete) "appt" "\ Delete an appointment from the list of appointments." t nil) -(autoload (quote appt-make-list) "appt" nil nil nil) +(autoload (quote appt-make-list) "appt" "\ +Create the appointments list from todays diary buffer. +The time must be at the beginning of a line for it to be +put in the appointments list. + 02/23/89 + 12:00pm lunch + Wednesday + 10:00am group meeting +We assume that the variables DATE and NUMBER +hold the arguments that `list-diary-entries' received. +They specify the range of dates that the diary is being processed for." nil nil) ;;;*** @@ -665,7 +675,7 @@ ;;;### (autoloads (batch-update-autoloads update-autoloads-from-directories ;;;;;; update-file-autoloads) "autoload" "emacs-lisp/autoload.el" -;;;;;; (14398 37513)) +;;;;;; (14563 8438)) ;;; Generated autoloads from emacs-lisp/autoload.el (autoload (quote update-file-autoloads) "autoload" "\ @@ -1310,7 +1320,7 @@ ;;;;;; browse-url-of-buffer browse-url-of-file browse-url-generic-program ;;;;;; browse-url-save-file browse-url-netscape-display browse-url-new-window-p ;;;;;; browse-url-browser-function) "browse-url" "net/browse-url.el" -;;;;;; (14554 2050)) +;;;;;; (14558 23455)) ;;; Generated autoloads from net/browse-url.el (defvar browse-url-browser-function (if (eq system-type (quote windows-nt)) (quote browse-url-default-windows-browser) (quote browse-url-netscape)) "\ @@ -1546,7 +1556,7 @@ ;;;### (autoloads (batch-byte-recompile-directory batch-byte-compile ;;;;;; display-call-tree byte-compile compile-defun byte-compile-file ;;;;;; byte-recompile-directory byte-force-recompile) "bytecomp" -;;;;;; "emacs-lisp/bytecomp.el" (14547 29523)) +;;;;;; "emacs-lisp/bytecomp.el" (14564 35790)) ;;; Generated autoloads from emacs-lisp/bytecomp.el (autoload (quote byte-force-recompile) "bytecomp" "\ @@ -2718,7 +2728,7 @@ ;;;### (autoloads (next-error compilation-minor-mode compilation-shell-minor-mode ;;;;;; compilation-mode grep-find grep compile compilation-search-path ;;;;;; compilation-ask-about-save compilation-window-height compilation-mode-hook) -;;;;;; "compile" "progmodes/compile.el" (14440 46010)) +;;;;;; "compile" "progmodes/compile.el" (14569 2479)) ;;; Generated autoloads from progmodes/compile.el (defvar compilation-mode-hook nil "\ @@ -3289,7 +3299,7 @@ ;;;*** ;;;### (autoloads (cpp-parse-edit cpp-highlight-buffer) "cpp" "progmodes/cpp.el" -;;;;;; (13826 9529)) +;;;;;; (14568 36509)) ;;; Generated autoloads from progmodes/cpp.el (autoload (quote cpp-highlight-buffer) "cpp" "\ @@ -3333,7 +3343,7 @@ ;;;;;; customize-option-other-window customize-changed-options customize-option ;;;;;; customize-group-other-window customize-group customize customize-save-variable ;;;;;; customize-set-variable customize-set-value) "cus-edit" "cus-edit.el" -;;;;;; (14552 48684)) +;;;;;; (14558 7062)) ;;; Generated autoloads from cus-edit.el (add-hook 'same-window-regexps "\\`\\*Customiz.*\\*\\'") @@ -3582,7 +3592,7 @@ ;;;*** ;;;### (autoloads (dabbrev-expand dabbrev-completion) "dabbrev" "dabbrev.el" -;;;;;; (14385 24830)) +;;;;;; (14568 46430)) ;;; Generated autoloads from dabbrev.el (define-key esc-map "/" (quote dabbrev-expand)) @@ -4066,7 +4076,7 @@ ;;;;;; dired dired-copy-preserve-time dired-dwim-target dired-keep-marker-symlink ;;;;;; dired-keep-marker-hardlink dired-keep-marker-copy dired-keep-marker-rename ;;;;;; dired-trivial-filenames dired-ls-F-marks-symlinks dired-listing-switches) -;;;;;; "dired" "dired.el" (14522 27392)) +;;;;;; "dired" "dired.el" (14563 8348)) ;;; Generated autoloads from dired.el (defvar dired-listing-switches "-al" "\ @@ -4625,8 +4635,8 @@ ;;;*** ;;;### (autoloads (easy-menu-change easy-menu-create-menu easy-menu-do-define -;;;;;; easy-menu-define) "easymenu" "emacs-lisp/easymenu.el" (14385 -;;;;;; 24854)) +;;;;;; easy-menu-define) "easymenu" "emacs-lisp/easymenu.el" (14574 +;;;;;; 18612)) ;;; Generated autoloads from emacs-lisp/easymenu.el (autoload (quote easy-menu-define) "easymenu" "\ @@ -4717,6 +4727,10 @@ SELECTED is an expression; the checkbox or radio button is selected whenever this expression's value is non-nil. + :help HELP + +HELP is a string, the help to display for the menu item. + 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. @@ -4860,6 +4874,43 @@ ;;;*** +;;;### (autoloads (ebrowse-save-tree-as ebrowse-tags-query-replace +;;;;;; ebrowse-tags-loop-continue ebrowse-tags-complete-symbol ebrowse-electric-choose-tree +;;;;;; ebrowse-tree-mode) "ebrowse" "progmodes/ebrowse.el" (14575 +;;;;;; 54558)) +;;; Generated autoloads from progmodes/ebrowse.el + +(autoload (quote ebrowse-tree-mode) "ebrowse" "\ +Major mode for Ebrowse class tree buffers. +Each line corresponds to a class in a class tree. +Letters do not insert themselves, they are commands. +File operations in the tree buffer work on class tree data structures. +E.g.\\[save-buffer] writes the tree to the file it was loaded from. + +Tree mode key bindings: +\\{ebrowse-tree-mode-map}" nil nil) + +(autoload (quote ebrowse-electric-choose-tree) "ebrowse" "\ +Return a buffer containing a tree or nil if no tree found or canceled." t nil) + +(autoload (quote ebrowse-tags-complete-symbol) "ebrowse" "Perform completion on the C++ symbol preceding point.\nA second call of this function without changing point inserts the next match. \nA call with prefix PREFIX reads the symbol to insert from the minibuffer with\ncompletion." t nil) + +(autoload (quote ebrowse-tags-loop-continue) "ebrowse" "\ +Repeat last operation on files in tree. +FIRST-TIME non-nil means this is not a repetition, but the first time. +TREE-BUFFER if indirectly specifies which files to loop over." t nil) + +(autoload (quote ebrowse-tags-query-replace) "ebrowse" "\ +Query replace FROM with TO in all files of a class tree. +With prefix arg, process files of marked classes only." t nil) + +(autoload (quote ebrowse-save-tree-as) "ebrowse" "\ +Write the current tree data structure to a file. +Read the file name from the minibuffer if interactive. +Otherwise, FILE-NAME specifies the file to save the tree in." t nil) + +;;;*** + ;;;### (autoloads (electric-buffer-list) "ebuff-menu" "ebuff-menu.el" ;;;;;; (13778 5499)) ;;; Generated autoloads from ebuff-menu.el @@ -4894,7 +4945,7 @@ ;;;*** ;;;### (autoloads (edebug-eval-top-level-form def-edebug-spec edebug-all-forms -;;;;;; edebug-all-defs) "edebug" "emacs-lisp/edebug.el" (14482 54435)) +;;;;;; edebug-all-defs) "edebug" "emacs-lisp/edebug.el" (14576 25687)) ;;; Generated autoloads from emacs-lisp/edebug.el (defvar edebug-all-defs nil "\ @@ -6957,7 +7008,7 @@ ;;;*** ;;;### (autoloads (glasses-mode) "glasses" "progmodes/glasses.el" -;;;;;; (14480 59906)) +;;;;;; (14568 44804)) ;;; Generated autoloads from progmodes/glasses.el (autoload (quote glasses-mode) "glasses" "\ @@ -8350,9 +8401,9 @@ ;;;*** ;;;### (autoloads (iso-cvt-define-menu iso-cvt-write-only iso-cvt-read-only -;;;;;; iso-iso2duden iso-iso2gtex iso-gtex2iso iso-tex2iso iso-iso2tex -;;;;;; iso-german iso-spanish) "iso-cvt" "international/iso-cvt.el" -;;;;;; (13768 42838)) +;;;;;; iso-sgml2iso iso-iso2sgml iso-iso2duden iso-iso2gtex iso-gtex2iso +;;;;;; iso-tex2iso iso-iso2tex iso-german iso-spanish) "iso-cvt" +;;;;;; "international/iso-cvt.el" (14564 29908)) ;;; Generated autoloads from international/iso-cvt.el (autoload (quote iso-spanish) "iso-cvt" "\ @@ -8397,6 +8448,18 @@ Optional arg BUFFER is ignored (so that the function can can be used in `format-alist')." t nil) +(autoload (quote iso-iso2sgml) "iso-cvt" "\ +Translate ISO 8859-1 characters in the region to SGML entities. +The entities used are from \"ISO 8879:1986//ENTITIES Added Latin 1//EN\". +Optional arg BUFFER is ignored (so that the function can can be used in +`format-alist')." t nil) + +(autoload (quote iso-sgml2iso) "iso-cvt" "\ +Translate SGML entities in the region to ISO 8859-1 characters. +The entities used are from \"ISO 8879:1986//ENTITIES Added Latin 1//EN\". +Optional arg BUFFER is ignored (so that the function can can be used in +`format-alist')." t nil) + (autoload (quote iso-cvt-read-only) "iso-cvt" "\ Warn that format is read-only." t nil) @@ -8765,7 +8828,7 @@ ;;;*** ;;;### (autoloads (turn-on-jit-lock jit-lock-mode) "jit-lock" "jit-lock.el" -;;;;;; (14550 5866)) +;;;;;; (14571 7073)) ;;; Generated autoloads from jit-lock.el (autoload (quote jit-lock-mode) "jit-lock" "\ @@ -8806,7 +8869,7 @@ ;;;*** ;;;### (autoloads (auto-compression-mode) "jka-compr" "jka-compr.el" -;;;;;; (14495 17985)) +;;;;;; (14568 39747)) ;;; Generated autoloads from jka-compr.el (defvar auto-compression-mode nil "\ @@ -9057,7 +9120,7 @@ ;;;*** ;;;### (autoloads (locate-with-filter locate) "locate" "locate.el" -;;;;;; (14396 4034)) +;;;;;; (14563 8348)) ;;; Generated autoloads from locate.el (autoload (quote locate) "locate" "\ @@ -9072,7 +9135,7 @@ ;;;*** -;;;### (autoloads (log-edit) "log-edit" "log-edit.el" (14537 49316)) +;;;### (autoloads (log-edit) "log-edit" "log-edit.el" (14559 17354)) ;;; Generated autoloads from log-edit.el (autoload (quote log-edit) "log-edit" "\ @@ -9096,8 +9159,8 @@ ;;;*** ;;;### (autoloads (print-region lpr-region print-buffer lpr-buffer -;;;;;; lpr-command lpr-switches printer-name) "lpr" "lpr.el" (14440 -;;;;;; 46009)) +;;;;;; lpr-command lpr-switches printer-name) "lpr" "lpr.el" (14563 +;;;;;; 22518)) ;;; Generated autoloads from lpr.el (defvar printer-name (if (memq system-type (quote (ms-dos windows-nt))) "PRN") "\ @@ -9428,7 +9491,7 @@ ;;;*** ;;;### (autoloads (makefile-mode) "make-mode" "progmodes/make-mode.el" -;;;;;; (14554 2005)) +;;;;;; (14570 19448)) ;;; Generated autoloads from progmodes/make-mode.el (autoload (quote makefile-mode) "make-mode" "\ @@ -9517,7 +9580,7 @@ ;;;*** -;;;### (autoloads (man-follow man) "man" "man.el" (14539 53667)) +;;;### (autoloads (man-follow man) "man" "man.el" (14570 21850)) ;;; Generated autoloads from man.el (defalias (quote manual-entry) (quote man)) @@ -9955,7 +10018,7 @@ ;;;*** -;;;### (autoloads (msb-mode msb-mode) "msb" "msb.el" (14263 63030)) +;;;### (autoloads (msb-mode msb-mode) "msb" "msb.el" (14555 52300)) ;;; Generated autoloads from msb.el (defvar msb-mode nil "\ @@ -10111,16 +10174,18 @@ ;;;;;; coding-system-post-read-conversion coding-system-eol-type-mnemonic ;;;;;; lookup-nested-alist set-nested-alist truncate-string-to-width ;;;;;; store-substring string-to-sequence) "mule-util" "international/mule-util.el" -;;;;;; (14423 50997)) +;;;;;; (14568 36382)) ;;; Generated autoloads from international/mule-util.el (autoload (quote string-to-sequence) "mule-util" "\ Convert STRING to a sequence of TYPE which contains characters in STRING. TYPE should be `list' or `vector'." nil nil) -(defsubst string-to-list (string) "Return a list of characters in STRING." (string-to-sequence string (quote list))) - -(defsubst string-to-vector (string) "Return a vector of characters in STRING." (string-to-sequence string (quote vector))) +(defsubst string-to-list (string) "\ +Return a list of characters in STRING." (string-to-sequence string (quote list))) + +(defsubst string-to-vector (string) "\ +Return a vector of characters in STRING." (string-to-sequence string (quote vector))) (autoload (quote store-substring) "mule-util" "\ Embed OBJ (string or character) at index IDX of STRING." nil nil) @@ -10142,7 +10207,16 @@ (defalias (quote truncate-string) (quote truncate-string-to-width)) -(defsubst nested-alist-p (obj) "Return t if OBJ is a nested alist.\n\nNested alist is a list of the form (ENTRY . BRANCHES), where ENTRY is\nany Lisp object, and BRANCHES is a list of cons cells of the form\n(KEY-ELEMENT . NESTED-ALIST).\n\nYou can use a nested alist to store any Lisp object (ENTRY) for a key\nsequence KEYSEQ, where KEYSEQ is a sequence of KEY-ELEMENT. KEYSEQ\ncan be a string, a vector, or a list." (and obj (listp obj) (listp (cdr obj)))) +(defsubst nested-alist-p (obj) "\ +Return t if OBJ is a nested alist. + +Nested alist is a list of the form (ENTRY . BRANCHES), where ENTRY is +any Lisp object, and BRANCHES is a list of cons cells of the form +\(KEY-ELEMENT . NESTED-ALIST). + +You can use a nested alist to store any Lisp object (ENTRY) for a key +sequence KEYSEQ, where KEYSEQ is a sequence of KEY-ELEMENT. KEYSEQ +can be a string, a vector, or a list." (and obj (listp obj) (listp (cdr obj)))) (autoload (quote set-nested-alist) "mule-util" "\ Set ENTRY for KEYSEQ in a nested alist ALIST. @@ -10207,7 +10281,7 @@ ;;;### (autoloads (network-connection network-connection-to-service ;;;;;; whois-reverse-lookup whois finger ftp dig nslookup nslookup-host ;;;;;; route arp netstat ipconfig ping traceroute) "net-utils" "net/net-utils.el" -;;;;;; (14385 24830)) +;;;;;; (14564 29931)) ;;; Generated autoloads from net/net-utils.el (autoload (quote traceroute) "net-utils" "\ @@ -11097,7 +11171,7 @@ ;;;;;; ps-spool-region ps-spool-buffer-with-faces ps-spool-buffer ;;;;;; ps-print-region-with-faces ps-print-region ps-print-buffer-with-faces ;;;;;; ps-print-buffer ps-print-customize ps-paper-type) "ps-print" -;;;;;; "ps-print.el" (14554 7425)) +;;;;;; "ps-print.el" (14563 18761)) ;;; Generated autoloads from ps-print.el (defvar ps-paper-type (quote letter) "\ @@ -11679,7 +11753,7 @@ ;;;*** ;;;### (autoloads (regexp-opt-depth regexp-opt) "regexp-opt" "emacs-lisp/regexp-opt.el" -;;;;;; (14535 45202)) +;;;;;; (14564 29908)) ;;; Generated autoloads from emacs-lisp/regexp-opt.el (autoload (quote regexp-opt) "regexp-opt" "\ @@ -12157,11 +12231,11 @@ ;;;*** -;;;### (autoloads (rmail-summary-line-decoder rmail-summary-by-senders -;;;;;; rmail-summary-by-topic rmail-summary-by-regexp rmail-summary-by-recipients -;;;;;; rmail-summary-by-labels rmail-summary rmail-summary-line-count-flag -;;;;;; rmail-summary-scroll-between-messages) "rmailsum" "mail/rmailsum.el" -;;;;;; (14547 28270)) +;;;### (autoloads (rmail-user-mail-address-regexp rmail-summary-line-decoder +;;;;;; rmail-summary-by-senders rmail-summary-by-topic rmail-summary-by-regexp +;;;;;; rmail-summary-by-recipients rmail-summary-by-labels rmail-summary +;;;;;; rmail-summary-line-count-flag rmail-summary-scroll-between-messages) +;;;;;; "rmailsum" "mail/rmailsum.el" (14568 47126)) ;;; Generated autoloads from mail/rmailsum.el (defvar rmail-summary-scroll-between-messages t "\ @@ -12206,6 +12280,20 @@ By default, `identity' is set.") +(defvar rmail-user-mail-address-regexp nil "\ +*Regexp matching user mail addresses. +If non-nil, this variable is used to identify the correspondent +when receiving new mail. If it matches the address of the sender, +the recipient is taken as correspondent of a mail. +If nil (default value), your `user-login-name' and `user-mail-address' +are used to exclude yourself as correspondent. + +Usually you don't have to set this variable, except if you collect mails +sent by you under different user names. +Then it should be a regexp matching your mail adresses. + +Setting this variable has an effect only before reading a mail.") + ;;;*** ;;;### (autoloads (news-post-news) "rnewspost" "mail/rnewspost.el" @@ -13450,7 +13538,7 @@ ;;;*** ;;;### (autoloads (sc-cite-original) "supercite" "mail/supercite.el" -;;;;;; (14385 23097)) +;;;;;; (14565 55801)) ;;; Generated autoloads from mail/supercite.el (autoload (quote sc-cite-original) "supercite" "\ @@ -14160,7 +14248,7 @@ ;;;;;; tibetan-compose-buffer tibetan-decompose-buffer tibetan-composition-function ;;;;;; tibetan-compose-region tibetan-compose-string tibetan-transcription-to-tibetan ;;;;;; tibetan-tibetan-to-transcription tibetan-char-p setup-tibetan-environment) -;;;;;; "tibet-util" "language/tibet-util.el" (14423 51008)) +;;;;;; "tibet-util" "language/tibet-util.el" (14568 36412)) ;;; Generated autoloads from language/tibet-util.el (autoload (quote setup-tibetan-environment) "tibet-util" nil t nil) @@ -14747,8 +14835,8 @@ ;;;;;; vc-create-snapshot vc-directory vc-resolve-conflicts vc-merge ;;;;;; vc-insert-headers vc-version-other-window vc-diff vc-register ;;;;;; vc-next-action edit-vc-file with-vc-file vc-annotate-mode-hook -;;;;;; vc-before-checkin-hook vc-checkin-hook) "vc" "vc.el" (14478 -;;;;;; 52465)) +;;;;;; vc-before-checkin-hook vc-checkin-hook) "vc" "vc.el" (14565 +;;;;;; 59735)) ;;; Generated autoloads from vc.el (defvar vc-checkin-hook nil "\
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/progmodes/ebrowse.el Sun Apr 09 11:15:57 2000 +0000 @@ -0,0 +1,4573 @@ +;;; ebrowse.el --- Emacs C++ class browser & tags facility + +;; Copyright (C) 1992-1999, 2000 Free Software Foundation Inc. + +;; Author: Gerd Moellmann <gerd@gnu.org> +;; Maintainer: FSF +;; Keywords: C++ tags tools + +;; 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 2, 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; see the file COPYING. If not, write to +;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Commentary: + +;; This package implements + +;; - A class browser for C++ +;; - A complete set of tags-like functions working on class trees +;; - An electric buffer list showing class browser buffers only + +;; Documentation is found in a separate Info file. + +;;; Code: + +(require 'easymenu) +(require 'view) +(require 'ebuff-menu) + +(eval-when-compile + (require 'cl) + (require 'helper)) + + +;;; User-options + +(defgroup ebrowse nil + "Settings for the C++ class browser." + :group 'tools) + + +(defcustom ebrowse-search-path nil + "*List of directories to search for source files in a class tree. +Elements should be directory names; nil as an element means to try +to find source files relative to the location of the EBROWSE file loaded." + :group 'ebrowse + :type '(repeat (choice (const :tag "Default" nil) + (string :tag "Directory")))) + + +(defcustom ebrowse-view/find-hook nil + "*Hooks run after finding or viewing a member or class." + :group 'ebrowse + :type 'hook) + + +(defcustom ebrowse-not-found-hook nil + "*Hooks run when finding or viewing a member or class was not successful." + :group 'ebrowse + :type 'hook) + + +(defcustom ebrowse-electric-list-mode-hook nil + "*Hook called by `ebrowse-electric-position-mode'." + :group 'ebrowse + :type 'hook) + + +(defcustom ebrowse-max-positions 50 + "*Number of markers saved on electric position stack." + :group 'ebrowse + :type 'integer) + + + +(defgroup ebrowse-tree nil + "Settings for class tree buffers." + :group 'ebrowse) + + +(defcustom ebrowse-tree-mode-hook nil + "*Hook run in each new tree buffer." + :group 'ebrowse-tree + :type 'hook) + + +(defcustom ebrowse-tree-buffer-name "*Tree*" + "*The default name of class tree buffers." + :group 'ebrowse-tree + :type 'string) + + +(defcustom ebrowse--indentation 4 + "*The amount by which subclasses are indented in the tree." + :group 'ebrowse-tree + :type 'integer) + + +(defcustom ebrowse-source-file-column 40 + "*The column in which source file names are displayed in the tree." + :group 'ebrowse-tree + :type 'integer) + + +(defcustom ebrowse-tree-left-margin 2 + "*Amount of space left at the left side of the tree display. +This space is used to display markers." + :group 'ebrowse-tree + :type 'integer) + + + +(defgroup ebrowse-member nil + "Settings for member buffers." + :group 'ebrowse) + + +(defcustom ebrowse-default-declaration-column 25 + "*The column in which member declarations are displayed in member buffers." + :group 'ebrowse-member + :type 'integer) + + +(defcustom ebrowse-default-column-width 25 + "*The width of the columns in member buffers (short display form)." + :group 'ebrowse-member + :type 'integer) + + +(defcustom ebrowse-member-buffer-name "*Members*" + "*The name of the buffer for member display." + :group 'ebrowse-member + :type 'string) + + +(defcustom ebrowse-member-mode-hook nil + "*Run in each new member buffer." + :group 'ebrowse-member + :type 'hook) + + + +(defgroup ebrowse-faces nil + "Faces used by Ebrowse." + :group 'ebrowse) + + +(defface ebrowse-tree-mark-face + '((t (:foreground "red"))) + "*The face used for the mark character in the tree." + :group 'ebrowse-faces) + + +(defface ebrowse-root-class-face + '((t (:weight bold :foreground "blue"))) + "*The face used for root classes in the tree." + :group 'ebrowse-faces) + + +(defface ebrowse-file-name-face + '((t (:italic t))) + "*The face for filenames displayed in the tree." + :group 'ebrowse-faces) + + +(defface ebrowse-default-face + '((t nil)) + "*Face for everything else in the tree not having other faces." + :group 'ebrowse-faces) + + +(defface ebrowse-member-attribute-face + '((t (:foreground "red"))) + "*Face used to display member attributes." + :group 'ebrowse-faces) + + +(defface ebrowse-member-class-face + '((t (:foreground "purple"))) + "*Face used to display the class title in member buffers." + :group 'ebrowse-faces) + + +(defface ebrowse-progress-face + '((t (:background "blue"))) + "*Face for progress indicator." + :group 'ebrowse-faces) + + + +;;; Utilities. + +(defun ebrowse-some (predicate vector) + "Return true if PREDICATE is true of some element of VECTOR. +If so, return the value returned by PREDICATE." + (let ((length (length vector)) + (i 0) + result) + (while (and (< i length) (not result)) + (setq result (funcall predicate (aref vector i)) + i (1+ i))) + result)) + + +(defun ebrowse-every (predicate vector) + "Return true if PREDICATE is true of every element of VECTOR." + (let ((length (length vector)) + (i 0) + (result t)) + (while (and (< i length) result) + (setq result (funcall predicate (aref vector i)) + i (1+ i))) + result)) + + +(defun ebrowse-position (item list &optional test) + "Return the position of ITEM in LIST or nil if not found. +Compare items with `eq' or TEST if specified." + (let ((i 0) found) + (cond (test + (while list + (when (funcall test item (car list)) + (setq found i list nil)) + (setq list (cdr list) i (1+ i)))) + (t + (while list + (when (eq item (car list)) + (setq found i list nil)) + (setq list (cdr list) i (1+ i))))) + found)) + + +(defun ebrowse-delete-if-not (predicate list) + "Remove elements not satisfying PREDICATE from LIST and return the result. +This is a destructive operation." + (let (result) + (while list + (let ((next (cdr list))) + (when (funcall predicate (car list)) + (setq result (nconc result list)) + (setf (cdr list) nil)) + (setq list next))) + result)) + + +(defun ebrowse-copy-list (list) + "Return a shallow copy of LIST." + (apply #'list list)) + + +(defmacro ebrowse-output (&rest body) + "Eval BODY with a writable current buffer. +Preserve buffer's modified state." + (let ((modified (gensym "--ebrowse-output--"))) + `(let (buffer-read-only (,modified (buffer-modified-p))) + (unwind-protect + (progn ,@body) + (set-buffer-modified-p ,modified))))) + + +(defmacro ebrowse-ignoring-completion-case (&rest body) + "Eval BODY with `completion-ignore-case' bound to t." + `(let ((completion-ignore-case t)) + ,@body)) + + +(defmacro ebrowse-save-selective (&rest body) + "Eval BODY with `selective-display' restored at the end." + (let ((var (make-symbol "var"))) + `(let ((,var selective-display)) + (unwind-protect + (progn ,@body) + (setq selective-display ,var))))) + + +(defmacro ebrowse-for-all-trees (spec &rest body) + "For all trees in SPEC, eval BODY." + (let ((var (make-symbol "var")) + (spec-var (car spec)) + (array (cadr spec))) + `(loop for ,var being the symbols of ,array + as ,spec-var = (get ,var 'ebrowse-root) do + (when (vectorp ,spec-var) + ,@body)))) + +;;; Set indentation for macros above. + +(put 'ebrowse-output 'lisp-indent-hook 0) +(put 'ebrowse-ignoring-completion-case 'lisp-indent-hook 0) +(put 'ebrowse-save-selective 'lisp-indent-hook 0) +(put 'ebrowse-for-all-trees 'lisp-indent-hook 1) + + +(defsubst ebrowse-set-face (start end face) + "Set face of a region START END to FACE." + (overlay-put (make-overlay start end) 'face face)) + + +(defun ebrowse-completing-read-value (prompt table initial-input) + "Read a string in the minibuffer, with completion. +Case is ignored in completions. + +PROMPT is a string to prompt with; normally it ends in a colon and a space. +TABLE is an alist whose elements' cars are strings, or an obarray. +TABLE can also be a function to do the completion itself. +If INITIAL-INPUT is non-nil, insert it in the minibuffer initially. +If it is (STRING . POSITION), the initial input +is STRING, but point is placed POSITION characters into the string." + (ebrowse-ignoring-completion-case + (completing-read prompt table nil t initial-input))) + + +(defun ebrowse-value-in-buffer (sym buffer) + "Return the value of SYM in BUFFER." + (let ((old-buffer (current-buffer))) + (unwind-protect + (progn + (set-buffer buffer) + (symbol-value sym)) + (set-buffer old-buffer)))) + + +(defun ebrowse-rename-buffer (new-name) + "Rename current buffer to NEW-NAME. +If a buffer with name NEW-NAME already exists, delete it first." + (let ((old-buffer (get-buffer new-name))) + (unless (eq old-buffer (current-buffer)) + (when old-buffer + (save-excursion (kill-buffer old-buffer))) + (rename-buffer new-name)))) + + +(defun ebrowse-trim-string (string) + "Return a copy of STRING with leading white space removed. +Replace sequences of newlines with a single space." + (when (string-match "^[ \t\n\r]+" string) + (setq string (substring string (match-end 0)))) + (loop while (string-match "[\n]+" string) + finally return string do + (setq string (replace-match " " nil t string)))) + + +(defun ebrowse-width-of-drawable-area () + "Return the width of the display area for the current buffer. +If buffer is displayed in a window, use that window's width, +otherwise use the current frame's width." + (let ((window (get-buffer-window (current-buffer)))) + (if window + (window-width window) + (frame-width)))) + + +;;; Structure definitions + +(defstruct (ebrowse-hs (:type vector) :named) + "Header structure found at the head of EBROWSE files." + ;; A version string that is compared against the version number of + ;; the Lisp package when the file is loaded. This is done to + ;; detect file format changes. + version + ;; Command line options used for producing the EBROWSE file. + command-line-options + ;; The following slot is currently not used. It's kept to keep + ;; the file format compatible. + unused + ;; A slot that is filled out after the tree is loaded. This slot is + ;; set to a hash table mapping members to lists of classes in which + ;; they are defined. + member-table) + + +(defstruct (ebrowse-ts (:type vector) :named) + "Tree structure. +Following the header structure, an EBROWSE file contains a number +of `ebrowse-ts' structures, each one describing one root class of +the class hierarchy with all its subclasses." + ;; A `ebrowse-cs' structure describing the root class. + class + ;; A list of `ebrowse-ts' structures for all subclasses. + subclasses + ;; Lists of `ebrowse-ms' structures for each member in a group of + ;; members. + member-variables member-functions static-variables static-functions + friends types + ;; List of `ebrowse-ts' structures for base classes. This slot is + ;; filled at load time. + base-classes + ;; A marker slot used in the tree buffer (can be saved back to disk. + mark) + + +(defstruct (ebrowse-bs (:type vector) :named) + "Common sub-structure. +A common structure defining an occurrence of some name in the +source files." + ;; The class or member name as a string constant + name + ;; An optional string for the scope of nested classes or for + ;; namespaces. + scope + ;; Various flags describing properties of classes/members, e.g. is + ;; template, is const etc. + flags + ;; File in which the entity is found. If this is part of a + ;; `ebrowse-ms' member description structure, and FILE is nil, then + ;; search for the name in the SOURCE-FILE of the members class. + file + ;; Regular expression to search for. This slot can be a number in + ;; which case the number is the file position at which the regular + ;; expression is found in a separate regexp file (see the header + ;; structure). This slot can be nil in which case the regular + ;; expression will be generated from the class/member name. + pattern + ;; The buffer position at which the search for the class or member + ;; will start. + point) + + +(defstruct (ebrowse-cs (:include ebrowse-bs) (:type vector) :named) + "Class structure. +This is the structure stored in the CLASS slot of a `ebrowse-ts' +structure. It describes the location of the class declaration." + source-file) + + +(defstruct (ebrowse-ms (:include ebrowse-bs) (:type vector) :named) + "Member structure. +This is the structure describing a single member. The `ebrowse-ts' +structure contains various lists for the different types of +members." + ;; Public, protected, private + visibility + ;; The file in which the member's definition can be found. + definition-file + ;; Same as PATTERN above, but for the member definition. + definition-pattern + ;; Same as POINT above but for member definition. + definition-point) + + + +;;; Some macros to access the FLAGS slot of a MEMBER. + +(defsubst ebrowse-member-bit-set-p (member bit) + "Value is non-nil if MEMBER's bit BIT is set." + (/= 0 (logand (ebrowse-bs-flags member) bit))) + + +(defsubst ebrowse-virtual-p (member) + "Value is non-nil if MEMBER is virtual." + (ebrowse-member-bit-set-p member 1)) + + +(defsubst ebrowse-inline-p (member) + "Value is non-nil if MEMBER is inline." + (ebrowse-member-bit-set-p member 2)) + + +(defsubst ebrowse-const-p (member) + "Value is non-nil if MEMBER is const." + (ebrowse-member-bit-set-p member 4)) + + +(defsubst ebrowse-pure-virtual-p (member) + "Value is non-nil if MEMBER is a pure virtual function." + (ebrowse-member-bit-set-p member 8)) + + +(defsubst ebrowse-mutable-p (member) + "Value is non-nil if MEMBER is mutable." + (ebrowse-member-bit-set-p member 16)) + + +(defsubst ebrowse-template-p (member) + "Value is non-nil if MEMBER is a template." + (ebrowse-member-bit-set-p member 32)) + + +(defsubst ebrowse-explicit-p (member) + "Value is non-nil if MEMBER is explicit." + (ebrowse-member-bit-set-p member 64)) + + +(defsubst ebrowse-throw-list-p (member) + "Value is non-nil if MEMBER has a throw specification." + (ebrowse-member-bit-set-p member 128)) + + +(defsubst ebrowse-extern-c-p (member) + "Value is non-nil if MEMBER.is `extern \"C\"'." + (ebrowse-member-bit-set-p member 256)) + + +(defsubst ebrowse-define-p (member) + "Value is non-nil if MEMBER is a define." + (ebrowse-member-bit-set-p member 512)) + + +(defconst ebrowse-version-string "ebrowse 5.0" + "Version string expected in EBROWSE files.") + + +(defconst ebrowse-globals-name "*Globals*" + "The name used for the surrogate class.containing global entities. +This must be the same that `ebrowse' uses.") + + +(defvar ebrowse--last-regexp nil + "Last regular expression searched for in tree and member buffers. +Automatically buffer-local so that each tree and member buffer +maintains its own search history.") +(make-variable-buffer-local 'ebrowse--last-regexp) + + +(defconst ebrowse-member-list-accessors + '(ebrowse-ts-member-variables + ebrowse-ts-member-functions + ebrowse-ts-static-variables + ebrowse-ts-static-functions + ebrowse-ts-friends + ebrowse-ts-types) + "List of accessors for member lists. +Each element is the symbol of an accessor function. +The nth element must be the accessor for the nth member list +in an `ebrowse-ts' structure.") + + +;;; FIXME: Add more doc strings for the buffer-local variables below. + +(defvar ebrowse--tree-obarray nil + "Obarray holding all `ebrowse-ts' structures of a class tree. +Buffer-local in Ebrowse buffers.") + + +(defvar ebrowse--tags-file-name nil + "File from which EBROWSE file was loaded. +Buffer-local in Ebrowse buffers.") + + +(defvar ebrowse--header nil + "Header structure of type `ebrowse-hs' of a class tree. +Buffer-local in Ebrowse buffers.") + + +(defvar ebrowse--frozen-flag nil + "Non-nil means an Ebrowse buffer won't be reused. +Buffer-local in Ebrowse buffers.") + + +(defvar ebrowse--show-file-names-flag nil + "Non-nil means show file names in a tree buffer. +Buffer-local in Ebrowse tree buffers.") + + +(defvar ebrowse--long-display-flag nil + "Non-nil means show members in long display form. +Buffer-local in Ebrowse member buffers.") + + +(defvar ebrowse--n-columns nil + "Number of columns to display for short member display form. +Buffer-local in Ebrowse member buffers.") + + +(defvar ebrowse--column-width nil + "Width of a columns to display for short member display form. +Buffer-local in Ebrowse member buffers.") + + +(defvar ebrowse--virtual-display-flag nil + "Non-nil means display virtual members in a member buffer. +Buffer-local in Ebrowse member buffers.") + + +(defvar ebrowse--inline-display-flag nil + "Non-nil means display inline members in a member buffer. +Buffer-local in Ebrowse member buffers.") + + +(defvar ebrowse--const-display-flag nil + "Non-nil means display const members in a member buffer. +Buffer-local in Ebrowse member buffers.") + + +(defvar ebrowse--pure-display-flag nil + "Non-nil means display pure virtual members in a member buffer. +Buffer-local in Ebrowse member buffers.") + + +(defvar ebrowse--filters nil + "Filter for display of public, protected, and private members. +This is a vector of three elements. An element nil means the +corresponding members are not shown. +Buffer-local in Ebrowse member buffers.") + + +(defvar ebrowse--show-inherited-flag nil + "Non-nil means display inherited members in a member buffer. +Buffer-local in Ebrowse member buffers.") + + +(defvar ebrowse--attributes-flag nil + "Non-nil means display member attributes in a member buffer. +Buffer-local in Ebrowse member buffers.") + + +(defvar ebrowse--source-regexp-flag nil + "Non-nil means display member regexps in a member buffer. +Buffer-local in Ebrowse member buffers.") + + +(defvar ebrowse--displayed-class nil + "Class displayed in a member buffer, a `ebrowse-ts' structure. +Buffer-local in Ebrowse member buffers.") + + +(defvar ebrowse--accessor nil + "Member list displayed in a member buffer. +This is a symbol whose function definition is an accessor for the +member list in `ebrowse-cs' structures. +Buffer-local in Ebrowse member buffers.") + + +(defvar ebrowse--member-list nil + "The list of `ebrowse-ms' structures displayed in a member buffer. +Buffer-local in Ebrowse member buffers.") + + +(defvar ebrowse--decl-column nil + "Column in which declarations are displayed in member buffers. +Buffer-local in Ebrowse member buffers.") + + +(defvar ebrowse--mode-strings nil + "Strings displayed in the mode line. +Buffer-local in Ebrowse tree buffers.") + + +(defvar ebrowse--frame-configuration nil + "Frame configuration saved when viewing a class/member in another frame. +Buffer-local in Ebrowse buffers.") + + +(defvar ebrowse--view-exit-action nil + "Action to perform after viewing a class/member. +Either `kill-buffer' or nil. +Buffer-local in Ebrowse buffers.") + + +(defvar ebrowse--tree nil + "Class tree. +Buffer-local in Ebrowse buffers.") + + +(defvar ebrowse--mode-line-props nil + "Text properties of mode line strings in member buffers. +Buffer-local in Ebrowse member buffers.") + + +;;; Temporaries used to communicate with `ebrowse-find-pattern'. + +(defvar ebrowse-temp-position-to-view nil) +(defvar ebrowse-temp-info-to-view nil) + + +(defvar ebrowse-tree-mode-map () + "The keymap used in tree mode buffers.") + + +(defvar ebrowse--member-mode-strings nil + "Strings displayed in the mode line of member buffers.") + + +(defvar ebrowse-member-mode-map () + "The keymap used in the member buffers.") + + +;;; Define mode line titles for each member list. + +(put 'ebrowse-ts-member-variables 'ebrowse-title "Member Variables") +(put 'ebrowse-ts-member-functions 'ebrowse-title "Member Functions") +(put 'ebrowse-ts-static-variables 'ebrowse-title "Static Variables") +(put 'ebrowse-ts-static-functions 'ebrowse-title "Static Functions") +(put 'ebrowse-ts-friends 'ebrowse-title "Friends") +(put 'ebrowse-ts-types 'ebrowse-title "Types") + +(put 'ebrowse-ts-member-variables 'ebrowse-global-title "Global Variables") +(put 'ebrowse-ts-member-functions 'ebrowse-global-title "Global Functions") +(put 'ebrowse-ts-static-variables 'ebrowse-global-title "Static Variables") +(put 'ebrowse-ts-static-functions 'ebrowse-global-title "Static Functions") +(put 'ebrowse-ts-friends 'ebrowse-global-title "Defines") +(put 'ebrowse-ts-types 'ebrowse-global-title "Types") + + + +;;; Operations on `ebrowse-ts' structures + +(defun ebrowse-files-table (&optional marked-only) + "Return an obarray containing all files mentioned in the current tree. +The tree is expected in the buffer-local variable `ebrowse--tree-obarray'. +MARKED-ONLY non-nil means include marked classes only." + (let ((files (make-hash-table :test 'equal)) + (i -1)) + (ebrowse-for-all-trees (tree ebrowse--tree-obarray) + (when (or (not marked-only) (ebrowse-ts-mark tree)) + (let ((class (ebrowse-ts-class tree))) + (when (zerop (% (incf i) 20)) + (ebrowse-show-progress "Preparing file list" (zerop i))) + ;; Add files mentioned in class description + (let ((source-file (ebrowse-cs-source-file class)) + (file (ebrowse-cs-file class))) + (when source-file + (puthash source-file source-file files)) + (when file + (puthash file file files)) + ;; For all member lists in this class + (loop for accessor in ebrowse-member-list-accessors do + (loop for m in (funcall accessor tree) + for file = (ebrowse-ms-file m) + for def-file = (ebrowse-ms-definition-file m) do + (when file + (puthash file file files)) + (when def-file + (puthash def-file def-file files)))))))) + files)) + + +(defun ebrowse-files-list (&optional marked-only) + "Return a list containing all files mentioned in a tree. +MARKED-ONLY non-nil means include marked classes only." + (let (list) + (maphash #'(lambda (file dummy) (setq list (cons file list))) + (ebrowse-files-table marked-only)) + list)) + + +(defun* ebrowse-marked-classes-p () + "Value is non-nil if any class in the current class tree is marked." + (ebrowse-for-all-trees (tree ebrowse--tree-obarray) + (when (ebrowse-ts-mark tree) + (return-from ebrowse-marked-classes-p tree)))) + + +(defsubst ebrowse-globals-tree-p (tree) + "Return t if TREE is the one for global entities." + (string= (ebrowse-bs-name (ebrowse-ts-class tree)) + ebrowse-globals-name)) + + +(defsubst ebrowse-qualified-class-name (class) + "Return the name of CLASS with scope prepended, if any." + (if (ebrowse-cs-scope class) + (concat (ebrowse-cs-scope class) "::" (ebrowse-cs-name class)) + (ebrowse-cs-name class))) + + +(defun ebrowse-tree-obarray-as-alist (&optional qualified-names-p) + "Return an alist describing all classes in a tree. +Each elements in the list has the form (CLASS-NAME . TREE). +CLASS-NAME is the name of the class. TREE is the +class tree whose root is QUALIFIED-CLASS-NAME. +QUALIFIED-NAMES-P non-nil means return qualified names as CLASS-NAME. +The class tree is found in the buffer-local variable `ebrowse--tree-obarray'." + (let (alist) + (if qualified-names-p + (ebrowse-for-all-trees (tree ebrowse--tree-obarray) + (setq alist + (acons (ebrowse-qualified-class-name (ebrowse-ts-class tree)) + tree alist))) + (ebrowse-for-all-trees (tree ebrowse--tree-obarray) + (setq alist + (acons (ebrowse-cs-name (ebrowse-ts-class tree)) + tree alist)))) + alist)) + + +(defun ebrowse-sort-tree-list (list) + "Sort a LIST of `ebrowse-ts' structures by qualified class names." + (sort list + #'(lambda (a b) + (string< (ebrowse-qualified-class-name (ebrowse-ts-class a)) + (ebrowse-qualified-class-name (ebrowse-ts-class b)))))) + + +(defun ebrowse-class-in-tree (class tree) + "Search for a class with name CLASS in TREE. +Return the class found, if any. This function is used during the load +phase where classes appended to a file replace older class +information." + (let ((tclass (ebrowse-ts-class class)) + found) + (while (and tree (not found)) + (let ((root (car tree))) + (when (string= (ebrowse-qualified-class-name (ebrowse-ts-class root)) + (ebrowse-qualified-class-name tclass)) + (setq found root)) + (setq tree (cdr tree)))) + found)) + + +(defun ebrowse-base-classes (tree) + "Return list of base-classes of TREE by searching subclass lists. +This function must be used instead of the struct slot +`base-classes' to access the base-class list directly because it +computes this information lazily." + (or (ebrowse-ts-base-classes tree) + (setf (ebrowse-ts-base-classes tree) + (loop with to-search = (list tree) + with result = nil + as search = (pop to-search) + while search finally return result + do (ebrowse-for-all-trees (ti ebrowse--tree-obarray) + (when (memq search (ebrowse-ts-subclasses ti)) + (unless (memq ti result) + (setq result (nconc result (list ti)))) + (push ti to-search))))))) + + +(defun ebrowse-direct-base-classes (tree) + "Return the list of direct super classes of TREE." + (let (result) + (dolist (s (ebrowse-base-classes tree)) + (when (memq tree (ebrowse-ts-subclasses s)) + (setq result (cons s result)))) + result)) + + + +;;; Operations on MEMBER structures/lists + +(defun ebrowse-name/accessor-alist (tree accessor) + "Return an alist containing all members of TREE in group ACCESSOR. +ACCESSOR is the accessor function for the member list. +Elements of the result have the form (NAME . ACCESSOR), where NAME +is the member name." + (loop for member in (funcall accessor tree) + collect (cons (ebrowse-ms-name member) accessor))) + + +(defun ebrowse-name/accessor-alist-for-visible-members () + "Return an alist describing all members visible in the current buffer. +Each element of the list has the form (MEMBER-NAME . ACCESSOR), +where MEMBER-NAME is the member's name, and ACCESSOR is the struct +accessor with which the member's list can be accessed in an `ebrowse-ts' +structure. The list includes inherited members if these are visible." + (let* ((list (ebrowse-name/accessor-alist ebrowse--displayed-class + ebrowse--accessor))) + (if ebrowse--show-inherited-flag + (nconc list + (loop for tree in (ebrowse-base-classes + ebrowse--displayed-class) + nconc (ebrowse-name/accessor-alist + tree ebrowse--accessor))) + list))) + + +(defun ebrowse-name/accessor-alist-for-class-members () + "Like `ebrowse-name/accessor-alist-for-visible-members'. +This function includes members of base classes if base class members +are visible in the buffer." + (let (list) + (dolist (func ebrowse-member-list-accessors list) + (setq list (nconc list (ebrowse-name/accessor-alist + ebrowse--displayed-class func))) + (when ebrowse--show-inherited-flag + (dolist (class (ebrowse-base-classes ebrowse--displayed-class)) + (setq list + (nconc list (ebrowse-name/accessor-alist class func)))))))) + + +;;; Progress indication + +(defvar ebrowse-n-boxes 0) +(defconst ebrowse-max-boxes 60) + +(defun ebrowse-show-progress (title &optional start) + "Display a progress indicator. +TITLE is the title of the progress message. START non-nil means +this is the first progress message displayed." + (let (message-log-max) + (when start (setq ebrowse-n-boxes 0)) + (setq ebrowse-n-boxes (mod (1+ ebrowse-n-boxes) ebrowse-max-boxes)) + (message (concat title ": " + (propertize (make-string ebrowse-n-boxes + (if (display-color-p) ?\ ?+)) + 'face 'ebrowse-progress-face))))) + + +;;; Reading a tree from disk + +(defun ebrowse-find-file () + "Function installed as `find-file hook'. +This loads a tree when it sees a special signature at the beginning of +the file loaded." + (when (looking-at "\\[ebrowse-hs") + (ebrowse-load buffer-file-name 'switch))) + + +(defun ebrowse-read () + "Read `ebrowse-hs' and `ebrowse-ts' structures in the current buffer. +Return a list (HEADER TREE) where HEADER is the file header read +and TREE is a list of `ebrowse-ts' structures forming the class tree." + (let ((header (condition-case nil + (read (current-buffer)) + (error (error "No Ebrowse file header found")))) + tree) + ;; Check file format. + (unless (ebrowse-hs-p header) + (error "No Ebrowse file header found")) + (unless (string= (ebrowse-hs-version header) ebrowse-version-string) + (error "File has wrong version `%s' (`%s' expected)" + (ebrowse-hs-version header) ebrowse-version-string)) + ;; Read Lisp objects. Temporarily increase `gc-cons-threshold' to + ;; prevent a GC that would not free any memory. + (let ((gc-cons-threshold 2000000)) + (while (not (eobp)) + (let* ((root (read (current-buffer))) + (old-root (ebrowse-class-in-tree root tree))) + (ebrowse-show-progress "Reading data" (null tree)) + (if old-root + (setf (car old-root) root) + (push root tree))))) + (garbage-collect) + (list header tree))) + + +(defun ebrowse-load (file &optional switch) + "Load an Ebrowse file FILE into memory and make a tree buffer. +Optional SWITCH non-nil means switch to the tree buffer afterwards. +This function is normally called from a `find-file-hook'. +Value is the tree buffer created." + (let (tree + header + (buffer (get-file-buffer file)) + tree-buffer) + (if buffer + (multiple-value-setq (header tree) + (ebrowse-read)) + (save-excursion + ;; Since find-file hooks may be involved, we must visit the + ;; file in a way that these hooks are not called. + (set-buffer (create-file-buffer file)) + (erase-buffer) + (insert-file file) + (set-buffer-modified-p nil) + (unwind-protect + (multiple-value-setq (header tree) + (ebrowse-read)) + (kill-buffer (current-buffer))))) + (when tree + (message "Sorting. Please be patient...") + (setf tree (ebrowse-sort-tree-list tree)) + ;; Create tree buffer + (setf tree-buffer + (ebrowse-create-tree-buffer tree file header + (ebrowse-build-tree-obarray tree) + switch buffer)) + (message nil) + tree-buffer))) + + +(defun ebrowse-revert-tree-buffer-from-file (ignore-auto-save noconfirm) + "Function installed as `revert-buffer-function' in tree buffers. +See that variable's documentation for the meaning of IGNORE-AUTO-SAVE and +NOCONFIRM." + (interactive) + (when (or noconfirm + (yes-or-no-p "Revert tree from disk? ")) + (let ((ebrowse-file (or buffer-file-name ebrowse--tags-file-name))) + (loop for member-buffer in (ebrowse-same-tree-member-buffer-list) + do (kill-buffer member-buffer)) + (kill-buffer (current-buffer)) + (switch-to-buffer (ebrowse-load ebrowse-file))))) + + +(defun ebrowse-create-tree-buffer (tree tags-file header obarray pop + &optional find-file-buffer) + "Create a new tree buffer for tree TREE. +The tree was loaded from file TAGS-FILE. +HEADER is the header structure of the file. +OBARRAY is an obarray with a symbol for each class in the tree. +POP non-nil means popup the buffer up at the end. +FIND-FILE-BUFFER, if non-nil, is the buffer from which the Lisp data +was read. +Return the buffer created." + (let (name) + (cond (find-file-buffer + (set-buffer find-file-buffer) + (erase-buffer) + (setq name (ebrowse-frozen-tree-buffer-name tags-file)) + (ebrowse-rename-buffer name)) + (t + (setq name ebrowse-tree-buffer-name) + (set-buffer (get-buffer-create name)))) + ;; Switch to tree mode and initialize buffer local variables. + (ebrowse-tree-mode) + (setf ebrowse--tree tree + ebrowse--tags-file-name tags-file + ebrowse--tree-obarray obarray + ebrowse--header header + ebrowse--frozen-flag (not (null find-file-buffer))) + ;; Switch or pop to the tree buffer; display the tree and return the + ;; buffer. + (case pop + (switch (switch-to-buffer name)) + (pop (pop-to-buffer name))) + (ebrowse-redraw-tree) + (set-buffer-modified-p nil) + (current-buffer))) + + + +;;; Operations for member obarrays + +(defun ebrowse-fill-member-table () + "Return an obarray holding all members of all classes in the current tree. + +For each member, a symbol is added to the obarray. Members are +extracted from the buffer-local tree `ebrowse--tree-obarray'. + +Each symbol has its property `ebrowse-info' set to a list (TREE MEMBER-LIST +MEMBER) where TREE is the tree in which the member is defined, +MEMBER-LIST is a symbol describing the member list in which the member +is found, and MEMBER is a MEMBER structure describing the member. + +The slot `member-table' of the buffer-local header structure of +type `ebrowse-hs' is set to the resulting obarray." + (let ((members (make-hash-table :test 'equal)) + (i -1)) + (setf (ebrowse-hs-member-table ebrowse--header) nil) + (garbage-collect) + ;; For all classes... + (ebrowse-for-all-trees (c ebrowse--tree-obarray) + (when (zerop (% (incf i) 10)) + (ebrowse-show-progress "Preparing member lookup" (zerop i))) + (loop for f in ebrowse-member-list-accessors do + (loop for m in (funcall f c) do + (let* ((member-name (ebrowse-ms-name m)) + (value (gethash member-name members))) + (push (list c f m) value) + (puthash member-name value members))))) + (setf (ebrowse-hs-member-table ebrowse--header) members))) + + +(defun ebrowse-member-table (header) + "Return the member obarray. Build it it hasn't been set up yet. +HEADER is the tree header structure of the class tree." + (when (null (ebrowse-hs-member-table header)) + (loop for buffer in (ebrowse-browser-buffer-list) + until (eq header (ebrowse-value-in-buffer 'ebrowse--header buffer)) + finally do + (save-excursion + (set-buffer buffer) + (ebrowse-fill-member-table)))) + (ebrowse-hs-member-table header)) + + + +;;; Operations on TREE obarrays + +(defun ebrowse-build-tree-obarray (tree) + "Make sure every class in TREE is represented by a unique object. +Build obarray of all classes in TREE." + (let ((classes (make-vector 127 0))) + ;; Add root classes... + (loop for root in tree + as sym = + (intern (ebrowse-qualified-class-name (ebrowse-ts-class root)) classes) + do (unless (get sym 'ebrowse-root) + (setf (get sym 'ebrowse-root) root))) + ;; Process subclasses + (ebrowse-insert-supers tree classes) + classes)) + + +(defun ebrowse-insert-supers (tree classes) + "Build base class lists in class tree TREE. +CLASSES is an obarray used to collect classes. + +Helper function for `ebrowse-build-tree-obarray'. Base classes should +be ordered so that immediate base classes come first, then the base +class of the immediate base class and so on. This means that we must +construct the base-class list top down with adding each level at the +beginning of the base-class list. + +We have to be cautious here not to end up in an infinite recursion +if for some reason a circle is in the inheritance graph." + (loop for class in tree + as subclasses = (ebrowse-ts-subclasses class) do + ;; Make sure every class is represented by a unique object + (loop for subclass on subclasses + as sym = (intern + (ebrowse-qualified-class-name (ebrowse-ts-class (car subclass))) + classes) + as next = nil + do + ;; Replace the subclass tree with the one found in + ;; CLASSES if there is already an entry for that class + ;; in it. Otherwise make a new entry. + ;; + ;; CAVEAT: If by some means (e.g., use of the + ;; preprocessor in class declarations, a name is marked + ;; as a subclass of itself on some path, we would end up + ;; in an endless loop. We have to omit subclasses from + ;; the recursion that already have been processed. + (if (get sym 'ebrowse-root) + (setf (car subclass) (get sym 'ebrowse-root)) + (setf (get sym 'ebrowse-root) (car subclass)))) + ;; Process subclasses + (ebrowse-insert-supers subclasses classes))) + + +;;; Tree buffers + +(unless ebrowse-tree-mode-map + (let ((map (make-keymap))) + (setf ebrowse-tree-mode-map map) + (suppress-keymap map) + + (when window-system + (define-key map [down-mouse-3] 'ebrowse-mouse-3-in-tree-buffer) + (define-key map [mouse-2] 'ebrowse-mouse-2-in-tree-buffer) + (define-key map [down-mouse-1] 'ebrowse-mouse-1-in-tree-buffer)) + + (let ((map1 (make-sparse-keymap))) + (suppress-keymap map1 t) + (define-key map "L" map1) + (define-key map1 "d" 'ebrowse-tree-command:show-friends) + (define-key map1 "f" 'ebrowse-tree-command:show-member-functions) + (define-key map1 "F" 'ebrowse-tree-command:show-static-member-functions) + (define-key map1 "t" 'ebrowse-tree-command:show-types) + (define-key map1 "v" 'ebrowse-tree-command:show-member-variables) + (define-key map1 "V" 'ebrowse-tree-command:show-static-member-variables)) + + (let ((map1 (make-sparse-keymap))) + (suppress-keymap map1 t) + (define-key map "M" map1) + (define-key map1 "a" 'ebrowse-mark-all-classes) + (define-key map1 "t" 'ebrowse-toggle-mark-at-point)) + + (let ((map1 (make-sparse-keymap))) + (suppress-keymap map1 t) + (define-key map "T" map1) + (define-key map1 "f" 'ebrowse-toggle-file-name-display) + (define-key map1 "s" 'ebrowse-show-file-name-at-point) + (define-key map1 "w" 'ebrowse-set-tree-indentation) + (define-key map "x" 'ebrowse-statistics)) + + (define-key map "n" 'ebrowse-repeat-member-search) + (define-key map "q" 'bury-buffer) + (define-key map "*" 'ebrowse-expand-all) + (define-key map "+" 'ebrowse-expand-branch) + (define-key map "-" 'ebrowse-collapse-branch) + (define-key map "/" 'ebrowse-read-class-name-and-go) + (define-key map " " 'ebrowse-view-class-declaration) + (define-key map "?" 'describe-mode) + (define-key map "\C-i" 'ebrowse-pop/switch-to-member-buffer-for-same-tree) + (define-key map "\C-k" 'ebrowse-remove-class-at-point) + (define-key map "\C-l" 'ebrowse-redraw-tree) + (define-key map "\C-m" 'ebrowse-find-class-declaration))) + + + +;;; Tree-mode - mode for tree buffers + +;;;###autoload +(defun ebrowse-tree-mode () + "Major mode for Ebrowse class tree buffers. +Each line corresponds to a class in a class tree. +Letters do not insert themselves, they are commands. +File operations in the tree buffer work on class tree data structures. +E.g.\\[save-buffer] writes the tree to the file it was loaded from. + +Tree mode key bindings: +\\{ebrowse-tree-mode-map}" + (kill-all-local-variables) + (mapcar 'make-local-variable + '(ebrowse--tags-file-name + ebrowse--indentation + ebrowse--tree + ebrowse--header + ebrowse--show-file-names-flag + ebrowse--frozen-flag + ebrowse--tree-obarray + ebrowse--mode-strings + revert-buffer-function)) + (use-local-map ebrowse-tree-mode-map) + (let* ((props (text-properties-at + 0 + (car (default-value 'mode-line-buffer-identification)))) + (ident (apply #'propertize "C++ Tree" props))) + (setf ebrowse--show-file-names-flag nil + ebrowse--tree-obarray (make-vector 127 0) + ebrowse--frozen-flag nil + major-mode 'ebrowse-tree-mode + mode-name "Ebrowse-Tree" + mode-line-buffer-identification (list ident) + buffer-read-only t + selective-display t + selective-display-ellipses t + revert-buffer-function 'ebrowse-revert-tree-buffer-from-file)) + (add-hook 'local-write-file-hooks 'ebrowse-write-file-hook-fn) + (modify-syntax-entry ?_ (char-to-string (char-syntax ?a))) + (run-hooks 'ebrowse-tree-mode-hook)) + + +(defun ebrowse-update-tree-buffer-mode-line () + "Update the tree buffer mode line." + (setf ebrowse--mode-strings + (concat (if ebrowse--frozen-flag (or buffer-file-name + ebrowse--tags-file-name)) + (if (buffer-modified-p) "-**"))) + (ebrowse-rename-buffer (if ebrowse--frozen-flag + (ebrowse-frozen-tree-buffer-name + ebrowse--tags-file-name) + ebrowse-tree-buffer-name)) + (force-mode-line-update)) + + + +;;; Removing classes from trees + +(defun ebrowse-remove-class-and-kill-member-buffers (tree class) + "Remove from TREE class CLASS. +Kill all member buffers still containing a reference to the class." + (let ((sym (intern-soft (ebrowse-cs-name (ebrowse-ts-class class)) + ebrowse--tree-obarray))) + (setf tree (delq class tree) + (get sym 'ebrowse-root) nil) + (dolist (root tree) + (setf (ebrowse-ts-subclasses root) + (delq class (ebrowse-ts-subclasses root)) + (ebrowse-ts-base-classes root) nil) + (ebrowse-remove-class-and-kill-member-buffers + (ebrowse-ts-subclasses root) class)) + (ebrowse-kill-member-buffers-displaying class) + tree)) + + +(defun ebrowse-remove-class-at-point (forced) + "Remove the class point is on from the class tree. +Do not ask for confirmation if FORCED is non-nil." + (interactive "P") + (let* ((class (ebrowse-tree-at-point)) + (class-name (ebrowse-cs-name (ebrowse-ts-class class))) + (subclasses (ebrowse-ts-subclasses class))) + (cond ((or forced + (y-or-n-p (concat "Delete class " class-name "? "))) + (setf ebrowse--tree (ebrowse-remove-class-and-kill-member-buffers + ebrowse--tree class)) + (set-buffer-modified-p t) + (message "%s %sdeleted." class-name + (if subclasses "and derived classes " "")) + (ebrowse-redraw-tree)) + (t (message "Aborted"))))) + + + +;;; Marking classes in the tree buffer + +(defun ebrowse-toggle-mark-at-point (&optional n-times) + "Toggle mark for class cursor is on. +If given a numeric N-TIMES argument, mark that many classes." + (interactive "p") + (let (to-change pnt) + ;; Get the classes whose mark must be toggled. Note that + ;; ebrowse-tree-at-point might issue an error. + (condition-case error + (loop repeat (or n-times 1) + as tree = (ebrowse-tree-at-point) + do (progn + (setf (ebrowse-ts-mark tree) (not (ebrowse-ts-mark tree))) + (forward-line 1) + (push tree to-change))) + (error nil)) + (save-excursion + ;; For all these classes, reverse the mark char in the display + ;; by a regexp replace over the whole buffer. The reason for this + ;; is that classes might have multiple base classes. If this is + ;; the case, they are displayed more than once in the tree. + (ebrowse-output + (loop for tree in to-change + as regexp = (concat "^.*\\b" + (regexp-quote + (ebrowse-cs-name (ebrowse-ts-class tree))) + "\\b") + do + (goto-char (point-min)) + (loop while (re-search-forward regexp nil t) + do (progn + (goto-char (match-beginning 0)) + (delete-char 1) + (insert-char (if (ebrowse-ts-mark tree) ?> ? ) 1) + (ebrowse-set-mark-props (1- (point)) (point) tree) + (goto-char (match-end 0))))))))) + + +(defun ebrowse-mark-all-classes (prefix) + "Unmark, with PREFIX mark, all classes in the tree." + (interactive "P") + (ebrowse-for-all-trees (tree ebrowse--tree-obarray) + (setf (ebrowse-ts-mark tree) prefix)) + (ebrowse-redraw-marks (point-min) (point-max))) + + +(defun ebrowse-redraw-marks (start end) + "Display class marker signs in the tree between START and END." + (interactive) + (save-excursion + (ebrowse-output + (catch 'end + (goto-char (point-min)) + (dolist (root ebrowse--tree) + (ebrowse-draw-marks-fn root start end)))) + (ebrowse-update-tree-buffer-mode-line))) + + +(defun ebrowse-draw-marks-fn (tree start end) + "Display class marker signs in TREE between START and END." + (when (>= (point) start) + (delete-char 1) + (insert (if (ebrowse-ts-mark tree) ?> ? )) + (ebrowse-set-mark-props (1- (point)) (point) tree)) + (forward-line 1) + (when (> (point) end) + (throw 'end nil)) + (dolist (sub (ebrowse-ts-subclasses tree)) + (ebrowse-draw-marks-fn sub start end))) + + + +;;; File name display in tree buffers + +(defun ebrowse-show-file-name-at-point (prefix) + "Show filename in the line point is in. +With PREFIX, insert that many filenames." + (interactive "p") + (unless ebrowse--show-file-names-flag + (ebrowse-output + (dotimes (i prefix) + (let ((tree (ebrowse-tree-at-point)) + start + file-name-existing) + (unless tree return) + (beginning-of-line) + (skip-chars-forward " \t*a-zA-Z0-9_") + (setq start (point) + file-name-existing (looking-at "(")) + (delete-region start (save-excursion (end-of-line) (point))) + (unless file-name-existing + (indent-to ebrowse-source-file-column) + (insert "(" (or (ebrowse-cs-file + (ebrowse-ts-class tree)) + "unknown") + ")")) + (ebrowse-set-face start (point) 'ebrowse-file-name-face) + (beginning-of-line) + (forward-line 1)))))) + + +(defun ebrowse-toggle-file-name-display () + "Toggle display of filenames in tree buffer." + (interactive) + (setf ebrowse--show-file-names-flag (not ebrowse--show-file-names-flag)) + (let ((old-line (count-lines (point-min) (point)))) + (ebrowse-redraw-tree) + (goto-line old-line))) + + + +;;; General member and tree buffer functions + +(defun ebrowse-member-buffer-p (buffer) + "Value is non-nil if BUFFER is a member buffer." + (eq (cdr (assoc 'major-mode (buffer-local-variables buffer))) + 'ebrowse-member-mode)) + + +(defun ebrowse-tree-buffer-p (buffer) + "Value is non-nil if BUFFER is a class tree buffer." + (eq (cdr (assoc 'major-mode (buffer-local-variables buffer))) + 'ebrowse-tree-mode)) + + +(defun ebrowse-buffer-p (buffer) + "Value is non-nil if BUFFER is a tree or member buffer." + (memq (cdr (assoc 'major-mode (buffer-local-variables buffer))) + '(ebrowse-tree-mode ebrowse-member-mode))) + + +(defun ebrowse-browser-buffer-list () + "Return a list of all tree or member buffers." + (ebrowse-delete-if-not 'ebrowse-buffer-p (buffer-list))) + + +(defun ebrowse-member-buffer-list () + "Return a list of all member buffers." + (ebrowse-delete-if-not 'ebrowse-member-buffer-p (buffer-list))) + + +(defun ebrowse-tree-buffer-list () + "Return a list of all tree buffers." + (ebrowse-delete-if-not 'ebrowse-tree-buffer-p (buffer-list))) + + +(defun ebrowse-known-class-trees-buffer-list () + "Return a list of buffers containing class trees. +The list will contain, for each class tree loaded, +one buffer. Prefer tree buffers over member buffers." + (let ((buffers (nconc (ebrowse-tree-buffer-list) + (ebrowse-member-buffer-list))) + (set (make-hash-table)) + result) + (dolist (buffer buffers) + (let ((tree (ebrowse-value-in-buffer 'ebrowse--tree buffer))) + (unless (gethash tree set) + (push buffer result)) + (puthash tree t set))) + result)) + + +(defun ebrowse-same-tree-member-buffer-list () + "Return a list of members buffers with same tree as current buffer." + (ebrowse-delete-if-not + #'(lambda (buffer) + (eq (ebrowse-value-in-buffer 'ebrowse--tree buffer) + ebrowse--tree)) + (ebrowse-member-buffer-list))) + + + +(defun ebrowse-pop/switch-to-member-buffer-for-same-tree (arg) + "Pop to the buffer displaying members. +Switch to buffer if prefix ARG. +If no member buffer exists, make one." + (interactive "P") + (let ((buf (or (first (ebrowse-same-tree-member-buffer-list)) + (get-buffer ebrowse-member-buffer-name) + (ebrowse-tree-command:show-member-functions)))) + (when buf + (if arg + (switch-to-buffer buf) + (pop-to-buffer buf))) + buf)) + + +(defun ebrowse-switch-to-next-member-buffer () + "Switch to next member buffer." + (interactive) + (let* ((list (ebrowse-member-buffer-list)) + (next-list (cdr (memq (current-buffer) list))) + (next-buffer (if next-list (car next-list) (car list)))) + (if (eq next-buffer (current-buffer)) + (error "No next buffer") + (bury-buffer) + (switch-to-buffer next-buffer)))) + + +(defun ebrowse-kill-member-buffers-displaying (tree) + "Kill all member buffers displaying TREE." + (loop for buffer in (ebrowse-member-buffer-list) + as class = (ebrowse-value-in-buffer 'ebrowse--displayed-class buffer) + when (eq class tree) do (kill-buffer buffer))) + + +(defun ebrowse-frozen-tree-buffer-name (tags-file-name) + "Return the buffer name of a tree which is associated TAGS-FILE-NAME." + (concat ebrowse-tree-buffer-name " (" tags-file-name ")")) + + +(defun ebrowse-pop-to-browser-buffer (arg) + "Pop to a browser buffer from any other buffer. +Pop to member buffer if no prefix ARG, to tree buffer otherwise." + (interactive "P") + (let ((buffer (get-buffer (if arg + ebrowse-tree-buffer-name + ebrowse-member-buffer-name)))) + (unless buffer + (setq buffer + (get-buffer (if arg + ebrowse-member-buffer-name + ebrowse-tree-buffer-name)))) + (unless buffer + (error "No browser buffer found")) + (pop-to-buffer buffer))) + + + +;;; Misc tree buffer commands + +(defun ebrowse-set-tree-indentation () + "Set the indentation width of the tree display." + (interactive) + (let ((width (string-to-int (read-from-minibuffer + (concat "Indentation (" + (int-to-string ebrowse--indentation) + "): "))))) + (when (plusp width) + (setf ebrowse--indentation width) + (ebrowse-redraw-tree)))) + + +(defun ebrowse-read-class-name-and-go (&optional class) + "Position cursor on CLASS. +Read a class name from the minibuffer if CLASS is nil." + (interactive) + (ebrowse-ignoring-completion-case + ;; If no class specified, read the class name from mini-buffer + (unless class + (setf class + (completing-read "Goto class: " + (ebrowse-tree-obarray-as-alist) nil t))) + (ebrowse-save-selective + (goto-char (point-min)) + (widen) + (setf selective-display nil) + (setq ebrowse--last-regexp (concat "\\b" class "\\b")) + (if (re-search-forward ebrowse--last-regexp nil t) + (progn + (goto-char (match-beginning 0)) + (ebrowse-unhide-base-classes)) + (error "Not found"))))) + + + +;;; Showing various kinds of member buffers + +(defun ebrowse-tree-command:show-member-variables (arg) + "Display member variables; with prefix ARG in frozen member buffer." + (interactive "P") + (ebrowse-display-member-buffer 'ebrowse-ts-member-variables arg)) + + +(defun ebrowse-tree-command:show-member-functions (&optional arg) + "Display member functions; with prefix ARG in frozen member buffer." + (interactive "P") + (ebrowse-display-member-buffer 'ebrowse-ts-member-functions arg)) + + +(defun ebrowse-tree-command:show-static-member-variables (arg) + "Display static member variables; with prefix ARG in frozen member buffer." + (interactive "P") + (ebrowse-display-member-buffer 'ebrowse-ts-static-variables arg)) + + +(defun ebrowse-tree-command:show-static-member-functions (arg) + "Display static member functions; with prefix ARG in frozen member buffer." + (interactive "P") + (ebrowse-display-member-buffer 'ebrowse-ts-static-functions arg)) + + +(defun ebrowse-tree-command:show-friends (arg) + "Display friend functions; with prefix ARG in frozen member buffer." + (interactive "P") + (ebrowse-display-member-buffer 'ebrowse-ts-friends arg)) + + +(defun ebrowse-tree-command:show-types (arg) + "Display types defined in a class; with prefix ARG in frozen member buffer." + (interactive "P") + (ebrowse-display-member-buffer 'ebrowse-ts-types arg)) + + + +;;; Viewing or finding a class declaration + +(defun ebrowse-tree-at-point () + "Return the class structure for the class point is on." + (or (get-text-property (point) 'ebrowse-tree) + (error "Not on a class"))) + + +(defun* ebrowse-view/find-class-declaration (&key view where) + "View or find the declarator of the class point is on. +VIEW non-nil means view it. WHERE is additional position info." + (let* ((class (ebrowse-ts-class (ebrowse-tree-at-point))) + (file (ebrowse-cs-file class)) + (browse-struct (make-ebrowse-bs + :name (ebrowse-cs-name class) + :pattern (ebrowse-cs-pattern class) + :flags (ebrowse-cs-flags class) + :file (ebrowse-cs-file class) + :point (ebrowse-cs-point class)))) + (ebrowse-view/find-file-and-search-pattern + browse-struct + (list ebrowse--header class nil) + file + ebrowse--tags-file-name + view + where))) + + +(defun ebrowse-find-class-declaration (prefix-arg) + "Find a class declaration and position cursor on it. +PREFIX-ARG 4 means find it in another window. +PREFIX-ARG 5 means find it in another frame." + (interactive "p") + (ebrowse-view/find-class-declaration + :view nil + :where (cond ((= prefix-arg 4) 'other-window) + ((= prefix-arg 5) 'other-frame) + (t 'this-window)))) + + +(defun ebrowse-view-class-declaration (prefix-arg) + "View class declaration and position cursor on it. +PREFIX-ARG 4 means view it in another window. +PREFIX-ARG 5 means view it in another frame." + (interactive "p") + (ebrowse-view/find-class-declaration + :view 'view + :where (cond ((= prefix-arg 4) 'other-window) + ((= prefix-arg 5) 'other-frame) + (t 'this-window)))) + + + +;;; The FIND engine + +(defun ebrowse-find-source-file (file tags-file-name) + "Find source file FILE. +Source files are searched for (a) relative to TAGS-FILE-NAME +which is the path of the BROWSE file from which the class tree was loaded, +and (b) in the directories named in `ebrowse-search-path'." + (let (file-name + (try-file (expand-file-name file + (file-name-directory tags-file-name)))) + (if (file-readable-p try-file) + (setq file-name try-file) + (let ((search-in ebrowse-search-path)) + (while (and search-in + (null file-name)) + (let ((try-file (expand-file-name file (car search-in)))) + (if (file-readable-p try-file) + (setq file-name try-file)) + (setq search-in (cdr search-in)))))) + (unless file-name + (error "File `%s' not found" file)) + file-name)) + + +(defun ebrowse-view-file-other-window (file) + "View a file FILE in another window. +This is a replacement for `view-file-other-window' which does not +seem to work. It should be removed when `view.el' is fixed." + (interactive) + (let ((old-arrangement (current-window-configuration)) + (had-a-buf (get-file-buffer file)) + (buf-to-view (find-file-noselect file))) + (switch-to-buffer-other-window buf-to-view) + (view-mode-enter old-arrangement + (and (not had-a-buf) + (not (buffer-modified-p buf-to-view)) + 'kill-buffer)))) + + +(defun ebrowse-view-exit-fn (buffer) + "Function called when exiting View mode in BUFFER. +Restore frame configuration active before viewing the file, +and possibly kill the viewed buffer." + (let (exit-action original-frame-configuration) + (save-excursion + (set-buffer buffer) + (setq original-frame-configuration ebrowse--frame-configuration + exit-action ebrowse--view-exit-action)) + ;; Delete the frame in which we viewed. + (mapcar 'delete-frame + (loop for frame in (frame-list) + when (not (assq frame original-frame-configuration)) + collect frame)) + (when exit-action + (funcall exit-action buffer)))) + + +(defun ebrowse-view-file-other-frame (file) + "View a file FILE in another frame. +The new frame is deleted when it is no longer used." + (interactive) + (let ((old-frame-configuration (current-frame-configuration)) + (old-arrangement (current-window-configuration)) + (had-a-buf (get-file-buffer file)) + (buf-to-view (find-file-noselect file))) + (switch-to-buffer-other-frame buf-to-view) + (make-local-variable 'ebrowse--frame-configuration) + (setq ebrowse--frame-configuration old-frame-configuration) + (make-local-variable 'ebrowse--view-exit-action) + (setq ebrowse--view-exit-action + (and (not had-a-buf) + (not (buffer-modified-p buf-to-view)) + 'kill-buffer)) + (view-mode-enter old-arrangement 'ebrowse-view-exit-fn))) + + +(defun ebrowse-view/find-file-and-search-pattern + (struc info file tags-file-name &optional view where) + "Find or view a member or class. +STRUC is an `ebrowse-bs' structure (or a structure including that) +describing what to search. +INFO is a list (HEADER MEMBER-OR-CLASS ACCESSOR). HEADER is the +header structure of a class tree. MEMBER-OR-CLASS is either an +`ebrowse-ms' or `ebrowse-cs' structure depending on what is searched. +ACCESSOR is an accessor function for the member list of an member +if MEMBER-OR-CLASS is an `ebrowse-ms'. +FILE is the file to search the member in. +FILE is not taken out of STRUC here because the filename in STRUC +may be nil in which case the filename of the class description is used. +TAGS-FILE-NAME is the name of the EBROWSE file from which the +tree was loaded. +If VIEW is non-nil, view file else find the file. +WHERE is either `other-window', `other-frame' or `this-window' and +specifies where to find/view the result." + (unless file + (error "Sorry, no file information available for %s" + (ebrowse-bs-name struc))) + ;; Get the source file to view or find. + (setf file (ebrowse-find-source-file file tags-file-name)) + ;; If current window is dedicated, use another frame. + (when (window-dedicated-p (selected-window)) + (setf where 'other-frame)) + (cond (view + (setf ebrowse-temp-position-to-view struc + ebrowse-temp-info-to-view info) + (unless (boundp 'view-mode-hook) + (setq view-mode-hook nil)) + (push 'ebrowse-find-pattern view-mode-hook) + (case where + (other-window (ebrowse-view-file-other-window file)) + (other-frame (ebrowse-view-file-other-frame file)) + (t (view-file file)))) + (t + (case where + (other-window (find-file-other-window file)) + (other-frame (find-file-other-frame file)) + (t (find-file file))) + (ebrowse-find-pattern struc info)))) + + +(defun ebrowse-symbol-regexp (name) + "Generate a suitable regular expression for a member or class NAME. +This is `regexp-quote' for most symbols, except for operator names +which may contain whitespace. For these symbols, replace white +space in the symbol name (generated by EBROWSE) with a regular +expression matching any number of whitespace characters." + (loop with regexp = (regexp-quote name) + with start = 0 + finally return regexp + while (string-match "[ \t]+" regexp start) + do (setf (substring regexp (match-beginning 0) (match-end 0)) + "[ \t]*" + start (+ (match-beginning 0) 5)))) + + +(defun ebrowse-class-declaration-regexp (name) + "Construct a regexp for a declaration of class NAME." + (concat "^[ \t]*\\(template[ \t\n]*<.*>\\)?" + "[ \t\n]*\\(class\\|struct\\|union\\).*\\S_" + (ebrowse-symbol-regexp name) + "\\S_")) + + +(defun ebrowse-variable-declaration-regexp (name) + "Construct a regexp for matching a variable NAME." + (concat "\\S_" (ebrowse-symbol-regexp name) "\\S_")) + + +(defun ebrowse-function-declaration/definition-regexp (name) + "Construct a regexp for matching a function NAME." + (concat "^[a-zA-Z0-9_:*&<>, \t]*\\S_" + (ebrowse-symbol-regexp name) + "[ \t\n]*(")) + + +(defun ebrowse-pp-define-regexp (name) + "Construct a regexp matching a define of NAME." + (concat "^[ \t]*#[ \t]*define[ \t]+" (regexp-quote name))) + + +(defun* ebrowse-find-pattern (&optional position info &aux viewing) + "Find a pattern. + +This is a kluge: Ebrowse allows you to find or view a file containing +a pattern. To be able to do a search in a viewed buffer, +`view-mode-hook' is temporarily set to this function; +`ebrowse-temp-position-to-view' holds what to search for. + +INFO is a list (TREE-HEADER TREE-OR-MEMBER MEMBER-LIST)." + (unless position + (pop view-mode-hook) + (setf viewing t + position ebrowse-temp-position-to-view + info ebrowse-temp-info-to-view)) + (widen) + (let* ((pattern (ebrowse-bs-pattern position)) + (start (ebrowse-bs-point position)) + (offset 100) + found) + (destructuring-bind (header class-or-member member-list) info + ;; If no pattern is specified, construct one from the member name. + (when (stringp pattern) + (setq pattern (concat "^.*" (regexp-quote pattern)))) + ;; Construct a regular expression if none given. + (unless pattern + (typecase class-or-member + (ebrowse-ms + (case member-list + ((ebrowse-ts-member-variables + ebrowse-ts-static-variables + ebrowse-ts-types) + (setf pattern (ebrowse-variable-declaration-regexp + (ebrowse-bs-name position)))) + (otherwise + (if (ebrowse-define-p class-or-member) + (setf pattern (ebrowse-pp-define-regexp (ebrowse-bs-name position))) + (setf pattern (ebrowse-function-declaration/definition-regexp + (ebrowse-bs-name position))))))) + (ebrowse-cs + (setf pattern (ebrowse-class-declaration-regexp + (ebrowse-bs-name position)))))) + ;; Begin searching some OFFSET from the original point where the + ;; regular expression was found by the parse, and step forward. + ;; When there is no regular expression in the database and a + ;; member definition/declaration was not seen by the parser, + ;; START will be 0. + (when (and (boundp 'ebrowse-debug) + (symbol-value 'ebrowse-debug)) + (y-or-n-p (format "start = %d" start)) + (y-or-n-p pattern)) + (setf found + (loop do (goto-char (max (point-min) (- start offset))) + when (re-search-forward pattern (+ start offset) t) return t + never (bobp) + do (incf offset offset))) + (cond (found + (beginning-of-line) + (run-hooks 'ebrowse-view/find-hook)) + ((numberp (ebrowse-bs-pattern position)) + (goto-char start) + (if ebrowse-not-found-hook + (run-hooks 'ebrowse-not-found-hook) + (message "Not found") + (sit-for 2))) + (t + (if ebrowse-not-found-hook + (run-hooks 'ebrowse-not-found-hook) + (unless viewing + (error "Not found")) + (message "Not found") + (sit-for 2))))))) + + +;;; Drawing the tree + +(defun ebrowse-redraw-tree (&optional quietly) + "Redisplay the complete tree. +QUIETLY non-nil means don't display progress messages." + (interactive) + (or quietly (message "Displaying...")) + (save-excursion + (ebrowse-output + (erase-buffer) + (ebrowse-draw-tree-fn))) + (ebrowse-update-tree-buffer-mode-line) + (or quietly (message nil))) + + +(defun ebrowse-set-mark-props (start end tree) + "Set text properties for class marker signs between START and END. +TREE denotes the class shown." + (add-text-properties + start end + `(mouse-face highlight ebrowse-what mark ebrowse-tree ,tree + help-echo "double-mouse-1: mark/unmark")) + (ebrowse-set-face start end 'ebrowse-tree-mark-face)) + + +(defun* ebrowse-draw-tree-fn (&aux stack1 stack2 start) + "Display a single class and recursively it's subclasses. +This function may look weird, but this is faster than recursion." + (setq stack1 (make-list (length ebrowse--tree) 0) + stack2 (ebrowse-copy-list ebrowse--tree)) + (loop while stack2 + as level = (pop stack1) + as tree = (pop stack2) + as class = (ebrowse-ts-class tree) do + (let ((start-of-line (point)) + start-of-class-name end-of-class-name) + ;; Insert mark + (insert (if (ebrowse-ts-mark tree) ">" " ")) + + ;; Indent and insert class name + (indent-to (+ (* level ebrowse--indentation) + ebrowse-tree-left-margin)) + (setq start (point)) + (insert (ebrowse-qualified-class-name class)) + + ;; If template class, add <> + (when (ebrowse-template-p class) + (insert "<>")) + (ebrowse-set-face start (point) (if (zerop level) + 'ebrowse-root-class-face + 'ebrowse-default-face)) + (setf start-of-class-name start + end-of-class-name (point)) + ;; If filenames are to be displayed... + (when ebrowse--show-file-names-flag + (indent-to ebrowse-source-file-column) + (setq start (point)) + (insert "(" + (or (ebrowse-cs-file class) + "unknown") + ")") + (ebrowse-set-face start (point) 'ebrowse-file-name-face)) + (ebrowse-set-mark-props start-of-line (1+ start-of-line) tree) + (add-text-properties + start-of-class-name end-of-class-name + `(mouse-face highlight ebrowse-what class-name + ebrowse-tree ,tree + help-echo "double-mouse-1: (un)expand tree; mouse-2: member functions, mouse-3: menu")) + (insert "\n")) + ;; Push subclasses, if any. + (when (ebrowse-ts-subclasses tree) + (setq stack2 + (nconc (ebrowse-copy-list (ebrowse-ts-subclasses tree)) stack2) + stack1 + (nconc (make-list (length (ebrowse-ts-subclasses tree)) + (1+ level)) stack1))))) + + + +;;; Expanding/ collapsing tree branches + +(defun ebrowse-expand-branch (arg) + "Expand a sub-tree that has been previously collapsed. +With prefix ARG, expand all sub-trees." + (interactive "P") + (if arg + (ebrowse-expand-all arg) + (ebrowse-collapse-fn nil))) + + +(defun ebrowse-collapse-branch (arg) + "Fold (do no longer display) the subclasses of the current class. +\(The class cursor is on.) With prefix ARG, fold all trees in the buffer." + (interactive "P") + (if arg + (ebrowse-expand-all (not arg)) + (ebrowse-collapse-fn t))) + + +(defun ebrowse-expand-all (collapse) + "Expand or fold all trees in the buffer. +COLLAPSE non-nil means fold them." + (interactive "P") + (let ((line-end (if collapse "^\n" "^\r")) + (insertion (if collapse "\r" "\n"))) + (ebrowse-output + (save-excursion + (goto-char (point-min)) + (while (not (progn (skip-chars-forward line-end) (eobp))) + (when (or (not collapse) + (looking-at "\n ")) + (delete-char 1) + (insert insertion)) + (when collapse + (skip-chars-forward "\n "))))))) + + +(defun ebrowse-unhide-base-classes () + "Unhide the line the cursor is on and all base classes." + (ebrowse-output + (save-excursion + (let (indent last-indent) + (skip-chars-backward "^\r\n") + (when (not (looking-at "[\r\n][^ \t]")) + (skip-chars-forward "\r\n \t") + (while (and (or (null last-indent) ;first time + (> indent 1)) ;not root class + (re-search-backward "[\r\n][ \t]*" nil t)) + (setf indent (- (match-end 0) + (match-beginning 0))) + (when (or (null last-indent) + (< indent last-indent)) + (setf last-indent indent) + (when (looking-at "\r") + (delete-char 1) + (insert 10))) + (backward-char 1))))))) + + +(defun ebrowse-hide-line (collapse) + "Hide/show a single line in the tree. +COLLAPSE non-nil means hide." + (save-excursion + (ebrowse-output + (skip-chars-forward "^\r\n") + (delete-char 1) + (insert (if collapse 13 10))))) + + +(defun ebrowse-collapse-fn (collapse) + "Collapse or expand a branch of the tree. +COLLAPSE non-nil means collapse the branch." + (ebrowse-output + (save-excursion + (beginning-of-line) + (skip-chars-forward "> \t") + (let ((indentation (current-column))) + (while (and (not (eobp)) + (save-excursion + (skip-chars-forward "^\r\n") + (goto-char (1+ (point))) + (skip-chars-forward "> \t") + (> (current-column) indentation))) + (ebrowse-hide-line collapse) + (skip-chars-forward "^\r\n") + (goto-char (1+ (point)))))))) + + +;;; Electric tree selection + +(defvar ebrowse-electric-list-mode-map () + "Keymap used in electric Ebrowse buffer list window.") + + +(unless ebrowse-electric-list-mode-map + (let ((map (make-keymap)) + (submap (make-keymap))) + (setq ebrowse-electric-list-mode-map map) + (fillarray (car (cdr map)) 'ebrowse-electric-list-undefined) + (fillarray (car (cdr submap)) 'ebrowse-electric-list-undefined) + (define-key map "\e" submap) + (define-key map "\C-z" 'suspend-emacs) + (define-key map "\C-h" 'Helper-help) + (define-key map "?" 'Helper-describe-bindings) + (define-key map "\C-c" nil) + (define-key map "\C-c\C-c" 'ebrowse-electric-list-quit) + (define-key map "q" 'ebrowse-electric-list-quit) + (define-key map " " 'ebrowse-electric-list-select) + (define-key map "\C-l" 'recenter) + (define-key map "\C-u" 'universal-argument) + (define-key map "\C-p" 'previous-line) + (define-key map "\C-n" 'next-line) + (define-key map "p" 'previous-line) + (define-key map "n" 'next-line) + (define-key map "v" 'ebrowse-electric-view-buffer) + (define-key map "\C-v" 'scroll-up) + (define-key map "\ev" 'scroll-down) + (define-key map "\e\C-v" 'scroll-other-window) + (define-key map "\e>" 'end-of-buffer) + (define-key map "\e<" 'beginning-of-buffer) + (define-key map "\e>" 'end-of-buffer))) + +(put 'ebrowse-electric-list-mode 'mode-class 'special) +(put 'ebrowse-electric-list-undefined 'suppress-keymap t) + + +(defun ebrowse-electric-list-mode () + "Mode for electric tree list mode." + (kill-all-local-variables) + (use-local-map ebrowse-electric-list-mode-map) + (setq mode-name "Electric Position Menu" + mode-line-buffer-identification "Electric Tree Menu") + (when (memq 'mode-name mode-line-format) + (setq mode-line-format (copy-sequence mode-line-format)) + (setcar (memq 'mode-name mode-line-format) "Tree Buffers")) + (make-local-variable 'Helper-return-blurb) + (setq Helper-return-blurb "return to buffer editing" + truncate-lines t + buffer-read-only t + major-mode 'ebrowse-electric-list-mode) + (run-hooks 'ebrowse-electric-list-mode-hook)) + + +(defun ebrowse-list-tree-buffers () + "Display a list of all tree buffers." + (set-buffer (get-buffer-create "*Tree Buffers*")) + (setq buffer-read-only nil) + (erase-buffer) + (insert "Tree\n" "----\n") + (dolist (buffer (ebrowse-known-class-trees-buffer-list)) + (insert (buffer-name buffer) "\n")) + (setq buffer-read-only t)) + + +;;;###autoload +(defun ebrowse-electric-choose-tree () + "Return a buffer containing a tree or nil if no tree found or canceled." + (interactive) + (unless (car (ebrowse-known-class-trees-buffer-list)) + (error "No tree buffers")) + (let (select buffer window) + (save-window-excursion + (save-window-excursion (ebrowse-list-tree-buffers)) + (setq window (Electric-pop-up-window "*Tree Buffers*") + buffer (window-buffer window)) + (shrink-window-if-larger-than-buffer window) + (unwind-protect + (progn + (set-buffer buffer) + (ebrowse-electric-list-mode) + (setq select + (catch 'ebrowse-electric-list-select + (message "<<< Press Space to bury the list >>>") + (let ((first (progn (goto-char (point-min)) + (forward-line 2) + (point))) + (last (progn (goto-char (point-max)) + (forward-line -1) + (point))) + (goal-column 0)) + (goto-char first) + (Electric-command-loop 'ebrowse-electric-list-select + nil + t + 'ebrowse-electric-list-looper + (cons first last)))))) + (set-buffer buffer) + (bury-buffer buffer) + (message nil))) + (when select + (set-buffer buffer) + (setq select (ebrowse-electric-get-buffer select))) + (kill-buffer buffer) + select)) + + +(defun ebrowse-electric-list-looper (state condition) + "Prevent cursor from moving beyond the buffer end. +Don't let it move into the title lines. +See 'Electric-command-loop' for a description of STATE and CONDITION." + (cond ((and condition + (not (memq (car condition) + '(buffer-read-only end-of-buffer + beginning-of-buffer)))) + (signal (car condition) (cdr condition))) + ((< (point) (car state)) + (goto-char (point-min)) + (forward-line 2)) + ((> (point) (cdr state)) + (goto-char (point-max)) + (forward-line -1) + (if (pos-visible-in-window-p (point-max)) + (recenter -1))))) + + +(defun ebrowse-electric-list-undefined () + "Function called for keys that are undefined." + (interactive) + (message "Type C-h for help, ? for commands, q to quit, Space to select.") + (sit-for 4)) + + +(defun ebrowse-electric-list-quit () + "Discard the buffer list." + (interactive) + (throw 'ebrowse-electric-list-select nil)) + + +(defun ebrowse-electric-list-select () + "Select a buffer from the buffer list." + (interactive) + (throw 'ebrowse-electric-list-select (point))) + + +(defun ebrowse-electric-get-buffer (point) + "Get a buffer corresponding to the line POINT is in." + (let ((index (- (count-lines (point-min) point) 2))) + (nth index (ebrowse-known-class-trees-buffer-list)))) + + +;;; View a buffer for a tree. + +(defun ebrowse-electric-view-buffer () + "View buffer point is on." + (interactive) + (let ((buffer (ebrowse-electric-get-buffer (point)))) + (cond (buffer + (view-buffer buffer)) + (t + (error "Buffer no longer exists"))))) + + +(defun ebrowse-choose-from-browser-buffers () + "Read a browser buffer name from the minibuffer and return that buffer." + (let* ((buffers (ebrowse-known-class-trees-buffer-list))) + (if buffers + (if (not (second buffers)) + (first buffers) + (or (ebrowse-electric-choose-tree) (error "No tree buffer"))) + (let* ((insert-default-directory t) + (file (read-file-name "Find tree: " nil nil t))) + (save-excursion + (find-file file)) + (find-buffer-visiting file))))) + + +;;; Member buffers + +(unless ebrowse-member-mode-map + (let ((map (make-keymap))) + (setf ebrowse-member-mode-map map) + (suppress-keymap map) + + (when window-system + (define-key map [down-mouse-3] 'ebrowse-member-mouse-3) + (define-key map [mouse-2] 'ebrowse-member-mouse-2)) + + (let ((map1 (make-sparse-keymap))) + (suppress-keymap map1 t) + (define-key map "C" map1) + (define-key map1 "b" 'ebrowse-switch-member-buffer-to-base-class) + (define-key map1 "c" 'ebrowse-switch-member-buffer-to-any-class) + (define-key map1 "d" 'ebrowse-switch-member-buffer-to-derived-class) + (define-key map1 "n" 'ebrowse-switch-member-buffer-to-next-sibling-class) + (define-key map1 "p" 'ebrowse-switch-member-buffer-to-previous-sibling-class)) + + (let ((map1 (make-sparse-keymap))) + (suppress-keymap map1 t) + (define-key map "D" map1) + (define-key map1 "a" 'ebrowse-toggle-member-attributes-display) + (define-key map1 "b" 'ebrowse-toggle-base-class-display) + (define-key map1 "f" 'ebrowse-freeze-member-buffer) + (define-key map1 "l" 'ebrowse-toggle-long-short-display) + (define-key map1 "r" 'ebrowse-toggle-regexp-display) + (define-key map1 "w" 'ebrowse-set-member-buffer-column-width)) + + (let ((map1 (make-sparse-keymap))) + (suppress-keymap map1 t) + (define-key map "F" map1) + (let ((map2 (make-sparse-keymap))) + (suppress-keymap map2 t) + (define-key map1 "a" map2) + (define-key map2 "i" 'ebrowse-toggle-private-member-filter) + (define-key map2 "o" 'ebrowse-toggle-protected-member-filter) + (define-key map2 "u" 'ebrowse-toggle-public-member-filter)) + (define-key map1 "c" 'ebrowse-toggle-const-member-filter) + (define-key map1 "i" 'ebrowse-toggle-inline-member-filter) + (define-key map1 "p" 'ebrowse-toggle-pure-member-filter) + (define-key map1 "r" 'ebrowse-remove-all-member-filters) + (define-key map1 "v" 'ebrowse-toggle-virtual-member-filter)) + + (let ((map1 (make-sparse-keymap))) + (suppress-keymap map1 t) + (define-key map "L" map1) + (define-key map1 "d" 'ebrowse-display-friends-member-list) + (define-key map1 "f" 'ebrowse-display-function-member-list) + (define-key map1 "F" 'ebrowse-display-static-functions-member-list) + (define-key map1 "n" 'ebrowse-display-next-member-list) + (define-key map1 "p" 'ebrowse-display-previous-member-list) + (define-key map1 "t" 'ebrowse-display-types-member-list) + (define-key map1 "v" 'ebrowse-display-variables-member-list) + (define-key map1 "V" 'ebrowse-display-static-variables-member-list)) + + (let ((map1 (make-sparse-keymap))) + (suppress-keymap map1 t) + (define-key map "G" map1) + (define-key map1 "m" 'ebrowse-goto-visible-member/all-member-lists) + (define-key map1 "n" 'ebrowse-repeat-member-search) + (define-key map1 "v" 'ebrowse-goto-visible-member)) + + (define-key map "f" 'ebrowse-find-member-declaration) + (define-key map "m" 'ebrowse-switch-to-next-member-buffer) + (define-key map "q" 'bury-buffer) + (define-key map "t" 'ebrowse-show-displayed-class-in-tree) + (define-key map "v" 'ebrowse-view-member-declaration) + (define-key map " " 'ebrowse-view-member-definition) + (define-key map "?" 'describe-mode) + (define-key map "\C-i" 'ebrowse-pop-from-member-to-tree-buffer) + (define-key map "\C-l" 'ebrowse-redisplay-member-buffer) + (define-key map "\C-m" 'ebrowse-find-member-definition))) + + + +;;; Member mode + +;;###autoload +(defun ebrowse-member-mode () + "Major mode for Ebrowse member buffers. + +\\{ebrowse-member-mode-map}" + (kill-all-local-variables) + (use-local-map ebrowse-member-mode-map) + (setq major-mode 'ebrowse-member-mode) + (mapcar 'make-local-variable + '(ebrowse--decl-column ;display column + ebrowse--n-columns ;number of short columns + ebrowse--column-width ;width of columns above + ebrowse--show-inherited-flag ;include inherited members? + ebrowse--filters ;public, protected, private + ebrowse--accessor ;vars, functions, friends + ebrowse--displayed-class ;class displayed + ebrowse--long-display-flag ;display with regexps? + ebrowse--source-regexp-flag ;show source regexp? + ebrowse--attributes-flag ;show `virtual' and `inline' + ebrowse--member-list ;list of members displayed + ebrowse--tree ;the class tree + ebrowse--member-mode-strings ;part of mode line + ebrowse--tags-file-name ; + ebrowse--header + ebrowse--tree-obarray + ebrowse--virtual-display-flag + ebrowse--inline-display-flag + ebrowse--const-display-flag + ebrowse--pure-display-flag + ebrowse--mode-line-props + ebrowse--frozen-flag)) ;buffer not automagically reused + (setq ebrowse--mode-line-props (text-properties-at + 0 (car (default-value + 'mode-line-buffer-identification))) + mode-name "Ebrowse-Members" + mode-line-buffer-identification 'ebrowse--member-mode-strings + buffer-read-only t + ebrowse--long-display-flag nil + ebrowse--attributes-flag t + ebrowse--show-inherited-flag t + ebrowse--source-regexp-flag nil + ebrowse--filters [0 1 2] + ebrowse--decl-column ebrowse-default-declaration-column + ebrowse--column-width ebrowse-default-column-width + ebrowse--virtual-display-flag nil + ebrowse--inline-display-flag nil + ebrowse--const-display-flag nil + ebrowse--pure-display-flag nil) + (modify-syntax-entry ?_ (char-to-string (char-syntax ?a))) + (run-hooks 'ebrowse-member-mode-hook)) + + + +;;; Member mode mode line + +(defsubst ebrowse-class-name-displayed-in-member-buffer () + "Return the name of the class displayed in the member buffer." + (ebrowse-cs-name (ebrowse-ts-class ebrowse--displayed-class))) + + +(defsubst ebrowse-member-list-name () + "Return a string describing what is displayed in the member buffer." + (get ebrowse--accessor (if (ebrowse-globals-tree-p ebrowse--displayed-class) + 'ebrowse-global-title + 'ebrowse-title))) + + +(defun ebrowse-update-member-buffer-mode-line () + "Update the mode line of member buffers." + (let* ((name (when ebrowse--frozen-flag + (concat (ebrowse-class-name-displayed-in-member-buffer) + " "))) + (ident (concat name (ebrowse-member-list-name)))) + (setq ebrowse--member-mode-strings + (apply #'propertize ident ebrowse--mode-line-props)) + (ebrowse-rename-buffer (if name ident ebrowse-member-buffer-name)) + (force-mode-line-update))) + + +;;; Misc member buffer commands + +(defun ebrowse-freeze-member-buffer () + "Toggle frozen status of current buffer." + (interactive) + (setq ebrowse--frozen-flag (not ebrowse--frozen-flag)) + (ebrowse-redisplay-member-buffer)) + + +(defun ebrowse-show-displayed-class-in-tree (arg) + "Show the currently displayed class in the tree window. +With prefix ARG, switch to the tree buffer else pop to it." + (interactive "P") + (let ((class-name (ebrowse-class-name-displayed-in-member-buffer))) + (when (ebrowse-pop-from-member-to-tree-buffer arg) + (ebrowse-read-class-name-and-go class-name)))) + + +(defun ebrowse-set-member-buffer-column-width () + "Set the column width of the member display. +The new width is read from the minibuffer." + (interactive) + (let ((width (string-to-int + (read-from-minibuffer + (concat "Column width (" + (int-to-string (if ebrowse--long-display-flag + ebrowse--decl-column + ebrowse--column-width)) + "): "))))) + (when (plusp width) + (if ebrowse--long-display-flag + (setq ebrowse--decl-column width) + (setq ebrowse--column-width width)) + (ebrowse-redisplay-member-buffer)))) + + +(defun ebrowse-pop-from-member-to-tree-buffer (arg) + "Pop from a member buffer to the matching tree buffer. +Switch to the buffer if prefix ARG. If no tree buffer exists, +make one." + (interactive "P") + (let ((buf (or (get-buffer (ebrowse-frozen-tree-buffer-name + ebrowse--tags-file-name)) + (get-buffer ebrowse-tree-buffer-name) + (ebrowse-create-tree-buffer ebrowse--tree + ebrowse--tags-file-name + ebrowse--header + ebrowse--tree-obarray + 'pop)))) + (and buf + (funcall (if arg 'switch-to-buffer 'pop-to-buffer) buf)) + buf)) + + + +;;; Switching between member lists + +(defun ebrowse-display-member-list-for-accessor (accessor) + "Switch the member buffer to display the member list for ACCESSOR." + (setf ebrowse--accessor accessor + ebrowse--member-list (funcall accessor ebrowse--displayed-class)) + (ebrowse-redisplay-member-buffer)) + + +(defun ebrowse-cyclic-display-next/previous-member-list (incr) + "Switch buffer to INCR'th next/previous list of members." + (let ((index (ebrowse-position ebrowse--accessor + ebrowse-member-list-accessors))) + (setf ebrowse--accessor + (cond ((plusp incr) + (or (nth (1+ index) + ebrowse-member-list-accessors) + (first ebrowse-member-list-accessors))) + ((minusp incr) + (or (and (>= (decf index) 0) + (nth index + ebrowse-member-list-accessors)) + (first (last ebrowse-member-list-accessors)))))) + (ebrowse-display-member-list-for-accessor ebrowse--accessor))) + + +(defun ebrowse-display-next-member-list () + "Switch buffer to next member list." + (interactive) + (ebrowse-cyclic-display-next/previous-member-list 1)) + + +(defun ebrowse-display-previous-member-list () + "Switch buffer to previous member list." + (interactive) + (ebrowse-cyclic-display-next/previous-member-list -1)) + + +(defun ebrowse-display-function-member-list () + "Display the list of member functions." + (interactive) + (ebrowse-display-member-list-for-accessor 'ebrowse-ts-member-functions)) + + +(defun ebrowse-display-variables-member-list () + "Display the list of member variables." + (interactive) + (ebrowse-display-member-list-for-accessor 'ebrowse-ts-member-variables)) + + +(defun ebrowse-display-static-variables-member-list () + "Display the list of static member variables." + (interactive) + (ebrowse-display-member-list-for-accessor 'ebrowse-ts-static-variables)) + + +(defun ebrowse-display-static-functions-member-list () + "Display the list of static member functions." + (interactive) + (ebrowse-display-member-list-for-accessor 'ebrowse-ts-static-functions)) + + +(defun ebrowse-display-friends-member-list () + "Display the list of friends." + (interactive) + (ebrowse-display-member-list-for-accessor 'ebrowse-ts-friends)) + + +(defun ebrowse-display-types-member-list () + "Display the list of types." + (interactive) + (ebrowse-display-member-list-for-accessor 'ebrowse-ts-types)) + + + +;;; Filters and other display attributes + +(defun ebrowse-toggle-member-attributes-display () + "Toggle display of `virtual', `inline', `const' etc." + (interactive) + (setq ebrowse--attributes-flag (not ebrowse--attributes-flag)) + (ebrowse-redisplay-member-buffer)) + + +(defun ebrowse-toggle-base-class-display () + "Toggle the display of members inherited from base classes." + (interactive) + (setf ebrowse--show-inherited-flag (not ebrowse--show-inherited-flag)) + (ebrowse-redisplay-member-buffer)) + + +(defun ebrowse-toggle-pure-member-filter () + "Toggle display of pure virtual members." + (interactive) + (setf ebrowse--pure-display-flag (not ebrowse--pure-display-flag)) + (ebrowse-redisplay-member-buffer)) + + +(defun ebrowse-toggle-const-member-filter () + "Toggle display of const members." + (interactive) + (setf ebrowse--const-display-flag (not ebrowse--const-display-flag)) + (ebrowse-redisplay-member-buffer)) + + +(defun ebrowse-toggle-inline-member-filter () + "Toggle display of inline members." + (interactive) + (setf ebrowse--inline-display-flag (not ebrowse--inline-display-flag)) + (ebrowse-redisplay-member-buffer)) + + +(defun ebrowse-toggle-virtual-member-filter () + "Toggle display of virtual members." + (interactive) + (setf ebrowse--virtual-display-flag (not ebrowse--virtual-display-flag)) + (ebrowse-redisplay-member-buffer)) + + +(defun ebrowse-remove-all-member-filters () + "Remove all filters." + (interactive) + (dotimes (i 3) + (aset ebrowse--filters i i)) + (setq ebrowse--pure-display-flag nil + ebrowse--const-display-flag nil + ebrowse--virtual-display-flag nil + ebrowse--inline-display-flag nil) + (ebrowse-redisplay-member-buffer)) + + +(defun ebrowse-toggle-public-member-filter () + "Toggle visibility of public members." + (interactive) + (ebrowse-set-member-access-visibility 0) + (ebrowse-redisplay-member-buffer)) + + +(defun ebrowse-toggle-protected-member-filter () + "Toggle visibility of protected members." + (interactive) + (ebrowse-set-member-access-visibility 1) + (ebrowse-redisplay-member-buffer)) + + +(defun ebrowse-toggle-private-member-filter () + "Toggle visibility of private members." + (interactive) + (ebrowse-set-member-access-visibility 2) + (ebrowse-redisplay-member-buffer)) + + +(defun ebrowse-set-member-access-visibility (vis) + (setf (aref ebrowse--filters vis) + (if (aref ebrowse--filters vis) nil vis))) + + +(defun ebrowse-toggle-long-short-display () + "Toggle between long and short display form of member buffers." + (interactive) + (setf ebrowse--long-display-flag (not ebrowse--long-display-flag)) + (ebrowse-redisplay-member-buffer)) + + +(defun ebrowse-toggle-regexp-display () + "Toggle declaration/definition regular expression display. +Used in member buffers showing the long display form." + (interactive) + (setf ebrowse--source-regexp-flag (not ebrowse--source-regexp-flag)) + (ebrowse-redisplay-member-buffer)) + + + +;;; Viewing/finding members + +(defun ebrowse-find-member-definition (&optional prefix) + "Find the file containing a member definition. +With PREFIX 4. find file in another window, with prefix 5 +find file in another frame." + (interactive "p") + (ebrowse-view/find-member-declaration/definition prefix nil t)) + + +(defun ebrowse-view-member-definition (prefix) + "View the file containing a member definition. +With PREFIX 4. find file in another window, with prefix 5 +find file in another frame." + (interactive "p") + (ebrowse-view/find-member-declaration/definition prefix t t)) + + +(defun ebrowse-find-member-declaration (prefix) + "Find the file containing a member's declaration. +With PREFIX 4. find file in another window, with prefix 5 +find file in another frame." + (interactive "p") + (ebrowse-view/find-member-declaration/definition prefix nil)) + + +(defun ebrowse-view-member-declaration (prefix) + "View the file containing a member's declaration. +With PREFIX 4. find file in another window, with prefix 5 +find file in another frame." + (interactive "p") + (ebrowse-view/find-member-declaration/definition prefix t)) + + +(defun* ebrowse-view/find-member-declaration/definition + (prefix view &optional definition info header tags-file-name) + "Find or view a member declaration or definition. +With PREFIX 4. find file in another window, with prefix 5 +find file in another frame. +DEFINITION non-nil means find the definition, otherwise find the +declaration. +INFO is a list (TREE ACCESSOR MEMBER) describing the member to +search. +TAGS-FILE-NAME is the file name of the EBROWSE file." + (unless header + (setq header ebrowse--header)) + (unless tags-file-name + (setq tags-file-name ebrowse--tags-file-name)) + (let (tree member accessor file on-class + (where (if (= prefix 4) 'other-window + (if (= prefix 5) 'other-frame 'this-window)))) + ;; If not given as parameters, get the necessary information + ;; out of the member buffer. + (if info + (setq tree (first info) + accessor (second info) + member (third info)) + (multiple-value-setq (tree member on-class) + (ebrowse-member-info-from-point)) + (setq accessor ebrowse--accessor)) + ;; View/find class if on a line containing a class name. + (when on-class + (return-from ebrowse-view/find-member-declaration/definition + (ebrowse-view/find-file-and-search-pattern + (ebrowse-ts-class tree) + (list ebrowse--header (ebrowse-ts-class tree) nil) + (ebrowse-cs-file (ebrowse-ts-class tree)) + tags-file-name view where))) + ;; For some member lists, it doesn't make sense to search for + ;; a definition. If this is requested, silently search for the + ;; declaration. + (when (and definition + (eq accessor 'ebrowse-ts-member-variables)) + (setq definition nil)) + ;; Construct a suitable `browse' struct for definitions. + (when definition + (setf member (make-ebrowse-ms + :name (ebrowse-ms-name member) + :file (ebrowse-ms-definition-file member) + :pattern (ebrowse-ms-definition-pattern + member) + :flags (ebrowse-ms-flags member) + :point (ebrowse-ms-definition-point + member)))) + ;; When no file information in member, use that of the class + (setf file (or (ebrowse-ms-file member) + (if definition + (ebrowse-cs-source-file (ebrowse-ts-class tree)) + (ebrowse-cs-file (ebrowse-ts-class tree))))) + ;; When we have no regular expressions in the database the only + ;; indication that the parser hasn't seen a definition/declaration + ;; is that the search start point will be zero. + (if (or (null file) (zerop (ebrowse-ms-point member))) + (if (y-or-n-p (concat "No information about " + (if definition "definition" "declaration") + ". Search for " + (if definition "declaration" "definition") + " of `" + (ebrowse-ms-name member) + "'? ")) + (progn + (message nil) + ;; Recurse with new info. + (ebrowse-view/find-member-declaration/definition + prefix view (not definition) info header tags-file-name)) + (error "Search canceled")) + ;; Find that thing. + (ebrowse-view/find-file-and-search-pattern + (make-ebrowse-bs :name (ebrowse-ms-name member) + :pattern (ebrowse-ms-pattern member) + :file (ebrowse-ms-file member) + :flags (ebrowse-ms-flags member) + :point (ebrowse-ms-point member)) + (list header member accessor) + file + tags-file-name + view + where)))) + + + +;;; Drawing the member buffer + +(defun ebrowse-redisplay-member-buffer () + "Force buffer redisplay." + (interactive) + (let ((display-fn (if ebrowse--long-display-flag + 'ebrowse-draw-member-long-fn + 'ebrowse-draw-member-short-fn))) + (ebrowse-output + (erase-buffer) + ;; Show this class + (ebrowse-draw-member-buffer-class-line) + (funcall display-fn ebrowse--member-list ebrowse--displayed-class) + ;; Show inherited members if corresponding switch is on + (when ebrowse--show-inherited-flag + (dolist (super (ebrowse-base-classes ebrowse--displayed-class)) + (goto-char (point-max)) + (insert (if (bolp) "\n\n" "\n")) + (ebrowse-draw-member-buffer-class-line super) + (funcall display-fn (funcall ebrowse--accessor super) super))) + (ebrowse-update-member-buffer-mode-line)))) + + +(defun ebrowse-draw-member-buffer-class-line (&optional class) + "Display the title line for a class section in the member buffer. +CLASS non-nil means display that class' title. Otherwise use +the class cursor is on." + (let ((start (point)) + (tree (or class ebrowse--displayed-class)) + class-name-start + class-name-end) + (insert "class ") + (setq class-name-start (point)) + (insert (ebrowse-qualified-class-name (ebrowse-ts-class tree))) + (when (ebrowse-template-p (ebrowse-ts-class tree)) + (insert "<>")) + (setq class-name-end (point)) + (insert ":\n\n") + (ebrowse-set-face start (point) 'ebrowse-member-class-face) + (add-text-properties + class-name-start class-name-end + '(ebrowse-what class-name + mouse-face highlight + help-echo "mouse-3: menu")) + (put-text-property start class-name-end 'ebrowse-tree tree))) + + +(defun ebrowse-display-member-buffer (list &optional stand-alone class) + "Start point for member buffer creation. +LIST is the member list to display. STAND-ALONE non-nil +means the member buffer is standalone. CLASS is its class." + (let* ((classes ebrowse--tree-obarray) + (tree ebrowse--tree) + (tags-file-name ebrowse--tags-file-name) + (header ebrowse--header) + temp-buffer-setup-hook + (temp-buffer (get-buffer ebrowse-member-buffer-name))) + ;; Get the class description from the name the cursor + ;; is on if not specified as an argument. + (unless class + (setq class (ebrowse-tree-at-point))) + (with-output-to-temp-buffer ebrowse-member-buffer-name + (save-excursion + (set-buffer standard-output) + ;; If new buffer, set the mode and initial values of locals + (unless temp-buffer + (ebrowse-member-mode)) + ;; Set local variables + (setq ebrowse--member-list (funcall list class) + ebrowse--displayed-class class + ebrowse--accessor list + ebrowse--tree-obarray classes + ebrowse--frozen-flag stand-alone + ebrowse--tags-file-name tags-file-name + ebrowse--header header + ebrowse--tree tree + buffer-read-only t) + (ebrowse-redisplay-member-buffer) + (current-buffer))))) + + +(defun ebrowse-member-display-p (member) + "Return t if MEMBER must be displayed under the current filter settings." + (if (and (aref ebrowse--filters (ebrowse-ms-visibility member)) + (or (null ebrowse--const-display-flag) + (ebrowse-const-p member)) + (or (null ebrowse--inline-display-flag) + (ebrowse-inline-p member)) + (or (null ebrowse--pure-display-flag) + (ebrowse-bs-p member)) + (or (null ebrowse--virtual-display-flag) + (ebrowse-virtual-p member))) + member)) + + +(defun ebrowse-draw-member-attributes (member) + "Insert a string for the attributes of MEMBER." + (insert (if (ebrowse-template-p member) "T" "-") + (if (ebrowse-extern-c-p member) "C" "-") + (if (ebrowse-virtual-p member) "v" "-") + (if (ebrowse-inline-p member) "i" "-") + (if (ebrowse-const-p member) "c" "-") + (if (ebrowse-pure-virtual-p member) "0" "-") + (if (ebrowse-mutable-p member) "m" "-") + (if (ebrowse-explicit-p member) "e" "-") + (if (ebrowse-throw-list-p member) "t" "-"))) + + +(defun ebrowse-draw-member-regexp (member-struc) + "Insert a string for the regular expression matching MEMBER-STRUC." + (let ((pattern (if ebrowse--source-regexp-flag + (ebrowse-ms-definition-pattern + member-struc) + (ebrowse-ms-pattern member-struc)))) + (cond ((stringp pattern) + (insert (ebrowse-trim-string pattern) "...\n") + (beginning-of-line 0) + (move-to-column (+ 4 ebrowse--decl-column)) + (while (re-search-forward "[ \t]+" nil t) + (delete-region (match-beginning 0) (match-end 0)) + (insert " ")) + (beginning-of-line 2)) + (t + (insert "[not recorded or unknown]\n"))))) + + +(defun ebrowse-draw-member-long-fn (member-list tree) + "Display member buffer for MEMBER-LIST in long form. +TREE is the class tree of MEMBER-LIST." + (dolist (member-struc (mapcar 'ebrowse-member-display-p member-list)) + (when member-struc + (let ((name (ebrowse-ms-name member-struc)) + (start (point))) + ;; Insert member name truncated to the right length + (insert (substring name + 0 + (min (length name) + (1- ebrowse--decl-column)))) + (add-text-properties + start (point) + `(mouse-face highlight ebrowse-what member-name + ebrowse-member ,member-struc + ebrowse-tree ,tree + help-echo "mouse-2: view definition; mouse-3: menu")) + ;; Display virtual, inline, and const status + (setf start (point)) + (indent-to ebrowse--decl-column) + (put-text-property start (point) 'mouse-face nil) + (when ebrowse--attributes-flag + (let ((start (point))) + (insert "<") + (ebrowse-draw-member-attributes member-struc) + (insert ">") + (ebrowse-set-face start (point) + 'ebrowse-member-attribute-face))) + (insert " ") + (ebrowse-draw-member-regexp member-struc)))) + (insert "\n") + (goto-char (point-min))) + + +(defun ebrowse-draw-member-short-fn (member-list tree) + "Display MEMBER-LIST in short form. +TREE is the class tree in which the members are found." + (let ((i 0) + (column-width (+ ebrowse--column-width + (if ebrowse--attributes-flag 12 0)))) + ;; Get the number of columns to draw. + (setq ebrowse--n-columns + (max 1 (/ (ebrowse-width-of-drawable-area) column-width))) + (dolist (member (mapcar #'ebrowse-member-display-p member-list)) + (when member + (let ((name (ebrowse-ms-name member)) + start-of-entry + (start-of-column (point)) + start-of-name) + (indent-to (* i column-width)) + (put-text-property start-of-column (point) 'mouse-face nil) + (setq start-of-entry (point)) + ;; Show various attributes + (when ebrowse--attributes-flag + (insert "<") + (ebrowse-draw-member-attributes member) + (insert "> ") + (ebrowse-set-face start-of-entry (point) + 'ebrowse-member-attribute-face)) + ;; insert member name truncated to column width + (setq start-of-name (point)) + (insert (substring name 0 + (min (length name) + (1- ebrowse--column-width)))) + ;; set text properties + (add-text-properties + start-of-name (point) + `(ebrowse-what member-name + ebrowse-member ,member + mouse-face highlight + ebrowse-tree ,tree + help-echo "mouse-2: view definition; mouse-3: menu")) + (incf i) + (when (>= i ebrowse--n-columns) + (setf i 0) + (insert "\n"))))) + (when (plusp i) + (insert "\n")) + (goto-char (point-min)))) + + + +;;; Killing members from tree + +(defun ebrowse-member-info-from-point () + "Ger information about the member at point. +The result has the form (TREE MEMBER NULL-P). TREE is the tree +we're in, MEMBER is the member we're on. NULL-P is t if MEMBER +is nil." + (let ((tree (or (get-text-property (point) 'ebrowse-tree) + (error "No information at point"))) + (member (get-text-property (point) 'ebrowse-member))) + (list tree member (null member)))) + + + +;;; Switching member buffer to display a selected member + +(defun ebrowse-goto-visible-member/all-member-lists (prefix) + "Position cursor on a member read from the minibuffer. +With PREFIX, search all members in the tree. Otherwise consider +only members visible in the buffer." + (interactive "p") + (ebrowse-ignoring-completion-case + (let* ((completion-list (ebrowse-name/accessor-alist-for-class-members)) + (member (completing-read "Goto member: " completion-list nil t)) + (accessor (cdr (assoc member completion-list)))) + (unless accessor + (error "`%s' not found" member)) + (unless (eq accessor ebrowse--accessor) + (setf ebrowse--accessor accessor + ebrowse--member-list (funcall accessor ebrowse--displayed-class)) + (ebrowse-redisplay-member-buffer)) + (ebrowse-move-point-to-member member)))) + + +(defun ebrowse-goto-visible-member (repeat) + "Position point on a member. +Read the member's name from the minibuffer. Consider only members +visible in the member buffer. +REPEAT non-nil means repeat the search that number of times." + (interactive "p") + (ebrowse-ignoring-completion-case + ;; Read member name + (let* ((completion-list (ebrowse-name/accessor-alist-for-visible-members)) + (member (completing-read "Goto member: " completion-list nil t))) + (ebrowse-move-point-to-member member repeat)))) + + + +;;; Searching a member in the member buffer + +(defun ebrowse-repeat-member-search (repeat) + "Repeat the last regular expression search. +REPEAT, if specified, says repeat the search REPEAT times." + (interactive "p") + (unless ebrowse--last-regexp + (error "No regular expression remembered")) + ;; Skip over word the point is on + (skip-chars-forward "^ \t\n") + ;; Search for regexp from point + (if (re-search-forward ebrowse--last-regexp nil t repeat) + (progn + (goto-char (match-beginning 0)) + (skip-chars-forward " \t\n")) + ;; If not found above, repeat search from buffer start + (goto-char (point-min)) + (if (re-search-forward ebrowse--last-regexp nil t) + (progn + (goto-char (match-beginning 0)) + (skip-chars-forward " \t\n")) + (error "Not found")))) + + +(defun* ebrowse-move-point-to-member (name &optional count &aux member) + "Set point on member NAME in the member buffer +COUNT, if specified, says search the COUNT'th member with the same name." + (goto-char (point-min)) + (widen) + (setq member + (substring name 0 (min (length name) (1- ebrowse--column-width))) + ebrowse--last-regexp + (concat "[ \t\n]" (regexp-quote member) "[ \n\t]")) + (if (re-search-forward ebrowse--last-regexp nil t count) + (goto-char (1+ (match-beginning 0))) + (error "Not found"))) + + + +;;; Switching member buffer to another class. + +(defun ebrowse-switch-member-buffer-to-other-class (title compl-list) + "Switch member buffer to a class read from the minibuffer. +Use TITLE as minibuffer prompt. +COMPL-LIST is a completion list to use." + (let* ((initial (unless (second compl-list) + (first (first compl-list)))) + (class (or (ebrowse-completing-read-value title compl-list initial) + (error "Not found")))) + (setf ebrowse--displayed-class class + ebrowse--member-list (funcall ebrowse--accessor ebrowse--displayed-class)) + (ebrowse-redisplay-member-buffer))) + + +(defun ebrowse-switch-member-buffer-to-any-class () + "Switch member buffer to a class read from the minibuffer." + (interactive) + (ebrowse-switch-member-buffer-to-other-class + "Goto class: " (ebrowse-tree-obarray-as-alist))) + + +(defun ebrowse-switch-member-buffer-to-base-class (arg) + "Switch buffer to ARG'th base class." + (interactive "P") + (let ((supers (or (ebrowse-direct-base-classes ebrowse--displayed-class) + (error "No base classes")))) + (if (and arg (second supers)) + (let ((alist (loop for s in supers + collect (cons (ebrowse-qualified-class-name + (ebrowse-ts-class s)) + s)))) + (ebrowse-switch-member-buffer-to-other-class + "Goto base class: " alist)) + (setq ebrowse--displayed-class (first supers) + ebrowse--member-list + (funcall ebrowse--accessor ebrowse--displayed-class)) + (ebrowse-redisplay-member-buffer)))) + +(defun ebrowse-switch-member-buffer-to-next-sibling-class (arg) + "Move to ARG'th next sibling." + (interactive "p") + (ebrowse-switch-member-buffer-to-sibling-class arg)) + + +(defun ebrowse-switch-member-buffer-to-previous-sibling-class (arg) + "Move to ARG'th previous sibling." + (interactive "p") + (ebrowse-switch-member-buffer-to-sibling-class (- arg))) + + +(defun ebrowse-switch-member-buffer-to-sibling-class (inc) + "Switch member display to nth sibling class. +Prefix arg INC specifies which one." + (interactive "p") + (let ((containing-list ebrowse--tree) + index cls + (supers (ebrowse-direct-base-classes ebrowse--displayed-class))) + (flet ((trees-alist (trees) + (loop for tr in trees + collect (cons (ebrowse-cs-name + (ebrowse-ts-class tr)) tr)))) + (when supers + (let ((tree (if (second supers) + (ebrowse-completing-read-value + "Relative to base class: " + (trees-alist supers) nil) + (first supers)))) + (unless tree (error "Not found")) + (setq containing-list (ebrowse-ts-subclasses tree))))) + (setq index (+ inc (ebrowse-position ebrowse--displayed-class + containing-list))) + (cond ((minusp index) (message "No previous class")) + ((null (nth index containing-list)) (message "No next class"))) + (setq index (max 0 (min index (1- (length containing-list))))) + (setq cls (nth index containing-list)) + (setf ebrowse--displayed-class cls + ebrowse--member-list (funcall ebrowse--accessor cls)) + (ebrowse-redisplay-member-buffer))) + + +(defun ebrowse-switch-member-buffer-to-derived-class (arg) + "Switch member display to nth derived class. +Prefix arg ARG says which class should be displayed. Default is +the first derived class." + (interactive "P") + (flet ((ebrowse-tree-obarray-as-alist () + (loop for s in (ebrowse-ts-subclasses + ebrowse--displayed-class) + collect (cons (ebrowse-cs-name + (ebrowse-ts-class s)) s)))) + (let ((subs (or (ebrowse-ts-subclasses ebrowse--displayed-class) + (error "No derived classes")))) + (if (and arg (second subs)) + (ebrowse-switch-member-buffer-to-other-class + "Goto derived class: " (ebrowse-tree-obarray-as-alist)) + (setq ebrowse--displayed-class (first subs) + ebrowse--member-list + (funcall ebrowse--accessor ebrowse--displayed-class)) + (ebrowse-redisplay-member-buffer))))) + + + +;;; Member buffer mouse functions + +(defun ebrowse-displaying-functions () + (eq ebrowse--accessor 'ebrowse-ts-member-functions)) +(defun ebrowse-displaying-variables () + (eq ebrowse--accessor 'ebrowse-ts-member-variables)) +(defun ebrowse-displaying-static-functions () + ) +(defun ebrowse-displaying-static-variables () + ) +(defun ebrowse-displaying-types () + (eq ebrowse--accessor 'ebrowse-ts-types)) +(defun ebrowse-displaying-friends () + (eq ebrowse--accessor 'ebrowse-ts-friends)) + +(easy-menu-define + ebrowse-member-buffer-object-menu ebrowse-member-mode-map + "Object menu for the member buffer itself." + '("Members" + ("Members List" + ["Functions" ebrowse-display-function-member-list + :help "Show the list of member functions" + :style radio + :selected (eq ebrowse--accessor 'ebrowse-ts-member-functions) + :active t] + ["Variables" ebrowse-display-variables-member-list + :help "Show the list of member variables" + :style radio + :selected (eq ebrowse--accessor 'ebrowse-ts-member-variables) + :active t] + ["Static Functions" ebrowse-display-static-functions-member-list + :help "Show the list of static member functions" + :style radio + :selected (eq ebrowse--accessor 'ebrowse-ts-static-functions) + :active t] + ["Static Variables" ebrowse-display-static-variables-member-list + :help "Show the list of static member variables" + :style radio + :selected (eq ebrowse--accessor 'ebrowse-ts-static-variables) + :active t] + ["Types" ebrowse-display-types-member-list + :help "Show the list of nested types" + :style radio + :selected (eq ebrowse--accessor 'ebrowse-ts-types) + :active t] + ["Friends/Defines" ebrowse-display-friends-member-list + :help "Show the list of friends or defines" + :style radio + :selected (eq ebrowse--accessor 'ebrowse-ts-friends) + :active t]) + ("Class" + ["Up" ebrowse-switch-member-buffer-to-base-class + :help "Show the base class of this class" + :active t] + ["Down" ebrowse-switch-member-buffer-to-derived-class + :help "Show a derived class class of this class" + :active t] + ["Next Sibling" ebrowse-switch-member-buffer-to-next-sibling-class + :help "Show the next sibling class" + :active t] + ["Previous Sibling" ebrowse-switch-member-buffer-to-previous-sibling-class + :help "Show the previous sibling class" + :active t]) + ("Member" + ["Show in Tree" ebrowse-show-displayed-class-in-tree + :help "Show this class in the class tree" + :active t] + ["Find in this Class" ebrowse-goto-visible-member + :help "Search for a member of this class" + :active t] + ["Find in Tree" ebrowse-goto-visible-member/all-member-lists + :help "Search for a member in any class" + :active t]) + ("Display" + ["Inherited" ebrowse-toggle-base-class-display + :help "Toggle display of inherited members" + :style toggle + :selected ebrowse--show-inherited-flag + :active t] + ["Attributes" ebrowse-toggle-member-attributes-display + :help "Show member attributes" + :style toggle + :selected ebrowse--attributes-flag + :active t] + ["Long Display" ebrowse-toggle-long-short-display + :help "Toggle the member display format" + :style toggle + :selected ebrowse--long-display-flag + :active t] + ["Column Width" ebrowse-set-member-buffer-column-width + :help "Set the display's column width" + :active t]) + ("Filter" + ["Public" ebrowse-toggle-public-member-filter + :help "Toggle the visibility of public members" + :style toggle + :selected (not (aref ebrowse--filters 0)) + :active t] + ["Protected" ebrowse-toggle-protected-member-filter + :help "Toggle the visibility of protected members" + :style toggle + :selected (not (aref ebrowse--filters 1)) + :active t] + ["Private" ebrowse-toggle-private-member-filter + :help "Toggle the visibility of private members" + :style toggle + :selected (not (aref ebrowse--filters 2)) + :active t] + ["Virtual" ebrowse-toggle-virtual-member-filter + :help "Toggle the visibility of virtual members" + :style toggle + :selected ebrowse--virtual-display-flag + :active t] + ["Inline" ebrowse-toggle-inline-member-filter + :help "Toggle the visibility of inline members" + :style toggle + :selected ebrowse--inline-display-flag + :active t] + ["Const" ebrowse-toggle-const-member-filter + :help "Toggle the visibility of const members" + :style toggle + :selected ebrowse--const-display-flag + :active t] + ["Pure" ebrowse-toggle-pure-member-filter + :help "Toggle the visibility of pure virtual members" + :style toggle + :selected ebrowse--pure-display-flag + :active t] + "-----------------" + ["Show all" ebrowse-remove-all-member-filters + :help "Remove any display filters" + :active t]) + ("Buffer" + ["Tree" ebrowse-pop-from-member-to-tree-buffer + :help "Pop to the class tree buffer" + :active t] + ["Next Member Buffer" ebrowse-switch-to-next-member-buffer + :help "Switch to the next member buffer of this class tree" + :active t] + ["Freeze" ebrowse-freeze-member-buffer + :help "Freeze (do not reuse) this member buffer" + :active t]))) + + +(defun ebrowse-on-class-name () + "Value is non-nil if point is on a class name." + (eq (get-text-property (point) 'ebrowse-what) 'class-name)) + + +(defun ebrowse-on-member-name () + "Value is non-nil if point is on a member name." + (eq (get-text-property (point) 'ebrowse-what) 'member-name)) + + +(easy-menu-define + ebrowse-member-class-name-object-menu ebrowse-member-mode-map + "Object menu for class names in member buffer." + '("Class" + ["Find" ebrowse-find-member-definition + :help "Find this class in the source files" + :active (eq (get-text-property (point) 'ebrowse-what) 'class-name)] + ["View" ebrowse-view-member-definition + :help "View this class in the source files" + :active (eq (get-text-property (point) 'ebrowse-what) 'class-name)])) + + +(easy-menu-define + ebrowse-member-name-object-menu ebrowse-member-mode-map + "Object menu for member names" + '("Ebrowse" + ["Find Definition" ebrowse-find-member-definition + :help "Find this member's definition in the source files" + :active (ebrowse-on-member-name)] + ["Find Declaration" ebrowse-find-member-declaration + :help "Find this member's declaration in the source files" + :active (ebrowse-on-member-name)] + ["View Definition" ebrowse-view-member-definition + :help "View this member's definition in the source files" + :active (ebrowse-on-member-name)] + ["View Declaration" ebrowse-view-member-declaration + :help "View this member's declaration in the source files" + :active (ebrowse-on-member-name)])) + + +(defun ebrowse-member-mouse-3 (event) + "Handle `mouse-3' events in member buffers. +EVENT is the mouse event." + (interactive "e") + (mouse-set-point event) + (case (event-click-count event) + (2 (ebrowse-find-member-definition)) + (1 (case (get-text-property (posn-point (event-start event)) + 'ebrowse-what) + (member-name + (ebrowse-popup-menu ebrowse-member-name-object-menu event)) + (class-name + (ebrowse-popup-menu ebrowse-member-class-name-object-menu event)) + (t + (ebrowse-popup-menu ebrowse-member-buffer-object-menu event)))))) + + +(defun ebrowse-member-mouse-2 (event) + "Handle `mouse-2' events in member buffers. +EVENT is the mouse event." + (interactive "e") + (mouse-set-point event) + (case (event-click-count event) + (2 (ebrowse-find-member-definition)) + (1 (case (get-text-property (posn-point (event-start event)) + 'ebrowse-what) + (member-name + (ebrowse-view-member-definition 0)))))) + + + +;;; Tags view/find + +(defun ebrowse-class-alist-for-member (tree-header name) + "Return information about a member in a class tree. +TREE-HEADER is the header structure of the class tree. +NAME is the name of the member. +Value is an alist of elements (CLASS-NAME . (CLASS LIST NAME)), +where each element describes one occurrence of member NAME in the tree. +CLASS-NAME is the qualified name of the class in which the +member was found. The CDR of the acons is described in function +`ebrowse-class/index/member-for-member'." + (let ((table (ebrowse-member-table tree-header)) + known-classes + alist) + (when name + (dolist (info (gethash name table) alist) + (unless (memq (first info) known-classes) + (setf alist (acons (ebrowse-qualified-class-name + (ebrowse-ts-class (first info))) + info alist) + known-classes (cons (first info) known-classes))))))) + + +(defun ebrowse-choose-tree () + "Choose a class tree to use. +If there's more than one class tree loaded, let the user choose +the one he wants. Value is (TREE HEADER BUFFER), with TREE being +the class tree, HEADER the header structure of the tree, and BUFFER +being the tree or member buffer containing the tree." + (let* ((buffer (ebrowse-choose-from-browser-buffers))) + (if buffer (list (ebrowse-value-in-buffer 'ebrowse--tree buffer) + (ebrowse-value-in-buffer 'ebrowse--header buffer) + buffer)))) + + +(defun ebrowse-tags-read-name (header prompt) + "Read a C++ identifier from the minibuffer. +HEADER is the `ebrowse-hs' structure of the class tree. +Prompt with PROMPT. Insert into the minibuffer a C++ identifier read +from point as default. Value is a list (CLASS-NAME MEMBER-NAME)." + (save-excursion + (let* (start member-info (members (ebrowse-member-table header))) + (multiple-value-bind (class-name member-name) + (ebrowse-tags-read-member+class-name) + (unless member-name + (error "No member name at point")) + (if members + (let* ((alist (ebrowse-hash-table-to-alist members)) + (name (ebrowse-ignoring-completion-case + (completing-read prompt alist nil nil member-name))) + (completion-result (try-completion name alist))) + ;; Cannot rely on `try-completion' returning T for exact + ;; matches! it returns the the name as a string. + (unless (setq member-info (gethash name members)) + (if (y-or-n-p "No exact match found. Try substrings? ") + (setq name + (or (first (ebrowse-list-of-matching-members + members (regexp-quote name) name)) + (error "Sorry, nothing found"))) + (error "Canceled"))) + (list class-name name)) + (list class-name (read-from-minibuffer prompt member-name))))))) + + +(defun ebrowse-tags-read-member+class-name () + "Read a C++ identifier from point. +Value is (CLASS-NAME MEMBER-NAME). +CLASS-NAME is the name of the class if the identifier was qualified. +It is nil otherwise. +MEMBER-NAME is the name of the member found." + (save-excursion + (skip-chars-backward "a-zA-Z0-9_") + (let* ((start (point)) + (name (progn (skip-chars-forward "a-zA-Z0-9_") + (buffer-substring start (point)))) + class) + (list class name)))) + + +(defun ebrowse-tags-choose-class (tree header name initial-class-name) + "Read a class name for a member from the minibuffer. +TREE is the class tree we operate on. +HEADER is its header structure. +NAME is the name of the member. +INITIAL-CLASS-NAME is an initial class name to insert in the minibuffer. +Value is a list (TREE ACCESSOR MEMBER) for the member." + (let ((alist (or (ebrowse-class-alist-for-member header name) + (error "No classes with member `%s' found" name)))) + (ebrowse-ignoring-completion-case + (if (null (second alist)) + (cdr (first alist)) + (push ?\? unread-command-events) + (cdr (assoc (completing-read "In class: " + alist nil t initial-class-name) + alist)))))) + + +(defun* ebrowse-tags-view/find-member-decl/defn + (prefix &key view definition member-name) + "If VIEW is t, view, else find an occurrence of MEMBER-NAME. + +If DEFINITION is t, find or view the member definition else its +declaration. This function reads the member's name from the +current buffer like FIND-TAG. It then prepares a completion list +of all classes containing a member with the given name and lets +the user choose the class to use. As a last step, a tags search +is performed that positions point on the member declaration or +definition." + (multiple-value-bind + (tree header tree-buffer) (ebrowse-choose-tree) + (unless tree (error "No class tree")) + (let* ((marker (point-marker)) + class-name + (name member-name) + info) + (unless name + (multiple-value-setq (class-name name) + (ebrowse-tags-read-name + header + (concat (if view "View" "Find") " member " + (if definition "definition" "declaration") ": ")))) + (setq info (ebrowse-tags-choose-class tree header name class-name)) + (ebrowse-push-position marker info) + ;; Goto the occurrence of the member + (ebrowse-view/find-member-declaration/definition + prefix view definition info + header + (ebrowse-value-in-buffer 'ebrowse--tags-file-name tree-buffer)) + ;; Record position jumped to + (ebrowse-push-position (point-marker) info t)))) + + +;;###autoload +(defun ebrowse-tags-view-declaration () + "View declaration of member at point." + (interactive) + (ebrowse-tags-view/find-member-decl/defn 0 :view t :definition nil)) + + +;;###autoload +(defun ebrowse-tags-find-declaration () + "Find declaration of member at point." + (interactive) + (ebrowse-tags-view/find-member-decl/defn 0 :view nil :definition nil)) + + +;;###autoload +(defun ebrowse-tags-view-definition () + "View definition of member at point." + (interactive) + (ebrowse-tags-view/find-member-decl/defn 0 :view t :definition t)) + + +;;###autoload +(defun ebrowse-tags-find-definition () + "Find definition of member at point." + (interactive) + (ebrowse-tags-view/find-member-decl/defn 0 :view nil :definition t)) + + +(defun ebrowse-tags-view-declaration-other-window () + "View declaration of member at point in other window." + (interactive) + (ebrowse-tags-view/find-member-decl/defn 4 :view t :definition nil)) + + +;;###autoload +(defun ebrowse-tags-find-declaration-other-window () + "Find declaration of member at point in other window." + (interactive) + (ebrowse-tags-view/find-member-decl/defn 4 :view nil :definition nil)) + + +;;###autoload +(defun ebrowse-tags-view-definition-other-window () + "View definition of member at point in other window." + (interactive) + (ebrowse-tags-view/find-member-decl/defn 4 :view t :definition t)) + + +;;###autoload +(defun ebrowse-tags-find-definition-other-window () + "Find definition of member at point in other window." + (interactive) + (ebrowse-tags-view/find-member-decl/defn 4 :view nil :definition t)) + + +(defun ebrowse-tags-view-declaration-other-frame () + "View definition of member at point in other frame." + (interactive) + (ebrowse-tags-view/find-member-decl/defn 5 :view t :definition nil)) + + +;;###autoload +(defun ebrowse-tags-find-declaration-other-frame () + "Find definition of member at point in other frame." + (interactive) + (ebrowse-tags-view/find-member-decl/defn 5 :view nil :definition nil)) + + +;;###autoload +(defun ebrowse-tags-view-definition-other-frame () + "View definition of member at point in other frame." + (interactive) + (ebrowse-tags-view/find-member-decl/defn 5 :view t :definition t)) + + +;;###autoload +(defun ebrowse-tags-find-definition-other-frame () + "Find definition of member at point in other frame." + (interactive) + (ebrowse-tags-view/find-member-decl/defn 5 :view nil :definition t)) + + +(defun ebrowse-tags-select/create-member-buffer (tree-buffer info) + "Select or create member buffer. +TREE-BUFFER specifies the tree to use. INFO describes the member. +It is a list (TREE ACCESSOR MEMBER)." + (let ((buffer (get-buffer ebrowse-member-buffer-name))) + (cond ((null buffer) + (set-buffer tree-buffer) + (switch-to-buffer (ebrowse-display-member-buffer + (second info) nil (first info)))) + (t + (switch-to-buffer buffer) + (setq ebrowse--displayed-class (first info) + ebrowse--accessor (second info) + ebrowse--member-list (funcall ebrowse--accessor ebrowse--displayed-class)) + (ebrowse-redisplay-member-buffer))) + (ebrowse-move-point-to-member (ebrowse-ms-name (third info))))) + + +(defun ebrowse-tags-display-member-buffer (&optional fix-name) + "Display a member buffer for a member. +FIX-NAME non-nil means display the buffer for that member. +Otherwise read a member name from point." + (interactive) + (multiple-value-bind + (tree header tree-buffer) (ebrowse-choose-tree) + (unless tree (error "No class tree")) + (let* ((marker (point-marker)) class-name (name fix-name) info) + (unless name + (multiple-value-setq (class-name name) + (ebrowse-tags-read-name header + (concat "Find member list of: ")))) + (setq info (ebrowse-tags-choose-class tree header name class-name)) + (ebrowse-push-position marker info) + (ebrowse-tags-select/create-member-buffer tree-buffer info)))) + + +(defun ebrowse-list-of-matching-members (members regexp &optional name) + "Return a list of members in table MEMBERS matching REGEXP or NAME. +Both NAME and REGEXP may be nil in which case exact or regexp matches +are not performed." + (let (list) + (when (or name regexp) + (maphash #'(lambda (member-name info) + (when (or (and name (string= name member-name)) + (and regexp (string-match regexp member-name))) + (setq list (cons member-name list)))) + members)) + list)) + + +(defun ebrowse-tags-apropos () + "Display a list of members matching a regexp read from the minibuffer." + (interactive) + (let* ((buffer (or (ebrowse-choose-from-browser-buffers) + (error "No tree buffer"))) + (header (ebrowse-value-in-buffer 'ebrowse--header buffer)) + (members (ebrowse-member-table header)) + temp-buffer-setup-hook + (regexp (read-from-minibuffer "List members matching regexp: "))) + (with-output-to-temp-buffer (concat "*Apropos Members*") + (set-buffer standard-output) + (erase-buffer) + (insert "Members matching `" regexp "'\n\n") + (loop for s in (ebrowse-list-of-matching-members members regexp) do + (loop for info in (gethash s members) do + (ebrowse-draw-file-member-info info)))))) + + +(defun ebrowse-tags-list-members-in-file () + "Display a list of members found in a file. +The file name is read from the minibuffer." + (interactive) + (let* ((buffer (or (ebrowse-choose-from-browser-buffers) + (error "No tree buffer"))) + (files (save-excursion (set-buffer buffer) (ebrowse-files-table))) + (alist (ebrowse-hash-table-to-alist files)) + (file (completing-read "List members in file: " alist nil t)) + (header (ebrowse-value-in-buffer 'ebrowse--header buffer)) + temp-buffer-setup-hook + (members (ebrowse-member-table header))) + (with-output-to-temp-buffer (concat "*Members in file " file "*") + (set-buffer standard-output) + (maphash + #'(lambda (member-name list) + (loop for info in list + as member = (third info) + as class = (ebrowse-ts-class (first info)) + when (or (and (null (ebrowse-ms-file member)) + (string= (ebrowse-cs-file class) file)) + (string= file (ebrowse-ms-file member))) + do (ebrowse-draw-file-member-info info "decl.") + when (or (and (null (ebrowse-ms-definition-file member)) + (string= (ebrowse-cs-source-file class) file)) + (string= file (ebrowse-ms-definition-file member))) + do (ebrowse-draw-file-member-info info "defn."))) + members)))) + + +(defun* ebrowse-draw-file-member-info (info &optional (kind "")) + "Display a line in an the members per file info buffer. +INFO describes the member. It has the form (TREE ACCESSOR MEMBER). +TREE is the class of the member to display. +ACCESSOR is the accessor symbol of its member list. +MEMBER is the member structure. +KIND is a an additional string printed in the buffer." + (let* ((tree (first info)) + (globals-p (ebrowse-globals-tree-p tree))) + (unless globals-p + (insert (ebrowse-cs-name (ebrowse-ts-class tree)))) + (insert "::" (ebrowse-ms-name (third info))) + (indent-to 40) + (insert kind) + (indent-to 50) + (insert (case (second info) + ('ebrowse-ts-member-functions "member function") + ('ebrowse-ts-member-variables "member variable") + ('ebrowse-ts-static-functions "static function") + ('ebrowse-ts-static-variables "static variable") + ('ebrowse-ts-friends (if globals-p "define" "friend")) + ('ebrowse-ts-types "type") + (t "unknown")) + "\n"))) + +(defvar ebrowse-last-completion nil + "Text inserted by the last completion operation.") + + +(defvar ebrowse-last-completion-start nil + "String which was the basis for the last completion operation.") + + +(defvar ebrowse-last-completion-location nil + "Buffer position at which the last completion operation was initiated.") + + +(defvar ebrowse-last-completion-obarray nil + "Member used in last completion operation.") + + +(make-variable-buffer-local 'ebrowse-last-completion-obarray) +(make-variable-buffer-local 'ebrowse-last-completion-location) +(make-variable-buffer-local 'ebrowse-last-completion) +(make-variable-buffer-local 'ebrowse-last-completion-start) + + + +(defun ebrowse-some-member-table () + "Return a hash table containing all member of a tree. +If there's only one tree loaded, use that. Otherwise let the +use choose a tree." + (let* ((buffers (ebrowse-known-class-trees-buffer-list)) + (buffer (cond ((and (first buffers) (not (second buffers))) + (first buffers)) + (t (or (ebrowse-electric-choose-tree) + (error "No tree buffer"))))) + (header (ebrowse-value-in-buffer 'ebrowse--header buffer))) + (ebrowse-member-table header))) + + +(defun ebrowse-hash-table-to-alist (table) + "Return an alist holding all key/value pairs of hash table TABLE." + (let ((list)) + (maphash #'(lambda (key value) + (setq list (cons (cons key value) list))) + table) + list)) + + +(defun ebrowse-cyclic-successor-in-string-list (string list) + "Return the item following STRING in LIST. +If STRING is the last element, return the first element as successor." + (or (nth (1+ (ebrowse-position string list 'string=)) list) + (first list))) + + +;;; Symbol completion + +;;;###autoload +(defun* ebrowse-tags-complete-symbol (prefix) + "Perform completion on the C++ symbol preceding point. +A second call of this function without changing point inserts the next match. +A call with prefix PREFIX reads the symbol to insert from the minibuffer with +completion." + (interactive "P") + (let* ((end (point)) + (begin (save-excursion (skip-chars-backward "a-zA-Z_0-9") (point))) + (pattern (buffer-substring begin end)) + list completion) + (cond + ;; With prefix, read name from minibuffer with completion. + (prefix + (let* ((members (ebrowse-some-member-table)) + (alist (ebrowse-hash-table-to-alist members)) + (completion (completing-read "Insert member: " + alist nil t pattern))) + (when completion + (setf ebrowse-last-completion-location nil) + (delete-region begin end) + (insert completion)))) + ;; If this function is called at the same point the last + ;; expansion ended, insert the next expansion. + ((eq (point) ebrowse-last-completion-location) + (setf list (all-completions ebrowse-last-completion-start + ebrowse-last-completion-obarray) + completion (ebrowse-cyclic-successor-in-string-list + ebrowse-last-completion list)) + (cond ((null completion) + (error "No completion")) + ((string= completion pattern) + (error "No further completion")) + (t + (delete-region begin end) + (insert completion) + (setf ebrowse-last-completion completion + ebrowse-last-completion-location (point))))) + ;; First time the function is called at some position in the + ;; buffer: Start new completion. + (t + (let* ((members (ebrowse-some-member-table)) + (completion (first (all-completions pattern members nil)))) + (cond ((eq completion t)) + ((null completion) + (error "Can't find completion for `%s'" pattern)) + (t + (delete-region begin end) + (insert completion) + + (setf ebrowse-last-completion-location (point) + ebrowse-last-completion-start pattern + ebrowse-last-completion completion + ebrowse-last-completion-obarray members)))))))) + + +;;; Tags query replace & search + +(defvar ebrowse-tags-loop-form () + "Form for `ebrowse-loop-continue'. +Evaluated for each file in the tree. If it returns nil, proceed +with the next file.") + +(defvar ebrowse-tags-next-file-list () + "A list of files to be processed.") + + +(defvar ebrowse-tags-next-file-path nil + "The path relative to which files have to be searched.") + + +(defvar ebrowse-tags-loop-last-file nil + "The last file visited via `ebrowse-tags-loop'.") + + +(defun ebrowse-tags-next-file (&optional initialize tree-buffer) + "Select next file among files in current tag table. +Non-nil argument INITIALIZE (prefix arg, if interactive) initializes +to the beginning of the list of files in the tag table. +TREE-BUFFER specifies the class tree we operate on." + (interactive "P") + ;; Call with INITIALIZE non-nil initializes the files list. + ;; If more than one tree buffer is loaded, let the user choose + ;; on which tree (s)he wants to operate. + (when initialize + (let ((buffer (or tree-buffer (ebrowse-choose-from-browser-buffers)))) + (save-excursion + (set-buffer buffer) + (setq ebrowse-tags-next-file-list + (ebrowse-files-list (ebrowse-marked-classes-p)) + ebrowse-tags-loop-last-file + nil + ebrowse-tags-next-file-path + (file-name-directory ebrowse--tags-file-name))))) + ;; End of the loop if the stack of files is empty. + (unless ebrowse-tags-next-file-list + (error "All files processed")) + ;; ebrowse-tags-loop-last-file is the last file that was visited due + ;; to a call to BROWSE-LOOP (see below). If that file is still + ;; in memory, and it wasn't modified, throw its buffer away to + ;; prevent cluttering up the buffer list. + (when ebrowse-tags-loop-last-file + (let ((buffer (get-file-buffer ebrowse-tags-loop-last-file))) + (when (and buffer + (not (buffer-modified-p buffer))) + (kill-buffer buffer)))) + ;; Remember this buffer file name for later deletion, if it + ;; wasn't visited by other means. + (let ((file (expand-file-name (car ebrowse-tags-next-file-list) + ebrowse-tags-next-file-path))) + (setq ebrowse-tags-loop-last-file (if (get-file-buffer file) nil file)) + ;; Find the file and pop the file list. Pop has to be done + ;; before the file is loaded because FIND-FILE might encounter + ;; an error, and we want to be able to proceed with the next + ;; file in this case. + (pop ebrowse-tags-next-file-list) + (find-file file))) + + +;;;###autoload +(defun ebrowse-tags-loop-continue (&optional first-time tree-buffer) + "Repeat last operation on files in tree. +FIRST-TIME non-nil means this is not a repetition, but the first time. +TREE-BUFFER if indirectly specifies which files to loop over." + (interactive) + (when first-time + (ebrowse-tags-next-file first-time tree-buffer) + (goto-char (point-min))) + (while (not (eval ebrowse-tags-loop-form)) + (ebrowse-tags-next-file) + (message "Scanning file `%s'..." buffer-file-name) + (goto-char (point-min)))) + + +;;###autoload +(defun ebrowse-tags-search (regexp) + "Search for REGEXP in all files in a tree. +If marked classes exist, process marked classes, only. +If regular expression is nil, repeat last search." + (interactive "sTree search (regexp): ") + (if (and (string= regexp "") + (eq (car ebrowse-tags-loop-form) 're-search-forward)) + (ebrowse-tags-loop-continue) + (setq ebrowse-tags-loop-form (list 're-search-forward regexp nil t)) + (ebrowse-tags-loop-continue 'first-time))) + + +;;;###autoload +(defun ebrowse-tags-query-replace (from to) + "Query replace FROM with TO in all files of a class tree. +With prefix arg, process files of marked classes only." + (interactive + "sTree query replace (regexp): \nsTree query replace %s by: ") + (setq ebrowse-tags-loop-form + (list 'and (list 'save-excursion + (list 're-search-forward from nil t)) + (list 'not (list 'perform-replace from to t t nil)))) + (ebrowse-tags-loop-continue 'first-time)) + + +;;; ###autoload +(defun ebrowse-tags-search-member-use (&optional fix-name) + "Search for call sites of a member. +If FIX-NAME is specified, search uses of that member. +Otherwise, read a member name from the minibuffer. +Searches in all files mentioned in a class tree for something that +looks like a function call to the member." + (interactive) + ;; Choose the tree to use if there is more than one. + (multiple-value-bind (tree header tree-buffer) + (ebrowse-choose-tree) + (unless tree + (error "No class tree")) + ;; Get the member name NAME (class-name is ignored). + (let ((name fix-name) class-name regexp) + (unless name + (multiple-value-setq (class-name name) + (ebrowse-tags-read-name header "Find calls of: "))) + ;; Set tags loop form to search for member and begin loop. + (setq regexp (concat "\\<" name "[ \t]*(") + ebrowse-tags-loop-form (list 're-search-forward regexp nil t)) + (ebrowse-tags-loop-continue 'first-time tree-buffer)))) + + + +;;; Tags position management + +;;; Structures of this kind are the elements of the position stack. + +(defstruct (ebrowse-position (:type vector) :named) + file-name ; in which file + point ; point in file + target ; t if target of a jump + info) ; (CLASS FUNC MEMBER) jumped to + + +(defvar ebrowse-position-stack () + "Stack of `ebrowse-position' structured.") + + +(defvar ebrowse-position-index 0 + "Current position in position stack.") + + +(defun ebrowse-position-name (position) + "Return an identifying string for POSITION. +The string is printed in the electric position list buffer." + (let ((info (ebrowse-position-info position))) + (concat (if (ebrowse-position-target position) "at " "to ") + (ebrowse-cs-name (ebrowse-ts-class (first info))) + "::" (ebrowse-ms-name (third info))))) + + +(defun ebrowse-view/find-position (position &optional view) + "Position point on POSITION. +If VIEW is non-nil, view the position, otherwise find it." + (cond ((not view) + (find-file (ebrowse-position-file-name position)) + (goto-char (ebrowse-position-point position))) + (t + (unwind-protect + (progn + (push (function + (lambda () + (goto-char (ebrowse-position-point position)))) + view-mode-hook) + (view-file (ebrowse-position-file-name position))) + (pop view-mode-hook))))) + + +(defun ebrowse-push-position (marker info &optional target) + "Push current position on position stack. +MARKER is the marker to remember as position. +INFO is a list (CLASS FUNC MEMBER) specifying what we jumped to. +TARGET non-nil means we performed a jump. +Positions in buffers that have no file names are not saved." + (when (buffer-file-name (marker-buffer marker)) + (let ((too-much (- (length ebrowse-position-stack) + ebrowse-max-positions))) + ;; Do not let the stack grow to infinity. + (when (plusp too-much) + (setq ebrowse-position-stack + (butlast ebrowse-position-stack too-much))) + ;; Push the position. + (push (make-ebrowse-position + :file-name (buffer-file-name (marker-buffer marker)) + :point (marker-position marker) + :target target + :info info) + ebrowse-position-stack)))) + + +(defun ebrowse-move-in-position-stack (increment) + "Move by INCREMENT in the position stack." + (let ((length (length ebrowse-position-stack))) + (when (zerop length) + (error "No positions remembered")) + (setq ebrowse-position-index + (mod (+ increment ebrowse-position-index) length)) + (message "Position %d of %d " ebrowse-position-index length) + (ebrowse-view/find-position (nth ebrowse-position-index + ebrowse-position-stack)))) + + +;;; ###autoload +(defun ebrowse-back-in-position-stack (arg) + "Move backward in the position stack. +Prefix arg ARG says how much." + (interactive "p") + (ebrowse-move-in-position-stack (max 1 arg))) + + +;;; ###autoload +(defun ebrowse-forward-in-position-stack (arg) + "Move forward in the position stack. +Prefix arg ARG says how much." + (interactive "p") + (ebrowse-move-in-position-stack (min -1 (- arg)))) + + + +;;; Electric position list + +(defvar ebrowse-electric-position-mode-map () + "Keymap used in electric position stack window.") + + +(defvar ebrowse-electric-position-mode-hook nil + "If non-nil, its value is called by ebrowse-electric-position-mode.") + + +(unless ebrowse-electric-position-mode-map + (let ((map (make-keymap)) + (submap (make-keymap))) + (setq ebrowse-electric-position-mode-map map) + (fillarray (car (cdr map)) 'ebrowse-electric-position-undefined) + (fillarray (car (cdr submap)) 'ebrowse-electric-position-undefined) + (define-key map "\e" submap) + (define-key map "\C-z" 'suspend-emacs) + (define-key map "\C-h" 'Helper-help) + (define-key map "?" 'Helper-describe-bindings) + (define-key map "\C-c" nil) + (define-key map "\C-c\C-c" 'ebrowse-electric-position-quit) + (define-key map "q" 'ebrowse-electric-position-quit) + (define-key map " " 'ebrowse-electric-select-position) + (define-key map "\C-l" 'recenter) + (define-key map "\C-u" 'universal-argument) + (define-key map "\C-p" 'previous-line) + (define-key map "\C-n" 'next-line) + (define-key map "p" 'previous-line) + (define-key map "n" 'next-line) + (define-key map "v" 'ebrowse-electric-view-position) + (define-key map "\C-v" 'scroll-up) + (define-key map "\ev" 'scroll-down) + (define-key map "\e\C-v" 'scroll-other-window) + (define-key map "\e>" 'end-of-buffer) + (define-key map "\e<" 'beginning-of-buffer) + (define-key map "\e>" 'end-of-buffer))) + +(put 'ebrowse-electric-position-mode 'mode-class 'special) +(put 'ebrowse-electric-position-undefined 'suppress-keymap t) + + +(defun ebrowse-electric-position-mode () + "Mode for electric position buffers. +Runs the hook `ebrowse-electric-position-mode-hook'." + (kill-all-local-variables) + (use-local-map ebrowse-electric-position-mode-map) + (setq mode-name "Electric Position Menu" + mode-line-buffer-identification "Electric Position Menu") + (when (memq 'mode-name mode-line-format) + (setq mode-line-format (copy-sequence mode-line-format)) + (setcar (memq 'mode-name mode-line-format) "Positions")) + (make-local-variable 'Helper-return-blurb) + (setq Helper-return-blurb "return to buffer editing" + truncate-lines t + buffer-read-only t + major-mode 'ebrowse-electric-position-mode) + (run-hooks 'ebrowse-electric-position-mode-hook)) + + +(defun ebrowse-draw-position-buffer () + "Display positions in buffer *Positions*." + (set-buffer (get-buffer-create "*Positions*")) + (setq buffer-read-only nil) + (erase-buffer) + (insert "File Point Description\n" + "---- ----- -----------\n") + (dolist (position ebrowse-position-stack) + (insert (file-name-nondirectory (ebrowse-position-file-name position))) + (indent-to 15) + (insert (int-to-string (ebrowse-position-point position))) + (indent-to 22) + (insert (ebrowse-position-name position) "\n")) + (setq buffer-read-only t)) + + +;;; ###autoload +(defun ebrowse-electric-position-menu () + "List positions in the position stack in an electric buffer." + (interactive) + (unless ebrowse-position-stack + (error "No positions remembered")) + (let (select buffer window) + (save-window-excursion + (save-window-excursion (ebrowse-draw-position-buffer)) + (setq window (Electric-pop-up-window "*Positions*") + buffer (window-buffer window)) + (shrink-window-if-larger-than-buffer window) + (unwind-protect + (progn + (set-buffer buffer) + (ebrowse-electric-position-mode) + (setq select + (catch 'ebrowse-electric-select-position + (message "<<< Press Space to bury the list >>>") + (let ((first (progn (goto-char (point-min)) + (forward-line 2) + (point))) + (last (progn (goto-char (point-max)) + (forward-line -1) + (point))) + (goal-column 0)) + (goto-char first) + (Electric-command-loop 'ebrowse-electric-select-position + nil t + 'ebrowse-electric-position-looper + (cons first last)))))) + (set-buffer buffer) + (bury-buffer buffer) + (message nil))) + (when select + (set-buffer buffer) + (ebrowse-electric-find-position select)) + (kill-buffer buffer))) + + +(defun ebrowse-electric-position-looper (state condition) + "Prevent moving point on invalid lines. +Called from `Electric-command-loop'. See there for the meaning +of STATE and CONDITION." + (cond ((and condition + (not (memq (car condition) '(buffer-read-only + end-of-buffer + beginning-of-buffer)))) + (signal (car condition) (cdr condition))) + ((< (point) (car state)) + (goto-char (point-min)) + (forward-line 2)) + ((> (point) (cdr state)) + (goto-char (point-max)) + (forward-line -1) + (if (pos-visible-in-window-p (point-max)) + (recenter -1))))) + + +(defun ebrowse-electric-position-undefined () + "Function called for undefined keys." + (interactive) + (message "Type C-h for help, ? for commands, q to quit, Space to execute") + (sit-for 4)) + + +(defun ebrowse-electric-position-quit () + "Leave the electric position list." + (interactive) + (throw 'ebrowse-electric-select-position nil)) + + +(defun ebrowse-electric-select-position () + "Select a position from the list." + (interactive) + (throw 'ebrowse-electric-select-position (point))) + + +(defun ebrowse-electric-find-position (point &optional view) + "View/find what is described by the line at POINT. +If VIEW is non-nil, view else find source files." + (let ((index (- (count-lines (point-min) point) 2))) + (ebrowse-view/find-position (nth index + ebrowse-position-stack) view))) + + +(defun ebrowse-electric-view-position () + "View the position described by the line point is in." + (interactive) + (ebrowse-electric-find-position (point) t)) + + + +;;; Saving trees to disk + +(defun ebrowse-write-file-hook-fn () + "Write current buffer as a class tree. +Installed on `local-write-file-hooks'." + (ebrowse-save-tree) + t) + + +;;; ###autoload +(defun ebrowse-save-tree () + "Save current tree in same file it was loaded from." + (interactive) + (ebrowse-save-tree-as (or buffer-file-name ebrowse--tags-file-name))) + + +;;;###autoload +(defun ebrowse-save-tree-as (&optional file-name) + "Write the current tree data structure to a file. +Read the file name from the minibuffer if interactive. +Otherwise, FILE-NAME specifies the file to save the tree in." + (interactive "FSave tree as: ") + (let ((temp-buffer (get-buffer-create "*Tree Output")) + (old-standard-output standard-output) + (header (copy-ebrowse-hs ebrowse--header)) + (tree ebrowse--tree)) + (unwind-protect + (save-excursion + (set-buffer (setq standard-output temp-buffer)) + (erase-buffer) + (setf (ebrowse-hs-member-table header) nil) + (insert (prin1-to-string header) " ") + (mapcar 'ebrowse-save-class tree) + (write-file file-name) + (message "Tree written to file `%s'" file-name)) + (kill-buffer temp-buffer) + (set-buffer-modified-p nil) + (ebrowse-update-tree-buffer-mode-line) + (setq standard-output old-standard-output)))) + + +(defun ebrowse-save-class (class) + "Write single class CLASS to current buffer." + (message "%s..." (ebrowse-cs-name (ebrowse-ts-class class))) + (insert "[ebrowse-ts ") + (prin1 (ebrowse-ts-class class)) ;class name + (insert "(") ;list of subclasses + (mapcar 'ebrowse-save-class (ebrowse-ts-subclasses class)) + (insert ")") + (dolist (func ebrowse-member-list-accessors) + (prin1 (funcall func class)) + (insert "\n")) + (insert "()") ;base-classes slot + (prin1 (ebrowse-ts-mark class)) + (insert "]\n")) + + + +;;; Statistics + +;;; ###autoload +(defun ebrowse-statistics () + "Display statistics for a class tree." + (interactive) + (let ((tree-file (buffer-file-name)) + temp-buffer-setup-hook) + (with-output-to-temp-buffer "*Tree Statistics*" + (multiple-value-bind (classes member-functions member-variables + static-functions static-variables) + (ebrowse-gather-statistics) + (set-buffer standard-output) + (erase-buffer) + (insert "STATISTICS FOR TREE " (or tree-file "unknown") ":\n\n") + (ebrowse-print-statistics-line "Number of classes:" classes) + (ebrowse-print-statistics-line "Number of member functions:" + member-functions) + (ebrowse-print-statistics-line "Number of member variables:" + member-variables) + (ebrowse-print-statistics-line "Number of static functions:" + static-functions) + (ebrowse-print-statistics-line "Number of static variables:" + static-variables))))) + + +(defun ebrowse-print-statistics-line (title value) + "Print a line in the statistics buffer. +TITLE is the title of the line, VALUE is number to be printed +after that." + (insert title) + (indent-to 40) + (insert (format "%d\n" value))) + + +(defun ebrowse-gather-statistics () + "Return statistics for a class tree. +The result is a list (NUMBER-OF-CLASSES NUMBER-OF-MEMBER-FUNCTIONS +NUMBER-OF-INSTANCE-VARIABLES NUMBER-OF-STATIC-FUNCTIONS +NUMBER-OF-STATIC-VARIABLES:" + (let ((classes 0) (member-functions 0) (member-variables 0) + (static-functions 0) (static-variables 0)) + (ebrowse-for-all-trees (tree ebrowse--tree-obarray) + (incf classes) + (incf member-functions (length (ebrowse-ts-member-functions tree))) + (incf member-variables (length (ebrowse-ts-member-variables tree))) + (incf static-functions (length (ebrowse-ts-static-functions tree))) + (incf static-variables (length (ebrowse-ts-static-variables tree)))) + (list classes member-functions member-variables + static-functions static-variables))) + + + +;;; Global key bindings + +;;; The following can be used to bind key sequences starting with +;;; prefix `\C-cb' to browse commands. + +(defvar ebrowse-global-map nil + "*Keymap for Ebrowse commands.") + + +(defvar ebrowse-global-prefix-key "\C-cb" + "Prefix key for Ebrowse commands.") + + +(defvar ebrowse-global-submap-4 nil + "Keymap used for `ebrowse-global-prefix' followed by `4'.") + + +(defvar ebrowse-global-submap-5 nil + "Keymap used for `ebrowse-global-prefix' followed by `5'.") + + +(unless ebrowse-global-map + (setq ebrowse-global-map (make-sparse-keymap)) + (setq ebrowse-global-submap-4 (make-sparse-keymap)) + (setq ebrowse-global-submap-5 (make-sparse-keymap)) + (define-key ebrowse-global-map "a" 'ebrowse-tags-apropos) + (define-key ebrowse-global-map "b" 'ebrowse-pop-to-browser-buffer) + (define-key ebrowse-global-map "-" 'ebrowse-back-in-position-stack) + (define-key ebrowse-global-map "+" 'ebrowse-forward-in-position-stack) + (define-key ebrowse-global-map "l" 'ebrowse-tags-list-members-in-file) + (define-key ebrowse-global-map "m" 'ebrowse-tags-display-member-buffer) + (define-key ebrowse-global-map "n" 'ebrowse-tags-next-file) + (define-key ebrowse-global-map "p" 'ebrowse-electric-position-menu) + (define-key ebrowse-global-map "s" 'ebrowse-tags-search) + (define-key ebrowse-global-map "u" 'ebrowse-tags-search-member-use) + (define-key ebrowse-global-map "v" 'ebrowse-tags-view-definition) + (define-key ebrowse-global-map "V" 'ebrowse-tags-view-declaration) + (define-key ebrowse-global-map "%" 'ebrowse-tags-query-replace) + (define-key ebrowse-global-map "." 'ebrowse-tags-find-definition) + (define-key ebrowse-global-map "f" 'ebrowse-tags-find-definition) + (define-key ebrowse-global-map "F" 'ebrowse-tags-find-declaration) + (define-key ebrowse-global-map "," 'ebrowse-tags-loop-continue) + (define-key ebrowse-global-map " " 'ebrowse-electric-buffer-list) + (define-key ebrowse-global-map "\t" 'ebrowse-tags-complete-symbol) + (define-key ebrowse-global-map "4" ebrowse-global-submap-4) + (define-key ebrowse-global-submap-4 "." 'ebrowse-tags-find-definition-other-window) + (define-key ebrowse-global-submap-4 "f" 'ebrowse-tags-find-definition-other-window) + (define-key ebrowse-global-submap-4 "v" 'ebrowse-tags-find-declaration-other-window) + (define-key ebrowse-global-submap-4 "F" 'ebrowse-tags-view-definition-other-window) + (define-key ebrowse-global-submap-4 "V" 'ebrowse-tags-view-declaration-other-window) + (define-key ebrowse-global-map "5" ebrowse-global-submap-5) + (define-key ebrowse-global-submap-5 "." 'ebrowse-tags-find-definition-other-frame) + (define-key ebrowse-global-submap-5 "f" 'ebrowse-tags-find-definition-other-frame) + (define-key ebrowse-global-submap-5 "v" 'ebrowse-tags-find-declaration-other-frame) + (define-key ebrowse-global-submap-5 "F" 'ebrowse-tags-view-definition-other-frame) + (define-key ebrowse-global-submap-5 "V" 'ebrowse-tags-view-declaration-other-frame) + (define-key global-map ebrowse-global-prefix-key ebrowse-global-map)) + + + +;;; Electric C++ browser buffer menu + +;;; Electric buffer menu customization to display only some buffers +;;; (in this case Tree buffers). There is only one problem with this: +;;; If the very first character typed in the buffer menu is a space, +;;; this will select the buffer from which the buffer menu was +;;; invoked. But this buffer is not displayed in the buffer list if +;;; it isn't a tree buffer. I therefore let the buffer menu command +;;; loop read the command `p' via `unread-command-char'. This command +;;; has no effect since we are on the first line of the buffer. + +(defvar electric-buffer-menu-mode-hook nil) + + +(defun ebrowse-hack-electric-buffer-menu () + "Hack the electric buffer menu to display browser buffers." + (let (non-empty) + (unwind-protect + (save-excursion + (setq buffer-read-only nil) + (goto-char 1) + (forward-line 2) + (while (not (eobp)) + (let ((b (Buffer-menu-buffer nil))) + (if (or (ebrowse-buffer-p b) + (string= (buffer-name b) "*Apropos Members*")) + (progn (forward-line 1) + (setq non-empty t)) + (delete-region (point) + (save-excursion (end-of-line) + (min (point-max) + (1+ (point))))))))) + (unless non-empty + (error "No tree buffers")) + (setf unread-command-events (listify-key-sequence "p")) + (shrink-window-if-larger-than-buffer (selected-window)) + (setq buffer-read-only t)))) + + +(defun ebrowse-select-1st-to-9nth () + "Select the nth entry in the list by the keys 1..9." + (interactive) + (let* ((maxlin (count-lines (point-min) (point-max))) + (n (min maxlin (+ 2 (string-to-int (this-command-keys)))))) + (goto-line n) + (throw 'electric-buffer-menu-select (point)))) + + +(defun ebrowse-install-1-to-9-keys () + "Define keys 1..9 to select the 1st to 0nth entry in the list." + (dotimes (i 9) + (define-key (current-local-map) (char-to-string (+ i ?1)) + 'ebrowse-select-1st-to-9nth))) + + +(defun ebrowse-electric-buffer-list () + "Display an electric list of Ebrowse buffers." + (interactive) + (unwind-protect + (progn + (add-hook 'electric-buffer-menu-mode-hook + 'ebrowse-hack-electric-buffer-menu) + (add-hook 'electric-buffer-menu-mode-hook + 'ebrowse-install-1-to-9-keys) + (call-interactively 'electric-buffer-list)) + (remove-hook 'electric-buffer-menu-mode-hook + 'ebrowse-hack-electric-buffer-menu))) + + +;;; Mouse support + +(defun ebrowse-mouse-find-member (event) + "Find the member clicked on in another frame. +EVENT is a mouse button event." + (interactive "e") + (mouse-set-point event) + (let (start name) + (save-excursion + (skip-chars-backward "a-zA-Z0-9_") + (setq start (point)) + (skip-chars-forward "a-zA-Z0-9_") + (setq name (buffer-substring start (point)))) + (ebrowse-tags-view/find-member-decl/defn + 5 :view nil :definition t :member-name name))) + + +(defun ebrowse-popup-menu (menu event) + "Pop up MENU and perform an action if something was selected. +EVENT is the mouse event." + (save-selected-window + (select-window (posn-window (event-start event))) + (let ((selection (x-popup-menu event menu)) binding) + (while selection + (setq binding (lookup-key (or binding menu) (vector (car selection))) + selection (cdr selection))) + (when binding + (call-interactively binding))))) + + +(easy-menu-define + ebrowse-tree-buffer-class-object-menu ebrowse-tree-mode-map + "Object menu for classes in the tree buffer" + '("Class" + ["Functions" ebrowse-tree-command:show-member-functions + :help "Display a list of member functions" + :active t] + ["Variables" ebrowse-tree-command:show-member-variables + :help "Display a list of member variables" + :active t] + ["Static Functions" ebrowse-tree-command:show-static-member-functions + :help "Display a list of static member functions" + :active t] + ["Static Variables" ebrowse-tree-command:show-static-member-variables + :help "Display a list of static member variables" + :active t] + ["Friends/ Defines" ebrowse-tree-command:show-friends + :help "Display a list of friends of a class" + :active t] + ["Types" ebrowse-tree-command:show-types + :help "Display a list of types defined in a class" + :active t] + "-----------------" + ["View" ebrowse-view-class-declaration + :help "View class declaration" + :active (eq (get-text-property (point) 'ebrowse-what) 'class-name)] + ["Find" ebrowse-find-class-declaration + :help "Find class declaration in file" + :active (eq (get-text-property (point) 'ebrowse-what) 'class-name)] + "-----------------" + ["Mark" ebrowse-toggle-mark-at-point + :help "Mark class point is on" + :active (eq (get-text-property (point) 'ebrowse-what) 'class-name)] + "-----------------" + ["Collapse" ebrowse-collapse-branch + :help "Collapse subtree under class point is on" + :active (eq (get-text-property (point) 'ebrowse-what) 'class-name)] + ["Expand" ebrowse-expand-branch + :help "Expand subtree under class point is on" + :active (eq (get-text-property (point) 'ebrowse-what) 'class-name)])) + + +(easy-menu-define + ebrowse-tree-buffer-object-menu ebrowse-tree-mode-map + "Object menu for tree buffers" + '("Ebrowse" + ["Filename Display" ebrowse-toggle-file-name-display + :help "Toggle display of source files names" + :style toggle + :selected ebrowse--show-file-names-flag + :active t] + ["Tree Indentation" ebrowse-set-tree-indentation + :help "Set the tree's indentation" + :active t] + ["Unmark All Classes" ebrowse-mark-all-classes + :help "Unmark all classes in the class tree" + :active t] + ["Expand All" ebrowse-expand-all + :help "Expand all subtrees in the class tree" + :active t] + ["Statistics" ebrowse-statistics + :help "Show a buffer with class hierarchy statistics" + :active t] + ["Find Class" ebrowse-read-class-name-and-go + :help "Find a class in the tree" + :active t] + ["Member Buffer" ebrowse-pop/switch-to-member-buffer-for-same-tree + :help "Show a member buffer for this class tree" + :active t])) + + +(defun ebrowse-mouse-3-in-tree-buffer (event) + "Perform mouse actions in tree buffers. +EVENT is the mouse event." + (interactive "e") + (mouse-set-point event) + (let* ((where (posn-point (event-start event))) + (property (get-text-property where 'ebrowse-what))) + (case (event-click-count event) + (1 + (case property + (class-name + (ebrowse-popup-menu ebrowse-tree-buffer-class-object-menu event)) + (t + (ebrowse-popup-menu ebrowse-tree-buffer-object-menu event))))))) + + +(defun ebrowse-mouse-2-in-tree-buffer (event) + "Perform mouse actions in tree buffers. +EVENT is the mouse event." + (interactive "e") + (mouse-set-point event) + (let* ((where (posn-point (event-start event))) + (property (get-text-property where 'ebrowse-what))) + (case (event-click-count event) + (1 (case property + (class-name + (ebrowse-tree-command:show-member-functions))))))) + + +(defun ebrowse-mouse-1-in-tree-buffer (event) + "Perform mouse actions in tree buffers. +EVENT is the mouse event." + (interactive "e") + (mouse-set-point event) + (let* ((where (posn-point (event-start event))) + (property (get-text-property where 'ebrowse-what))) + (case (event-click-count event) + (2 (case property + (class-name + (let ((collapsed (save-excursion (skip-chars-forward "^\r\n") + (looking-at "\r")))) + (ebrowse-collapse-fn (not collapsed)))) + (mark + (ebrowse-toggle-mark-at-point 1))))))) + + + +;;; Hooks installed + +(add-hook 'find-file-hooks 'ebrowse-find-file) + + +(provide 'ebrowse) + +;;; Local variables: +;;; eval:(put 'ebrowse-output 'lisp-indent-hook 0) +;;; eval:(put 'ebrowse-ignoring-completion-case 'lisp-indent-hook 0) +;;; eval:(put 'ebrowse-save-selective 'lisp-indent-hook 0) +;;; eval:(put 'ebrowse-for-all-trees 'lisp-indent-hook 1) +;;; End: + +;;; ebrowse.el ends here. +