[elpa] externals/smalltalk-mode 89b685f: Add sample code for testing purposes

[Stefan Monnier]

branch: externals/smalltalk-mode
commit 89b685f157c79df493aacd2e4cb283daf1177fc5
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>

    Add sample code for testing purposes
---
 indent-bang-test.st | 279 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 indent-test.st      | 144 +++++++++++++++++++++++++++
 2 files changed, 423 insertions(+)

diff --git a/indent-bang-test.st b/indent-bang-test.st
new file mode 100644
index 0000000..3c8191b
--- /dev/null
+++ b/indent-bang-test.st
@@ -0,0 +1,279 @@
+"======================================================================
+|
+|   Lisp interpreter written in Smalltalk
+|
+|
+ ======================================================================"
+
+
+"======================================================================
+|
+| Written by Aoki Atsushi and Nishihara Satoshi.
+| Modified by Paolo Bonzini (removed GUI and compiler for subset of Smalltalk).
+|
+| This file is part of GNU Smalltalk.
+|
+| GNU Smalltalk is free software; you can redistribute it and/or modify it
+| under the terms of the GNU General Public License as published by the Free
+| Software Foundation; either version 2, or (at your option) any later version.
+| 
+| GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
+| ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+| FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
+| details.
+| 
+| You should have received a copy of the GNU General Public License along with
+| GNU Smalltalk; see the file COPYING.  If not, write to the Free Software
+| Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.  
+|
+ ======================================================================"
+
+SequenceableCollection subclass:  #LispList
+       instanceVariableNames: ''
+       classVariableNames: ''
+       poolDictionaries: ''
+       category: 'Examples-Lisp'!
+
+LispList subclass:  #LispCons
+       instanceVariableNames: 'head tail '
+       classVariableNames: 'VerticalLevel HorizontalLevel '
+       poolDictionaries: ''
+       category: 'Examples-Lisp'!
+
+LispList subclass:  #LispNil
+       instanceVariableNames: ''
+       classVariableNames: ''
+       poolDictionaries: ''
+       category: 'Examples-Lisp'!
+
+
+!LispList class methodsFor: 'copyright'!
+
+copyright
+    ^'Copyright (C) 1995-1998 AOKI Atsushi, All Rights Reserved.'!
+
+system
+    ^'Goodies'!
+
+version
+    ^'003'! !
+
+!LispList class methodsFor: 'instance creation'!
+
+cell
+    ^self subclassResponsibility!
+
+head: headObject 
+    ^self subclassResponsibility!
+
+head: headObject tail: tailObject 
+    ^self subclassResponsibility!
+
+list: anArray 
+    "LispCons list: #(1 2 3 4)"
+
+    | size list |
+    size := anArray size.
+    list := self null.
+    size
+       to: 1
+       by: -1
+       do: [:i | list := self head: (anArray at: i)
+                       tail: list].
+    ^list!
+
+new: anInteger 
+    "LispCons new: 5"
+
+    | newList |
+    newList := self null.
+    anInteger timesRepeat: [newList := self head: self null tail: newList].
+    ^newList!
+
+null
+    ^self subclassResponsibility!
+
+with: anObject 
+    "LispCons with: 1"
+
+    ^self head: anObject!
+
+with: firstObject with: secondObject 
+    "LispCons with: 1 with: 2"
+
+    ^self head: firstObject tail: (self with: secondObject)!
+
+with: firstObject with: secondObject with: thirdObject 
+    "LispCons with: 1 with: 2 with: 3"
+
+    ^self head: firstObject tail: (self with: secondObject with: thirdObject)!
+
+with: firstObject with: secondObject with: thirdObject with: fourthObject 
+    "LispCons with: 1 with: 2 with: 3 with: 4"
+
+    ^self head: firstObject tail: (self
+           with: secondObject
+           with: thirdObject
+           with: fourthObject)! !
+
+!LispList methodsFor: 'accessing'!
+
+at: indexInteger put: anObject 
+    ^self subscriptOutOfBoundsError: indexInteger!
+
+size
+    | tally |
+    tally := 0.
+    self do: [:each | tally := tally + 1].
+    ^tally! !
+
+!LispList methodsFor: 'private'!
+
+subscriptOutOfBoundsError: index 
+    ^self error: 'subscript out of bounds: ' , index printString! !
+
+!LispList methodsFor: 'testing'!
+
+isCons
+    ^self null not!
+
+null
+    ^false! !
+
+
+
+!LispCons class methodsFor: 'class initialization'!
+
+initialize
+    "LispCons initialize."
+
+    HorizontalLevel := VerticalLevel := nil! !
+
+!LispCons class methodsFor: 'copyright'!
+
+copyright
+    ^'Copyright (C) 1995-1998 AOKI Atsushi, All Rights Reserved.'!
+
+system
+    ^'Goodies'!
+
+version
+    ^'003'! !
+
+!LispCons class methodsFor: 'examples'!
+
+example1
+    "LispCons example1."
+
+    | list |
+    list := LispCons list: #(1 2 3 4 5 6 7 8 9 10 ).
+    Transcript nl; show: list printString.
+    ^list!
+
+example2
+    "LispCons example2."
+
+    | null list |
+    null := LispCons null.
+    list := LispCons list: #(1 2 ).
+    list := LispCons head: list tail: null.
+    list := LispCons head: list tail: null.
+    Transcript nl; show: list printString.
+    ^list!
+
+example3
+    "LispCons example3."
+
+    | x y z |
+    x := LispCons list: #(1 2 3 ).
+    y := LispCons list: #(4 5 6 ).
+    z := LispCons list: #(1 2 3 4 5 6 ).
+    Transcript nl; show: '(setq x ''(1 2 3)) => ' , x printString.
+    Transcript nl; show: '(setq y ''(4 5 6)) => ' , y printString.
+    Transcript nl; show: '(setq z ''(1 2 3 4 5 6)) => ' , z printString.
+    Transcript nl; show: '(append x y) => ' , (x append: y) printString.
+    Transcript nl; show: '(length z) => ' , z length printString.
+    Transcript nl; show: '(member 3 z) => ' , (z member: 3) printString.
+    Transcript nl; show: '(nth 4 z) => ' , (z nth: 4) printString.
+    ^z!
+
+example4
+    "LispCons example4."
+
+    | list |
+    list := LispCons list: #(1 2 ).
+    list := LispCons head: list tail: (LispCons list: #(3 4 )).
+    list := LispCons head: list tail: (LispCons list: #(5 6 )).
+    Transcript nl; show: list saveString.
+    ^list!
+
+example5
+    "LispCons example5."
+
+    | list |
+    list := LispCons loadFrom: '
+           (PetriNet Aoki
+               (Place p1 p2 p3 p4 p5)
+               (Transition t1 t2 t3 t4 t5)
+               (InputFunction
+                   (t1 p1 p2 p3 p4 p5)
+                   (t2 . p4)
+                   (t3 . p5))
+               (OutputFunction
+                   (t1 p1 p2 p3 p4 p5)
+                   (t2 . p4)
+                   (t3 . p5))
+               (Marking {#(1 2 3 4 5)})))'.
+    Transcript nl; show: list saveString.
+    ^list!
+
+example6
+    "LispCons example6."
+
+    | list |
+    list := LispCons loadFrom: '(aaa bbb ccc)'.
+    Transcript nl; show: list saveString.
+    ^list!
+
+example7
+    "LispCons example7."
+
+    | list |
+    list := LispCons loadFrom: ' `(`(1 2 `3) . `4 ) '.
+    Transcript nl; show: list saveString.
+    ^list! !
+
+!LispCons class methodsFor: 'instance creation'!
+
+cell
+    ^super new head: self null tail: self null!
+
+head: headObject 
+    ^super new head: headObject tail: self null!
+
+head: headObject tail: tailObject 
+    ^super new head: headObject tail: tailObject!
+
+list: anArray 
+    | size list |
+    size := anArray size.
+    list := self null.
+    size
+       to: 1
+       by: -1
+       do: [:i | list := self head: (anArray at: i)
+                       tail: list].
+    ^list!
+
+loadFrom: aStream 
+    "by nishis, 1998/04/19 07:51"
+
+    | list |
+    list := LispParser parse: aStream.
+    ^list!
+
+new
+    ^self cell!
+
+null
+    ^LispNil null! !
diff --git a/indent-test.st b/indent-test.st
new file mode 100644
index 0000000..d5ecf1a
--- /dev/null
+++ b/indent-test.st
@@ -0,0 +1,144 @@
+"======================================================================
+|
+|   Smalltalk package installer
+|
+|
+ ======================================================================"
+
+
+"======================================================================
+|
+| Copyright 2007-2019 Free Software Foundation, Inc.
+| Written by Paolo Bonzini.
+|
+| This file is part of GNU Smalltalk.
+|
+| GNU Smalltalk is free software; you can redistribute it and/or modify it
+| under the terms of the GNU General Public License as published by the Free
+| Software Foundation; either version 2, or (at your option) any later version.
+|
+| GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
+| ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+| FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
+| details.
+|
+| You should have received a copy of the GNU General Public License along with
+| GNU Smalltalk; see the file COPYING.  If not, write to the Free Software
+| Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+|
+ ======================================================================"
+
+[PackageLoader fileInPackage: 'NetClients'] on: Error do: [:ex | ex return].
+
+
+DynamicVariable subclass: CurrentCommand [
+]
+
+
+Package extend [
+    srcdir [
+       ^self baseDirectories last
+    ]
+
+    isStarPackageBody [
+       ^self baseDirectories first isKindOf: VFS.ArchiveFile
+    ]
+
+    starFileName [
+       | dir |
+       self isStarPackageBody ifFalse: [ self halt ].
+       ^self baseDirectories first asString
+    ]
+
+    runCommand: aCommand [
+       self isStarPackageBody
+           ifTrue: [ aCommand runOnStar: self ]
+           ifFalse: [ aCommand runOnPackage: self ]
+    ]
+]
+
+Kernel.PackageContainer subclass: StarPackageFile [
+    | name |
+
+    StarPackageFile class >> on: aFile [
+       ^self new file: aFile; yourself
+    ]
+
+    StarPackageFile class >> on: aFile name: aString [
+       ^self new file: aFile; name: aString; yourself
+    ]
+
+    baseDirectoriesFor: aPackage [
+       ^self file zip
+    ]
+
+    name [
+       ^name
+    ]
+
+    name: aString [
+       name := aString
+    ]
+
+    refresh: loadDate [
+       | package |
+       package := Kernel.StarPackage file: self file.
+       name isNil ifFalse: [ package name: self name ].
+        self packages at: package name put: package loadedPackage
+    ]
+]
+
+Kernel.PackageContainer subclass: RemotePackageFile [
+    RemotePackageFile class >> on: aFile [
+       ^self new file: aFile; yourself
+    ]
+
+    testPackageValidity: package [ ]
+
+    refresh: loadDate [
+        | file |
+       self file withReadStreamDo: [ :fileStream |
+           self parse: fileStream ]
+    ]
+]
+
+Kernel.PackageContainer subclass: PackageFile [
+    | srcdir |
+
+    PackageFile class >> on: aFile [
+       ^self new file: aFile; yourself
+    ]
+
+    srcdir [
+       ^srcdir
+    ]
+
+    srcdir: aString [
+       srcdir := aString
+    ]
+
+    baseDirectoriesFor: aPackage [
+       | srcdirFile builddirPrefix |
+       self srcdir isNil ifTrue: [ ^{ file path } ].
+
+       "See if the file is in srcdir or builddir.  In any case, we want to
+        look for files first in the builddir, and secondarily in srcdir."
+       srcdirFile := self file pathFrom: self srcdir.
+       builddirPrefix := Directory working pathFrom: self srcdir.
+       ^(srcdirFile startsWith: builddirPrefix, Directory pathSeparatorString)
+           ifFalse: [ {
+               "file is in srcdir."
+               (File name: srcdirFile) parent.
+               self file parent } ]
+           ifTrue: [ {
+               "file is in builddir."
+               self file parent.
+               (self srcdir / (self file pathFrom: Directory working)) parent 
} ]
+    ]
+
+    refresh: loadDate [
+        | file |
+       self file withReadStreamDo: [ :fileStream |
+           self parse: fileStream ]
+    ]
+]