home *** CD-ROM | disk | FTP | other *** search
Text File | 1993-06-20 | 71.9 KB | 2,447 lines |
- Newsgroups: comp.sources.misc
- From: kennedy@art.intellection.com (Brian M Kennedy)
- Subject: v38i015: cie - C++ In Emacs v1.0, Part01/02
- Message-ID: <csm-v38i015=cie.182302@sparky.IMD.Sterling.COM>
- X-Md4-Signature: d975b3451263f1d25fd0907d3c799274
- Sender: kent@sparky.imd.sterling.com (Kent Landfield)
- Reply-To: Brian M Kennedy <kennedy@intellection.com>
- Organization: Sterling Software
- Date: Sun, 20 Jun 1993 23:23:27 GMT
- Approved: kent@sparky.imd.sterling.com
-
- Submitted-by: kennedy@art.intellection.com (Brian M Kennedy)
- Posting-number: Volume 38, Issue 15
- Archive-name: cie/part01
- Environment: Emacs, C++
-
- Excerpts from the README:
-
- This package is a collection of some of the tools/enhancements we use for C++
- development work within GNU Emacs. Briefly, it consists of an enhanced etags
- for C++, a related class hierarchy generator, a mode and M-x commands for
- browsing the hierarchy and getting lists of class members, a command goto-file
- that takes you to the proper line in a file, functions to make both tag names
- and file names mouseable, and a class manual generator that uses the hierarchy
- and tag information, coupled with the comments in the code, to build a class
- manual in texinfo format.
-
- I've been stalling on releasing this, hoping to find time to implement some of
- the outstanding features and do some significant cleanup. I have decided that
- I will never get to it (and I feel more and more guilty every time I see one
- of the many requests for these features on the newsgroups), so I am just going
- to release it basically as is. My apologies.
-
- This has run with GNU Emacs 18.51, 18.55, 18.57 and 18.58. I have not yet
- switched to Emacs 19, so neither has this code. If you want to use it with
- Emacs 19, I encourage you to volunteer to "port" it for the rest of us ;-)
-
- The etags++ and hier++ C++ programs have been compiled with Sun C++,
- Centerline C++, Lucid C++, and Comeau C++ on Sun OS, Ultrix, and AIX
- platforms.
-
- =====
-
- Here are excerpts from the important files:
-
- ======================
- ;;; tags.el
-
- ;; INTELLECTION MODS:
- ;;
- ;; 1) Prefers the tags named explicitly after C-A's at the end of each line.
- ;; This is true both for find-tag and for the completion-alist.
- ;; 2) Support for C++ scoping -- class::name is considered a tag and both
- ;; class::name and name are matches (class::name preferred though).
- ;; 3) Support for completion of scoped names as well as unscoped names.
- ;; That is, the alist contains both the fully-scoped name, and each
- ;; subname (c1::c2::mem => c1::c2::mem, c2::mem, and mem in the alist).
- ;; 4) Added mechanism to save out the completion alist into TAGS.alist
- ;; which is checked for when loading TAGS to prevent the need to rebuild
- ;; the alist (which can take a while with large systems). As an added
- ;; advantage, this mechanism removes duplicates from the alist before
- ;; saving it out (making it faster and much smaller).
-
- ======================
- ;;; hier-mode.el
- ;;; Hierarchy mode (for hierarchies output by hier++)
-
- "Major mode for viewing class hierarchy files output by hier++.
- The file is formatted like this:
-
- * class_a
- * child_b :class_a
- * child_c :class_a :class_f
- * grandchild_d :child_c
- * grandchild_e :child_c
- * class_f
- * child_c :class_a :class_f
- * grandchild_d :child_c
- * grandchild_e :child_c
- * child_g :class_f
-
- Classes child_b and child_c are derived from class_a; classes child_c and
- child_g are derived from class_f; classes grandchild_d and grandchild_e are
- both derived from child_c. Note that each class (and all of its children)
- will appear in the file once under each parent.
-
- Defined keys:
- M-p moves to the previous sibling
- M-n moves to the next sibling
- M-u moves up to the parent
- M-h finds the first occurrence of the hierarchy element for a class
- (similar to M-. in behavior)
- M-g finds the next occurrence (like M-,) in the case of multiple-inheritance.
- M-m brings up a new window with a listing of all the members (both direct and
- inherited) of that hierarchy entry. It does this via tags, so you must
- have tags set up in Emacs. It will also only work properly if the tags
- file was generated by etags++ (companion to hier++)."
-
- ======================
- ;;; class-manual.el
- ;;; Class Manual Generation
- ;;; Code to use hier-mode (for hierarchies output by hier++) and etags++
- ;;; functionality to build a class manual using the header comments in
- ;;; the code itself. The formatting is in standard texinfo.
- ;;; This is a hack that has been helpful for us, given our coding
- ;;; guidelines. It will likely need modification to produce good
- ;;; output for you. (Header comments are those placed between the
- ;;; signature and the body of functions or classes. If you don't follow
- ;;; this convention, then this code will need modification.)
-
- ======================
- // etags++/etags++.c
- //
- // This program reads in C++ code and generates a tags file for GNU Emacs.
- // This program is more sophisticated than the standard etags program for C++
- // programs. It finds all classes, structs, unions, enums, enumerators, #defines,
- // typedefs, functions (both global and member), and data (both global and member).
- // Furthermore, it handles C++ scoping correctly, outputting fully-scoped tags
- // at the end of each line. Thus, we have modified our Emacs tags.el to search
- // the fully-scoped names at the ends of the lines before the patterns. It also
- // handles template syntax.
-
- ======================
- // etags++/hier++.c
- //
- // This program reads in C++ code and generates a "hier" file that displays the
- // class hierarchy. You can then use the GNU Emacs hier-mode for traversing the
- // hierarchy and extracting information from your TAGS (if generated by etags++).
-
-
- =============================================================================
- == c++_in_emacs.shar ========================================================
- =============================================================================
- #! /bin/sh
- # This is a shell archive. Remove anything before this line, then feed it
- # into a shell via "sh file" or similar. To overwrite existing files,
- # type "sh file -c".
- # Contents: cie cie/etags++ cie/etags++/c++file.c
- # cie/etags++/etags++.c cie/hier-mode.el cie/minibuffer-yank.el
- # cie/tags.el
- # Wrapped by kent@sparky on Sun Jun 20 18:21:17 1993
- PATH=/bin:/usr/bin:/usr/ucb:/usr/local/bin:/usr/lbin ; export PATH
- echo If this archive is complete, you will see the following message:
- echo ' "shar: End of archive 1 (of 2)."'
- if test ! -d 'cie' ; then
- echo shar: Creating directory \"'cie'\"
- mkdir 'cie'
- fi
- if test ! -d 'cie/etags++' ; then
- echo shar: Creating directory \"'cie/etags++'\"
- mkdir 'cie/etags++'
- fi
- if test -f 'cie/etags++/c++file.c' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'cie/etags++/c++file.c'\"
- else
- echo shar: Extracting \"'cie/etags++/c++file.c'\" \(10994 characters\)
- sed "s/^X//" >'cie/etags++/c++file.c' <<'END_OF_FILE'
- X////////////////////////////////////////////////////////////////////////////////
- X// c++file.c
- X//
- X// This .c file, written in C++, is intended to be included in etags++.c and hier++.c.
- X// It is a quick-and-dirty "fuzzy" parser for C++ files that identifies enough tokens for
- X// etags++ and hier++ to do a good job. See those files for information on the resultant
- X// functionality. This file simply provides the common parsing code.
- X//
- X// Author: Brian M. Kennedy
- X// (C) Copyright 1993, Intellection Inc.
- X// Permission is granted to use, copy, or modify this code as long as this author and
- X// copyright notice is maintained in all copies.
- X//
- X// Note:
- X// This is quick, hack code that was not written to be modifiable or maintainable -- beware!!
- X// I would not allow code such as this into our product! But it is okay for a quick tool hack.
- X// If you are a user, I hope you enjoy it. If you are modifier, my apologies ;-(
- X
- X#include <stdlib.h>
- X#include <iostream.h>
- X#include <fstream.h>
- X#include <ctype.h>
- X#include <string.h>
- X
- X
- Xtypedef char Boolean;
- X#define FALSE 0
- X#define TRUE 1
- X
- X
- X// Exit Status
- X#define GOOD 0
- X#define BAD 1
- X
- X
- X////////////////////////////////////////////////////////////////////////////////
- X
- Xinline Boolean
- Xisident (char c)
- X{ return c == '_' || isalnum(c); }
- X
- X
- Xunsigned
- Xsize (unsigned num)
- X{ unsigned ret = 0;
- X while (num)
- X { ++ret;
- X num /= 10;
- X }
- X return ret;
- X}
- X
- X
- X////////////////////////////////////////////////////////////////////////////////
- X
- Xstruct File
- X{
- X int size;
- X char* chars;
- X
- X File (int max_size);
- X File (int max_size, char* initial_string);
- X
- X void read (const char* filename);
- X};
- X
- X
- XFile::
- XFile (int max_size)
- X:size(max_size+1), chars(new char [size+2])
- X{
- X chars[0] = 0;
- X chars[size+1] = 0;
- X}
- X
- X
- XFile::
- XFile (int max_size, char* initial_string)
- X:size(max_size), chars(new char [size+2])
- X{
- X chars[0] = 0;
- X strcpy(chars+1, initial_string);
- X chars[size+1] = 0;
- X}
- X
- X
- Xvoid File::
- Xread (const char* filename)
- X{ ifstream is (filename);
- X is.get(chars+1, size, 0); // note: chars is indexed-based at 1, not 0
- X}
- X
- X
- X////////////////////////////////////////////////////////////////////////////////
- X
- Xstruct File_Pos
- X{
- X const File* file;
- X unsigned char_no;
- X unsigned line_no;
- X
- X File_Pos (const File& file_arg) :file(&file_arg), char_no(1), line_no(1) {}
- X File_Pos (const File_Pos& p) :file(p.file), char_no(p.char_no), line_no(p.line_no) {}
- X
- X const char* chars () const { return file->chars + char_no; }
- X char chars (unsigned n) const { return chars()[n]; }
- X
- X File_Pos& inc ();
- X File_Pos& inc (unsigned n);
- X
- X inline Boolean match (const char* string, unsigned size);
- X Boolean match (const char* string) { return match(string, strlen(string)); }
- X Boolean match (Boolean (*fn)(char c));
- X
- X void find_match (const char* string, unsigned size);
- X void find_match (const char* string) { find_match(string, strlen(string)); }
- X void find_match (Boolean (*fn)(char c));
- X void find_match (char match, char escape);
- X
- X void find_prev_newline ();
- X};
- X
- X
- Xinline File_Pos& File_Pos::
- Xinc ()
- X{ char c = chars(0);
- X if (c)
- X { ++char_no;
- X if (c == '\n')
- X ++line_no;
- X }
- X return *this;
- X}
- X
- X
- XFile_Pos& File_Pos::
- Xinc (unsigned n)
- X{ for(unsigned i = 0; i < n; ++i)
- X inc();
- X return *this;
- X}
- X
- X
- Xinline Boolean File_Pos::
- Xmatch (const char* string, unsigned size)
- X{ if (strncmp(string, chars(), size))
- X return FALSE;
- X else
- X { inc(size);
- X return TRUE;
- X }
- X}
- X
- X
- XBoolean File_Pos::
- Xmatch (Boolean (*fn)(char c))
- X{ Boolean ret = fn(chars(0));
- X while (fn(chars(0)))
- X inc();
- X return ret;
- X}
- X
- X
- Xvoid File_Pos::
- Xfind_match (const char* string, unsigned size)
- X{
- X while (!match(string,size) && chars(0))
- X inc();
- X}
- X
- Xvoid File_Pos::
- Xfind_match (Boolean (*fn)(char c))
- X{
- X while (!match(fn) && chars(0))
- X inc();
- X}
- X
- X
- Xvoid File_Pos::
- Xfind_match (char match, char escape)
- X{
- X while (chars(0) && chars(0) != match)
- X { if (chars(0) == escape)
- X inc();
- X inc();
- X }
- X inc();
- X}
- X
- X
- Xvoid File_Pos::
- Xfind_prev_newline ()
- X{
- X while (chars(0) && chars(0) != '\n')
- X --char_no;
- X ++char_no;
- X}
- X
- X
- X////////////////////////////////////////////////////////////////////////////////
- X
- Xenum C_Token
- X{ CHARACTER, ESCAPED,
- X TOKEN, COMMENT, DIRECTIVE,
- X CODE_TOKEN, CLASS_KW, STRUCT_KW, UNION_KW, ENUM_KW, TYPEDEF_KW,
- X TEMPLATE_KW, TEMPLATE_ARGS,
- X IDENTIFIER, STRING_CONSTANT, CHAR_CONSTANT, DEFINE,
- X OPEN_PARE, CLOSE_PARE, OPEN_BRACE, CLOSE_BRACE, COLONS, COMMA, SEMI_COLON, EQUAL,
- X NOTE, EXPORT, DECLARE_MACRO,
- X DEFINE_MACRO, DEFINE_GET, DEFINE_SET, DEFINE_GETSET, DEFINE_INC, DEFINE_DEC,
- X END_OF_FILE
- X};
- X
- X
- Xstruct C_File_Pos
- X:public File_Pos
- X{
- X C_Token token;
- X unsigned length;
- X
- X C_File_Pos (const File& file_arg);
- X
- X void identify_token ();
- X void next_char ();
- X void next_token ();
- X void next_code ();
- X void next_identifier ();
- X
- X void close_brace ();
- X void close_pare ();
- X void close_func ();
- X void close_define ();
- X
- X};
- X
- X
- XC_File_Pos::
- XC_File_Pos (const File& file_arg)
- X:File_Pos(file_arg), token(CHARACTER), length(1)
- X{ identify_token(); }
- X
- X
- X#define TOKEN_IDENTIFIER \
- X{ pos.match(isident); \
- X token = IDENTIFIER; \
- X length = pos.char_no - char_no; \
- X}
- X
- X
- Xvoid C_File_Pos::
- Xidentify_token ()
- X{
- X File_Pos pos (*this);
- X switch(chars(0))
- X {
- X case '\0':
- X token = END_OF_FILE;
- X length = 1;
- X break;
- X case 'c':
- X if (pos.match("class", 5) && !isident(pos.chars(0)))
- X { token = CLASS_KW;
- X length = pos.char_no - char_no;
- X }
- X else
- X TOKEN_IDENTIFIER;
- X break;
- X case 's':
- X if (pos.match("struct", 6) && !isident(pos.chars(0)))
- X { token = STRUCT_KW;
- X length = pos.char_no - char_no;
- X }
- X else
- X TOKEN_IDENTIFIER;
- X break;
- X case 'u':
- X if (pos.match("union", 5) && !isident(pos.chars(0)))
- X { token = UNION_KW;
- X length = pos.char_no - char_no;
- X }
- X else
- X TOKEN_IDENTIFIER;
- X break;
- X case 'e':
- X if (pos.match("enum", 4) && !isident(pos.chars(0)))
- X { token = ENUM_KW;
- X length = pos.char_no - char_no;
- X }
- X else
- X TOKEN_IDENTIFIER;
- X break;
- X case 't':
- X if (pos.match("typedef", 7))
- X { if (!isident(pos.chars(0)))
- X { token = TYPEDEF_KW;
- X length = pos.char_no - char_no;
- X }
- X else
- X TOKEN_IDENTIFIER;
- X }
- X else if (pos.match("template", 8) && !isident(pos.chars(0)))
- X { token = TEMPLATE_KW;
- X length = pos.char_no - char_no;
- X }
- X else
- X TOKEN_IDENTIFIER;
- X break;
- X case '#':
- X do
- X { pos.inc();
- X } while (pos.chars(0) != '\n' && isspace(pos.chars(0)));
- X if (pos.match("define", 6) && !isident(pos.chars(0)))
- X { token = DEFINE;
- X length = pos.char_no - char_no;
- X }
- X else
- X { pos.find_match('\n', '\\');
- X token = DIRECTIVE;
- X length = pos.char_no - char_no;
- X }
- X break;
- X case '(':
- X token = OPEN_PARE;
- X length = 1;
- X break;
- X case ')':
- X token = CLOSE_PARE;
- X length = 1;
- X break;
- X case '{':
- X token = OPEN_BRACE;
- X length = 1;
- X break;
- X case '}':
- X token = CLOSE_BRACE;
- X length = 1;
- X break;
- X case '<': {
- X unsigned last_more = pos.char_no;
- X pos.inc();
- X while (!strchr("{}\"\';\n", pos.chars(0)))
- X { if (pos.chars(0) == '>')
- X last_more = pos.char_no;
- X pos.inc();
- X }
- X if (last_more != char_no)
- X { token = TEMPLATE_ARGS;
- X length = last_more - char_no + 1;
- X }
- X else
- X { token = CHARACTER;
- X length = 1;
- X }
- X break;
- X }
- X case ':':
- X if (pos.match("::", 2))
- X { token = COLONS;
- X length = 2;
- X }
- X else
- X { token = CHARACTER;
- X length = 1;
- X }
- X break;
- X case ',':
- X token = COMMA;
- X length = 1;
- X break;
- X case ';':
- X token = SEMI_COLON;
- X length = 1;
- X break;
- X case '=':
- X token = EQUAL;
- X length = 1;
- X break;
- X case '/':
- X if (pos.match("//", 2))
- X { pos.find_match("\n", 1);
- X token = COMMENT;
- X length = pos.char_no - char_no;
- X }
- X else if (pos.match("/*", 2)) // */
- X { pos.find_match("*/", 2);
- X token = COMMENT;
- X length = pos.char_no - char_no;
- X }
- X else
- X { token = CHARACTER;
- X length = 1;
- X }
- X break;
- X case '\"':
- X pos.inc();
- X pos.find_match('\"', '\\');
- X token = STRING_CONSTANT;
- X length = pos.char_no - char_no;
- X break;
- X case '\'':
- X pos.inc();
- X pos.find_match('\'', '\\');
- X token = CHAR_CONSTANT;
- X length = pos.char_no - char_no;
- X break;
- X case '\\':
- X token = ESCAPED;
- X length = 2;
- X break;
- X case 'R':
- X if (pos.match("RWExport") && !isident(pos.chars(0)))
- X { token = COMMENT;
- X length = pos.char_no - char_no;
- X }
- X else
- X TOKEN_IDENTIFIER;
- X break;
- X case 'D':
- X if (pos.match("DEFINE_"))
- X { switch(pos.chars(0))
- X {
- X case 'G':
- X token = (chars(3) == 'S') ? DEFINE_GETSET : DEFINE_GET;
- X break;
- X case 'S':
- X token = DEFINE_SET;
- X break;
- X case 'I':
- X token = DEFINE_INC;
- X break;
- X case 'D':
- X token = DEFINE_DEC;
- X break;
- X default:
- X token = DEFINE_MACRO;
- X }
- X pos.match(isident);
- X length = pos.char_no - char_no;
- X }
- X else if (pos.match("DECLARE_"))
- X { pos.match(isident);
- X token = DECLARE_MACRO;
- X length = pos.char_no - char_no;
- X }
- X else
- X TOKEN_IDENTIFIER;
- X break;
- X case 'N':
- X if (pos.match("NOTE") && !isident(pos.chars(0)))
- X { token = NOTE;
- X length = pos.char_no - char_no;
- X }
- X else
- X TOKEN_IDENTIFIER;
- X break;
- X case 'E':
- X if ( pos.match("EXPORT_ACCESSOR")
- X || pos.match("EXPORT_PARM")
- X || (pos.match("EXPORT") && !isident(pos.chars(0))))
- X { token = EXPORT;
- X length = pos.char_no - char_no;
- X }
- X else
- X TOKEN_IDENTIFIER;
- X break;
- X default:
- X if (!isalpha(chars(0)))
- X { token = CHARACTER;
- X length = 1;
- X }
- X else
- X TOKEN_IDENTIFIER;
- X }
- X}
- X
- X
- Xinline void C_File_Pos::
- Xnext_char ()
- X{ inc(length);
- X identify_token();
- X}
- X
- X
- Xvoid C_File_Pos::
- Xnext_token ()
- X{ do
- X { next_char();
- X } while (token <= TOKEN);
- X}
- X
- X
- Xvoid C_File_Pos::
- Xnext_code ()
- X{ do
- X { next_char();
- X } while (token <= CODE_TOKEN);
- X}
- X
- X
- Xvoid C_File_Pos::
- Xnext_identifier ()
- X{ do
- X { next_char();
- X } while (token != IDENTIFIER && token != END_OF_FILE);
- X}
- X
- X
- Xvoid C_File_Pos::
- Xclose_brace ()
- X{ int level = 1;
- X while (level)
- X { next_code();
- X if (token == OPEN_BRACE)
- X ++level;
- X else if (token == CLOSE_BRACE)
- X --level;
- X else if (token == END_OF_FILE)
- X level = 0;
- X }
- X}
- X
- X
- Xvoid C_File_Pos::
- Xclose_pare ()
- X{ int level = 1;
- X while (level)
- X { next_code();
- X if (token == OPEN_PARE)
- X ++level;
- X else if (token == CLOSE_PARE)
- X --level;
- X else if (token == END_OF_FILE)
- X level = 0;
- X }
- X}
- X
- X
- Xvoid C_File_Pos::
- Xclose_func ()
- X{ while (token != SEMI_COLON && token != OPEN_BRACE && token != END_OF_FILE)
- X next_code();
- X if (token == OPEN_BRACE)
- X close_brace();
- X}
- X
- X
- Xvoid C_File_Pos::
- Xclose_define ()
- X{ while (chars(0) && chars(0) != '\n')
- X { if (chars(0) == '\\')
- X inc();
- X inc();
- X }
- X if (chars(0))
- X token = CHARACTER;
- X else
- X token = END_OF_FILE;
- X length = 1;
- X}
- END_OF_FILE
- if test 10994 -ne `wc -c <'cie/etags++/c++file.c'`; then
- echo shar: \"'cie/etags++/c++file.c'\" unpacked with wrong size!
- fi
- # end of 'cie/etags++/c++file.c'
- fi
- if test -f 'cie/etags++/etags++.c' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'cie/etags++/etags++.c'\"
- else
- echo shar: Extracting \"'cie/etags++/etags++.c'\" \(13241 characters\)
- sed "s/^X//" >'cie/etags++/etags++.c' <<'END_OF_FILE'
- X////////////////////////////////////////////////////////////////////////////////
- X// etags++.c
- X//
- X// This program reads in C++ code and generates a tags file for GNU Emacs.
- X// This program is more sophisticated than the standard etags program for C++
- X// programs. It finds all classes, structs, unions, enums, enumerators, #defines,
- X// typedefs, functions (both global and member), and data (both global and member).
- X// Furthermore, it handles C++ scoping correctly, outputting fully-scoped tags
- X// at the end of each line. Thus, we have modified our Emacs tags.el to search
- X// the fully-scoped names at the ends of the lines before the patterns. It also
- X// handles template syntax.
- X//
- X// In addition, we have added support for a few important macro conventions that
- X// we use. DECLARE_*(name,..) macros define the tag <name> in the current scope;
- X// DEFINE_*(class,name,...) macros define the tag <class>::<name>. We use NOTE(name)
- X// macros to name comments, so that you can refer to them by See::name in other
- X// comments. In Emacs, M-. on See::name will take you to the named comment.
- X//
- X// Note that this uses "fuzzy", quick-and-dirty parsing to find the tokens. Thus, it
- X// can miss some things. Also note that this is not an etags replacement -- it only
- X// supports C/C++ code. The etags program will still be needed for TeX, Fortran, etc.
- X//
- X// Author: Brian M. Kennedy
- X// (C) Copyright 1993, Intellection Inc.
- X// Permission is granted to use, copy, or modify this code as long as this author and
- X// copyright notice is maintained in all copies.
- X//
- X// Note:
- X// This is quick, hack code that was not written to be modifiable or maintainable -- beware!!
- X// I would not allow code such as this into our product! But it is okay for a quick tool hack.
- X// If you are a user, I hope you enjoy it. If you are modifier, my apologies ;-(
- X
- X#include "c++file.c"
- X
- X
- X////////////////////////////////////////////////////////////////////////////////
- X
- Xstruct Tag;
- X
- Xstruct Scope
- X{
- X C_File_Pos name;
- X Scope* next;
- X
- X Scope (const Scope& copy);
- X Scope (const C_File_Pos& name_arg, Scope* next_arg);
- X ~Scope () { delete next; }
- X
- X Scope* pop ();
- X
- X unsigned etags_size () const;
- X void etags_put (ostream& os) const;
- X};
- X
- Xinline Scope* copy (const Scope* s);
- X
- X
- XScope::
- XScope (const Scope& s)
- X:name(s.name), next(copy(s.next))
- X{}
- X
- X
- XScope::
- XScope (const C_File_Pos& name_arg, Scope* next_arg)
- X:name(name_arg), next(copy(next_arg))
- X{}
- X
- X
- Xinline Scope* Scope::
- Xpop ()
- X{ Scope* ret = next;
- X next = 0;
- X delete this;
- X return ret;
- X}
- X
- X
- Xunsigned Scope::
- Xetags_size () const
- X{ if(this)
- X return name.length + 2 + next->etags_size();
- X else
- X return 0;
- X}
- X
- X
- Xvoid Scope::
- Xetags_put (ostream& os) const
- X{ if(this)
- X { next->etags_put(os);
- X os.write(name.chars(), name.length);
- X os << "::";
- X }
- X}
- X
- X
- Xinline Scope*
- Xcopy (const Scope* s)
- X{ return s ? new Scope (*s) : 0; }
- X
- X
- X////////////////////////////////////////////////////////////////////////////////
- X// Prefixes
- X
- Xchar* prefix_string = " See EXPORTED set_ inc_ dec_";
- X
- XFile prefix_file (strlen(prefix_string), prefix_string);
- X
- XC_File_Pos prefix_pos (prefix_file);
- XC_File_Pos see_pos ((prefix_pos.next_identifier(), prefix_pos));
- XC_File_Pos exported_pos ((prefix_pos.next_identifier(), prefix_pos));
- XC_File_Pos set_pos ((prefix_pos.next_identifier(), prefix_pos));
- XC_File_Pos inc_pos ((prefix_pos.next_identifier(), prefix_pos));
- XC_File_Pos dec_pos ((prefix_pos.next_identifier(), prefix_pos));
- X
- XScope see_scope_obj (see_pos, 0);
- XScope* see_scope = &see_scope_obj;
- X
- XScope exported_scope_obj (exported_pos, 0);
- XScope* exported_scope = &exported_scope_obj;
- X
- X
- X////////////////////////////////////////////////////////////////////////////////
- X
- Xstruct Tag
- X{
- X Tag* next;
- X C_File_Pos name;
- X File_Pos pattern;
- X Scope* scope;
- X
- X Tag (const Tag& t);
- X Tag (const C_File_Pos& name_arg, const Scope* scope_arg);
- X
- X ~Tag () { delete scope; }
- X
- X unsigned etags_size () const;
- X void etags_put (ostream& os) const;
- X};
- X
- XTag::
- XTag (const Tag& t)
- X:next(0), name(t.name), pattern(t.pattern), scope(copy(t.scope))
- X{}
- X
- XTag::
- XTag (const C_File_Pos& name_arg, const Scope* scope_arg)
- X:next(0), name(name_arg), pattern(name_arg), scope(copy(scope_arg))
- X{ pattern.find_prev_newline();
- X}
- X
- X
- Xunsigned Tag::
- Xetags_size () const
- X{ return ((name.length + pattern.char_no - name.char_no)
- X + 1 + size(name.line_no) + 1 + size(name.char_no) + 2
- X + scope->etags_size() + name.length + 1);
- X}
- X
- X
- Xvoid Tag::
- Xetags_put (ostream& os) const
- X{ os.write(pattern.chars(), name.length + name.char_no - pattern.char_no);
- X os << '\177' << name.line_no << ',' << name.char_no << ",\1";
- X scope->etags_put(os);
- X os.write(name.chars(), name.length);
- X os << '\n';
- X}
- X
- X
- X////////////////////////////////////////////////////////////////////////////////
- X
- Xstruct Tag_List
- X{
- X Tag* first;
- X Tag* last;
- X
- X Tag_List () :first(0), last(0) {}
- X ~Tag_List ();
- X
- X void inc (Tag* tag);
- X
- X unsigned etags_size () const;
- X void etags_put (ostream& os) const;
- X};
- X
- X
- XTag_List::
- X~Tag_List ()
- X{ Tag* tag = first;
- X while(tag)
- X { first = tag->next;
- X delete tag;
- X tag = first;
- X }
- X last = 0;
- X}
- X
- X
- Xinline void Tag_List::
- Xinc (Tag* tag)
- X{ if(last)
- X { last->next = tag;
- X last = tag;
- X }
- X else
- X { first = last = tag;
- X }
- X}
- X
- X
- Xunsigned Tag_List::
- Xetags_size () const
- X{ unsigned sum = 0;
- X for(Tag* tag = first; tag; tag = tag->next)
- X sum += tag->etags_size();
- X return sum;
- X}
- X
- X
- Xvoid Tag_List::
- Xetags_put (ostream& os) const
- X{ for(Tag* tag = first; tag; tag = tag->next)
- X tag->etags_put(os);
- X}
- X
- X
- Xostream&
- Xoperator << (ostream& os, Tag_List* tags)
- X{ tags->etags_put(os);
- X return os;
- X}
- X
- X
- X////////////////////////////////////////////////////////////////////////////////
- X
- XTag_List*
- Xget_tags (const File& file)
- X{
- X Tag_List* tags = new Tag_List ();
- X Scope* scope = 0;
- X Scope* qualified = 0;
- X C_File_Pos pos (file);
- X C_File_Pos prev_id (pos);
- X while(pos.token != END_OF_FILE)
- X {
- X switch(pos.token)
- X {
- X case CLASS_KW:
- X case STRUCT_KW:
- X case UNION_KW:
- X pos.next_code();
- X if(pos.token == IDENTIFIER)
- X { C_File_Pos tag_name (pos);
- X do
- X { pos.next_code();
- X } while(pos.token != SEMI_COLON && pos.token != OPEN_BRACE && pos.token != END_OF_FILE);
- X if(pos.token == OPEN_BRACE)
- X { tags->inc(new Tag(tag_name, scope));
- X scope = new Scope(tag_name, scope);
- X }
- X }
- X else
- X { while(pos.token != SEMI_COLON && pos.token != OPEN_BRACE && pos.token != END_OF_FILE)
- X pos.next_code();
- X if(pos.token == OPEN_BRACE)
- X pos.close_brace();
- X }
- X break;
- X case ENUM_KW:
- X pos.next_code();
- X if(pos.token == IDENTIFIER)
- X { C_File_Pos tag_name (pos);
- X do
- X { pos.next_code();
- X } while(pos.token != SEMI_COLON && pos.token != OPEN_BRACE && pos.token != END_OF_FILE);
- X if(pos.token == OPEN_BRACE)
- X tags->inc(new Tag (tag_name, scope));
- X }
- X if(pos.token == OPEN_BRACE)
- X { while(pos.token != CLOSE_BRACE && pos.token != END_OF_FILE)
- X { pos.next_code();
- X if(pos.token == IDENTIFIER)
- X tags->inc(new Tag (pos, scope));
- X do
- X { pos.next_code();
- X } while(pos.token != COMMA && pos.token != CLOSE_BRACE && pos.token != END_OF_FILE);
- X }
- X }
- X while(pos.token != SEMI_COLON && pos.token != END_OF_FILE)
- X pos.next_code();
- X break;
- X case TYPEDEF_KW: // only catches last typedef (e.g 'c' in typedef int a, b, c;)
- X { C_File_Pos next (pos);
- X next.next_code();
- X do
- X { pos = next;
- X next.next_code();
- X } while(next.token != SEMI_COLON && next.token != OPEN_PARE && next.token != END_OF_FILE);
- X
- X if(next.token == OPEN_PARE && next.chars(1) == '*')
- X { // Function Typedef
- X next.next_code();
- X if(next.token == IDENTIFIER)
- X tags->inc(new Tag (next, scope));
- X }
- X
- X while(next.token != SEMI_COLON && next.token != END_OF_FILE)
- X { pos = next;
- X next.next_code();
- X }
- X
- X if(pos.token == IDENTIFIER)
- X tags->inc(new Tag (pos, scope));
- X pos = next;
- X }
- X break;
- X case DEFINE:
- X pos.next_code();
- X if(pos.token == IDENTIFIER || pos.token == DECLARE_MACRO || pos.token == DEFINE_MACRO)
- X tags->inc(new Tag (pos, scope));
- X pos.close_define();
- X break;
- X case CLOSE_BRACE:
- X if(scope) scope = scope->pop();
- X break;
- X case OPEN_BRACE:
- X pos.close_brace();
- X break;
- X case OPEN_PARE:
- X if(prev_id.token == IDENTIFIER)
- X { tags->inc(new Tag(prev_id, qualified));
- X prev_id = pos;
- X }
- X pos.close_pare();
- X pos.close_func();
- X break;
- X case COLONS:
- X if(prev_id.token == IDENTIFIER)
- X { qualified = new Scope(prev_id, qualified);
- X prev_id = pos;
- X }
- X break;
- X case IDENTIFIER:
- X if(prev_id.token != COLONS)
- X { delete qualified;
- X qualified = copy(scope);
- X }
- X prev_id = pos;
- X break;
- X case SEMI_COLON:
- X if(prev_id.token == IDENTIFIER)
- X { tags->inc(new Tag(prev_id, qualified));
- X prev_id = pos;
- X }
- X break;
- X case EQUAL:
- X if(prev_id.token == IDENTIFIER)
- X { tags->inc(new Tag(prev_id, qualified));
- X prev_id = pos;
- X }
- X pos.close_func();
- X break;
- X case NOTE:
- X pos.next_code();
- X if(pos.token == OPEN_PARE)
- X { pos.next_code();
- X if(pos.token == IDENTIFIER)
- X tags->inc(new Tag(pos, see_scope));
- X if(pos.token != CLOSE_PARE)
- X pos.close_pare();
- X }
- X while(pos.token != SEMI_COLON && pos.token != END_OF_FILE)
- X pos.next_code();
- X break;
- X case EXPORT:
- X pos.next_code();
- X if(pos.token == OPEN_PARE)
- X { do
- X { pos.next_code();
- X } while (pos.token != COMMA && pos.token != END_OF_FILE);
- X pos.next_code();
- X if(pos.token == IDENTIFIER)
- X tags->inc(new Tag(pos, exported_scope));
- X if(pos.token != CLOSE_PARE)
- X pos.close_pare();
- X }
- X while(pos.token != SEMI_COLON && pos.token != END_OF_FILE)
- X pos.next_code();
- X break;
- X case DECLARE_MACRO:
- X pos.next_code();
- X if(pos.token == OPEN_PARE)
- X { pos.next_code();
- X if(pos.token == IDENTIFIER)
- X tags->inc(new Tag(pos, scope));
- X if(pos.token != CLOSE_PARE)
- X pos.close_pare();
- X }
- X while(pos.token != SEMI_COLON && pos.token != END_OF_FILE)
- X pos.next_code();
- X break;
- X case DEFINE_MACRO:
- X pos.next_code();
- X if(pos.token == OPEN_PARE)
- X { pos.next_code();
- X if(pos.token == IDENTIFIER)
- X { qualified = new Scope (pos, 0);
- X while(pos.token != COMMA && pos.token != CLOSE_PARE && pos.token != END_OF_FILE)
- X pos.next_code();
- X if(pos.token == COMMA)
- X { pos.next_code();
- X if(pos.token == IDENTIFIER)
- X tags->inc(new Tag(pos, qualified));
- X }
- X qualified = qualified->pop();
- X }
- X if(pos.token != CLOSE_PARE)
- X pos.close_pare();
- X }
- X break;
- X case DEFINE_GET:
- X case DEFINE_GETSET:
- X pos.next_code();
- X if(pos.token == OPEN_PARE)
- X { while(pos.token != COMMA && pos.token != CLOSE_PARE && pos.token != END_OF_FILE)
- X pos.next_code();
- X if(pos.token == COMMA)
- X { pos.next_code();
- X if(pos.token == IDENTIFIER)
- X tags->inc(new Tag(pos, scope));
- X }
- X if(pos.token != CLOSE_PARE)
- X pos.close_pare();
- X }
- X break;
- X case DEFINE_SET:
- X case DEFINE_INC:
- X case DEFINE_DEC:
- X pos.next_code();
- X if(pos.token == OPEN_PARE)
- X pos.close_pare();
- X break;
- X default:
- X ;
- X }
- X pos.next_code();
- X }
- X return tags;
- X}
- X
- X
- X////////////////////////////////////////////////////////////////////////////////
- X
- Xvoid
- Xusage_error (const char* progname)
- X{ cerr << "Usage " << progname << " [-a] [-f outfile] [-k max_infile_kbytes] infile ..."
- X << endl;
- X exit(BAD);
- X}
- X
- X
- Xmain (int argc, char** argv)
- X{
- X unsigned argi = 0;
- X char* progname = argv[argi];
- X
- X // Default flags
- X Boolean append = FALSE;
- X const char* outfile = 0;
- X int size = 1024;
- X
- X // Process flags
- X for(argi = 1; argi < argc && argv[argi][0] == '-'; ++argi)
- X {
- X Boolean done = FALSE;
- X for(unsigned chari = 1; !done && argv[argi][chari]; ++chari)
- X {
- X switch(argv[argi][chari])
- X {
- X case '?':
- X case 'h':
- X usage_error(progname);
- X case 'a':
- X append = TRUE;
- X break;
- X case 'f':
- X if(outfile)
- X { cerr << "The -f option may only be given once." << endl;
- X usage_error(progname);
- X }
- X if(argv[argi][chari+1])
- X { done = TRUE;
- X outfile = &argv[argi][chari+1];
- X }
- X else if(argi < argc)
- X { done = TRUE;
- X outfile = argv[++argi];
- X }
- X else
- X { cerr << "The -f option must be given an argument (the outfile name)" << endl;
- X usage_error(progname);
- X }
- X break;
- X case 'k':
- X if(argv[argi][chari+1])
- X { done = TRUE;
- X size = atoi(&argv[argi][chari+1]);
- X }
- X else if(argi < argc)
- X { done = TRUE;
- X size = atoi(argv[++argi]);
- X }
- X else
- X { cerr << "The -k option must be given an argument (the max_file_size in kbytes)" << endl;
- X usage_error(progname);
- X }
- X break;
- X default:
- X ;
- X }
- X }
- X }
- X
- X // Arg value checks
- X if(size < 64)
- X size = 64;
- X if(!outfile)
- X outfile = "TAGS";
- X
- X // Create output TAGS file
- X ofstream out (outfile, (append ? ios::app : ios::out));
- X
- X // Create File for input
- X File infile (size*1024);
- X
- X // Process files
- X for(; argi < argc; ++argi)
- X {
- X infile.read(argv[argi]);
- X Tag_List* tags = get_tags(infile);
- X out << "\f\n" << argv[argi] << ',' << tags->etags_size() << '\n' << tags;
- X delete tags;
- X }
- X
- X out << flush;
- X
- X exit(GOOD);
- X}
- END_OF_FILE
- if test 13241 -ne `wc -c <'cie/etags++/etags++.c'`; then
- echo shar: \"'cie/etags++/etags++.c'\" unpacked with wrong size!
- fi
- # end of 'cie/etags++/etags++.c'
- fi
- if test -f 'cie/hier-mode.el' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'cie/hier-mode.el'\"
- else
- echo shar: Extracting \"'cie/hier-mode.el'\" \(11240 characters\)
- sed "s/^X//" >'cie/hier-mode.el' <<'END_OF_FILE'
- X;;; hier-mode.el
- X;;; Hierarchy mode (for hierarchies output by hier++)
- X
- X;;; See the docstring for defun hier-mode for a description.
- X
- X;;; Copyright (C) 1993, Intellection Inc.
- X;;;
- X;;; Author: Brian M Kennedy (kennedy@intellection.com)
- X;;;
- X;;; This program is free software; you can redistribute it and/or modify
- X;;; it under the terms of the GNU General Public License as published by
- X;;; the Free Software Foundation; either version 1, or (at your option)
- X;;; any later version.
- X;;;
- X;;; This program is distributed in the hope that it will be useful,
- X;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
- X;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- X;;; GNU General Public License for more details.
- X;;;
- X;;; A copy of the GNU General Public License can be obtained from the
- X;;; Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- X
- X;;; 92/08 Brian M Kennedy Added direct access commands; added sort to member list
- X;;; 92/06 Brian M Kennedy Original
- X;;; (using other GNU Emacs modes as a template)
- X
- X;;; Ideally, this mode should be rewritten based on outline.el, by simply setting
- X;;; a few of outline.el's variables. That would provide additional functionality
- X;;; such as hide/show. But to do it right, you should modify the other functions
- X;;; in this file to auto-show things being searched for (otherwise, hiding would
- X;;; be more a hindrance than a help).
- X
- X(provide 'hier-mode)
- X
- X(autoload 'visit-tags-table-buffer "tags")
- X(autoload 'prompt-for-tag "tags")
- X
- X
- X(defvar hier-mode-syntax-table nil
- X "Syntax table used while in hier mode.")
- X(if hier-mode-syntax-table
- X ()
- X (setq hier-mode-syntax-table (make-syntax-table))
- X )
- X
- X(defvar hier-mode-abbrev-table nil
- X "Abbrev table used while in bib mode.")
- X(define-abbrev-table 'hier-mode-abbrev-table ())
- X
- X(defvar hier-mode-map nil "")
- X(if hier-mode-map
- X ()
- X (setq hier-mode-map (make-sparse-keymap))
- X (define-key hier-mode-map "\M-h" 'hier-find)
- X (define-key hier-mode-map "\M-g" 'hier-find-again)
- X (define-key hier-mode-map "\M-m" 'hier-show-members)
- X (define-key hier-mode-map "\M-p" 'hier-previous-element)
- X (define-key hier-mode-map "\M-n" 'hier-next-element)
- X (define-key hier-mode-map "\M-u" 'hier-upto-parent)
- X )
- X
- X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- X
- X(defun hier-mode ()
- X "Major mode for viewing class hierarchy files output by hier++.
- XThe file is formatted like this:
- X
- X* class_a
- X * child_b :class_a
- X * child_c :class_a :class_f
- X * grandchild_d :child_c
- X * grandchild_e :child_c
- X* class_f
- X * child_c :class_a :class_f
- X * grandchild_d :child_c
- X * grandchild_e :child_c
- X * child_g :class_f
- X
- XClasses child_b and child_c are derived from class_a; classes child_c and
- Xchild_g are derived from class_f; classes grandchild_d and grandchild_e are
- Xboth derived from child_c. Note that each class (and all of its children)
- Xwill appear in the file once under each parent.
- X
- XDefined keys:
- XM-p moves to the previous sibling
- XM-n moves to the next sibling
- XM-u moves up to the parent
- XM-h finds the first occurrence of the hierarchy element for a class
- X (similar to M-. in behavior)
- XM-g finds the next occurrence (like M-,) in the case of multiple-inheritance.
- XM-m brings up a new window with a listing of all the members (both direct and
- X inherited) of that hierarchy entry. It does this via tags, so you must
- X have tags set up in Emacs. It will also only work properly if the tags
- X file was generated by etags++ (companion to hier++)."
- X (interactive)
- X (kill-all-local-variables)
- X (use-local-map hier-mode-map)
- X (setq mode-name "Hierarchy")
- X (setq major-mode 'hier-mode)
- X (setq local-abbrev-table hier-mode-abbrev-table)
- X (set-syntax-table hier-mode-syntax-table)
- X ;(run-hooks 'hier-mode-hook)
- X )
- X
- X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- X;; Find hierarchy elements
- X
- X;; Return a default name to search for, based on the text at point.
- X(defun hier-find-default ()
- X (save-excursion
- X (while (looking-at "\\sw\\|\\s_")
- X (forward-char 1))
- X (if (re-search-backward "\\sw\\|\\s_" nil t)
- X (progn (forward-char 1)
- X (buffer-substring (point)
- X (progn (forward-sexp -1)
- X (while (looking-at "\\s'")
- X (forward-char 1))
- X (point))))
- X nil)))
- X
- X(defun hier-find-element (string)
- X (let* ((default (hier-find-default))
- X (spec (read-string
- X (if default
- X (format "%s(default %s) " string default)
- X string))))
- X (list (if (equal spec "")
- X default
- X spec))))
- X
- X(defvar hier-last-find-element nil
- X "The last element searched for by hier-find.")
- X
- X(defun hier-find (element)
- X (interactive (hier-find-element "Find element: "))
- X (setq hier-last-find-element (concat "* " element " "))
- X (goto-char (point-min))
- X (hier-find-again)
- X )
- X
- X(defun hier-find-again ()
- X (interactive)
- X (if hier-last-find-element
- X (search-forward hier-last-find-element)))
- X
- X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- X;; Cursor movement through hierarchy
- X
- X(defun hier-previous-element (ignore)
- X "Goto previous hierarchy element at this level or higher."
- X (interactive "p")
- X (back-to-indentation)
- X (let ((indent (current-indentation)))
- X (previous-line 1)
- X (while (< indent (current-indentation))
- X (previous-line 1) ))
- X (back-to-indentation) )
- X
- X(defun hier-next-element (ignore)
- X "Goto next hierarchy element at this level or higher."
- X (interactive "p")
- X (back-to-indentation)
- X (let ((indent (current-indentation)))
- X (next-line 1)
- X (while (< indent (current-indentation))
- X (next-line 1) ))
- X (back-to-indentation) )
- X
- X(defun hier-upto-parent (arg)
- X "Goto the parent hierarchy element."
- X (interactive "p")
- X (let ((indent (current-indentation)))
- X (if (> indent 0)
- X (while (<= indent (current-indentation))
- X (forward-line -1) )))
- X (back-to-indentation) )
- X
- X
- X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- X;; Find Class Members
- X
- X(defun hier-regexp-list (&optional re-list)
- X (end-of-line)
- X (let ((eol (point)))
- X (back-to-indentation)
- X (forward-char 2)
- X (let ((re (concat "\C-a"
- X (buffer-substring (point) (progn (while (looking-at "\\sw\\|\\s_")
- X (forward-char 1))
- X (point) ))
- X "::")))
- X (setq re-list (cons re re-list))
- X (forward-word 1)
- X (while (<= (point) eol)
- X (forward-word -1)
- X (let ((start (point))
- X (end (progn (while (looking-at "\\sw\\|\\s_")
- X (forward-char 1))
- X (point) )) )
- X (save-excursion
- X (hier-find (buffer-substring start end))
- X (setq re-list (hier-regexp-list re-list)) ))
- X (forward-word 1) )
- X re-list)))
- X
- X
- X(defvar hier-members-column 30
- X "Column to line up member names in *Members List* buffer.")
- X
- X(defun hier-members-apropos (name re-list &optional data-members-only-p)
- X "Display list of all tags in tag table that regexp matches."
- X (save-excursion
- X (with-output-to-temp-buffer "*Members List*"
- X (if data-members-only-p
- X (princ "== Data Members of Class ")
- X (princ "== All Members of Class "))
- X (prin1 name)
- X (princ " ==")
- X (terpri)
- X (visit-tags-table-buffer)
- X (while re-list
- X (goto-char 1)
- X (while (re-search-forward (car re-list) nil t)
- X (skip-chars-backward "^\C-a")
- X (princ (buffer-substring (point)
- X (progn (end-of-line)
- X (point))))
- X (terpri)
- X (forward-line 1) )
- X (setq re-list (cdr re-list)) ))
- X (set-buffer "*Members List*")
- X ;; Remove Non-Data Members?
- X (if data-members-only-p
- X ;; remove lines not ending in "_" or "=" (title line)
- X (progn (goto-char (point-max))
- X (while (not (bobp))
- X (forward-char -2)
- X (if (not (looking-at "[_=]"))
- X (progn (forward-char 2)
- X (delete-region (point) (progn (forward-line -1) (point))))
- X (forward-line -1)))))
- X ;; Sort Buffer
- X (goto-line 2)
- X (sort-regexp-fields nil "^.*$" "::[^:\n]*$" (point) (point-max))
- X ;; Remove Duplicate Entries
- X (goto-line 2)
- X (while (not (save-excursion (forward-line 1) (eobp)))
- X (if (string-equal (buffer-substring (point) (progn (forward-line 1) (point)))
- X (buffer-substring (point) (progn (forward-line 1) (point))))
- X (delete-region (point) (progn (forward-line -1) (point))) )
- X (forward-line -1) )
- X ;; Line Up Colons
- X (goto-char (point-min))
- X (while (search-forward "::" nil t)
- X (let ((indent (- hier-members-column (current-column))))
- X (if (> indent 0)
- X (progn (beginning-of-line)
- X (indent-to-column indent) )))
- X (forward-line 1) )
- X ))
- X
- X
- X(defun hier-show-members (&optional data-members-only-p)
- X "Show the members, both direct and inherited, of this hierarchy element."
- X (interactive)
- X (save-excursion
- X (back-to-indentation)
- X (forward-char 2)
- X (let ((name (buffer-substring (point) (progn (while (looking-at "\\sw\\|\\s_")
- X (forward-char 1))
- X (point) ))) )
- X (hier-members-apropos name (hier-regexp-list) data-members-only-p) )))
- X
- X
- X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- X;; Auxiliary Functions
- X
- X(defun hier-base-list ()
- X "Returns a list of the names of all the direct base classes on the current line."
- X (save-excursion
- X (end-of-line)
- X (let ((base-list nil)
- X (eol (point)))
- X (back-to-indentation)
- X (forward-char 2)
- X (while (looking-at "\\sw\\|\\s_")
- X (forward-char 1))
- X (forward-word 1)
- X (while (<= (point) eol)
- X (forward-word -1)
- X (setq base-list (cons (buffer-substring (point)
- X (progn (while (looking-at "\\sw\\|\\s_")
- X (forward-char 1))
- X (point) ))
- X base-list))
- X (forward-word 1) )
- X base-list) ) )
- X
- X
- X(defun hier-derived-list ()
- X "Returns a list of the names of all the directly derived classes
- X from the one on the current line."
- X (save-excursion
- X (let ((derived-list nil)
- X (indent (current-indentation)))
- X (next-line 1)
- X (back-to-indentation)
- X (while (< indent (current-indentation))
- X (forward-char 2)
- X (setq derived-list (cons (buffer-substring (point)
- X (progn (while (looking-at "\\sw\\|\\s_")
- X (forward-char 1))
- X (point) ))
- X derived-list))
- X (hier-next-element 1) )
- X derived-list) ) )
- X
- X
- X;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- X;; External Functions
- X
- X(defvar hier-file-name nil
- X "The filename in which to find the class hierarchy generated by hier++.")
- X
- X(defun prompt-for-hier-file-name ()
- X "Get hier-file-name from user."
- X (setq hier-file-name
- X (read-file-name "File containing class hierarchy [typically CLASS.hier]: ")))
- X
- X(defun class-hierarchy (class-name)
- X "Display the hierarchy for the given class. M-g for next occurrence."
- X (interactive (list (prompt-for-tag "Display hierarchy for class: ")))
- X (if (not hier-file-name)
- X (prompt-for-hier-file-name))
- X (find-file-other-window hier-file-name)
- X (hier-find class-name))
- X
- X(defun class-members (class-name)
- X "Display all members for the given class."
- X (interactive (list (prompt-for-tag "Display all members for class: ")))
- X (save-excursion
- X (set-buffer (find-file-noselect hier-file-name))
- X (hier-find class-name)
- X (hier-show-members) ))
- X
- X(defun class-data-members (class-name)
- X "Display the data members for the given class."
- X (interactive (list (prompt-for-tag "Display data members for class: ")))
- X (save-excursion
- X (set-buffer (find-file-noselect hier-file-name))
- X (hier-find class-name)
- X (hier-show-members t) ))
- END_OF_FILE
- if test 11240 -ne `wc -c <'cie/hier-mode.el'`; then
- echo shar: \"'cie/hier-mode.el'\" unpacked with wrong size!
- fi
- # end of 'cie/hier-mode.el'
- fi
- if test -f 'cie/minibuffer-yank.el' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'cie/minibuffer-yank.el'\"
- else
- echo shar: Extracting \"'cie/minibuffer-yank.el'\" \(1845 characters\)
- sed "s/^X//" >'cie/minibuffer-yank.el' <<'END_OF_FILE'
- X;;; minibuffer-yank.el
- X
- X;;; Use this to yank the default or typical response into the minibuffer.
- X;;; In CIE, this is used to yank the default tag into the buffer. So, for
- X;;; example, you could type the "Class_Name::" and then C-c C-y to pull in
- X;;; the default which contained the unscoped tag. Or you could yank in the
- X;;; tag and edit it. And so on. It can also be used for many other things.
- X;;; By default it yanks in the current buffer file name (very convenient).
- X
- X;;; Copyright (C) 1993, Intellection Inc.
- X;;;
- X;;; Author: Walt Buehring
- X;;;
- X;;; This program is free software; you can redistribute it and/or modify
- X;;; it under the terms of the GNU General Public License as published by
- X;;; the Free Software Foundation; either version 1, or (at your option)
- X;;; any later version.
- X;;;
- X;;; This program is distributed in the hope that it will be useful,
- X;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
- X;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- X;;; GNU General Public License for more details.
- X;;;
- X;;; A copy of the GNU General Public License can be obtained from the
- X;;; Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- X
- X
- X;;; Minibuffer Yank
- X
- X(defvar minibuffer-yank-string nil
- X "Bound by commands to specify string yanked by \"minibuffer-yank\" instead
- Xof the buffer file name.")
- X
- X(defun minibuffer-yank ()
- X "Insert the value of 'minibuffer-yank-string' if non-nil, else the
- Xfilename of the buffer which invoked the minibuffer command."
- X (interactive)
- X ;; Use the previous buffer on the buffer list and ensure it has a
- X ;; filename associated with it.
- X (if minibuffer-yank-string
- X (insert minibuffer-yank-string)
- X (and (cdr (buffer-list))
- X (let ((f (buffer-file-name (car (cdr (buffer-list))))))
- X (and f
- X (insert (file-name-nondirectory f)))))))
- END_OF_FILE
- if test 1845 -ne `wc -c <'cie/minibuffer-yank.el'`; then
- echo shar: \"'cie/minibuffer-yank.el'\" unpacked with wrong size!
- fi
- # end of 'cie/minibuffer-yank.el'
- fi
- if test -f 'cie/tags.el' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'cie/tags.el'\"
- else
- echo shar: Extracting \"'cie/tags.el'\" \(24786 characters\)
- sed "s/^X//" >'cie/tags.el' <<'END_OF_FILE'
- X;; Tags facility for Emacs.
- X;; Copyright (C) 1985, 1986, 1988 Free Software Foundation, Inc.
- X
- X;; This file WAS part of some old GNU Emacs.
- X
- X;; GNU Emacs is distributed in the hope that it will be useful,
- X;; but WITHOUT ANY WARRANTY. No author or distributor
- X;; accepts responsibility to anyone for the consequences of using it
- X;; or for whether it serves any particular purpose or works at all,
- X;; unless he says so in writing. Refer to the GNU Emacs General Public
- X;; License for full details.
- X
- X;; Everyone is granted permission to copy, modify and redistribute
- X;; GNU Emacs, but only under the conditions described in the
- X;; GNU Emacs General Public License. A copy of this license is
- X;; supposed to have been given to you along with GNU Emacs so you
- X;; can know your rights and responsibilities. It should be in a
- X;; file named COPYING. Among other things, the copyright notice
- X;; and this notice must be preserved on all copies.
- X
- X;; $Id: tags.el,v 1.5 1993/05/13 17:22:55 kennedy Exp $
- X;;
- X;; NOTE:
- X;; 1. Quick fix inserted for C users. The problem is that in the tags line
- X;;
- X;; typedef char *string^?...
- X;;
- X;; `string' won't be an exact match, because the `*' is a word character
- X;; in the TAGS buffer (although not in a C source file). The quick fix is
- X;; in tag-exact-match-p; look for "HACK 7/19/89".
- X;; 2. Fixed tags-completion-alist problem 1/23/90.
- X
- X;; INTELLECTION MODS:
- X;;
- X;; 1) Prefers the tags named explicitly after C-A's at the end of each line.
- X;; This is true both for find-tag and for the completion-alist.
- X;; 2) Support for C++ scoping -- class::name is considered a tag and both
- X;; class::name and name are matches (class::name preferred though).
- X;; 3) Support for completion of scoped names as well as unscoped names.
- X;; That is, the alist contains both the fully-scoped name, and each
- X;; subname (c1::c2::mem => c1::c2::mem, c2::mem, and mem in the alist).
- X;; 4) Added mechanism to save out the completion alist into TAGS.alist
- X;; which is checked for when loading TAGS to prevent the need to rebuild
- X;; the alist (which can take a while with large systems). As an added
- X;; advantage, this mechanism removes duplicates from the alist before
- X;; saving it out (making it faster and much smaller).
- X
- X
- X(provide 'tags)
- X
- X(defvar tags-prompt-with-initial-input nil
- X "*When non-nil, supply default tag as initial input when prompting")
- X
- X;; Tag table state.
- X
- X(defun initialize-new-tag-table ()
- X "Call when the tag table changes."
- X (setq tag-table-files nil
- X find-tag-state nil
- X tag-order nil
- X tag-lines-already-matched nil)
- X (make-local-variable 'tags-completion-alist) )
- X
- X(defun save-tags-state ()
- X "Returns an object that can later be passed to `restore-tags-state'."
- X (vector tag-order
- X tag-lines-already-matched
- X tag-table-files
- X find-tag-state
- X next-file-list))
- X
- X(defun restore-tags-state (state)
- X "Restore from an object created by `save-tags-state'."
- X (setq tag-order (aref state 0)
- X tag-lines-already-matched (aref state 1)
- X tag-table-files (aref state 2)
- X find-tag-state (aref state 3)
- X next-file-list (aref state 4)))
- X
- X(defvar tag-order nil
- X "List of functions to use in partitioning the set of tag matches.")
- X
- X(defvar tag-lines-already-matched nil
- X "List of lines within the tag table that are already matched.")
- X
- X(defvar tag-table-files nil
- X "List of file names covered by current tags table.
- Xnil means it has not been computed yet; do (tag-table-files) to compute it.")
- X
- X(defvar tags-completion-alist nil
- X "Alist of tag names defined in current tags table.")
- X
- X(defvar find-tag-state nil
- X "Some of the state of the last find-tag, find-tag-other-window, or
- Xfind-tag-regexp. This is a vector whose 0th element is the last tagname
- Xor regexp used.")
- X
- X(defvar tags-table-file-list nil
- X "Alist of tags table file names for \\[select-tags-table].
- XEach element is a list containing one element, a file name.
- XAny tags table file you visit is automatically added to this list.
- XYou can also add names yourself.")
- X
- X(defvar next-file-list nil
- X "List of files for \\[next-file] to process.")
- X
- X
- X
- X(defun visit-tags-table (file)
- X "Tell tags commands to use tags table file FILE.
- XFILE should be the name of a file created with the `etags' program.
- XA directory name is ok too; it means file TAGS in that directory."
- X (interactive (list (read-file-name "Visit tags table: (default TAGS) "
- X default-directory
- X (expand-file-name "TAGS" default-directory)
- X t)))
- X (setq file (expand-file-name file default-directory))
- X (if (file-directory-p file)
- X (setq file (expand-file-name "TAGS" file)))
- X ;; Add an element to TAGS-TABLE-FILE-LIST.
- X (or (assoc file tags-table-file-list)
- X (setq tags-table-file-list
- X (cons (list file) tags-table-file-list)))
- X (setq tags-file-name file)
- X (save-excursion
- X (visit-tags-table-buffer)))
- X
- X
- X(defun visit-tags-table-buffer ()
- X "Select the buffer containing the current tags table.
- XThis is a file whose name is in the variable tags-file-name."
- X (or tags-file-name
- X (call-interactively 'visit-tags-table))
- X (let ((new-file nil))
- X (set-buffer (or (get-file-buffer tags-file-name)
- X (progn
- X (initialize-new-tag-table)
- X (setq new-file t)
- X (find-file-noselect tags-file-name))))
- X (or (not new-file)
- X (progn
- X (initialize-new-tag-table)
- X ;; reclaim memory from old alist before creating new.
- X (setq tags-completion-alist nil)
- X (garbage-collect)
- X (setq tags-completion-alist (tags-completion-alist)))))
- X (or (verify-visited-file-modtime (get-file-buffer tags-file-name))
- X (cond ((yes-or-no-p "Tags file has changed, read new contents? ")
- X (revert-buffer t t)
- X (initialize-new-tag-table)
- X ;; reclaim memory from old alist before creating new.
- X (setq tags-completion-alist nil)
- X (garbage-collect)
- X (setq tags-completion-alist (tags-completion-alist)))))
- X (or (eq (char-after 1) ?\^L)
- X (error "File %s not a valid tag table" tags-file-name)))
- X
- X
- X(defun file-of-tag ()
- X "Return the file name of the file whose tags point is within.
- XAssumes the tag table is the current buffer.
- XFile name returned is relative to tag table file's directory."
- X (save-excursion
- X (search-backward "\f\n")
- X (forward-char 2)
- X (buffer-substring (point)
- X (progn (skip-chars-forward "^,") (point)))))
- X
- X(defun tag-table-files ()
- X "Return a list of files in the current tag table.
- XFile names returned are absolute."
- X (or tag-table-files
- X (save-excursion
- X (visit-tags-table-buffer)
- X (let (files)
- X (goto-char (point-min))
- X (while (search-forward "\f\n" nil t)
- X (setq files (cons (expand-file-name
- X (buffer-substring
- X (point)
- X (progn (skip-chars-forward "^,\n") (point)))
- X (file-name-directory tags-file-name))
- X files)))
- X (setq tag-table-files (nreverse files))))))
- X
- X(defun tags-completion-alist ()
- X "Return an alist of tags in the current buffer, which is a tag table."
- X ; BMK: read alist if a .alist file exists and is newer
- X (let ((alist nil)
- X (alist-file (concat buffer-file-name ".alist")))
- X (if (and (file-readable-p alist-file)
- X (file-newer-than-file-p alist-file buffer-file-name))
- X (load-file alist-file)
- X (let ((gc-cons-threshold 1000000)
- X (next nil))
- X (message "Making tags completion alist...")
- X (save-excursion
- X (goto-char (point-min))
- X (while (search-forward "\177" nil t)
- X (if (save-excursion
- X (skip-chars-forward "^\001\n")
- X (setq next (1+ (point)))
- X (= (following-char) ?\001))
- X ;; If there are ^A's, get tags after them.
- X ;; BMK: for each, get each subscoped tag down to id
- X (progn
- X (goto-char next) ;; after the first ^A
- X (while (= (preceding-char) ?\001)
- X (while (not (looking-at "[\001\n]"))
- X (skip-chars-forward ":")
- X (setq alist
- X (cons (cons (buffer-substring (point)
- X (save-excursion
- X (skip-chars-forward "^\001\n")
- X (point)))
- X nil)
- X alist))
- X (skip-chars-forward "^:\001\n"))
- X (forward-char 1)))
- X ;; If no ^A's, get tags from before the ^?.
- X (skip-chars-backward "^-A-Za-z0-9_$:~\n")
- X (or (bolp)
- X (setq alist
- X (cons (cons (buffer-substring
- X (point)
- X (progn
- X (skip-chars-backward "-A-Za-z0-9_$:~")
- X (point)))
- X nil)
- X alist)))
- X (goto-char next) ; next line
- X )))
- X (message "Making tags completion alist...done")))
- X alist) )
- X
- X(defun tags-alist-less-p (a b)
- X (string< (car a) (car b)))
- X
- X(defun save-tags-completion-alist ()
- X "Save out a .alist file for this tags table."
- X (interactive)
- X (save-excursion
- X (visit-tags-table-buffer)
- X ;; sort list then eliminate duplicates
- X (message "Removing duplicates from tags completion alist...")
- X (setq tags-completion-alist
- X (sort tags-completion-alist 'tags-alist-less-p))
- X (let ((l tags-completion-alist))
- X (while (and l (cdr l))
- X ;; compare current element to next
- X (if (not (string= (car (car l)) (car (car (cdr l)))))
- X ;; no match, proceed to next element
- X (setq l (cdr l))
- X ;; match, drop next element.
- X (setcdr l (cdr (cdr l))))))
- X (garbage-collect)
- X ;; generate lisp form that will recreate the completion alist
- X (let* ((alist-file (concat buffer-file-name ".alist"))
- X (alist-buffer (get-buffer-create "*TAGS-alist*")) )
- X (prin1 (list 'setq 'alist (list 'quote tags-completion-alist))
- X alist-buffer)
- X (terpri alist-buffer)
- X (set-buffer alist-buffer)
- X (write-file alist-file)
- X (kill-buffer alist-buffer) ) )
- X )
- X
- X
- X;; BMK: give completing-read an initial input
- X(defun prompt-for-tag (prompt)
- X "Prompt for a tag to find. Default is determined by find-tag-default."
- X (let* ((default (find-tag-default))
- X (alist (save-excursion (visit-tags-table-buffer)
- X tags-completion-alist))
- X (read-prompt (if (or (not default) tags-prompt-with-initial-input)
- X prompt
- X (format "%s(default %s) " prompt default)))
- X (initial-input (if tags-prompt-with-initial-input default nil))
- X (minibuffer-yank-string default)
- X spec)
- X (setq spec (completing-read read-prompt
- X ;; completing-read craps out if given a nil table
- X (or alist '(("")))
- X nil
- X nil
- X initial-input))
- X (if (equal spec "")
- X (if (or tags-prompt-with-initial-input (null default))
- X (error "No tag specified.")
- X default)
- X spec)))
- X
- X
- X;; Return a default tag to search for, based on the text at point, or nil.
- X;; BMK: Grab fully-scoped C++ tags as the default.
- X;; This is highly preferable. The old function is below.
- X(defun find-tag-default ()
- X (save-excursion
- X ; Find end of default tag
- X (if (looking-at "\\sw\\|\\s_")
- X (while (looking-at "\\sw\\|\\s_")
- X (forward-char 1))
- X (progn (while (and (not (bobp)) (not (looking-at "\\sw\\|\\s_")))
- X (forward-char -1))
- X (if (and (not (eobp)) (looking-at "\\sw\\|\\s_"))
- X (forward-char 1) )))
- X (if (bobp) ; no tag found
- X nil
- X (let ((end-point (point)))
- X (forward-char -1)
- X (while (and (not (bobp)) (looking-at "\\sw\\|\\s_\\|:"))
- X (forward-char -1))
- X (while (not (looking-at "\\sw\\|\\s_"))
- X (forward-char 1))
- X (if (looking-at "[A-Z]\\|[a-z]\\|:\\s_")
- X (buffer-substring (point) end-point)
- X nil)))))
- X
- X;;(defun find-tag-default ()
- X;; (save-excursion
- X;; (while (looking-at "\\sw\\|\\s_")
- X;; (forward-char 1))
- X;; (if (re-search-backward "\\sw\\|\\s_" nil t)
- X;; (progn (forward-char 1)
- X;; (buffer-substring (point)
- X;; (progn (forward-sexp -1)
- X;; (while (looking-at "\\s'")
- X;; (forward-char 1))
- X;; (point))))
- X;; nil)))
- X
- X
- X(defun find-tag (tagname &optional next-p other-window regexp-p)
- X "Find tag (in current tag table) whose name contains TAGNAME;
- Xmore exact matches are found first.
- XSelect the buffer containing the tag's definition and move point there.
- XThe default for TAGNAME is the expression in the buffer after or around point.
- X
- XIf second arg NEXT-P is non-nil (interactively, with prefix arg), search
- Xfor another tag that matches the last tagname or regexp used.
- X
- XIf third arg OTHER-WINDOW is non-nil, select the buffer in another window.
- X
- XIf fourth arg REGEXP-P is non-nil, treat TAGNAME as a regexp.
- X
- XSee documentation of variable `tags-file-name'."
- X (interactive (if current-prefix-arg
- X '(nil t)
- X (list (prompt-for-tag "Find tag: "))))
- X (cond
- X (next-p (find-tag-in-order nil nil nil nil nil other-window))
- X (regexp-p (find-tag-in-order tagname
- X 're-search-forward
- X '(tag-re-match-p)
- X t
- X "matching"
- X other-window))
- X (t
- X (find-tag-in-order
- X tagname
- X 'search-forward
- X '(tag-exact-match-rhs-p
- X tag-member-match-rhs-p
- X tag-exact-match-p
- X tag-word-match-p
- X tag-any-match-p)
- X nil
- X "containing"
- X other-window))))
- X
- X(defun find-tag-other-window (tagname &optional next-p)
- X "Find tag (in current tag table) whose name contains TAGNAME;
- Xmore exact matches are found first.
- XSelect the buffer containing the tag's definition
- Xin another window, and move point there.
- XThe default for TAGNAME is the expression in the buffer around or before point.
- X
- XIf second arg NEXT-P is non-nil (interactively, with prefix arg), search
- Xfor another tag that matches the last tagname used.
- X
- XSee documentation of variable `tags-file-name'."
- X (interactive (if current-prefix-arg
- X '(nil t)
- X (list (prompt-for-tag "Find tag other window: "))))
- X (find-tag tagname next-p t))
- X
- X(defun find-tag-regexp (regexp &optional next-p other-window)
- X "Find tag (in current tag table) whose name matches REGEXP.
- XSelect the buffer containing the tag's definition and move point there.
- X
- XIf second arg NEXT-P is non-nil (interactively, with prefix arg), search
- Xfor another tag that matches the last tagname used.
- X
- XIf third arg OTHER-WINDOW is non-nil, select the buffer in another window.
- X
- XSee documentation of variable `tags-file-name'."
- X (interactive (if current-prefix-arg
- X '(nil t)
- X (list (read-string "Find tag regexp: "))))
- X (find-tag regexp next-p other-window t))
- X
- X(defun find-tag-in-order
- X (pattern search-forward-func order next-line-after-failure-p matching other-window)
- X "Internal tag finding function. PATTERN is a string to pass to
- Xsecond arg SEARCH-FORWARD-FUNC, and to any member of the function list
- XORDER (third arg). If ORDER is nil, use saved state to continue a
- Xprevious search.
- X
- XFourth arg MATCHING is a string, an English '-ing' word, to be used in
- Xan error message.
- X
- XFifth arg NEXT-LINE-AFTER-FAILURE-P is non-nil if after a failed match,
- Xpoint should be moved to the next line.
- X
- XIf sixth arg OTHER-WINDOW is non-nil, select the buffer in another window.
- X
- XAlgorithm is as follows. For each qualifier-func in ORDER, go to
- Xbeginning of tags file, and perform inner loop: for each naive match for
- XPATTERN found using SEARCH-FORWARD-FUNC, qualify the naive match using
- Xqualifier-func. If it qualifies, go to the specified line in the
- Xspecified source file and return. Qualified matches are remembered to
- Xavoid repetition. State is saved so that the loop can be continued."
- X (let (file linebeg startpos)
- X (save-excursion
- X (visit-tags-table-buffer)
- X (if order
- X (progn
- X ;; Save state.
- X (setq find-tag-state (vector pattern search-forward-func matching)
- X tag-order order
- X tag-lines-already-matched nil)
- X ;; Start at beginning of tags file.
- X (goto-char (point-min)))
- X (progn
- X ;; Restore state.
- X (setq pattern (aref find-tag-state 0)
- X search-forward-func (aref find-tag-state 1)
- X matching (aref find-tag-state 2))))
- X
- X ;; Get a qualified match.
- X (catch 'qualified-match-found
- X (while (car tag-order)
- X (while (funcall search-forward-func pattern nil t)
- X ;; Naive match found.
- X (if (and
- X ;; Qualify the match.
- X (funcall (car tag-order) pattern)
- X ;; Make sure it is not a previous qualified match.
- X ;; Use of `memq' depends on numbers being eq.
- X (not (memq (save-excursion (beginning-of-line) (point))
- X tag-lines-already-matched)))
- X (throw 'qualified-match-found nil))
- X (if next-line-after-failure-p (forward-line 1)))
- X (setq tag-order (cdr tag-order))
- X (goto-char (point-min)))
- X (error "No %stags %s %s" (if order "" "more ") matching pattern))
- X
- X ;; Found a tag; extract location info.
- X (beginning-of-line)
- X (setq tag-lines-already-matched (cons (point) tag-lines-already-matched))
- X (search-forward "\177")
- X (setq file (expand-file-name (file-of-tag)
- X (file-name-directory tags-file-name)))
- X (setq linebeg
- X (buffer-substring (1- (point))
- X (save-excursion (beginning-of-line) (point))))
- X (search-forward ",")
- X (setq startpos (string-to-int (buffer-substring
- X (point)
- X (progn (skip-chars-forward "0-9")
- X (point)))))
- X ;; Leave point on next line of tags file.
- X (forward-line 1))
- X
- X ;; Find the right line in the specified file.
- X (if other-window
- X (find-file-other-window file)
- X (find-file file))
- X (widen)
- X (push-mark)
- X
- X (let ((offset 16) ;; this constant is 1/2 the initial search window
- X found
- X (pat (concat "^" (regexp-quote linebeg))))
- X (or startpos (setq startpos (point-min)))
- X (while (and (not found)
- X (progn
- X (goto-char (- startpos offset))
- X (not (bobp))))
- X (setq found
- X (re-search-forward pat (+ startpos offset (length pat)) t))
- X (setq offset (* 4 offset))) ;; expand search window
- X (or found
- X (re-search-forward pat nil t)
- X (error "\"%s\" not found in %s; time to rerun etags" pat file)))
- X (beginning-of-line))
- X (setq tags-loop-form '(find-tag-in-order nil nil nil nil nil nil))
- X ;; Return t in case used as the tags-loop-form.
- X t)
- X
- X;;; Match qualifier functions for tagnames.
- X
- X(defun tag-exact-match-rhs-p (tag)
- X "Did we find an exact, case sensitive match for TAG following a Control-A?
- XAssume point is in a tags file, immediately after an occurence of TAG."
- X (let ((tag-length (length tag)))
- X (and (looking-at "[\001\n]")
- X (save-excursion
- X (backward-char tag-length)
- X (and (= (preceding-char) ?\001)
- X (let ((case-fold-search nil))
- X (looking-at tag)))))))
- X
- X(defun tag-member-match-rhs-p (tag)
- X "Did we find an exact, case sensitive match for TAG following a colon following a Control-A?
- XAssume point is in a tags file, immediately after an occurence of TAG."
- X (let ((tag-length (length tag)))
- X (and (looking-at "[\001\n]")
- X (save-excursion
- X (backward-char tag-length)
- X (and (or (= (preceding-char) ?\001) (= (preceding-char) ?:))
- X (let ((case-fold-search nil))
- X (looking-at tag)))))))
- X
- X
- X(defun tag-exact-match-p (tag)
- X "Did we find an exact match for TAG? Assume point is in a tags file,
- Ximmediately after an occurence of TAG."
- X (let ((tag-length (length tag)))
- X (or (and (looking-at "[ \t();,]?\177")
- X (save-excursion (backward-char tag-length)
- X (or (bolp)
- X (let ((c (preceding-char)))
- X (or (= c ? ) (= c ?\t)
- X (= c ?*) ;; HACK 7/19/89
- X )))))
- X (and (looking-at "[\001\n]")
- X (save-excursion (backward-char tag-length)
- X (= (preceding-char) ?\001))))))
- X
- X(defun tag-word-match-p (tag)
- X "Did we find a word match for TAG? Assume point is in a tags file,
- Ximmediately after an occurence of TAG."
- X (let ((tag-length (length tag)))
- X (or (and (looking-at "\\b.*\177")
- X (save-excursion (backward-char tag-length)
- X (looking-at "\\b")))
- X (and (looking-at "\\b.*[\001\n]")
- X (save-excursion (backward-char tag-length)
- X (and
- X (looking-at "\\b")
- X (progn
- X (skip-chars-backward "^\001\n")
- X (= (preceding-char) ?\001))))))))
- X
- X(defun tag-any-match-p (tag)
- X "Did we find any match for TAG? Assume point is in a tags file,
- Ximmediately after an occurence of TAG."
- X (or (looking-at ".*\177")
- X (save-excursion
- X (backward-char (length tag))
- X (skip-chars-backward "^\001\n")
- X (= (preceding-char) ?\001))))
- X
- X;;; Match qualifier function for regexps.
- X
- X(defun tag-re-match-p (re)
- X "Is point (in a tags file) on a line with a match for RE?"
- X (save-excursion
- X (beginning-of-line)
- X (catch 'done
- X (let* ((bol (point))
- X (eol (save-excursion (end-of-line) (point)))
- X (del (save-excursion (if (search-forward "\177" eol t)
- X (point)
- X (throw 'done nil)))))
- X (if (search-forward "\001" eol t)
- X ;; There are ^A's: try to match in each tag after a ^A
- X (let ((bot (point))
- X eot)
- X (while (< bot eol)
- X (save-excursion
- X (setq eot (if (search-forward "\001" eol t)
- X (1- (point))
- X eol))
- X (if (re-search-forward re eot t)
- X (throw 'done t))
- X (setq bot (1+ eot))
- X (goto-char bot))))
- X ;; No ^A: try to match the line before the ^?
- X (goto-char bol)
- X (re-search-forward re (1- del) t))))))
- X
- X(defun next-file (&optional initialize)
- X "Select next file among files in current tag table.
- XNon-nil argument (prefix arg, if interactive)
- Xinitializes to the beginning of the list of files in the tag table."
- X (interactive "P")
- X (if initialize
- X (setq next-file-list (tag-table-files)))
- X (or next-file-list
- X (error "All files processed."))
- X (find-file (car next-file-list))
- X (setq next-file-list (cdr next-file-list)))
- X
- X(defvar tags-loop-form nil
- X "Form for tags-loop-continue to eval to process one file.
- XIf it returns nil, it is through with one file; move on to next.")
- X
- X(defun tags-loop-continue (&optional first-time)
- X "Continue last \\[find-tag], \\[tags-search], or
- X\\[tags-query-replace] command. Used noninteractively with non-nil
- Xargument to begin such a command. See variable `tags-loop-form'."
- X (interactive)
- X (if first-time
- X (progn (next-file t)
- X (goto-char (point-min))))
- X (while (not (eval tags-loop-form))
- X (next-file)
- X (message "Scanning file %s..." buffer-file-name)
- X (goto-char (point-min))))
- X
- X(defun tags-search (regexp)
- X "Search through all files listed in tag table for match for REGEXP.
- XStops when a match is found.
- XTo continue searching for next match, use command \\[tags-loop-continue].
- X
- XSee documentation of variable tags-file-name."
- X (interactive "sTags search (regexp): ")
- X (if (and (equal regexp "")
- X (eq (car tags-loop-form) 're-search-forward))
- X (tags-loop-continue nil)
- X (setq tags-loop-form
- X (list 're-search-forward regexp nil t))
- X (tags-loop-continue t)))
- X
- X(defun tags-query-replace (from to)
- X "Query-replace-regexp FROM with TO through all files listed in tag table.
- XIf you exit (C-G or ESC), you can resume the query-replace
- Xwith the command \\[tags-loop-continue].
- X
- XSee documentation of variable tags-file-name."
- X (interactive "sTags query replace (regexp): \nsTags query replace %s by: ")
- X (setq tags-loop-form
- X (list 'and (list 'save-excursion
- X (list 're-search-forward from nil t))
- X (list 'not (list 'perform-replace from to t t nil))))
- X (tags-loop-continue t))
- X
- X(defun list-tags (string)
- X "Display list of tags in file FILE.
- XFILE should not contain a directory spec
- Xunless it has one in the tag table."
- X (interactive "sList tags (in file): ")
- X (with-output-to-temp-buffer "*Tags List*"
- X (princ "Tags in file ")
- X (princ string)
- X (terpri)
- X (save-excursion
- X (visit-tags-table-buffer)
- X (goto-char 1)
- X (search-forward (concat "\f\n" string ","))
- X (forward-line 1)
- X (while (not (looking-at "\f"))
- X (princ (buffer-substring (point)
- X (progn (skip-chars-forward "^\177")
- X (point))))
- X (terpri)
- X (forward-line 1)))))
- X
- X(defun tags-apropos (string)
- X "Display list of all tags in tag table REGEXP matches."
- X (interactive "sTag apropos (regexp): ")
- X (with-output-to-temp-buffer "*Tags List*"
- X (princ "Tags matching regexp ")
- X (prin1 string)
- X (terpri)
- X (save-excursion
- X (visit-tags-table-buffer)
- X (goto-char 1)
- X (while (re-search-forward string nil t)
- X (beginning-of-line)
- X (princ (buffer-substring (point)
- X (progn (skip-chars-forward "^\177")
- X (point))))
- X (terpri)
- X (forward-line 1)))))
- X
- X(defun select-tags-table ()
- X "Select a tags table file from a menu of those you have already used.
- XThe list of tags tables to select from is stored in `tags-table-file-list';
- Xsee the doc of that variable if you want to add names to the list."
- X (interactive)
- X (switch-to-buffer "*Tags Table List*")
- X (erase-buffer)
- X (let ((list tags-table-file-list))
- X (while list
- X (insert (car (car list)) "\n")
- X (setq list (cdr list))))
- X (goto-char 1)
- X (insert "Type `t' to select a tag table:\n\n")
- X (set-buffer-modified-p nil)
- X (let ((map (make-sparse-keymap)))
- X (define-key map "t" 'select-tags-table-select)
- X (use-local-map map)))
- X
- X(defun select-tags-table-select ()
- X "Select the tag table named on this line."
- X (interactive)
- X (let ((name (buffer-substring (point)
- X (save-excursion (end-of-line) (point)))))
- X (visit-tags-table name)
- X (message "Tag table now %s" name)))
- X
- X
- END_OF_FILE
- if test 24786 -ne `wc -c <'cie/tags.el'`; then
- echo shar: \"'cie/tags.el'\" unpacked with wrong size!
- fi
- # end of 'cie/tags.el'
- fi
- echo shar: End of archive 1 \(of 2\).
- cp /dev/null ark1isdone
- MISSING=""
- for I in 1 2 ; do
- if test ! -f ark${I}isdone ; then
- MISSING="${MISSING} ${I}"
- fi
- done
- if test "${MISSING}" = "" ; then
- echo You have unpacked both archives.
- rm -f ark[1-9]isdone
- else
- echo You still must unpack the following archives:
- echo " " ${MISSING}
- fi
- exit 0
- exit 0 # Just in case...
-