From: eyvind.ness@hrp.NO (Eyvind Ness)
Subject: etags for CLOS and C++?
Reply-To: Eyvind.Ness@hrp.no
Organization: Source only  Discussion and requests in gnu.emacs.help.
Distribution: gnu
Date: Tue, 15 Sep 1992 20:32:00 GMT

  | Date: Wed, 2 September 92,  9:11 GMT
  | From: Eyvind Ness
  |
  |   | Date: Tue, 1 Sep 92 09:27:23 -0500
  |   | From: liberte@cs.uiuc.edu
  |   | 
  |   | C++ is difficult, but someone will tell you about a version of etags that
  |   | does it.  For CLOS, maybe add a function to my tagify.el.
  | 
  | Thank you. This looks promising. I will try to write a make-clos-tag and
  | make-c++-tag function the next spare minute I get ;-)

Here is the results of my efforts making Dan's tagify util work with
CLOS and with Brad's nice taglist util.

This mail contains three files that should be installed somwhere along
your `load-path':

	tagify.el - a modified version of Dan's original tagify program
	cl-programming-utils.el - a few extra auxiliary functions
	gobble-whitespace.el - same

Enjoy.

Eyvind.

+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
 Eyvind Ness                    Internet Email: Eyvind.Ness@HRP.No
 Research Scientist             Phone: +47 9 183100
 Control Room Systems Division  Fax: +47 9 187109
 OECD Halden Reactor Project    Snail Mail: P.O. Box 173, N-1751 Halden
 Norway
+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=

;Author: Eyvind Ness (eyvind) 
;Date:   Thursday, September 3 1992 08:37 GMT
;File:   /usr/local/gnu/emacs/elisp/site-extensions/tagify.el

;; tagify.el  - make TAGS files.
;; Copyright (C) 1989 Daniel LaLiberte
;;;
;;; Modified by Eyvind Ness, a number of bugs removed, support for
;;; taglist by bmears@deltahp.jsc.nasa.gov (Brad Mears) added,
;;; compatibility with clpu-make-export-list added.

;;-----------------------------------------------------------------
;; To build a TAGS file for a set of files, first make sure there is a
;; make-tag function associated with the major mode for each file.
;; These are stored in tagify-mode-alist. Then call tagify-files.  You
;; will be asked for a list of file names and the TAGS file.  The TAGS
;; file is saved for you after it is created.  If a major-mode does
;; not have a make-tag function, you will be asked to name one that
;; will be used for the remainder of the files.

;; To update the TAGS file, use retagify-files.  You are asked to
;; specify the TAGS file.  retagify-files will then regenerate
;; tags for just those files in the TAGS file that are newer than the TAGS
;; file.

;; Daniel LaLiberte
;; uiucdcs!liberte
;; liberte@cs.uiuc.edu
;; liberte%a.cs.uiuc.edu@uiucvmd.bitnet

;; Need:
;; add-file-tags filenames
;; delete-file-tags filenames

(require 'cl-programming-utils)
(provide 'tagify)

(defconst tagify-mode-alist '
  ((texinfo-mode . make-texinfo-tag)
   (c-mode . make-c-tag)
   (emacs-lisp-mode . make-elisp-tag)
   (lisp-mode . make-clos-tag)
   (common-lisp-mode . make-clos-tag)
   )
  "Association list between major modes and tag matching functions.
The function should find the next tag and return it, or return nil if
there are no more tags for the current buffer.  The tag is only used
to sort the entries for each file.  The function should leave point
after the tag.")

;; -----------------------------------------------
;; Example make-tag functions

(defun make-texinfo-tag ()
  "Function to make next texinfo tag."
  (if (re-search-forward
       "^@def\\(un\\|var\\|opt\\|const\\|cmd\\|spec\\) \\([^ \n]+\\) ?\\|^@node \\([^,]+\\)" nil t)
      (if (match-beginning 2)
	  (buffer-substring (match-beginning 2)
			    (match-end 2))
	;; @node found
	(buffer-substring (match-beginning 3)
			  (match-end 3)))
    ))

(defun make-info-tag ()
  "Function to make next tag for an info file."
  (if (re-search-forward
       "^\\* \\(Function\\|Command\\|Macro\\|Special form\\|Variable\\|Option\\|Constant\\): \\([^ \n]+\\) ?" nil t)
      (buffer-substring (match-beginning 2)
			(match-end 2))
    ))

(defun make-elisp-tag ()
  "Function to make the next tag for an elisp file."
  (if (re-search-forward
       "^ ?(def\\w* \\([^ \n]+\\) ?" nil t)
      (buffer-substring (match-beginning 1)
			(match-end 1))
    ))

(defun make-clos-tag ()
  (clpu-next-def))

(defun make-c-tag-not-done ()
  "Function to make next c tag."
  ;; #defines are the easy part
  ;; I dont know how to match function declarations
  (if (re-search-forward
       "^[ \t]*#define[ \t]+\\([a-zA-Z_]+\\)")
      (buffer-substring (match-beginning 1)
			(match-end 1))))

;;-----------------------------------------------------------

(defun find-tags-table (file)
    "Tell tags commands to use tag table file FILE.
FILE should be the name of a file created with the `etags' program,
or tagify-files, or it may be a new file.
A directory name is ok too; it means file TAGS in that directory."
  (interactive (list (read-file-name "Find tags table: (default TAGS) "
				     default-directory
				     (concat default-directory "TAGS")
				     nil)))
  (setq file (expand-file-name file))
  (if (file-directory-p file)
      (setq file (concat file "TAGS")))
  (setq tag-table-files nil
	tags-file-name file))

(defconst find-tags-table-hook 'find-tags-table
  "Function to call to find the TAGS file.")


(defun tagify-files (filenames &optional TAGS-file-name)
  "Make a tags file from files listed in FILENAMES.  
The existing tags file, if any, is replaced.
FILENAMES are files to search for tags.  The FILENAMES argument may
actually specify several files, with shell wildcards, e.g. \"*.c *.h\".
Paths may be either absolute or relative to the current directory.
How to make tags is determined from tagify-mode-alist and the major mode
of each file."

  (interactive "sMake TAGS for files: ")
  (let (TAGS-buffer
	tag-entries
	(all-tag-entries nil)
	file
	(file-list (if (stringp filenames)
		       (files-matching filenames)
		       filenames))
	tagifier
	(local-tagify-alist tagify-mode-alist)  ; may be added to
	)
    (save-excursion
      ;; find and erase the TAGS file
      (if TAGS-file-name
	  (funcall find-tags-table-hook TAGS-file-name)    
	  (call-interactively find-tags-table-hook))
      (set-buffer (or (get-file-buffer tags-file-name)
		      (progn
			(setq tag-table-files nil)
			(find-file-noselect tags-file-name))))
      (setq TAGS-buffer (current-buffer))
      (erase-buffer)  ;; to add new files, just dont erase
      (save-excursion
	(set-buffer (get-buffer-create "TAGLIST"))
	(erase-buffer))

      ;; tagify each file
      (while file-list
	(setq file (car file-list))
	(setq file-list (cdr file-list))

	(save-excursion
	  (set-buffer 
	   (find-file-noselect file))
	  (or noninteractive
	      (message "Tagify: %s" file))
	  (if (setq tagifier (cdr (assq major-mode local-tagify-alist)))
	      nil
	    (if (setq tagifier (tagify-read-tagifier))
		(setq local-tagify-alist
		      (cons (cons major-mode tagifier) local-tagify-alist))
	      (error "Abort tagifying.")
	      ))
	  (setq tag-entries (tagify-current-buffer tagifier)))

	(setq tag-entries (finish-tagging-file file tag-entries TAGS-buffer))
	(setq all-tag-entries (append tag-entries all-tag-entries))
	)

      ;; finish off by writing the TAGS and TAGLIST files:
      (buildtaglist-for TAGS-buffer tags-file-name all-tag-entries)
      )))

(defun buildtaglist-for (buffer filename tag-entries)
  (or noninteractive
      (message "Saving %s" tags-file-name))
  (let ((last-sym-name "")
	(tag-entries
	 (sort tag-entries
	       (function (lambda (e1 e2)
		 (string< (car e1) (car e2)))))))
    (save-excursion
      (let ((taglist-filename
	     (concat (file-name-directory filename) "TAGLIST")))
	(set-buffer buffer)
	(set-visited-file-name filename)
	(let ((write-file-hooks nil)) (save-buffer))
	(set-buffer (get-buffer-create "TAGLIST"))
	(mapcar
	 (function (lambda (entry)
	   (let ((sym-name (car entry)))
	     (or (string-equal last-sym-name sym-name)
		 ;; they are sorted now, and if the last one is equal to
		 ;; this one it means we have dups. ignore them.
		 (insert sym-name "\n"))
	     (setq last-sym-name sym-name))))
	 tag-entries)
	(set-visited-file-name taglist-filename)
	(let ((write-file-hooks nil)) (save-buffer))))
    tag-entries))

(defun retagify-files ()
  "Update the TAGS file replacing entries only for files that
have changed since the TAGS file was saved."
;; try combining this with tagify-files
  (interactive)
  (let (TAGS-buffer
	file
	tag-entries
	startpt size
	tagifier
	(local-tagify-alist tagify-mode-alist)  ; may be added to
	)

    (save-some-buffers)
    (save-excursion
      ;; find the TAGS file
      (call-interactively find-tags-table-hook)
      (visit-tags-table-buffer)
      (setq TAGS-buffer (current-buffer))
      (goto-char (point-min))

      ;; check each file
      (while (not (eobp))
	;; get the next file name
	(forward-line 1)
	(end-of-line)
	(skip-chars-backward "^,\n")
	(save-excursion (setq size (read (current-buffer))))
	(setq file (buffer-substring (1- (point))
				     (progn (beginning-of-line) (point))))
	(setq startpt (- (point) 2))  ; before leading \^L
	(forward-line 1)
	(forward-char size) ; at end of tags for file

	(if (file-newer-than-file-p file tags-file-name)
	    (progn
	      ;; strip out old entries for this file
	      (delete-region startpt (point))

	      (save-excursion
		(set-buffer 
		 (find-file-noselect file))
		(or noninteractive
		    (message "Retagify: %s" file))
		(if (setq tagifier (cdr (assq major-mode local-tagify-alist)))
		    nil
		  (if (setq tagifier (tagify-read-tagifier))
		      (setq local-tagify-alist
			    (cons (cons major-mode tagifier)
				  local-tagify-alist))
		    (error "Abort tagifying.")
		    ))
		(setq tag-entries (tagify-current-buffer tagifier)))
	      
	      (setq tag-entries (finish-tagging-file file tag-entries TAGS-buffer))
	      )))

      ;; finish off by writing the TAGS file
      (buildtaglist-for TAGS-buffer tags-file-name tag-entries)
      )))


(defun tagify-read-tagifier ()
  "Read a tagifier function for the current mode."
  (let ((name
	 (completing-read (format "Specify tagifier for %s (RET to exit): "
				  major-mode)
			  obarray 'fboundp 'match)))
    (if (> (length name) 0)
	(intern name)
      nil)))


(defun tagify-current-buffer (make-tag)
  "Return the list of tag entries for the current buffer.
Tags are found with the MAKE-TAG function.
See tagify-mode-alist."
  (let ((tag-entries nil)
	(last-line 1)
	(last-char 1)
	tag text line char)
    (save-excursion
      (goto-char (point-min))
      
      ;; find all tags in the file
      (while (setq tag (funcall make-tag))
	
	(save-excursion
	  (setq text
		(buffer-substring
		 (point)
		 (progn
		   (beginning-of-line)
		   (point))))
	  (setq line (+ last-line
			(count-lines last-char (point))))
	  (setq char (point))
	  (setq last-line line)
	  (setq last-char char)
	  (setq tag-entries
		(cons (list tag text line char) tag-entries))
	  )))
    tag-entries
    ))



;;---------------------------------------------------
;; Format of a TAGS file

;; A TAGS file consists of a sequence of file sections.
;; Each file section begins with \014 (^L).
;; The file name may be relative to the directory that the
;; TAGS file is in.  The file name is followed by ",n", where
;; n is the length, in chars, of the tag entry lines for this file.

;; \014
;; filename,n
;; <n chars of entries>
;; <including newlines>
;; \014
;; nextfile ...

;; Each entry is the text at the start of the tagged line,
;; including the text of the tag itself.
;; Following that is "\177n,m", where n is the line number
;; of the tagged line and m is the character number of the
;; newline before the tagged line.  Exact numbers do not matter
;; since find-tag looks in the neighborhood.

;; examples:
;; text of line before tag\17713,400
;; text of another line before tag\1775,30

;; The entries are sorted by the tags of all entries for each file.
;;-----------------------------------------------------------------

(defun finish-tagging-file (filename tag-entries TAGS-buffer)
  "Finish tagging FILENAME by inserting all TAG-ENTRIES to the TAGS-BUFFER.
Insertion is at point and may be in middle of buffer."
  
;;; NB! Destroys its second arg, TAG-ENTRIES, but returns a sorted copy
;;; of the list.
  
  ;; could make it more general by just returning a string that may be
  ;; inserted anywhere
  (let ((tag-entries
	 (sort tag-entries
	       (function (lambda (e1 e2)
		 (string< (car e1) (car e2))))))
	startp endp entry length sorted-tag-entries
	)
    (setq sorted-tag-entries tag-entries)
    (set-buffer TAGS-buffer)
    (insert ?\^L ?\n filename ?\n)
    (setq startpt (point))
    ;; insert the tag entries
    (while tag-entries
      (setq entry (car tag-entries))
      (insert (nth 1 entry) ?\177
	      (format "%d,%d\n"
		      (nth 2 entry)
		      (nth 3 entry)))
      (setq tag-entries (cdr tag-entries)))
    (setq endpt (point))
    (goto-char (1- startpt))		; end of filename line
    (setq length (format ",%d" (- endpt startpt)))
    (insert length)
    (goto-char (+ endpt (length length)))
    sorted-tag-entries))


;;--------------------------------------------------
;; Handy utility section

(defun files-matching (&rest filenames)
  "Return a list of files matching FILENAMES.
FILENAMES may include shell wildcards.
ls is used."
  (interactive "sFilenames: ")
  (let (filename
	file-list)
    (save-excursion
      (with-output-to-temp-buffer "*Directory*"
	;; NB! This screws up the window configuration.
	(buffer-flush-undo standard-output)
	(funcall 'call-process (getenv "SHELL")
		 nil standard-output nil "-c"
		 (concat "ls " (mapconcat 'identity filenames " ")))

	(set-buffer "*Directory*")
	(goto-char (point-min))
	(while (not (eobp))
	  (setq file-list (cons
			   (buffer-substring (point)
					     (progn (end-of-line) (point)))
			   file-list))
	  (if (not (eobp))
	      (forward-char 1))))
      (kill-buffer "*Directory*"))
    (nreverse file-list)))

;Author: Eyvind Ness (eyvind) 
;Date:   Tuesday, September 15 1992 20:14 GMT
;File:   /usr/local/gnu/emacs/elisp/site-extensions/cl-programming-utils.el

(require 'gobble-whitespace)

;;; Need a CL conformant syntax table to make elisp parsing work - see
;;; lisp-mode-variables () in lisp-mode.el:
(condition-case c
    (require 'rpc-hm)
  (error
   (message "Non-fatal error: Ignoring problems loading RPC-HM (%s)" c)
   ;; Copied from the rpc-hm package
   (defvar rpc-hm-lisp-mode-syntax-table
     (progn
       (setq rpc-hm-lisp-mode-syntax-table
	     (copy-syntax-table emacs-lisp-mode-syntax-table))
       (let* ((const "!$%&*+-./0123456789:<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz[]^_{}~")
	      (i 0))
	 (while (< i (length const))
	   (modify-syntax-entry (aref const i) "w" rpc-hm-lisp-mode-syntax-table)
	   (setq i (1+ i))))
       (modify-syntax-entry ?\| "\"   "
			    rpc-hm-lisp-mode-syntax-table)
       (modify-syntax-entry ?\# "'   "
			    rpc-hm-lisp-mode-syntax-table)
       (modify-syntax-entry ?\[ "_   "
			    rpc-hm-lisp-mode-syntax-table)
       (modify-syntax-entry ?\] "_   "
			    rpc-hm-lisp-mode-syntax-table)
       rpc-hm-lisp-mode-syntax-table))))


(provide 'cl-programming-utils)

(defconst clpu-cl-definition-regexp
  "^(\\(\\w+::?\\)?def\\w+\\s-+\\(\\((setf\\s-+\\w+)\\)\\|\\(\\((\\)*\\w+\\)\\)"
  "Regular expression that defines a Common Lisp definition entry.
Careful with groups as they affect match references. See below.")


(defun clpu-next-def (&optional from-point)
  "Given a buffer position this function returns the next
Common Lisp definition or NIL if there are none."
  (or from-point
      (setq from-point (point)))
  (let ((syntax-table (syntax-table))
	(sym nil))
    (unwind-protect
	 (and
	  (prog1 t
	    (set-syntax-table rpc-hm-lisp-mode-syntax-table)
	    (goto-char from-point))
	  (re-search-forward clpu-cl-definition-regexp nil t)
	  (setq sym (buffer-substring (match-beginning 0) (match-end 0)))
	  ;; ignore DEFADVICEs (Lucid CL)
	  (prog1 t
	    (while (and (string-match "^(\\(\\w*::?\\)?defadvice\\s-" sym)
			(prog1 t (setq sym nil))
			(re-search-forward clpu-cl-definition-regexp nil t)
			(setq sym t))))
	  sym
	  (setq sym (buffer-substring (match-beginning 2) (match-end 2)))
	  (if (string-match "^(setf" sym)
	      sym
	      (if (string-match "^(+\\(\\w+\\)" sym)
		  ;; remove the initial "("'s
		  (substring sym (match-beginning 1) (match-end 1))
		  sym)))
      (set-syntax-table syntax-table))))


(defun clpu-make-export-list ()
  (interactive)
  (and
   (string-match
    "^\\(common\-\\)?lisp-mode$"
    (symbol-name major-mode))
   (save-excursion
     (set-syntax-table rpc-hm-lisp-mode-syntax-table)
     (goto-char (point-min))
     (let ((syms nil) (last-sym "") (sym "") (require-extra-nl nil))
       (while (setq sym (clpu-next-def))
	 (setq syms (cons sym syms)))
       (goto-char (point-min))
       (if (re-search-forward "^(export[ \t\n]+" (point-max) t)
	   (progn
	     (goto-char (match-beginning 0))
	     (delete-region
	      (point)
	      (save-excursion (forward-sexp 1) (point))))
	   (progn (gw-skip-blank-lines-and-comments)
		  (setq require-extra-nl t)))
       (insert "(export\n'(\n")
       (mapcar
	(function (lambda (sym)
	  (or (string-equal last-sym sym)
	      ;; they are sorted now, and if the last one is equal to
	      ;; this one it means we have dups. ignore them.
	      (insert sym "\n"))
	  (setq last-sym sym)))
	(nreverse
	 (sort syms
	       (function
		(lambda (s1 s2) 
		 (string-lessp s2 s1))))))
       (insert "))")
       (if require-extra-nl (insert "\n\n"))
       (forward-sexp -1)
       (indent-sexp))))
  ;; always return nil so that other write-file-hooks or save-buffer may run
  nil)

;Author: Eyvind Ness (eyvind) 
;Date:   Thursday, March 26 1992 19:35 GMT
;File:   /usr/local/gnu/emacs/elisp/site-extensions/gobble-whitespace.el

(provide 'gobble-whitespace)

(defun gw-skip-blank-lines-and-comments ()
  (interactive)
  (let ((omd (match-data)))
    (unwind-protect
	(let ((current-line-string
	       (buffer-substring 
		(point)
		(save-excursion (end-of-line) (point)))))
	  (while (and (not (eobp))
		      (string-match 
		       "\\(^[ \t]*$\\)\\|\\(^[ \t]*[;]+.*$\\)"
		       current-line-string))
	    (forward-line 1)
	    (setq current-line-string
		  (buffer-substring 
		   (point)
		   (save-excursion (end-of-line) (point)))))
	  (skip-chars-forward " \t" (point-max)))
      (store-match-data omd))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; The End
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Newsgroups: gnu.emacs.sources