[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Help-smalltalk] [PATCH] Install documentation generator
|
From: |
Paolo Bonzini |
|
Subject: |
[Help-smalltalk] [PATCH] Install documentation generator |
|
Date: |
Tue, 07 Aug 2007 10:27:13 +0200 |
|
User-agent: |
Thunderbird 2.0.0.6 (Macintosh/20070728) |
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 <address@hidden>
* 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 <address@hidden>
* 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 <address@hidden>
* Publish.st: From examples/Publish.st. Rename classes.
* looking for address@hidden/smalltalk--devo--2.2--patch-497 to compare with
* comparing to address@hidden/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>
+
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Help-smalltalk] [PATCH] Install documentation generator,
Paolo Bonzini <=