[PATCH] Install documentation generator

The new tool is installed as gst-doc.  To this end, the Publish.st is
moved into its own .star package, ClassPublisher.  Merging GenBaseDoc.st
and GenLibDoc.st into a single script with a decent command-line
interface highlighted a few deficencies in #nameIn: implementations
(some returned a String, some a Symbol) and in the package hierarchy
(StarPackage lacked a couple of useful methods) which this patch also fixes.

Last but not least, the doc/Makefile.am is also a tad simpler becausee
the command-line interface of GenDoc.st is much better than the one of
GenLibDoc.st.

Paolo

2007-08-06  Paolo Bonzini  <[hidden email]>

        * kernel/Behavior.st: Add a (notYetImplemented) parseTreeFor: method.
        * kernel/PkgLoader.st: Move #fullPathsOf: (new name of #findPathsFor:)
        and #createNamespace up to PackageInfo, implement #fullPathOf: (new name
        of #findPathFor:) in StarPackage.

        * kernel/Namespace.st: Return a string in #nameIn:.
        * kernel/RootNamespc.st: Return a string in #nameIn:.

        * kernel/SeqCollect.st: Add #first: and #last:.
        * kernel/VFSZip.st: Add #copyFrom:to: to LimitedStream.

        * scripts/GenDoc.st: New.
        * scripts/Package.st: Fix for renaming of #findPathFor:.
        * scripts/GenBaseDoc.st: Removed.
        * scripts/GenLibDoc.st: Removed.

packages/stinst/parser:
2007-08-06  Paolo Bonzini  <[hidden email]>

        * STLoader.st: Accept a non-proxy namespace in #currentNamespace:.
        Add #loadedClasses.
        * STLoaderObjs.st: Ensure #nameIn: returns a string.

packages/stinst/doc:
2007-08-06  Paolo Bonzini  <[hidden email]>

        * Publish.st: From examples/Publish.st.  Rename classes.

* looking for [hidden email]--2004b/smalltalk--devo--2.2--patch-497 to compare with
* comparing to [hidden email]--2004b/smalltalk--devo--2.2--patch-497
A/ packages/stinst/doc
A  packages/stinst/doc/package.xml
D  scripts/GenBaseDoc.st
M  scripts/Package.st
M  kernel/VFSZip.st
M  gst-tool.c
M  configure.ac
M  doc/Makefile.am
M  packages/stinst/doc/Publish.st
M  Makefile.am
M  packages/stinst/parser/STLoader.st
M  packages/stinst/parser/STLoaderObjs.st
M  kernel/Behavior.st
M  kernel/Class.st
M  kernel/Namespace.st
M  kernel/PkgLoader.st
M  kernel/RootNamespc.st
M  kernel/SeqCollect.st
M  packages.xml
M  scripts/GenDoc.st
=> examples/.arch-ids/Publish.st.id packages/stinst/doc/.arch-ids/Publish.st.id
=> examples/Publish.st packages/stinst/doc/Publish.st
=> scripts/.arch-ids/GenLibDoc.st.id scripts/.arch-ids/GenDoc.st.id
=> scripts/GenLibDoc.st scripts/GenDoc.st

* modified files

--- orig/Makefile.am
+++ mod/Makefile.am
@@ -62,8 +62,7 @@ nodist_pkgconfig_DATA = gnu-smalltalk.pc
 pkglib_DATA = libc.la
 noinst_DATA = gst.im
 dist_noinst_DATA += smalltalk-mode.el.in gst-mode.el.in .gdbinit \
- scripts/Finish.st scripts/GenLibDoc.st \
- scripts/GenBaseDoc.st gsticon.ico
+ scripts/Finish.st gsticon.ico
 
 if WITH_EMACS
 nodist_lisp_LISP = smalltalk-mode.el
@@ -121,7 +120,7 @@ gst_tool_LDADD = libgst/libgst.la
 gst_tool_DEPENDENCIES = libgst/libgst.la
 gst_tool_LDFLAGS = -export-dynamic -static
 
-GST_EXTRA_TOOLS = gst-reload gst-sunit gst-blox gst-package gst-convert
+GST_EXTRA_TOOLS = gst-reload gst-sunit gst-blox gst-package gst-convert gst-doc
 
 uninstall-local::
  @for i in gst-load $(GST_EXTRA_TOOLS); do \


--- orig/configure.ac
+++ mod/configure.ac
@@ -304,6 +304,7 @@ GST_PACKAGE_ENABLE([NetClients], [net])
 GST_PACKAGE_ENABLE([DhbNumericalMethods], [numerics])
 GST_PACKAGE_ENABLE([Compiler], [stinst/compiler])
 GST_PACKAGE_ENABLE([Parser], [stinst/parser])
+GST_PACKAGE_ENABLE([ClassPublisher], [stinst/doc])
 GST_PACKAGE_ENABLE([SUnit], [sunit])
 GST_PACKAGE_ENABLE([TCP], [tcp],
   [GST_INET_SOCKETS],


--- orig/doc/Makefile.am
+++ mod/doc/Makefile.am
@@ -8,7 +8,9 @@ HTML_IMAGES = images/backon.png images/b
  images/prevon.png images/prev.png images/tocon.png \
  images/toc.png images/upon.png images/up.png
 
-dist_man_MANS = gst.1 gst-load.1 gst-package.1 gst-sunit.1 gst-config.1 gst-convert.1
+dist_man_MANS = gst.1 gst-load.1 gst-package.1 gst-sunit.1 gst-config.1 \
+ gst-convert.1 gst-doc.1
+
 HELP2MAN = $(top_srcdir)/build-aux/help2man -p gst
 
 info_TEXINFOS = gst.texi gst-base.texi gst-libs.texi
@@ -21,6 +23,9 @@ MOSTLYCLEANFILES = gst-libs.me gst-libs.
  gst-libs.cl gst-libs.cls gst-base.cl gst-base.cls \
  gst-libs.sl gst-libs.sls gst-base.sl gst-base.sls
 
+GST_TOOL_ARGS = -I $(top_builddir)/gst.im --kernel-dir $(top_srcdir)/kernel
+GST_DOC = $(top_builddir)/gst-tool gst-doc $(GST_TOOL_ARGS)
+
 ####################################################
 ##
 ##  Rule to build the man page
@@ -30,26 +35,27 @@ MOSTLYCLEANFILES = gst-libs.me gst-libs.
 $(srcdir)/gst-package.1: $(top_srcdir)/scripts/Package.st $(top_srcdir)/configure.ac
  $(HELP2MAN) \
   --name "create and install GNU Smalltalk .star package files" \
-  "$(top_builddir)/gst-tool gst-package -I $(top_builddir)/gst.im \
-     --kernel-directory $(top_srcdir)/kernel" >$@
+  "$(top_builddir)/gst-tool gst-package $(GST_TOOL_ARGS)" >$@
 
 $(srcdir)/gst-convert.1: $(top_srcdir)/scripts/Load.st $(top_srcdir)/configure.ac
  $(HELP2MAN) \
   --name "Smalltalk syntax converter and beautifier" \
-  "$(top_builddir)/gst-tool gst-convert -I $(top_builddir)/gst.im \
-     --kernel-directory $(top_srcdir)/kernel" >$@
+  "$(top_builddir)/gst-tool gst-convert $(GST_TOOL_ARGS)" >$@
 
 $(srcdir)/gst-load.1: $(top_srcdir)/scripts/Load.st $(top_srcdir)/configure.ac
  $(HELP2MAN) \
   --name "test and load packages into a GNU Smalltalk image" \
-  "$(top_builddir)/gst-tool gst-load -I $(top_builddir)/gst.im \
-     --kernel-directory $(top_srcdir)/kernel" >$@
+  "$(top_builddir)/gst-tool gst-load $(GST_TOOL_ARGS)" >$@
 
 $(srcdir)/gst-sunit.1: $(top_srcdir)/scripts/Test.st $(top_srcdir)/configure.ac
  $(HELP2MAN) \
   --name "unit testing tool for GNU Smalltalk" \
-  "$(top_builddir)/gst-tool gst-load -I $(top_builddir)/gst.im \
-     --kernel-directory $(top_srcdir)/kernel" >$@
+  "$(top_builddir)/gst-tool gst-sunit $(GST_TOOL_ARGS)" >$@
+
+$(srcdir)/gst-doc.1: $(top_srcdir)/scripts/GenDoc.st $(top_srcdir)/configure.ac
+ $(HELP2MAN) \
+  --name "GNU Smalltalk documentation generator" \
+  "$(top_builddir)/gst-tool gst-doc $(GST_TOOL_ARGS)" >$@
 
 $(srcdir)/gst.1: $(top_srcdir)/main.c $(top_srcdir)/configure.ac
  $(HELP2MAN) \
@@ -72,30 +78,26 @@ install-data-local: install-man
 ##
 ####################################################
 
-PUBLISHED_NAMESPACES = Smalltalk SystemExceptions NetClients VFS
+PUBLISHED_CLASSES = Smalltalk.* SystemExceptions.* NetClients.* VFS.*
 
 $(srcdir)/blox.texi: $(top_srcdir)/packages/blox/tk/stamp-classes
- rm -f $(srcdir)/blox.texi
- cd $(srcdir) && @abs_top_builddir@/gst -I @abs_top_builddir@/gst.im \
-    -f ../scripts/GenLibDoc.st BLOX BloxTK blox.texi Blox.st
+ $(GST_DOC) -p BloxTK -o $(srcdir)/blox.texi BLOX.* || \
+  rm -f $(srcdir)/blox.texi
  test -f $(srcdir)/blox.texi && touch $(srcdir)/gst-libs.texi
 
 $(srcdir)/tcp.texi: $(top_srcdir)/packages/tcp/stamp-classes
- rm -f $(srcdir)/tcp.texi
- cd $(srcdir) && @abs_top_builddir@/gst -I @abs_top_builddir@/gst.im \
-    -f ../scripts/GenLibDoc.st TCP TCP tcp.texi TCP.st
+ $(GST_DOC) -p TCP -o $(srcdir)/tcp.texi TCP.* || \
+  rm -f $(srcdir)/tcp.texi
  test -f $(srcdir)/tcp.texi && touch $(srcdir)/gst-libs.texi
 
 $(srcdir)/i18n.texi: $(top_srcdir)/packages/i18n/stamp-classes
- rm -f $(srcdir)/i18n.texi
- cd $(srcdir) && @abs_top_builddir@/gst -I @abs_top_builddir@/gst.im \
-    -f ../scripts/GenLibDoc.st I18N I18N i18n.texi Load.st Collation.st
+ $(GST_DOC) -p I18N -o $(srcdir)/i18n.texi I18N.* || \
+  rm -f $(srcdir)/i18n.texi
  test -f $(srcdir)/i18n.texi && touch $(srcdir)/gst-libs.texi
 
 $(srcdir)/classes.texi: $(top_srcdir)/kernel/stamp-classes
- rm -f $(srcdir)/classes.texi
- cd $(srcdir) && @abs_top_builddir@/gst -I @abs_top_builddir@/gst.im \
-    -f ../scripts/GenBaseDoc.st $(PUBLISHED_NAMESPACES)
+ $(GST_DOC) -o $(srcdir)/classes.texi $(PUBLISHED_CLASSES) || \
+  rm -f $(srcdir)/classes.texi
  test -f $(srcdir)/classes.texi && touch $(srcdir)/gst-base.texi
 
 # In TeX output, having colons in index entries looks pretty, but


--- orig/gst-tool.c
+++ mod/gst-tool.c
@@ -113,6 +113,12 @@ struct tool tools[] = {
     "-I|--image-file: --kernel-directory:",
     NULL
   },
+  {
+    "gst-doc", "scripts/GenDoc.st",
+    "-h|--help --version -p|--package: -f|--file: -I|--image-file: \
+        -o|--output: --kernel-directory:",
+    NULL
+  },
   { NULL, NULL, NULL, NULL }
 };
 


--- orig/kernel/Behavior.st
+++ mod/kernel/Behavior.st
@@ -528,15 +528,21 @@ compiledMethodAt: selector
 !
 
 selectorAt: method
-    "Return selector for the given compiledMethod"
+    "Return selector for the given CompiledMethod"
     self methodDictionary isNil ifTrue: [
  SystemExceptions.NotFound signalOn: method what: 'method' ].
     ^self methodDictionary keyAtValue: method ifAbsent: [
         SystemExceptions.NotFound signalOn: method what: 'method' ].
 !
 
+parseTreeFor: selector
+    "Answer the parse tree for the given selector, or nil if there was an
+     error.  Requires the Parser package to be loaded."
+    self notYetImplemented
+!
+
 sourceCodeAt: selector
-    "Answer source code (if available) for the given compiledMethod"
+    "Answer source code (if available) for the given selector."
     | source |
     source := (self compiledMethodAt: selector) methodSourceCode.
     source isNil ifTrue: [ ^'" *** SOURCE CODE NOT AVAILABLE *** "' copy ].


--- orig/kernel/Namespace.st
+++ mod/kernel/Namespace.st
@@ -220,7 +220,7 @@ nameIn: aNamespace
 
     | reference |
     reference := aNamespace at: self name asGlobalKey ifAbsent: [ nil ].
-    reference == self ifTrue: [ ^self name ].
+    reference == self ifTrue: [ ^self name asString ].
     ^(self superspace nameIn: aNamespace), '.', self name
 !
 


--- orig/kernel/PkgLoader.st
+++ mod/kernel/PkgLoader.st
@@ -458,6 +458,19 @@ parse: file
 
 !Kernel.PackageInfo methodsFor: 'accessing'!
 
+createNamespace
+    "Create the path of namespaces indicated by our namespace field in
+     dot notation, and answer the final namespace"
+    | ns |
+    ns := Smalltalk.
+    self namespace isNil ifTrue: [ ^ns ].
+    (self namespace subStrings: $.) do: [ :each || key |
+ key := each asSymbol.
+ (ns includesKey: key) ifFalse: [ ns addSubspace: key ].
+ ns := ns at: key
+    ].
+    ^ns!
+
 fileIn
     "File in the given package and its dependencies."
     self name isNil
@@ -468,6 +481,19 @@ fileIn
  ifFalse: [
     PackageLoader fileInPackage: self name ]!
 
+fullPathsOf: aCollection
+    "Resolve the names in aCollection according to the base directories
+     in baseDirectories, and return the collection with the full filenames.
+     Raise a PackageNotAvailable exception if no directory was found for one
+     or more files in aCollection."
+    ^aCollection collect: [ :fileName || name |
+        name := self fullPathOf: fileName ]
+!
+
+fullPathOf: fileName
+    self subclassResponsibility
+!
+
 printXmlOn: aStream collection: aCollection tag: aString indent: indent
     "Private - Print aCollection on aStream as a sequence of aString
      tags."
@@ -692,6 +718,13 @@ fileName: fileName
 
 !Kernel.StarPackage methodsFor: 'accessing'!
 
+fullPathOf: fileName
+    "Try appending 'self directory' and fileName to each of the directory
+     in baseDirectories, and return the path to the first tried filename that
+     exists.  Raise a PackageNotAvailable exception if no directory is
+     found that contains the file."
+    ^self loadedPackage fullPathOf: fileName!
+
 test
     "Answer the test subpackage for this package."
     ^self loadedPackage test!
@@ -909,26 +942,19 @@ baseDirectories: aCollection
      the local image directory, instead, only directory 3 is searched."
 
     baseDirectories := aCollection.
-    self findPathsFor: self files.
-    "self findPathsFor: self fileIns."
-    "self findPathsFor: self builtFiles."
+    self fullPathsOf: self files.
+    "self fullPathsOf: self fileIns."
+    "self fullPathsOf: self builtFiles."
     self directory.
 
     self test notNil ifTrue: [ self test baseDirectories: aCollection ].
 !
 
-findPathsFor: aCollection
-    "Resolve the names in aCollection according to the base directories
-     in baseDirectories, and return the collection with the full filenames, or
-     nil if no directory was found for one or more file in aCollection."
-    ^aCollection collect: [ :fileName || name |
-        name := self findPathFor: fileName ]
-!
-
-findPathFor: fileName
+fullPathOf: fileName
     "Try appending 'self directory' and fileName to each of the directory
      in baseDirectories, and return the path to the first tried filename that
-     exists.  Return nil if no directory is found that contains the file."
+     exists.  Raise a PackageNotAvailable exception if no directory is
+     found that contains the file."
     | name |
     baseDirectories do: [ :dir |
  name := dir.
@@ -965,19 +991,6 @@ relativeDirectory: dir
      the package, to dir."
     relativeDirectory := dir!
 
-createNamespace
-    "Private - Create the path of namespaces indicated by our
-     namespace field in dot notation, and answer the final namespace"
-    | ns |
-    ns := Smalltalk.
-    self namespace isNil ifTrue: [ ^ns ].
-    (self namespace subStrings: $.) do: [ :each || key |
- key := each asSymbol.
- (ns includesKey: key) ifFalse: [ ns addSubspace: key ].
- ns := ns at: key
-    ].
-    ^ns!
-
 primFileIn
     "Private - File in the given package without paying attention at
      dependencies and C callout availability"
@@ -999,7 +1012,7 @@ primFileIn
                 (CFunctionDescriptor isFunction: func)
              ifFalse: [ ^self error: 'C callout not available: ', func ]]].
 
-        loadedFiles := self findPathsFor: self fileIns.
+        loadedFiles := self fullPathsOf: self fileIns.
  loadedFiles do: [ :each | FileStream fileIn: each ].
         self name isNil ifFalse: [ Smalltalk addFeature: self name ].
         self features do: [ :each | Smalltalk addFeature: each ].


--- orig/kernel/RootNamespc.st
+++ mod/kernel/RootNamespc.st
@@ -116,7 +116,7 @@ nameIn: aNamespace
     | reference |
     reference := aNamespace at: self name asGlobalKey ifAbsent: [ nil ].
     ^reference == self
- ifTrue: [ self name ]
+ ifTrue: [ self name asString ]
  ifFalse: [ 'Smalltalk.', self name ]
 !
 


--- orig/kernel/SeqCollect.st
+++ mod/kernel/SeqCollect.st
@@ -232,6 +232,16 @@ fourth
     ^self at: 4
 !
 
+first: n
+    "Answer the first n items in the receiver"
+    ^self copyFrom: 1 to: n
+!
+
+last: n
+    "Answer the last n items in the receiver"
+    ^self copyFrom: self size - n + 1
+!
+
 last
     "Answer the last item in the receiver"
     ^self at: self size


--- orig/kernel/VFSZip.st
+++ mod/kernel/VFSZip.st
@@ -204,6 +204,13 @@ on: aStream from: start to: end
 atEnd
     ^stream position >= limit or: [ stream atEnd ]!
 
+copyFrom: start to: end
+    (start between: 0 and: limit - offset)
+        ifFalse: [ SystemExceptions.IndexOutOfRange signalOn: self withIndex: start ].
+    (end between: 0 and: limit - offset)
+        ifFalse: [ SystemExceptions.IndexOutOfRange signalOn: self withIndex: end ].
+    ^stream copyFrom: offset + start to: offset + end!
+
 isPositionable
     ^true!
 


--- orig/packages.xml
+++ mod/packages.xml
@@ -79,7 +79,6 @@
   <file>EditStream.st</file>
   <file>PrtHier.st</file>
   <file>Case.st</file>
-  <file>Publish.st</file>
   <file>RegExp.st</file>
   <file>PushBack.st</file>
   <file>SortCriter.st</file>
@@ -221,6 +220,7 @@
   <file>Load.st</file>
   <file>Package.st</file>
   <file>Browser.st</file>
+  <file>GenDoc.st</file>
   <file>Convert.st</file>
 </disabled-package>
 


--- orig/examples/Publish.st
+++ mod/packages/stinst/doc/Publish.st
@@ -28,17 +28,13 @@
 |
  ======================================================================"
 
-Smalltalk addSubspace: #ClassPublisher!
-
-Namespace current: ClassPublisher!
-
-Object subclass: #Basic
+Object subclass: #ClassPublisher
     instanceVariableNames: 'class destination referenceNamespace'
     classVariableNames: ''
     poolDictionaries: ''
     category: 'Examples-File out'!
 
-!Basic class methodsFor: 'publishing'!
+!ClassPublisher class methodsFor: 'publishing'!
 
 basicPublish: aClass on: aFileStream
     "Publish aClass, in the format supported by the receiver, on aFileStream"
@@ -67,7 +63,7 @@ publish: aClass onFile: fileNameString
     ] ensure: [ file close ]
 ! !
 
-!Basic methodsFor: 'publishing'!
+!ClassPublisher methodsFor: 'publishing'!
 
 fileOut: aClass on: aFileStream
     "File out the given class on aFileStream."
@@ -95,7 +91,7 @@ fileOutMethods
  [ :category | self emitCategory: category ].
 ! !
 
-!Basic methodsFor: 'to be subclassed'!
+!ClassPublisher methodsFor: 'to be subclassed'!
 
 emitCategory: category
     "Emit valid output for the given category."
@@ -131,7 +127,7 @@ printEscaped: ch
     self nextPut: ch
 ! !
 
-!Basic methodsFor: 'accessing/delegating'!
+!ClassPublisher methodsFor: 'accessing/delegating'!
 
 currentClass
     "Answer the class which we are working on"
@@ -240,7 +236,7 @@ methodDictionary
     ^self currentClass methodDictionary
 ! !
 
-!Basic methodsFor: 'useful parsing'!
+!ClassPublisher methodsFor: 'useful parsing'!
 
 selectorAndBody: methodString
     "Answer a two-element Array containing the selector and the
@@ -457,14 +453,14 @@ guessComment: source
 
 "----------------------------------------------------------------------"
 
-Basic subclass: #Documentation
+ClassPublisher subclass: #DocPublisher
     instanceVariableNames: 'categories'
     classVariableNames: ''
     poolDictionaries: ''
     category: 'Examples-File out'!
 !
 
-!Documentation class methodsFor: 'printing trees'!
+!DocPublisher class methodsFor: 'printing trees'!
 
 printHierarchyOf: classes on: aFileStream
     "Typeset on aFileStream a full hierarchy tree, starting from the classes
@@ -564,7 +560,7 @@ makeDescendentsDictionary: dict thenPrin
 ! !
 
 
-!Documentation methodsFor: 'abstract'!
+!DocPublisher methodsFor: 'abstract'!
 
 emitMethod: source
 !
@@ -596,7 +592,7 @@ namespaceFor: aClass
     ^Namespace current
 ! !
 
-!Documentation methodsFor: 'accessing'!
+!DocPublisher methodsFor: 'accessing'!
 
 categoriesSize
     ^categories size
@@ -612,7 +608,7 @@ categoryAt: n ifBadIndex: aString
     ^(categories at: n) key
 ! !
 
-!Documentation methodsFor: 'subclassed'!
+!DocPublisher methodsFor: 'subclassed'!
 
 emitCategory: category
     "I emit a link to the anchor where the category will be, and store
@@ -660,13 +656,13 @@ emitFooter
 "----------------------------------------------------------------------"
 
 
-Basic subclass: #Postscript
+ClassPublisher subclass: #PSFileOutPublisher
     instanceVariableNames: ''
     classVariableNames: ''
     poolDictionaries: ''
     category: 'Examples-File out'!
 
-!Postscript methodsFor: 'subclassed'!
+!PSFileOutPublisher methodsFor: 'subclassed'!
 
 emitCategory: category
     "I write Postscript for legal Smalltalk load syntax definitions of all of my methods
@@ -745,7 +741,7 @@ emitHeader: now
  nextPutAll: '() show newline newline'; nl; nl
 ! !
 
-!Postscript methodsFor: 'PostScript'!
+!PSFileOutPublisher methodsFor: 'PostScript'!
 
 header
 ^'%!
@@ -810,14 +806,14 @@ indent ypos moveto
 ! !
 
 
-Documentation subclass: #HTML
+DocPublisher subclass: #HTMLDocPublisher
     instanceVariableNames: ''
     classVariableNames: ''
     poolDictionaries: ''
     category: 'Examples-File out'!
 !
 
-!HTML class methodsFor: 'multiple classes'!
+!HTMLDocPublisher class methodsFor: 'multiple classes'!
 
 publishNamespaces: aCollection
     | subclasses |
@@ -840,12 +836,12 @@ publishAll: classArray withIndexOn: aFil
     aFileStream nextPutAll:
 
 '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN"> <!--
-Automatically yours from GNU Smalltalk''s HTML ClassPublisher! -->
+Automatically yours from GNU Smalltalk''s HTMLDocPublisher! -->
 
 <HTML>
 <HEAD>
     <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=iso-8859-1">
-    <META NAME="GENERATOR" CONTENT="GNU Smalltalk HTML ClassPublisher">
+    <META NAME="GENERATOR" CONTENT="GNU Smalltalk HTMLDocPublisher">
     <TITLE>Smalltalk class reference</TITLE>
 </HEAD>
 <BODY>
@@ -880,7 +876,7 @@ publishAll: classArray withIndexOnFile:
 ! !
 
 
-!HTML class methodsFor: 'writing the class tree'!
+!HTMLDocPublisher class methodsFor: 'writing the class tree'!
 
 printTreeClass: class shouldLink: aBoolean on: aFileStream indent: indent
     | fileName |
@@ -900,7 +896,7 @@ printTreeClass: class shouldLink: aBoole
     aFileStream nl.
 ! !
 
-!HTML methodsFor: 'emitting comments'!
+!HTMLDocPublisher methodsFor: 'emitting comments'!
 
 emitMethod: source
     "I emit valid HTML for a comment contained in source - which is a method's
@@ -918,7 +914,7 @@ emitMethod: source
  nl; nl
 ! !
 
-!HTML methodsFor: 'subclassed'!
+!HTMLDocPublisher methodsFor: 'subclassed'!
 
 emitLink: category kind: kind
     self nextPutAll: '<A HREF="#';
@@ -959,13 +955,13 @@ emitHeader: now
     self nextPutAll: (
 
 '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN"> <!--
-Automatically yours from GNU Smalltalk''s HTML ClassPublisher!
+Automatically yours from GNU Smalltalk''s HTMLDocPublisher!
 Filed out from %1 on %2 %3 -->
 
 <HTML>
 <HEAD>
     <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=iso-8859-1">
-    <META NAME="GENERATOR" CONTENT="GNU Smalltalk HTML ClassPublisher">
+    <META NAME="GENERATOR" CONTENT="GNU Smalltalk HTMLDocPublisher">
     <TITLE>%4</TITLE>
 </HEAD>
 <BODY>
@@ -1000,18 +996,18 @@ printEscaped: ch
 "----------------------------------------------------------------------"
 
 
-Documentation subclass: #Texinfo
+DocPublisher subclass: #TexinfoDocPublisher
     instanceVariableNames: ''
     classVariableNames: ''
     poolDictionaries: ''
     category: 'Examples-File out'!
 !
 
-Texinfo class
+TexinfoDocPublisher class
     instanceVariableNames: 'current'!
 
 
-!Texinfo class methodsFor: 'multiple classes'!
+!TexinfoDocPublisher class methodsFor: 'multiple classes'!
 
 nextClass
     | result |
@@ -1072,7 +1068,7 @@ publish: aClass on: aFileStream
 ! !
 
 
-!Texinfo class methodsFor: 'texinfo source'!
+!TexinfoDocPublisher class methodsFor: 'texinfo source'!
 
 header
 
@@ -1178,7 +1174,7 @@ afterTree
 footer
 ^''! !
 
-!Texinfo class methodsFor: 'creating the class tree'!
+!TexinfoDocPublisher class methodsFor: 'creating the class tree'!
 
 printTreeClass: class shouldLink: aBoolean on: aFileStream indent: indent
 
@@ -1197,7 +1193,7 @@ printTreeClass: class shouldLink: aBoole
  nl.
 ! !
 
-!Texinfo class methodsFor: 'creating GST''s manual'!
+!TexinfoDocPublisher class methodsFor: 'creating GST''s manual'!
 
 publishNamespaces: aCollection
     | subclasses |
@@ -1213,7 +1209,7 @@ publishNamespaces: aCollection
  onFile: 'classes.texi'
 ! !
 
-!Texinfo methodsFor: 'emitting comments'!
+!TexinfoDocPublisher methodsFor: 'emitting comments'!
 
 emitMethodSelector: aSymbol
     "I emit a Texinfo indexing command for the selector in aSymbol."
@@ -1242,7 +1238,7 @@ emitCrossReferences: comment
  ]
 !
 
-!Texinfo methodsFor: 'subclassed'!
+!TexinfoDocPublisher methodsFor: 'subclassed'!
 
 emitSelectorAndMethod: association
     "I emit valid Texinfo markup for a comment contained in source - which is
@@ -1371,5 +1367,3 @@ printEscaped: ch
     ch = $# ifTrue: [ self nextPut: $- ].
     self nextPut: ch
 ! !
-
-Namespace current: Smalltalk!


--- orig/packages/stinst/parser/STLoader.st
+++ mod/packages/stinst/parser/STLoader.st
@@ -171,7 +171,7 @@ currentNamespace
     ^currentNamespace!
 
 currentNamespace: ns
-    currentNamespace := ns!
+    currentNamespace := self proxyForNamespace: ns!
 
 proxyNilClass
     proxyNilClass isNil ifTrue: [ proxyNilClass := ProxyNilClass on: nil for: self ].
@@ -206,9 +206,13 @@ initialize
 
 !STClassLoader methodsFor: 'overrides'!
 
+loadedClasses
+    ^loadedClasses
+!
+
 result
     "This is what #parseSmalltalk answers"
-    ^loadedClasses
+    ^self loadedClasses
 !
 
 endMethodList


--- orig/packages/stinst/parser/STLoaderObjs.st
+++ mod/packages/stinst/parser/STLoaderObjs.st
@@ -471,7 +471,7 @@ nameIn: aNamespace
     | proxy reference |
     proxy := loader proxyForNamespace: aNamespace.
     reference := proxy at: self name asSymbol ifAbsent: [ nil ].
-    self = reference ifTrue: [ ^self name ].
+    self = reference ifTrue: [ ^self name asString ].
     ^(self environment nameIn: aNamespace), '.', self printString
 ! !
 
@@ -1006,7 +1006,7 @@ nameIn: aNamespace
     | reference proxy |
     proxy := loader proxyForNamespace: aNamespace.
     reference := proxy at: self name asSymbol ifAbsent: [ nil ].
-    self = reference ifTrue: [ ^self name ].
+    self = reference ifTrue: [ ^self name asString ].
     ^(self superspace nameIn: aNamespace ), '.', self name
 !
 


--- orig/scripts/GenLibDoc.st
+++ mod/scripts/GenDoc.st
@@ -29,31 +29,93 @@
  ======================================================================"
 
 "Load the prerequisites"
-PackageLoader fileInPackage: 'Parser'.
-FileStream fileIn: '../examples/Publish.st'!
+PackageLoader fileInPackage: #ClassPublisher!
 
-| namespace package outTexinfo rejected files dir source classes |
-namespace := (Smalltalk arguments at: 1) asSymbol.
-package := Smalltalk arguments at: 2.
-outTexinfo := Smalltalk arguments at: 3.
-rejected := (Smalltalk arguments copyFrom: 4) asSet.
-
-"Load the list of files comprising the package"
-dir := PackageLoader directoryFor: package.
-files := PackageLoader filesFor: package.
-files := files select: [ :each | '*.st' match: each ].
-files := files reject: [ :each | rejected includes: each ].
-files := files collect: [ :each | Directory append: each to: dir ].
-files := files collect: [ :each | FileStream open: each mode: FileStream read ].
-
-"Load the source code"
-source := files fold: [ :old :each | old, each ].
-
-"Go!"
-Smalltalk addSubspace: namespace.
-Namespace current: (Smalltalk at: namespace).
-classes := STInST.STClassLoader new
- parseSmalltalkStream: source
- with: STInST.STFileInParser.
+| package outFile publisher files classes classPatterns loader |
+
+classPatterns := OrderedCollection new.
+publisher := STInST.TexinfoDocPublisher.
+
+helpString :=
+'Usage:
+    gst-doc [ flag ... ] class ...
+
+Options:
+    -p --package=PKG      look for classes in the given package
+    -f --file=FILE        look for classes in the given file
+    -I --image-file=FILE  look for classes in the given image
+    -o --output=OUT       look for classes in the given image
+       --kernel-dir=PATH  use the specified kernel directory
+    -h --help             show this message
+       --version          print version information and exit
+'.
+
+loader := STInST.STClassLoader new.
 Namespace current: Smalltalk.
-ClassPublisher.Texinfo publishAll: classes onFile: outTexinfo!
+
+"Parse the command-line arguments."
+Smalltalk
+    arguments: '-h|--help --version -p|--package: -f|--file: -I|--image-file:
+                -o|--output: --kernel-directory:'
+    do: [ :opt :arg |
+
+    opt = 'help' ifTrue: [
+        helpString displayOn: stdout.
+        ObjectMemory quit: 0 ].
+
+    opt = 'version' ifTrue: [
+        ('gst-doc - %1' % {Smalltalk version}) displayNl.
+        ObjectMemory quit: 0 ].
+
+    opt = 'output' ifTrue: [
+ outFile isNil ifFalse: [
+    self error: '--output specified multiple times' ].
+ outFile := arg ].
+
+    opt = 'package' ifTrue: [
+ package := PackageLoader packageAt: arg.
+ loader currentNamespace: package createNamespace.
+        files := package fullPathsOf: package fileIns.
+ files do: [ :each || file |
+    file := FileStream open: each mode: FileStream read.
+    loader
+        parseSmalltalkStream: file
+        with: STInST.STFileInParser ].
+
+ loader currentNamespace: Smalltalk ].
+
+    opt = 'file' ifTrue: [
+ file := FileStream open: arg mode: FileStream read.
+ loader
+    parseSmalltalkStream: file
+    with: STInST.STFileInParser ].
+
+    opt isNil ifTrue: [ classPatterns add: arg ] ]
+
+    ifError: [
+        helpString displayOn: stderr.
+        ObjectMemory quit: 1 ].
+
+allClasses :=
+    loader loadedClasses,
+    (Class allSubclasses collect: [ :each | each instanceClass ]).
+
+classes := IdentitySet new.
+classPatterns do: [ :pat || namespace |
+    (pat last: 2) = '.*'
+ ifTrue: [
+    namespace := pat allButLast: 2.
+            classes addAll:
+ (allClasses select: [ :each |
+    (each environment nameIn: Smalltalk) = namespace ]) ]
+ ifFalse: [
+            classes addAll:
+ (allClasses select: [ :each |
+    (each nameIn: Smalltalk) = pat ]) ] ].
+
+outFile isNil
+    ifTrue: [
+ Transcript message: stderr -> #nextPutAllFlush:.
+ publisher publishAll: classes on: stdout ]
+    ifFalse: [
+ publisher publishAll: classes onFile: outFile ]!


--- orig/scripts/Package.st
+++ mod/scripts/Package.st
@@ -276,7 +276,7 @@ Object subclass: Command [
     package := self packages at: each.
     package allFiles do: [ :file |
  | path relativePath |
- path := package findPathFor: file.
+ path := package fullPathOf: file.
  relativePath := base pathTo: path.
  (vpath and: [ (relativePath indexOfSubCollection: '../') > 0 ])
     ifTrue: [ relativePath := vpathBase pathTo: path ].
@@ -338,7 +338,7 @@ Command subclass: PkgDist [
     (self installDir directoryAt: dir) emitMkdir ].
 
         files do: [ :file || srcFile destName |
-    srcFile := File name: (aPackage findPathFor: file).
+    srcFile := File name: (aPackage fullPathOf: file).
     self distribute: srcFile as: file in: aPackage relativeDirectory ]
     ]
     runOnStar: aPackage [
@@ -431,7 +431,7 @@ Command subclass: PkgInstall [
             (baseDir directoryAt: dir) emitMkdir ].
 
                 files do: [ :file || srcFile |
-            srcFile := File name: (aPackage findPathFor: file).
+            srcFile := File name: (aPackage fullPathOf: file).
             srcFile emitSymlink: (baseDir nameAt: file) ].
 
         (self installDir fileAt: aPackage name, '.star')



* added files

--- /dev/null
+++ mod/packages/stinst/doc/package.xml
@@ -0,0 +1,9 @@
+<package>
+  <name>ClassPublisher</name>
+  <namespace>STInST</namespace>
+  <prereq>Parser</prereq>
+  <filein>Publish.st</filein>
+
+  <file>Publish.st</file>
+</package>
+


_______________________________________________
help-smalltalk mailing list
[hidden email]
http://lists.gnu.org/mailman/listinfo/help-smalltalk