home *** CD-ROM | disk | FTP | other *** search
/ BMUG Revelations / BMUG Revelations.toast / Programming / Programming Languages / Yerk 3.64 / Supplement / Unsupported / Utilities / Sources < prev    next >
Encoding:
Text File  |  1986-10-21  |  3.7 KB  |  174 lines  |  [TEXT/MACA]
  1. \ words -- sorted and a unsorted WORDS that may be echoed to the printer
  2. \ 11/30/84  SSG Version 1.0
  3. \ 12/17/84  SSG Moved selectors to select1; modified sortnfas:
  4. \ 12/17/84  SSG Modified w;  deleted .h and .d
  5. \ 12/19/84  SSG Commented-out method words:
  6. \ 12/29/84  SSG Added page: and lastPage: to WordsClass
  7. \ 12/31/84  SSG Made theList an ordered-col in theList (mod)
  8. \               Changed WordsClass methods to NEON words.
  9. \  2/17/85  SSG Made compatible with Neon release 0.95
  10. \  1/05/86  cdn Made compatible with Neon release 1.5
  11. \  8/20/86  cdn Replaced initFmarkers with x
  12.  
  13. // Alert
  14. // Ctl
  15. // CtlWind
  16. // Dialog
  17. // Drvr
  18. // fInfo
  19. // Interval
  20. // QD1
  21. // Struct1
  22. // vScroll
  23. // Serial
  24. // Radio
  25. // date
  26. // vol
  27.  
  28. 0 value cnt
  29. : k 2drop 1 ++> cnt ;
  30. 'c k 0 trav
  31.  
  32. cnt Ordered-Col theList
  33.  50 Ordered-Col fileMarkers    \ first NFA's of source files
  34.  
  35. : x    here add: fileMarkers
  36.     @pfa nfa ,
  37.     tib in + bl enclose (LCword)
  38.     here c@ 1+ align allot ;
  39.     
  40. clear: fileMarkers
  41. x fwind            nucleus
  42. x \                Base
  43. x inparms        Args
  44. x ^class        Class
  45. x nullcfa        Struct
  46. x basicstr        BasicStr
  47. x string        String
  48. x dirfind        Files
  49. x 2**            Ovl
  50. x from            Mod
  51. x aboutmod        Imports
  52. x srccopy        QD
  53. x menubar        Event
  54. x thewindow        Window
  55. x mydoc            objInit
  56. x pstartlen        Proc
  57. x ?new            Menu 
  58. x execword        fltMem
  59. x (fcmp2)        fpCode
  60. x @fp0            fArgs
  61. x stringer        fpI/O
  62. x fnumber        fInterpret
  63. x flt@            fValue
  64. x ln            elCode
  65. x 1.0            fpExtra
  66. x getflt        Float
  67. x pathlist        PathList
  68. x frontend        FrontEnd
  69. x alert            Alert
  70. x get-ctl-obj    Ctl
  71. x ctlexec        CtlWind
  72. x closer        Dialog
  73. x pbdrvr        Drvr
  74. x fin            fInfo
  75. x timer            Interval
  76. x +pair            QD1
  77. x warray        Struct1
  78. x myctl            vScroll
  79. x port            Serial
  80. x radioset        Radio
  81. x secs2date        date
  82. x volInfo        vol
  83.  
  84. \ ( NFA -- previousNFA )
  85. : nextNfa
  86.     pfa lfa @ ;
  87.  
  88. \ ( fldWid -- )  Pads with blanks to field-width using current out
  89.  
  90. : padBlanks
  91.     out - spaces 0 -> out ;
  92.  
  93. \ Prints name of source file which contains the word.
  94. : .word { theNfa \ index before after -- }
  95.     0 -> after
  96.     5 spaces
  97.     theNfa 6 .r space
  98.     0 -> out        \ Initialize system output count value.
  99.     theNfa id. 16 padBlanks
  100.     size: fileMarkers 0 over -> index    ( size 0 )
  101.     DO    theNfa i at: fileMarkers @ <
  102.         IF i -> index leave THEN
  103.     LOOP
  104.     index 1- at: fileMarkers 4+ count type
  105.     20 padBlanks    \ file name
  106.     context @ -> after        \ last dictionary entry
  107.     theNfa after =
  108.     IF ."  last entry"
  109.     ELSE  after nextNfa -> before    \ previous entry
  110.         BEGIN
  111.             theNfa before <
  112.         WHILE    
  113.             before -> after
  114.             after nextNfa -> before
  115.         REPEAT
  116.         theNfa nextNfa -> before
  117.         before id. 16 padblanks
  118.         after  id. 16 padblanks
  119.     THEN   
  120.     CR
  121. ;
  122.  
  123. \ Prints page number and issues formfeed if 58 lines out.
  124. :  page { len -- }
  125.     len 58 /mod swap not    \ 58 lines printed out?
  126.     IF    CR 
  127.         38 spaces ." Page" .d CR 
  128.         np                    \ Send a form feed.
  129.     ELSE  drop                \ number of pages
  130.     THEN
  131. ;
  132.  
  133. \ Prints last page number and number of entries.
  134. : lastPage { len -- }
  135.     CR CR  
  136.     5 spaces ." There are" size: theList .d  ." entries in the dictionary."
  137.     CR 3 ++> len
  138.     len 58 /mod 1+                    ( lines-on-last-page  page# )
  139.     58 rot -  0 DO CR LOOP            \ Linefeed to end of page.
  140.     38 spaces  ." Page" .d  CR np    \ Print last page number. 
  141.               ;
  142.        
  143. \ ( nfa1 nfa2 -- result )  Compares the name strings pointed to by two NFAs.
  144. : nfaComp
  145.     count $ 1F and rot 
  146.     count $ 1F and 2swap    ( addr1 len1 addr2 len2 )
  147.     $= ;
  148.  
  149. \ ( -- )  Puts all nfa's in dictionary into theList. 
  150. :  getNfas
  151.     clear: theList
  152.     last: fileMarkers @ pfa lfa @
  153.     BEGIN
  154.         dup add: theList
  155.         pfa lfa @ -dup 0=
  156.     UNTIL
  157. ;
  158.  
  159. \ Prints names of all word and the source files that contain them
  160. : sources { \ len -- }
  161.     getnfas
  162.     CR ." Sorting…"
  163.     ixAddr: theList size: theList 'c nfaComp sort
  164.     0 -> len   +print
  165.     base >R hex
  166.     size: theList 0
  167.     DO    i at: theList .word
  168.         1 ++> len len page
  169.         ?pause
  170.     LOOP
  171.     len lastPage
  172.     R> -> base -print
  173. ;
  174.