[comp.windows.news] A better PostScript tags facility

siegel@booga.Eng.Sun.COM (Josh Siegel) (03/20/91)

This is a newer/better/strong NeWS tags program then the version which
I posted more then a year ago now.  This generates tags in vi, gnuemacs, and
a custom format (for gnuemacs with lisp support).

The gnuemacs custom format supports a fancy class browsing system that lets
you move quickly to a method in a class and to find out where all the
places a particlar method is defined.  I have used this stuff on a daily
bases for almost 6 months now and feel its pritty stable.

This also includes my own "psh" mode based on the cmushell package.  You
can get this from most elisp archive sites.

             --josh

#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#		"End of archive 1 (of 1)."
# Contents:  MANIFEST Makefile README ps-post.el ps-pstags.el ps.el
#   pstags.1 pstags.c
# Wrapped by siegel@booga on Tue Mar 19 10:57:29 1991
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'MANIFEST' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'MANIFEST'\"
else
echo shar: Extracting \"'MANIFEST'\" \(545 characters\)
sed "s/^X//" >'MANIFEST' <<'END_OF_FILE'
X   File Name		Archive #	Description
X-----------------------------------------------------------
X MANIFEST                   1	this shipping list
X Makefile                   1	the makefile that builds it all
X README                     1	A simple README for all this stuff
X ps-post.el                 1	postscript buffer mode 
X ps-pstags.el               1	elisp code for pstags
X ps.el                      1	something to load them all in
X pstags.1                   1	manual for pstags (outdated)
X pstags.c                   1	source for pstags
END_OF_FILE
if test 545 -ne `wc -c <'MANIFEST'`; then
    echo shar: \"'MANIFEST'\" unpacked with wrong size!
fi
# end of 'MANIFEST'
fi
if test -f 'Makefile' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'Makefile'\"
else
echo shar: Extracting \"'Makefile'\" \(293 characters\)
sed "s/^X//" >'Makefile' <<'END_OF_FILE'
XCFLAGS = -g
X
XCC = /usr/ucb/cc
X#CC = gcc
X#CC = /usr/local/lang/cc
X
Xall: pstags
X
Xpstags: pstags.o
X	${CC} ${CFLAGS} -o pstags pstags.o
X
Xclean:
X	@/bin/rm -f *.o psindent pstags
X
Xtest: pstags
X	pstags -E -v -m $$PWD/NeWS/*.ps $$PWD/NeWS/tnt/*.ps
X
Xtest2: pstags
X	pstags -E -v -m foo.ps
X
X.KEEP_STATE:
END_OF_FILE
if test 293 -ne `wc -c <'Makefile'`; then
    echo shar: \"'Makefile'\" unpacked with wrong size!
fi
# end of 'Makefile'
fi
if test -f 'README' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'README'\"
else
echo shar: Extracting \"'README'\" \(2339 characters\)
sed "s/^X//" >'README' <<'END_OF_FILE'
X
XThis directory contains most of the files needed to support a primitive 
Xelectric-postscript mode for gnuemacs.  The files that it does not contain
Xare the CMU shell modes.  These can be gotten from me seperatly or via ftp from
Xvarious gnu emacs source archives. 
X
XThe first thing that should be done to use this stuff is to put a entry
Xfor load-path in your .emacs that points at this directory.  Something like:
X
X   (setq load-path (append load-path '("/home/booga/siegel/games/pstags" )))
X
XAlso, you could setup autoload to help:
X
X  (autoload 'psh "ps.el" nil t)
X  (autoload 'ps-load-tags "ps.el" nil t)
X  (autoload 'postscript-mode "ps.el" "" t)
X  (setq auto-mode-alist
X     (cons '("\\.c?ps$".postscript-mode) auto-mode-alist))
X
XNext, you should setup TAGS for your NeWS PS files.  The
Xeasiest way of doing this is to "cd" into your NeWS
Xdirectory and do a:
X
X  % pstags -E -v -m $cwd/*.ps $cwd/tnt/*.ps
X
Xor if the PS files change to often (if you develop toolkits), you might do a
X
X  % pstags -E -v -r -m $cwd/*.ps $cwd/tnt/*.ps
X
Xwhich will tell pstags to generate "relative" tags (tags
Xwhich use search patterns to find lines instead of absolute
Xcharacter positions).  These tags take up a great deal more
Xspace so don't use them unless you have to.   You can also
Xgenerate seperate TAGS files for each directory.
X
XNow, do a "M-x ps-load-tags" and load in the TAGS.el file{s}.
X
XI have a:
X
X	(defun ps-mytags()
X	  (interactive)
X	  (ps-load-tags "~/NeWS/TAGS.el")
X	  (ps-load-tags "~/NeWS/tnt/TAGS.el")
X	)
X
Xin my .emacs file to make loading all my tags files easier.
X
XNow, do a "M-x ps-goto" and jump to "ClassCanvas".  Do a
X"M-x ps-method" and go to "ClassCanvas" method "Paint".
XDo a "M-x inverted" and go to method "Paint" and class
X"ClassCanvas".  At any time, type "?" to get possible
Xcompletions.
X
Xdo a "M-x psh" to get to a "psh" window.  This is a
Xinteractive "psh" window that lets you type in commands to
Xyour NeWS server.  This window has a history system that
Xlets you type "M-p" to move up and "M-n" to move down.  You
Xcan also do "C-r" and do a search through the history for a
Xspecific string.
X
XHitting the tab key will complete the word you are on for any
XOpenWindows primitive.
X
XRemember, typing "M-x describe-bindings" will tell you what
Xthe current bindings are for the window you are in.
X
X  --josh
X  siegel@sun.com
END_OF_FILE
if test 2339 -ne `wc -c <'README'`; then
    echo shar: \"'README'\" unpacked with wrong size!
fi
# end of 'README'
fi
if test -f 'ps-post.el' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'ps-post.el'\"
else
echo shar: Extracting \"'ps-post.el'\" \(8137 characters\)
sed "s/^X//" >'ps-post.el' <<'END_OF_FILE'
X;; Major mode for editing PostScript programs.
X;;
X;;
X;; Author:	Chris Maio
X;; Last edit:	4 Sep 1988
X;; modified by Josh Siegel
X;;
X;; The following two statements, placed in your .emacs file or site-init.el,
X;; will cause this file to be autoloaded, and postscript-mode invoked, when
X;; visiting .ps or .cps files:
X;;
X;;	(autoload 'postscript-mode "postscript.el" "" t)
X;;	(setq auto-mode-alist
X;;	      (cons '("\\.c?ps$".postscript-mode) auto-mode-alist))
X;;
X
X(provide 'postscript)
X(require 'psh)
X
X(defconst ps-indent-level 4
X  "*Indentation to be used inside of PostScript blocks or arrays")
X
X(defconst ps-tab-width 4
X  "*Tab stop width for PostScript mode")
X
X(defun ps-make-tabs (stop)
X  (and (< stop 132) (cons stop (ps-make-tabs (+ stop ps-tab-width)))))
X
X(defconst ps-tab-stop-list (ps-make-tabs ps-tab-width)
X  "*Tab stop list for PostScript mode")
X
X(defconst ps-postscript-command "psh"
X  "*Command used to invoke with a printer spooler or NeWS server.")
X
X(defvar ps-mode-map nil
X  "Keymap used in PostScript mode buffers")
X
X(defvar ps-mode-syntax-table nil
X  "PostScript mode syntax table")
X
X(defun postscript-mode nil
X  "Major mode for editing PostScript files.
X
X\\[ps-execute-buffer] will send the contents of the buffer to the NeWS
Xserver using psh(1).  \\[ps-execute-region] sends the current region.
X\\[ps-shell] starts an interactive psh(1) window which will be used for
Xsubsequent \\[ps-execute-buffer] or \\[ps-execute-region] commands.
X
XIn this mode, TAB and \\[indent-region] attempt to indent code
Xbased on the position of {}, [], and begin/end pairs.  The variable
Xps-indent-level controls the amount of indentation used inside
Xarrays and begin/end pairs.  
X
X\\{ps-mode-map}
X
X\\[postscript-mode] calls the value of the variable ps-mode-hook with no args,
Xif that value is non-nil."
X  (interactive)
X  (kill-all-local-variables)
X  (use-local-map ps-mode-map)
X  (if ps-mode-syntax-table
X      (set-syntax-table ps-mode-syntax-table)
X      (progn
X	(setq ps-mode-syntax-table (make-syntax-table))
X	(set-syntax-table ps-mode-syntax-table)
X	(modify-syntax-entry ?\( "<")
X	(modify-syntax-entry ?\) ">")
X	(modify-syntax-entry ?\[ "(\]")
X	(modify-syntax-entry ?\] ")\[")
X	(modify-syntax-entry ?\% "<")
X	(modify-syntax-entry ?\n ">")))
X  (make-local-variable 'comment-start)
X  (make-local-variable 'comment-start-skip)
X  (make-local-variable 'comment-column)
X  (make-local-variable 'indent-line-function)
X  (make-local-variable 'tab-stop-list)
X  (setq comment-start "% "
X	comment-start-skip "% *"
X	comment-column 40
X	indent-line-function 'ps-indent-line
X	tab-stop-list ps-tab-stop-list)
X  (setq mode-name "PostScript")
X  (setq major-mode 'postscript-mode)
X  (run-hooks 'ps-mode-hook))
X
X(defun ps-tab nil
X  "Command assigned to the TAB key in PostScript mode."
X  (interactive)
X  (if (save-excursion (skip-chars-backward " \t") (bolp))
X      (ps-indent-line)			; fancy indent if beginning of line
X    (indent-relative)))			; otherwise indent relative
X
X(defun ps-indent-line nil
X  "Indents a line of PostScript code."
X  (interactive)
X  (beginning-of-line)
X  (delete-horizontal-space)
X  (if (not (or (looking-at "%%")	; "%%" comments stay at left margin
X	       (ps-top-level-p)))
X      (if (and (< (point) (point-max))
X	       (eq ?\) (char-syntax (char-after (point)))))
X	  (ps-indent-close)		; indent close-delimiter
X	(if (looking-at "\\(dict\\|class\\)?end\\|cdef")
X	    (ps-indent-end)		; indent end token
X	  (ps-indent-in-block)))))	; indent line after open delimiter
X  
X(defun ps-open nil
X  (interactive)
X  (insert last-command-char))
X
X(defun ps-insert-d-char (arg)
X  "Awful hack to make \"end\" and \"cdef\" keywords indent themselves."
X  (interactive "p")
X  (insert-char last-command-char arg)
X  (save-excursion
X    (beginning-of-line)
X    (if (looking-at "^[ \t]*\\(\\(dict\\|class\\)?end\\|cdef\\)")
X	(progn
X	  (delete-horizontal-space)
X	  (ps-indent-end)))))
X
X(defun ps-close-old nil
X  "Inserts and indents a close delimiter."
X  (interactive)
X  (insert last-command-char)
X  (backward-char 1)
X  (ps-indent-close)
X  (forward-char 1)
X  (blink-matching-open))
X
X(defun ps-close nil
X  "Inserts and indents a close delimiter."
X  (interactive)
X  (insert last-command-char)
X  (save-excursion (let (beg end)
X    (setq end (point))
X    (backward-sexp 1)
X    (setq beg (point))
X    (indent-region beg end nil)
X  ))
X)
X
X
X(defun ps-indent-close nil
X  "Internal function to indent a line containing a an array close delimiter."
X  (if (save-excursion (skip-chars-backward " \t") (bolp))
X      (let (x (oldpoint (point)))
X	(forward-char) (backward-sexp)	;XXX
X	(if (and (eq 1 (count-lines (point) oldpoint))
X		 (> 1 (- oldpoint (point))))
X	    (goto-char oldpoint)
X	  (beginning-of-line)
X	  (skip-chars-forward " \t")
X	  (setq x (current-column))
X	  (goto-char oldpoint)
X	  (delete-horizontal-space)
X	  (indent-to x)))))
X
X(defun ps-indent-end nil
X  "Indent an \"end\" token or array close delimiter."
X  (let ((goal (ps-block-start)))
X    (if (not goal)
X	(indent-relative)
X      (setq goal (save-excursion
X		   (goto-char goal) (back-to-indentation) (current-column)))
X      (indent-to goal))))
X
X(defun ps-indent-in-block nil
X  "Indent a line which does not open or close a block."
X  (let ((goal (ps-block-start)))
X    (setq goal (save-excursion
X		 (goto-char goal)
X		 (back-to-indentation)
X		 (if (bolp)
X		     ps-indent-level
X		   (back-to-indentation)
X		   (+ (current-column) ps-indent-level))))
X    (indent-to goal)))
X
X;;; returns nil if at top-level, or char pos of beginning of current block
X
X(defun ps-block-start nil
X  "Returns the character position of the character following the nearest
Xenclosing `[' `{' or `begin' keyword."
X  (save-excursion
X    (let (open (skip 0))
X      (setq open (condition-case nil
X		     (save-excursion
X		       (backward-up-list 1)
X		       (1+ (point)))
X		   (error nil)))
X      (ps-begin-end-hack open))))
X
X(defun ps-begin-end-hack (start)
X  "Search backwards from point to START for enclosing `begin' and returns the
Xcharacter number of the character following `begin' or START if not found."
X  (save-excursion
X    (let ((depth 1) match)
X      (while (and (> depth 0)
X		  (or (re-search-backward
X;"\\(^|[ \t]\\)+\\(dict\\|class\\)?\\(end\\|begin\\)\\(package\\)?\\([ \t]|$\\)+" start t)
X		       "^[ \t]*\\(dict\\|class\\)?end\\|begin[ \t]*\\(%.*\\)*$" start t)
X		      (re-search-backward "^[ \t]*cdef.*$" start t)))
X	(setq depth (if (looking-at "[ \t]*\\(dict\\|class\\)?end\\(package\\)?")
X			(1+ depth) (1- depth))))
X      (if (not (eq 0 depth))
X	  start
X	(forward-word 1)
X	(point)))))
X
X
X(defun ps-top-level-p nil
X  "Awful test to see whether we are inside some sort of PostScript block."
X  (and (condition-case nil
X	   (not (scan-lists (point) -1 1))
X	 (error t))
X       (not (ps-begin-end-hack nil))))
X
X;;; initialize the keymap if it doesn't already exist
X(if (null ps-mode-map)
X    (progn
X      (setq ps-mode-map (make-sparse-keymap))
X      (define-key ps-mode-map "d" 'ps-insert-d-char)
X      (define-key ps-mode-map "f" 'ps-insert-d-char)
X      (define-key ps-mode-map "{" 'ps-open)
X      (define-key ps-mode-map "}" 'ps-close)
X      (define-key ps-mode-map "[" 'ps-open)
X      (define-key ps-mode-map "]" 'ps-close)
X      (define-key ps-mode-map "\t" 'ps-tab)
X      (define-key ps-mode-map "\C-c\C-c" 'ps-execute-buffer)
X      (define-key ps-mode-map "\C-c|" 'ps-execute-region)
X      (define-key ps-mode-map "\M-\t" 'ps-completer)
X      (define-key ps-mode-map "\C-c!" 'psh)))
X
X(defun ps-execute-buffer nil
X  "Send the contents of the buffer to a printer or NeWS server."
X  (interactive)
X  (save-excursion
X    (mark-whole-buffer)
X    (ps-execute-region (point-min) (point-max))))
X
X(defun ps-execute-region (start end)
X  "Send the region between START and END to a printer or NeWS server.
XYou should kill any existing *PostScript* buffer unless you want the
XPostScript text to be executed in that process."
X  (interactive "r")
X  (let ((start (min (point) (mark)))
X	(end (max (point) (mark))))
X    (condition-case nil
X	(process-send-string (get-buffer-process "*psh*") 
X			     (buffer-substring start end))
X      (error (shell-command-on-region start end ps-postscript-command nil)))))
END_OF_FILE
if test 8137 -ne `wc -c <'ps-post.el'`; then
    echo shar: \"'ps-post.el'\" unpacked with wrong size!
fi
# end of 'ps-post.el'
fi
if test -f 'ps-pstags.el' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'ps-pstags.el'\"
else
echo shar: Extracting \"'ps-pstags.el'\" \(12109 characters\)
sed "s/^X//" >'ps-pstags.el' <<'END_OF_FILE'
X;; pstags.el
X;;
X;; version 0.5
X;;
X;; Written by Josh Siegel
X;;
X;; Changes since 0.1
X;;   Reduced size of data structure over previous version by %50
X;;
X;; Changes since 0.2
X;;
X;;   Reduced size over previous data structure by %71
X;;     ($OPENWINHOME/etc/NeWS/{,tnt/}*.ps now makes a 71K text file
X;;     instead of 450K (and loads a lot faster!)
X;;
X;;   Added inverted tag search
X;;   Added goto class
X;;   Added goto top of class
X;;
X;; Changes since 0.3
X;;   
X;;   Added relitive searches as well as direct searches (expressions)
X;;       Relitive tags take up a great deal more space (x3)
X;;
X;;   Added ability to load multiple TAGS.el files
X;;
X;; Changes since 0.4
X;;
X;;   A few bug fixes
X;;
X;; In my own defense, I was learning lisp as I was writting this.  Later
X;; functions (not in order in the file) were better then earlier ones.  I 
X;; hope to go back through many of these and rewrite so as to reduce abuse
X;; on the system (it seems to be fast enough :-)
X;;
X
X(setq ps-tag-file-names nil)
X(setq ps-tags-list nil)
X(setq ps-method-list nil)
X
X(defun ps-initialize-methods ()
X  (message "Initializing method list...")
X  (let (ptr bits)
X    (setq bits (sort (mapcar 'car
X      (apply 'append (mapcar '(lambda(x) (nth 3 x)) ps-tags-list))) 'string<))
X    (setq ptr bits)
X    (while (cdr ptr)
X      (if (string= (car ptr) (car (cdr ptr))) 
X	  (rplacd ptr (cdr (cdr ptr)))
X	(setq ptr (cdr ptr))
X	)
X      )
X    (setq ps-method-list (mapcar 'list bits))
X    )
X  (message "done")
X)
X
X(defun ps-method (class method)
X "Goto specific tag"
X  (interactive (list 
X		(setq ps-current-class 
X		      (completing-read "Class: " ps-tags-list))
X		(completing-read "Method: " 
X		       (nth 3 (assoc ps-current-class ps-tags-list)))))
X  (let (ps-the-line)
X    (setq ps-the-line (assoc class ps-tags-list))
X    (setq ps-current-class class)
X    (ps-goto-file (car (cdr ps-the-line)) 
X		  (car (cdr (assoc method (nth 3 ps-the-line)))))
X    )
X)
X
X
X(defun ps-goto (class)
X "goto a specific class"
X (interactive (list (setq ps-current-class 
X		      (completing-read "Class: " ps-tags-list))))
X (let (ps-the-line)
X   (setq ps-the-line (assoc class ps-tags-list))
X   (ps-goto-file (car (cdr ps-the-line)) 
X		 (nth 2 ps-the-line))
X )
X)
X
X(defun ps-return-method-and-class ()
X  (list 
X   (setq ps-current-method 
X	 (completing-read "method: " ps-method-list))
X   (if (= (length (setq magic_list (apply 'append 
X      (mapcar '(lambda(x) (if (car x) (list x) nil))
X        (mapcar '(lambda(x) 
X	  (list (if (assoc ps-current-method (nth 3 x)) (nth 0 x) nil))) 
X	    ps-tags-list))))) 1) 
X       (car (car magic_list))
X       (completing-read "Class: " magic_list)
X     )
X   )
X)
X
X(defun ps-inverted (method class)
X "Goto a method in a class"
X (interactive (ps-return-method-and-class))
X (ps-method class method)
X)
X
X(defun ps-start-of-class ()
X  "Goto beginning of class"
X  (interactive)
X  (ps-goto-class ps-current-class)
X)
X
X(defun ps-goto-file (file place)
X  (find-file-other-window file)
X  (if (numberp place)
X      (goto-char (- place 2))
X    (progn
X      (goto-char (point-min))
X      (search-forward place)
X      (beginning-of-line)
X      )
X  )
X)
X
X
X(defun ps-load-tags (file)
X  "Load PostScript tag file"
X  (interactive "fPostScript tags file: ")
X  (let (new_critter ps-bit-o-list)
X    (ps-unload-tags file)
X    (load-file file)
X    (setq new_critter (list (list 
X      file (mapcar '(lambda(x) (list (car (cdr x)))) ps-bit-o-list))))
X  
X    (if ps-tag-file-names
X	(rplacd new_critter ps-tag-file-names))
X  
X    (setq ps-tag-file-names new_critter)
X
X    (if ps-tags-list
X	(nconc ps-tags-list ps-bit-o-list)
X        (setq  ps-tags-list ps-bit-o-list)
X    )
X
X    (ps-initialize-methods)
X  )
X)
X
X(defun ps-unload-tags (file)
X  "Unload loaded tags file"
X  (interactive (list (completing-read "Tag file:" ps-tag-file-names)))
X  (let (files)
X    (setq files (car (cdr (assoc file ps-tag-file-names))))
X    (if files 
X	(progn
X	  (setq ps-tags-list 
X		(apply 'nconc 
X		    (mapcar '(lambda(x) (if (assoc (car (cdr x)) files) nil (list x))) ps-tags-list)
X                )
X          )
X	  (ps-initialize-methods)
X	  (setq ps-tag-file-names (delq (assoc file ps-tag-file-names) ps-tag-file-names))
X	)
X    )
X  )
X)
X
X
X
X(defun complete-token (completion-list)
X  "Complete token before point using COMPLETION-LIST. Inserts as many
Xcharacters as possible, and then if multiple completions, display them
Xin a *Completions* buffer."
X    (let* ((end (point))
X	 (beg (save-excursion
X		(backward-sexp 1)
X		(point)))
X	 (pattern (buffer-substring beg end))
X	 (completion (try-completion pattern completion-list)))
X    (cond ((eq completion t)
X	   (expand-token pattern completion-list))
X	  ((null completion)
X	   (message "Can't find completion for \"%s\"" pattern)
X	   (ding))
X	  ((not (string= pattern completion))
X	   (delete-region beg end)
X	   (insert completion))
X	  (t
X	   (message "Making completion list...")
X	   (let ((list (all-completions pattern completion-list)))
X	     (with-output-to-temp-buffer "*Completions*"
X	       (display-completion-list list))
X	   (message "Making completion list...%s" "done"))))))
X
X(defun expand-token  (completion completion-list)
X  "\
XExpand COMPLETION using COMPLETION-LIST to (momentarily) show generic 
Xdeclaration, and display synopsis in echo area. COMPLETION must be 
Xcomplete, and COMPLETION-LIST is a list of elements of the form
X
X    \(\"completion\" . \(\"declaration\" . \"synopsis\"\)\)\n"
X   (cond
X   ((null completion-list)
X    (message "no expansion found for %s" completion))
X   ((string-equal completion (car (car completion-list)))
X    (momentary-string-display 
X     (concat " " (car (cdr (car completion-list)))) (point) ?\ 
X     (cdr (cdr (car completion-list)))))
X   (t
X    (expand-token completion (cdr completion-list)))))
X
X(defun ps-completer ()
X  (interactive)
X  (complete-token  (append nil ps-operators ps-tags-list ps-method-list nil))
X)
X
X(setq ps-operators '(("abs") ("acceptconnection") ("add") ("aload")
X("anchorsearch") ("and") ("arc") ("arccos") ("arcn") ("arcsin") ("arctan")
X("arcto") ("array") ("ashow") ("assert") ("astore") ("atan")
X("awaitevent") ("awidthshow") ("beep") ("begin") ("bitshift")
X("blockinputqueue") ("breakpoint") ("buildimage") ("bytesavailable")
X("canvasesunderpath") ("canvasesunderpoint") ("canvastobottom")
X("canvastotop") ("ceiling") ("charpath") ("clear") ("clearsendcontexts")
X("cleartomark") ("clip") ("clipcanvas") ("clipcanvaspath") ("clippath")
X("closefile") ("closepath") ("concat") ("concatmatrix")
X("continueprocess") ("contrastswithcurrent") ("controlpoint") ("copy")
X("copyarea") ("cos") ("count") ("countdictstack") ("countexecstack")
X("countfileinputtoken") ("countinputqueue") ("counttomark")
X("createcolormap") ("createcolorsegment") ("createdevice") ("createevent")
X("createmonitor") ("createoverlay") ("currentautobind")
X("currentbackcolor") ("currentbackpixel") ("currentcanvas")
X("currentcolor") ("currentcursorlocation") ("currentdash") ("currentdict")
X("currentfile") ("currentflat") ("currentfont") ("currentfontmem")
X("currentgray") ("currenthalftone") ("currenthsbcolor") ("currentlinecap")
X("currentlinejoin") ("currentlinewidth") ("currentmatrix")
X("currentmiterlimit") ("currentpath") ("currentpixel")
X("currentplanemask") ("currentpoint") ("currentprintermatch")
X("currentprocess") ("currentrasteropcode") ("currentrgbcolor")
X("currentstate") ("currenttime") ("currenttimems") ("curveto") ("cvi")
X("cvlit") ("cvn") ("cvr") ("cvrs") ("cvs") ("cvx") ("damagepath") ("def")
X("defaulterroraction") ("defaultmatrix") ("definefont") ("deliverevent")
X("dict") ("disableinterruptcursor") ("div") ("dtransform") ("dup")
X("emptypath") ("enableinterruptcursor") ("encodefont") ("end")
X("enumeratefontdicts") ("eoclip") ("eoclipcanvas") ("eocopyarea")
X("eocurrentpath") ("eoextenddamage") ("eoextenddamageall") ("eofill")
X("eoreshapecanvas") ("eowritecanvas") ("eowritescreen") ("eq")
X("erasepage") ("exch") ("exec") ("exit") ("exp") ("expressinterest")
X("extenddamage") ("extenddamageall") ("false") ("file") ("fill")
X("findfilefont") ("findfont") ("flattenpath") ("floor") ("flush")
X("flushfile") ("fontascent") ("fontdescent") ("fontheight") ("for")
X("forall") ("fork") ("ge") ("get") ("getbbox") ("getcanvaslocation")
X("getcanvasshape") ("getcard32") ("getcolor") ("getcompateventdist")
X("getenv") ("geteventlogger") ("getfileinputtoken") ("getfocusrevertmode")
X("getinterval") ("getkeyboardfocus") ("getkeyboardtranslation")
X("getprocesses") ("getprocessgroup") ("getsocketlocaladdress")
X("getsocketpeername") ("globalinterestlist") ("globalroot") ("grabcursor")
X("grestore") ("grestoreall") ("gsave") ("gt") ("harden") ("hsbcolor")
X("idiv") ("idtransform") ("if") ("ifelse") ("imagecanvas")
X("imagemaskcanvas") ("imagepath") ("index") ("initauthorization")
X("initclip") ("initgraphics") ("initmatrix") ("initxoperators")
X("insertcanvasabove") ("insertcanvasbelow") ("invertmatrix") ("isarray?")
X("itransform") ("keyboardtype") ("killprocess") ("killprocessgroup")
X("known") ("lasteventkeystate") ("lasteventtime") ("lasteventtimems")
X("lasteventx") ("lasteventy") ("le") ("length") ("lineto") ("ln") ("load")
X("load:unpack") ("localhostnamearray") ("log") ("loop") ("lt")
X("makefont") ("mark") ("max") ("maxlength") ("min") ("mod") ("monitor")
X("monitorlocked") ("movecanvas") ("moveto") ("mul") ("ne") ("neg")
X("newcanvas") ("newcursor") ("newpath") ("newprocessgroup") ("not")
X("null") ("or") ("packedarray") ("pathbbox") ("pathforallvec") ("pause")
X("pipe") ("pointinpath") ("pop") ("postcrossings") ("print")
X("printermatchfont") ("pstack") ("put") ("putcard32") ("putcolor")
X("putenv") ("putinterval") ("quit") ("rand") ("rcheck") ("rcontrolpoint")
X("rcurveto") ("read") ("readcanvas") ("readhexstring") ("readline")
X("readonly") ("readstring") ("recallevent") ("redistributeevent")
X("registerencoding") ("renamevm") ("repeat") ("reshapecanvas") ("restore")
X("revokeinterest") ("rgbcolor") ("rlineto") ("rmoveto") ("roll")
X("rotate") ("round") ("rrand") ("runprogram") ("rusage") ("save")
X("scale") ("scalefont") ("search") ("send") ("sendevent") ("setautobind")
X("setbackcolor") ("setbackpixel") ("setcachedevice") ("setcachelimit")
X("setcanvas") ("setcharwidth") ("setcolor") ("setcompateventdist")
X("setcursorlocation") ("setdash") ("seteventlogger") ("setfileinputtoken")
X("setflat") ("setfocusrevertmode") ("setfont") ("setfontmem") ("setgray")
X("sethsbcolor") ("setkeyboardfocus") ("setkeyboardtranslation")
X("setlinecap") ("setlinejoin") ("setlinewidth") ("setmatchbit")
X("setmatrix") ("setmiterlimit") ("setothercanvas") ("setpath")
X("setpixel") ("setplanemask") ("setprintermatch") ("setrasteropcode")
X("setretainthreshold") ("setrgbcolor") ("setscreen") ("setstate")
X("setsysinputtoken") ("settransferfromarray") ("setxrootpattern") ("show")
X("shutdownserver") ("signalready") ("sin") ("smoothscrollymax") ("soft")
X("soften") ("sqrt") ("srand") ("stack") ("startkeyboardandmouse")
X("status") ("statusdict_jobtimeout") ("statusdict_setjobtimeout") ("stop")
X("stopped") ("stoprepeating") ("store") ("string") ("stringwidth")
X("stroke") ("strokepath") ("sub") ("supersend") ("suspendprocess")
X("systemdict") ("tagprint") ("token") ("transform") ("translate") ("true")
X("truetype") ("truncate") ("type") ("typedprint") ("unblockinputqueue")
X("undef") ("userdict") ("verbose") ("verifytree") ("vm") ("vmstatus")
X("waitprocess") ("wcheck") ("where") ("widthshow") ("write")
X("writecanvas") ("writehexstring") ("writeobject") ("writescreen")
X("writestring") ("xaddresource") ("xcheck") ("xfreeclientresources")
X("xfreeresource") ("xinitclientresources") ("xlookupid") ("xor")))
X
X(require 'comint)
X
X(defun psh-mode ()
X  (interactive)
X  (comint-mode)
X  (define-key comint-mode-map "\t" 'ps-completer)
X  (setq major-mode 'psh-mode)
X  (setq mode-name "psh")
X  (run-hooks 'psh-mode-hook)
X)
X
X(defun psh ()
X  (interactive)
X  "Start up a PostScript shell"
X  (if (not (comint-check-proc "*psh*"))
X      (process-send-string 
X       (get-buffer-process (make-comint "psh" 
X					(substitute-in-file-name "$OPENWINHOME/bin/psh")))
X       "executive\n"))
X  (switch-to-buffer-other-window "*psh*")
X  (psh-mode)
X)
X
X(provide 'psh)
END_OF_FILE
if test 12109 -ne `wc -c <'ps-pstags.el'`; then
    echo shar: \"'ps-pstags.el'\" unpacked with wrong size!
fi
# end of 'ps-pstags.el'
fi
if test -f 'ps.el' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'ps.el'\"
else
echo shar: Extracting \"'ps.el'\" \(65 characters\)
sed "s/^X//" >'ps.el' <<'END_OF_FILE'
X;; Load them all up!
X
X(load "ps-pstags.el")
X(load "ps-post.el")
X
END_OF_FILE
if test 65 -ne `wc -c <'ps.el'`; then
    echo shar: \"'ps.el'\" unpacked with wrong size!
fi
# end of 'ps.el'
fi
if test -f 'pstags.1' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'pstags.1'\"
else
echo shar: Extracting \"'pstags.1'\" \(3215 characters\)
sed "s/^X//" >'pstags.1' <<'END_OF_FILE'
X.\" @(#)pstags.1 23.3 90/10/01 SMI;
X.TH PSTAGS 1 "1 October 1990"
X.ds Ps P\s-2OST\s+2S\s-2CRIPT\s+2
X.ds Sd \s-2Ne\h'-0.2n'WS\s+2
X.ds Xn X11/Ne\h'-0.2n'WS
X.IX pstags#(1) "" "\fLpstags\fP(1)"
X.SH NAME
Xpstags \- create a \*(Ps language or \*(Sd tags file for use with 
X\fBvi\fP or \fBemacs\fP.
X.SH SYNOPSIS
X.B pstags
X[
X.B \-Eemrv
X]
X[
X.B \-f
X.I tagsfile
X]
X[
X.I files
X]
X.SH DESCRIPTION
X.B pstags
Xmakes a tags file for
X.BR ex (1)
Xor
X.BR emacs(l)
Xfrom a \*(Ps language or \*(Sd source file. See
X.BR ctags (1) 
Xfor more information.
X.B pstags
Xgenerates tags for lines with the string 
X.B cdef
Xand lines with the hint
X.BI "pstag=<"tagname "> "
Xembedded anywhere in a comment.  It can automaticly
Xgenerate tags for both classes and their methods.
X.LP
XThe default tagfile is
X.BR ps.tags .
XBecause this is not in the default tag search path, the command
X.TP
X.ne
X.RS
X.ft B
Xset tags=tags ps.tags
X.ft R
X.RE
X.LP
Xis required in
X.BR vi (1),
Xor in the user's   
X.B .exrc
Xfile to initialize that path. Depending on the system, a backslash may be required to escape the space between
X.B tags
Xand
X.BR ps.tags .
X.LP
XThe default tagfile for standard
X.BR emacs
Xis
X.BR ps.TAGS.
XYou can do a
X.BR visit-tags-table
Xto point
X.BR emacs
Xat the correct tags file.
X.LP
XThere is also a custom
X.BR emacs
Xmode that uses a non-standard tags format and custom elisp code.  The
Xdefault tagfile for this is
X.BR TAGS.el.
X.SH OPTIONS
X.TP
X.BI \-E
XGenerate custom emacs tag-files (TAGS.el)
X.TP
X.BI \-e
XGenerate standard emacs tag-files (ps.TAGS)
X.TP
X.BI \-m
Xgenerate tags for the methods inside each class.  Due to constraints in
Xthe standard emacs tag-file format, this option is a no-op when generating
Xtags.
X.TP
X.BI \-r
XTurns on relative tags.  This option only applies to the custom
X.BR emacs
Xtags format and tells 
X.BR pstags
Xto use search patterns instead of absolute character positions to find tags.
X.TP
X.BI \-v
XTurns on verbose mode.  This will make
X.BR pstags
Xtell you if it gets confused on any particular construct.
X.TP
X.BI \-f " [out-file]"
XSets the out file.
X.SH EXAMPLES
XUsing
X.B pstags
Xon a file containing the function definition
X.sp .5
X.RS
X.BI "cdef " function_name "(int " arg") "
X.RE
X.LP
Xproduces the tag 
X.I function_name.
X.LP
XInserting the comment:
X.sp .5
X.RS
X.BI "/name { %  object => - pstag=<name>" 
X.RE
X.LP
Xin the source file yields the tag 
X.I name
Xfor that line. Note that it is the string within the 
X.B <...>
Xthat is used as the tag.
X.LP
XThe tag for a class definition will be the class name and the
Xtag for a method inside of a class will be the class_name.method_name
X.LP
XNatually this meas that you will have to use the tag directly instead
Xof using ^] (if using these under vi).
X.LP
X.sp .5
X.RS
X.BI "/foo Object [] classbegin /bar { (hello) == } def classend"
X.RE
X.LP
Xwill produce both a tag called "foo" and a tag called "foo.bar"
X.LP
XThe manual for the custom emacs tags files is in a seperate document.
X.SH FILES
X.PD 0
X.TP 20
X.B ps.tags
Xoutput tags file
X.PD
X.BR
X.SH SEE ALSO
X.BR ctags (1),
X.BR etags (l),
X.BR emacs (l),
X.BR ex (1),
X.BR psindent (1),
X.BR vgrind (1),
X.BR vi (1)
X.SH BUGS
XShould be able to generate both a 
X.I emacs 
Xtag file and a 
X.I ex(1) 
Xtag file at the same time.
X.SH AUTHOR
XJosh Siegel (siegel@sun.com)
END_OF_FILE
if test 3215 -ne `wc -c <'pstags.1'`; then
    echo shar: \"'pstags.1'\" unpacked with wrong size!
fi
# end of 'pstags.1'
fi
if test -f 'pstags.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'pstags.c'\"
else
echo shar: Extracting \"'pstags.c'\" \(18306 characters\)
sed "s/^X//" >'pstags.c' <<'END_OF_FILE'
X#include <stdio.h>
X#include <ctype.h>
X#include <sys/param.h>
X#include <sys/file.h>
X#include <sys/stat.h>
X#include <string.h>
X
X/*
X * This program is pritty brute force.  No clever programming here...
X * 
X * Written by: Josh Siegel Fri Sep 14 14:19:21 PDT 1990
X */
X
Xtypedef enum {
X    false = 0, true = 1
X} bool;
X
Xbool	    in_class;
X
Xextern char    *malloc();
X
Xchar	   *progname;
Xchar	   *out_file;
Xbool	    gnu_mode;
Xbool	    emacs_mode;
Xbool	    rel_mode;
Xbool	    verbose;
Xbool	    methods;
X
Xstruct ll_struct {
X    struct ll_struct *next;
X    char	   *func_name;
X    char	   *comment;
X    char	   *file;
X    char	   *line;
X    int	     cno;
X    int	     lno;
X}	      *first = 0;
X
Xint	     ent_cnt = 0;
Xint	     fcnt = 0;
X
XFILE	   *outf;
X
Xextern void usage();
Xextern void extract_tags();
Xextern void print_entries();
Xextern void qsort();
Xextern void fprintf();
Xextern void printf();
Xextern void free();
Xextern void fclose();
Xextern void close();
Xextern void exit();
Xextern void perror();
X
Xextern int getopt();
Xextern int read();
X
Xvoid
Xmain(argc, argv)
X    int	     argc;
X    char	   *argv[];
X{
X    extern int      optind;
X    extern char    *optarg;
X    int	     c;
X
X    out_file = "ps.tags";
X    gnu_mode = false;
X    emacs_mode = false;
X    rel_mode = false;
X    verbose = false;
X    methods = false;
X
X    progname = argv[0];
X
X    if (argc < 2)
X	usage();
X
X    while ((c = getopt(argc, argv, "Ef:ervm")) != EOF)
X	switch (c) {
X	case 'f':
X	    out_file = optarg;
X	    break;
X	case 'e':
X	    gnu_mode = true;
X	    out_file = "ps.TAGS";
X	    break;
X	case 'E':
X	    emacs_mode = true;
X	    out_file = "TAGS.el";
X	    break;
X	case 'r':
X	    rel_mode = true;
X	    break;
X	case 'v':
X	    verbose = true;
X	    break;
X	case 'm':
X	    methods = true;
X	    break;
X	case '?':
X	    usage();
X	    break;
X	}
X
X    argc -= optind;
X    argv += optind;
X
X    outf = fopen(out_file, "w");
X
X    if (emacs_mode)
X        fprintf(outf, "(setq ps-bit-o-list (list\n");
X    while (argc) {
X	if (verbose)
X	    printf("File: %s\n", argv[0]);
X	extract_tags(argv[0]);
X	argc--;
X	argv++;
X
X	if (gnu_mode)
X	    print_entries();
X    }
X
X    print_entries();
X
X    if (emacs_mode)
X        fprintf(outf, "))\n");
X
X    fclose(outf);
X
X    exit(0);
X}
X
Xvoid
Xusage()
X{
X    fprintf(stderr, "Usage: %s [-Eemrv] [ -f out_file ] file [ ... ]\n", progname);
X    exit(1);
X}
X
Xvoid
Xadd_entry(name, file, line, lno, cno, comment)
X    char	   *name;
X    char	   *file;
X    char	   *line;
X    int	     lno;
X    int	     cno;
X    char	   *comment;
X{
X    struct ll_struct *foo;
X
X    foo = (struct ll_struct *) malloc(sizeof(struct ll_struct));
X
X    foo->file = file;
X
X    foo->cno = cno;
X    foo->lno = lno;
X    foo->comment = comment;
X
X    foo->func_name = malloc(strlen(name) + 1);
X    strcpy(foo->func_name, name);
X
X    foo->line = malloc(strlen(line) + 1);
X    strcpy(foo->line, line);
X
X    foo->next = first;
X    first = foo;
X
X    ent_cnt++;
X}
X
Xvoid
Xclear_entries()
X{
X    struct ll_struct *next;
X
X    while (first) {
X	next = first->next;
X
X	free(first->func_name);
X	free(first->line);
X	free(first);
X
X	first = next;
X    }
X    ent_cnt = 0;
X}
X
Xint
Xent_cmp(a, b)
X    struct ll_struct **a, **b;
X{
X    return (strcmp((*a)->func_name, (*b)->func_name));
X}
X
Xvoid
Xprint_entries()
X{
X    struct ll_struct *runner;
X
X    if (first == (struct ll_struct *) 0)
X	return;
X
X    if (gnu_mode) {
X	char	    buff[4096];
X	char	    buf[128];
X	register char  *ptr, *p2;
X	register int    len;
X
X	ptr = buff;
X
X	runner = first;
X
X	while (runner) {
X	    p2 = runner->line;
X	    len = strlen(runner->func_name);
X	    while (strncmp(runner->func_name, p2, len))
X		p2++;
X	    p2[len] = '\0';
X
X	    sprintf(buf, "%s%c%d,%d\n", runner->line, 0177,
X		runner->lno, runner->cno);
X	    p2 = buf;
X	    while (*p2) {
X		*ptr++ = *p2++;
X	    }
X	    runner = runner->next;
X	}
X
X	*ptr = '\0';
X
X	fprintf(outf, "\f\n%s,%d\n",
X	    first->file, ptr - buff);
X	fprintf(outf, "%s", buff);
X
X	clear_entries();
X    } else if (emacs_mode) {
X	register struct ll_struct **full_list;
X	register int    idx;
X
X	full_list = (struct ll_struct **)
X	    malloc(ent_cnt * sizeof(struct ll_struct *));
X
X	runner = first;
X	idx = 0;
X
X	while (runner) {
X	    full_list[idx++] = runner;
X	    runner = runner->next;
X	}
X
X	if (idx != ent_cnt) {
X	    printf("Somethings wrong!\n");
X	    exit(0);
X	}
X	qsort(full_list, ent_cnt, sizeof(struct ll_struct *), ent_cmp);
X
X	if (in_class) {
X	  if (rel_mode) {
X	    for (idx = 0; idx < ent_cnt; idx++)
X	      if (full_list[idx]->comment)
X		fprintf(outf, "\t\t(list \"%s\"\t(regexp-quote \"%s\")\t\"%s\")\n",
X			full_list[idx]->func_name,
X			full_list[idx]->line, full_list[idx]->comment);
X	      else
X		fprintf(outf, "\t\t(list \"%s\"\t(regexp-quote \"%s\"))\n",
X			full_list[idx]->func_name, full_list[idx]->line);
X	  } else {
X	    for (idx = 0; idx < ent_cnt; idx++)
X	      if (full_list[idx]->comment)
X		fprintf(outf, "\t\t(list \"%s\"\t%d\t\"%s\")\n",
X			full_list[idx]->func_name,
X			full_list[idx]->cno, full_list[idx]->comment);
X	      else
X		fprintf(outf, "\t\t(list \"%s\"\t%d)\n",
X			full_list[idx]->func_name, full_list[idx]->cno);
X	  }
X	} else {
X	  if (rel_mode) {
X	    for (idx = 0; idx < ent_cnt; idx++)
X	      if (full_list[idx]->comment)
X		fprintf(outf, "(list \"%s\"\t\"%s\"\t(regexp-quote \"%s\")\t\"%s\")\n",
X			full_list[idx]->func_name,full_list[idx]->file,
X			full_list[idx]->line, full_list[idx]->comment);
X	      else
X		fprintf(outf, "(list \"%s\"\t\"%s\"\t(regexp-quote \"%s\"))\n",
X			full_list[idx]->func_name, full_list[idx]->file,
X			full_list[idx]->line);
X	  } else {
X	    for (idx = 0; idx < ent_cnt; idx++)
X	      if (full_list[idx]->comment)
X		fprintf(outf, "(list \"%s\"\t\"%s\"\t%d\t\"%s\")\n",
X			full_list[idx]->func_name,full_list[idx]->file,
X			full_list[idx]->cno, full_list[idx]->comment);
X	      else
X		fprintf(outf, "(list \"%s\"\t\"%s\"\t%d)\n",
X			full_list[idx]->func_name,full_list[idx]->file,
X			full_list[idx]->cno);
X	  }
X	}
X	clear_entries();
X    } else {
X	register struct ll_struct **full_list;
X	register int    idx;
X
X	full_list = (struct ll_struct **)
X	    malloc(ent_cnt * sizeof(struct ll_struct *));
X
X	runner = first;
X	idx = 0;
X
X	while (runner) {
X	    full_list[idx++] = runner;
X	    runner = runner->next;
X	}
X
X	if (idx != ent_cnt) {
X	    printf("Somethings wrong!\n");
X	    exit(0);
X	}
X	qsort(full_list, ent_cnt, sizeof(struct ll_struct *), ent_cmp);
X
X	for (idx = 0; idx < ent_cnt; idx++)
X	    fprintf(outf, "%s\t%s\t/^%s$/\n",
X		full_list[idx]->func_name, full_list[idx]->file, full_list[idx]->line);
X    }
X}
X
Xchar	   *
Xbackup_white(ptr, lno)
X    register char  *ptr;
X    int	    *lno;
X{
X    register char  *p2;
X
X    while (1) {
X	switch (*ptr) {
X	case ' ':
X	case '\t':
X	    ptr--;
X	    break;
X	case '\n':
X	    (*lno)--;    /* We are stepping back up a line */
X
X	    /* Now we need to look for a comment */
X	    p2 = ptr - 1;
X	    while (*p2 != '%' && *p2 != '\0' && *p2 != '\n')
X		p2--;
X	    if (*p2 == '%')
X		ptr = p2 - 1;
X	    else
X		ptr--;
X	    break;
X	default:
X	    return (ptr);
X	}
X    }
X}
X
X/*
X * This function assumes we are looking at a larger then life word in
X * PostScript land.
X */
X
Xchar	    DictBegin[] = {"dictbegin"};
Xchar	    DictEnd[] = {"dictend"};
X
X#ifdef SNOT	    /* A ifdef to honor Scott Comer */
Xchar	    ClassBegin[] = {"classbegin"};
Xchar	    ClassEnd[] = {"classend"};
X#endif
X
Xchar	   *
Xstring_match(ptr, lno)
X    register char  *ptr;
X    int	    *lno;
X{
X    int	     count;
X    int	     dir, adderlen, suberlen;
X    char	   *suber;
X    char	   *adder;
X
X    /* Back up to the beginning of the word */
X
X    while (1) {
X	switch (*ptr) {
X	case '[':
X	case '{':
X	case '(':
X	case ']':
X	case '}':
X	case ')':
X	case ' ':
X	case '\t':
X	case '\0':
X	case '\n':
X	    goto got_there;
X	default:
X	    ptr--;
X	}
X    }
Xgot_there:
X    ptr++;
X
X    if (!strncmp(ptr, DictBegin, sizeof(DictBegin) - 1)) {
X	adder = DictBegin;
X	suber = DictEnd;
X	dir = 1;
X	adderlen = sizeof(DictBegin) - 1;
X	suberlen = sizeof(DictEnd) - 1;
X    } else if (!strncmp(ptr, DictEnd, sizeof(DictEnd) - 1)) {
X	adder = DictEnd;
X	suber = DictBegin;
X	dir = -1;
X	adderlen = sizeof(DictEnd) - 1;
X	suberlen = sizeof(DictBegin) - 1;
X    } else
X	return (NULL);
X
X    count = 1;
X
X    while (*ptr) {
X	ptr += dir;
X	if (*ptr == '\n') {
X	    if (dir == 1)
X		(*lno)++;
X	    else
X		(*lno)--;
X	}
X	if (!strncmp(ptr, adder, adderlen))
X	    count++;
X	if (!strncmp(ptr, suber, suberlen))
X	    count--;
X	if (count == 0)
X	    return (ptr);
X    }
X    return (NULL);
X}
X
X/*
X * generalized find_match().  Since I will need this later, I decided to
X * generalize it now
X */
X
Xchar	   *
Xmatch_parens(ptr, lno, flg)
X    register char  *ptr;
X    int	    *lno;
X    bool	    flg;
X{
X    register char   adder, suber;
X    register int    count, dir;
X
X    adder = *ptr;
X    switch (*ptr) {
X    case '(':
X	suber = ')';
X	dir = 1;
X	break;
X    case ')':
X	suber = '(';
X	dir = -1;
X	break;
X    default:
X	fprintf(stderr, "Ack! match_parens() was called on a non-paren!\n");
X	exit(0);
X	dir = -1;
X	suber = 'a';
X    }
X
X    count = 1;
X
X    while (*ptr) {
X	ptr += dir;
X	if (*ptr == '\n') {
X	    if (flg == false)
X		return (NULL);
X	    if (dir == 1)
X		(*lno)++;
X	    else {
X		(*lno)--;
X	    }
X	} else if (*ptr == adder) {
X	    count++;
X	} else if (*ptr == suber) {
X	    count--;
X	}
X	if (count == 0) {
X	    return (ptr);
X	}
X    }
X    return (NULL);
X}
X
Xchar	   *
Xback_comment(ptr, lno)
X    char	   *ptr;
X    int	           *lno;
X{
X    register char           *tmp, *tmp2;
X
X    tmp = ptr - 1;
X
X    while (1) {
X        while (*tmp != '\n' && *tmp != '\0' && *tmp != ')' && *tmp != '%')
X            tmp--;    /* back to the beginning of the line */
X    
X        switch (*tmp) {
X           case '\n':
X           case '\0':
X               return (ptr);
X           case ')':
X                tmp2 = match_parens(tmp, lno, false);
X                if (tmp2 != NULL)
X                    tmp = tmp2;
X                break;
X           case '%':
X               ptr = tmp;
X               break;
X           default:
X		fprintf(stderr,"can't get here!\n");
X		exit(0);
X        }
X	tmp--;
X    }
X}
Xchar	   *
Xfind_match(ptr, lno)
X    register char  *ptr;
X    int	    *lno;
X{
X    register char   adder, suber;
X    register int    count, dir;
X
X    adder = *ptr;
X    switch (*ptr) {
X    case '[':
X	suber = ']';
X	dir = 1;
X	break;
X    case '{':
X	suber = '}';
X	dir = 1;
X	break;
X    case '(':
X	return (match_parens(ptr, lno, true));
X    case ']':
X	suber = '[';
X	dir = -1;
X	break;
X    case '}':
X	suber = '{';
X	dir = -1;
X	break;
X    case ')':
X	return (match_parens(ptr, lno, true));
X    case ' ':
X    case '\t':
X    case '\n':
X    case '\0':
X	return (NULL);
X    default:
X	return (string_match(ptr, lno));
X    }
X
X    count = 1;
X
X    while (*ptr) {
X	ptr += dir;
X	if (*ptr == '\n') {
X	    if (dir == 1)
X		(*lno)++;
X	    else {
X		(*lno)--;
X
X		ptr = back_comment(ptr, lno);
X	    }
X	} else if (*ptr == adder) {
X	    count++;
X	} else if (*ptr == suber) {
X	    count--;
X	} else if (*ptr == '(') {
X	    if (dir == -1)
X		return (NULL);
X	    ptr = match_parens(ptr, lno, true);
X	    if (ptr == NULL) {
X		fprintf(stderr, "Unmatched string!\n");
X		exit(0);
X	    }
X	} else if (*ptr == ')') {
X	    if (dir == 1)
X		return (NULL);
X	    ptr = match_parens(ptr, lno, true);
X	    if (ptr == NULL) {
X		fprintf(stderr, "Unmatched string!\n");
X		exit(0);
X	    }
X	} else if (*ptr == '%') {
X	    while (*ptr != '\n' && *ptr != '\0')
X		ptr++;
X	    ptr--;
X	}
X	if (count == 0) {
X	    return (ptr);
X	}
X    }
X    return (NULL);
X}
X
X/*
X * Search backawards and return before the next PostScript object.
X */
X
Xchar	   *
Xback_obj(ptr, lno)
X    register char  *ptr;
X    int	    *lno;
X{
X    char	   *rptr;
X
X    ptr = backup_white(ptr, lno);
X
X    rptr = find_match(ptr, lno);
X    if (rptr != NULL)
X	return (rptr);
X
X    while (1) {
X	ptr--;
X	switch (*ptr) {
X	case '[':
X	case '{':
X	case '(':
X	case ']':
X	case '}':
X	case ')':
X	case ' ':
X	case '\t':
X	case '\0':
X	case '\n':
X	    return (ptr + 1);
X	default:
X	    break;
X	}
X    }
X}
X
Xvoid
Xpump_out(dest, src, len)
X    register char  *dest;
X    register char  *src;
X    register int    len;
X{
X    while (len--) {
X	if (emacs_mode) {
X	    if (*src == '"') {
X		*dest++ = '\\';
X	    }
X	} else {
X	    if (!gnu_mode) {
X		if (*src == '/') {
X		    *dest++ = '\\';
X		}
X	    }
X	}
X	*dest++ = *src++;
X    }
X    *dest = '\0';
X}
X
Xvoid
Xextract_tags(file)
X    char	   *file;
X{
X    static char    *mem_buf = 0;
X    static int      buf_size = -1;
X
X    struct stat     stat_buf;
X    int	     fd, n;
X    register char  *ptr, *end_ptr, *tmp_ptr, *whr;
X    int	     lno;
X    int	     tlno;
X    char	    class_name[64];
X    char	    tag_name[128];
X    char	    tag_line[1024];
X
X    in_class = false;
X
X    fd = open(file, O_RDONLY);
X
X    lno = 1;
X
X    if (fd < 0) {
X	perror(file);
X	exit(0);
X    }
X    if (fstat(fd, &stat_buf) < 0) {
X	perror(file);
X	exit(0);
X    }
X    if (stat_buf.st_size + 2 > buf_size) {
X
X	if (mem_buf)
X	    free(mem_buf);
X
X	mem_buf = (char *) malloc(stat_buf.st_size + 2);
X	buf_size = stat_buf.st_size + 2;
X    }
X    n = read(fd, mem_buf + 1, stat_buf.st_size);
X
X    if (n != stat_buf.st_size) {    /* reads should give you everything! */
X	perror("read");
X	exit(0);
X    }
X    mem_buf[stat_buf.st_size] = '\0';    /* NULL terminated */
X    mem_buf[0] = '\0';
X
X    ptr = mem_buf + 1;    /* Start past the null termination */
X
X    while (*ptr) {
X	if (*ptr == 'c') {    /* Avoid the strncmp unless we have
X		     * to */
X	    if (!strncmp(ptr, "classbegin", 10)) {
X		if (*(ptr - 1) == '/') {
X		    ptr++;    /* This is a /classbegin
X			 * turd! */
X		    continue;
X		}
X		if (in_class) {
X		    in_class = false;
X		}
X		if (emacs_mode) {
X		  print_entries();
X		}
X		tlno = lno;
X		tmp_ptr = back_obj(ptr - 1, &tlno);
X		/* Pointing at instance dict */
X		if (tmp_ptr == NULL) {
X		    ptr++;
X		    continue;
X		}
X		whr = tmp_ptr - 1;
X		tmp_ptr = back_obj(tmp_ptr - 1, &tlno);
X		/* Pointing at parent class */
X		if (tmp_ptr == NULL) {
X		    ptr++;
X		    continue;
X		}
X		if (!strncmp(tmp_ptr, "send", 4)) {
X		    /*
X		     * Snif snif... I smell a
X		     * /DefaultClass ClassSelectable send
X		     */
X
X		    tmp_ptr = back_obj(tmp_ptr - 1, &tlno);
X		    if (tmp_ptr == NULL) {
X			ptr++;
X			continue;
X		    }
X		    tmp_ptr = back_obj(tmp_ptr - 1, &tlno);
X		    if (tmp_ptr == NULL) {
X			ptr++;
X			continue;
X		    }
X		}
X		tmp_ptr = back_obj(tmp_ptr - 1, &tlno);
X		/* Pointing at class name */
X		if (tmp_ptr == NULL) {
X		    ptr++;
X		    continue;
X		}
X		end_ptr = tmp_ptr;
X		while (*end_ptr != ' ' && *end_ptr != '\t' && *end_ptr != '\n')
X		    end_ptr++;
X
X		pump_out(tag_name, whr = (tmp_ptr + 1), end_ptr - tmp_ptr - 1);
X
X		while (*end_ptr != '\0' && *end_ptr != '\n')
X		    end_ptr++;
X
X		while (*tmp_ptr != '\0' && *tmp_ptr != '\n')
X		    tmp_ptr--;
X
X		pump_out(tag_line, tmp_ptr + 1, end_ptr - tmp_ptr - 1);
X
X		if (*(whr - 1) != '/') {
X		    if (verbose)
X			fprintf(stderr, "I'm confused about class %s in file %s (line %d)\n", tag_name, file, tlno);
X		} else {
X		    in_class = true;
X		    if (emacs_mode) {
X			if (rel_mode)
X			    fprintf(outf, "(list \"%s\"\t\"%s\"\t(regexp-quote \"%s\")\n\t(list\n",
X				tag_name, file, tag_line);
X			else
X			    fprintf(outf, "(list \"%s\"\t\"%s\"\t%d\t\t(list\n",
X				tag_name, file, whr + 1 - mem_buf);
X		    } else {
X			strcpy(class_name, tag_name);
X			add_entry(tag_name, file, tag_line, tlno, whr + 1 - mem_buf, 0);
X		    }
X		}
X	    }
X	    if ((!strncmp(ptr, "classend", 8)) && (*(ptr - 1) != '/')) {
X		if (in_class) {
X		    if (emacs_mode) {
X			print_entries();
X			fprintf(outf, "\t)\n)\n");
X		    }
X		    in_class = false;
X		} else if (verbose)
X		    fprintf(stderr, "classend without classbegin: %s\n", file);
X	    }
X	    if (!strncmp(ptr - 1, "\ncdef", 5)) {
X		if (in_class) {
X		    if (emacs_mode) {
X			print_entries();
X			fprintf(outf, "\t)\n)\n");
X		    }
X		    in_class = false;
X		}
X
X		tmp_ptr = ptr + 4;
X		while (*tmp_ptr == ' ' || *tmp_ptr == '\t')
X		    tmp_ptr++;
X
X		end_ptr = tmp_ptr;
X		while (*end_ptr != '(' && *end_ptr != '\n')
X		    end_ptr++;
X
X		pump_out(tag_name, tmp_ptr, end_ptr - tmp_ptr);
X
X		end_ptr = ptr + 4;
X		while (*end_ptr != '\n')
X		    end_ptr++;
X
X		pump_out(tag_line, ptr, end_ptr - ptr);
X		add_entry(tag_name, file, tag_line, lno, tmp_ptr - mem_buf, 0);
X		ptr = end_ptr;
X	    }
X	}
X	if (*ptr == 'd') {
X	    if (gnu_mode == false && methods == true && in_class == true) {
X		if (!strncmp(ptr, "def", 3)) {
X		    tlno = lno;
X		    tmp_ptr = back_obj(ptr - 1, &tlno);
X		    /* Pointing at whats begin defined */
X		    if (tmp_ptr == NULL) {
X			ptr++;
X			continue;
X		    }
X		    tmp_ptr = back_obj(tmp_ptr - 1, &tlno);
X		    /* Pointing at method name */
X		    if (tmp_ptr == NULL) {
X			ptr++;
X			continue;
X		    }
X		    if (*tmp_ptr != '/') {
X			ptr++;
X			continue;
X		    }
X		    end_ptr = tmp_ptr;
X		    while (*end_ptr != ' ' && *end_ptr != '\t' && *end_ptr != '\n')
X			end_ptr++;
X
X		    if (!emacs_mode) {
X			strcpy(tag_name, class_name);
X			strcat(tag_name, ".");
X		    } else {
X			tag_name[0] = '\0';
X		    }
X
X		    pump_out(tag_name + strlen(tag_name), whr = (tmp_ptr + 1),
X			 end_ptr - tmp_ptr - 1);
X		    while (*end_ptr != '\0' && *end_ptr != '\n')
X			end_ptr++;
X
X		    while (*tmp_ptr != '\0' && *tmp_ptr != '\n')
X			tmp_ptr--;
X
X		    pump_out(tag_line, tmp_ptr + 1, end_ptr - tmp_ptr - 1);
X
X		    add_entry(tag_name, file, tag_line, tlno, whr + 1 - mem_buf, 0);
X		}
X	    }
X	}
X	if (*ptr == '%') {    /* We have a comment here */
X	    while (*ptr) {
X		if (*ptr == '\n')
X		    break;
X		if (!strncmp(ptr, "pstag=<", 7)) {    /* We found one */
X
X		    tmp_ptr = ptr;
X		    while (*tmp_ptr != '\n' && *tmp_ptr != '\0')
X			tmp_ptr--;
X
X		    tmp_ptr++;    /* The beginning of the
X			     * line */
X
X		    ptr += 7;
X
X		    end_ptr = ptr;
X
X		    while (*end_ptr != '>' && *end_ptr != '\n')
X			end_ptr++;
X
X		    pump_out(tag_name, ptr, end_ptr - ptr);
X
X		    while (*end_ptr != '\n')
X			end_ptr++;
X
X		    pump_out(tag_line, tmp_ptr, end_ptr - tmp_ptr);
X
X		    add_entry(tag_name, file, tag_line, lno, ptr - mem_buf, 0);
X		    ptr = end_ptr;
X
X		    break;
X		}
X		ptr++;
X	    }
X	    if (*ptr == '\0')
X		ptr--;
X	}
X	if (*ptr == '{' || *ptr == '(') {
X	    register char  *rptr;
X	    int	     nlno;
X
X	    /* Lets match this puppy */
X
X	    nlno = lno;
X	    rptr = find_match(ptr, &nlno);
X	    if (rptr == NULL) {
X	      fprintf(stderr, "Unmatched brace '{'\n");
X	      close(fd);
X	      return;
X	    }
X	    ptr = rptr;
X	    lno = nlno;
X	}
X	if (*ptr == '\n')
X	    lno++;
X
X	ptr++;
X    }
X
X    close(fd);
X}
END_OF_FILE
if test 18306 -ne `wc -c <'pstags.c'`; then
    echo shar: \"'pstags.c'\" unpacked with wrong size!
fi
# end of 'pstags.c'
fi
echo shar: End of archive 1 \(of 1\).
cp /dev/null ark1isdone
MISSING=""
for I in 1 ; do
    if test ! -f ark${I}isdone ; then
	MISSING="${MISSING} ${I}"
    fi
done
if test "${MISSING}" = "" ; then
    echo You have the archive.
    rm -f ark[1-9]isdone
else
    echo You still need to unpack the following archives:
    echo "        " ${MISSING}
fi
##  End of shell archive.
exit 0