home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / sedwhelp.seq < prev    next >
Text File  |  1991-04-05  |  18KB  |  424 lines
  1. \ SEDWHELP.SEQ          Word Help while in Editor       by Tom Zimmer
  2.  
  3. \ WORDHELP was suggested by Phil Friis
  4.  
  5. \ invoked by Alt-H
  6.  
  7. editor definitions
  8.  
  9. handle wordhndl
  10. handle hndlsave
  11. create helpbuf 32 allot
  12.  
  13. 0 value wordline
  14. 0 value listsave
  15. 0 value newbrowse
  16. 0 value browseset
  17. 0 value ?wordhelp
  18. 0 value toggling
  19.  
  20. : 'word@cur     ( --- cfa f1 )
  21.                 @word@cur dup>r 1+ c@ hyperchar =
  22.                                                 \ remove a leading hyper char
  23.                 if      r@ count >r dup 1+ swap r> 1- cmove
  24.                         -1 r@ c+!
  25.                 then
  26.                 r@ count + 2 bl fill            \ append a couple of blanks
  27.                 r@ hfind                        \ try to look it up
  28.                 r> c@ 0> and  ;
  29.  
  30. 0 value wordfnd
  31.  
  32. : findword      ( --- f1 )
  33.                 IBRESET
  34.                 0.0 seqhandle movepointer
  35.                 0.0 filepointer 2!
  36.                 loadline off
  37.                 off> wordfnd
  38.                 20000 1
  39.                 do      lineread c@ 0= ?leave
  40.                         bl outbuf count + 2- c!
  41.                                 \ have at least 1 blank at end of line.
  42.                         helpbuf count outbuf 1+ swap 1+ caps-comp 0=
  43.                         if      i =: loadline
  44.                                 on> wordfnd leave
  45.                         then
  46.                 loop    wordfnd ;
  47.  
  48. : cfa-word-ed/br    ( false cfa --- f1 )
  49.                 savescr
  50.                 cursor-off
  51.                 save> screenchar        \ save current cursor position
  52.                 here helpbuf over c@ 2+ cmove
  53.                 wordhndl save!> seqhandle
  54.                 >viewfile       ( --- offset a1 )
  55.                 ?wordhelp
  56.                 if      " HLP" ">$ over $>ext
  57.                 then
  58.                 $file 0=
  59.                 if      =: listsave
  60.                         on> leavesave  \ setup to leave EDIT
  61.                         seqhandle hndlsave $>handle
  62.                         browseset  =: newbrowse
  63.                         screenline =: linesave
  64.                         ?wordhelp
  65.                         if      findword
  66.                                 if      loadline @ =: listsave
  67.                                 else    off> listsave
  68.                                 then
  69.                         then
  70.                         leavesave newfl and
  71.                         if      on> changed     \ write newfile to disk
  72.                         then
  73.                 else    drop true
  74.                         " \4 FILE is not available " ?softerror
  75.                 then
  76.                 restore> seqhandle
  77.                 restore> screenchar             \ restore cursor position
  78.                 restscr
  79.                 cursor-on showcur
  80.                 leavesave
  81.                 if      sesc
  82.                 then    ;
  83.  
  84.                                         \ n1 = line number in file if found
  85. : check-ndx     ( --- n1 f1 )           \ f1 = true if found index
  86.                                         \ searched for word must be at HERE.
  87.                 here c@ 0= if 0 false exit then
  88.                 save> screenchar
  89.                 wordhndl save!> seqhandle
  90.                 here helpbuf over c@ 2+ cmove
  91.                 " HYPER.NDX" ">$ $file 0=
  92.                 if      IBRESET
  93.                         0.0 seqhandle movepointer
  94.                         0.0 filepointer 2!
  95.                         loadline off
  96.                         off> wordfnd
  97.                         0 20000 1
  98.                         do      lineread c@ 0= ?leave
  99.                                 outbuf 1+ c@ 249 ( ∙ ) =
  100.                             if          outbuf count 1 /string 2-
  101.                                         hndlsave ">handle
  102.                             else
  103.                                 $2020 outbuf count + 2- !
  104.                                       \ have at least 1 blank at end of line.
  105.                                 helpbuf count outbuf 1+ swap 1+ caps-comp 0=
  106.                                 if      drop
  107.                                         outbuf count bl scan 1 /string
  108.                                         2dup bl scan nip - here place
  109.                                         here count + 3 blank
  110.                                         here number? 2drop
  111.                                         on> wordfnd leave
  112.                                 then
  113.                             then
  114.                         loop    wordhndl hclose drop
  115.                         wordfnd
  116.                 else    0 false
  117.                 then
  118.                 restore> seqhandle
  119.                 restore> screenchar ;
  120.  
  121. : line-ed/br    ( false line --- f1 )
  122.                 =: listsave
  123.                 save> screenchar        \ save because $FILE below resets it
  124.                 wordhndl save!> seqhandle
  125.                 hndlsave $file 0=
  126.                 restore> seqhandle
  127.                 if      wordhndl hclose drop
  128.                         wordhndl hndlsave $>handle
  129.                         on> leavesave  \ setup to leave EDIT
  130.                         browseset  =: newbrowse
  131.                         screenline =: linesave
  132.                         newfl
  133.                         if      on> changed     \ write newfile to disk
  134.                         then
  135.                         sesc
  136.                 else    true " \4 FILE is not available " ?softerror
  137.                         scrshow
  138.                 then    restore> screenchar ;
  139.  
  140. : word-ed/br    ( false --- f1 )
  141.                 'word@cur
  142.                 if      cfa-word-ed/br
  143.                 else    drop
  144.                         check-ndx
  145.                         if      line-ed/br
  146.                         else    drop
  147.                                 true " \4 No LINKAGE for this word "
  148.                                 ?softerror
  149.                                 scrshow
  150.                         then
  151.                 then    ;
  152.  
  153. : wordedit      ( --- )
  154.                 off> browseset
  155.                 off> ?wordhelp
  156.                 word-ed/br ;
  157.  
  158. \ 146 fnset wordedit      \ function value for Alt-E
  159.  
  160. : worddefer     ( false --- f1 )
  161.                 on> browseset
  162.                 off> ?wordhelp
  163.                 'word@cur
  164.                 if      dup @rel>abs
  165.                         ['] bgstuff @rel>abs =
  166.                         if      >body @ cfa-word-ed/br
  167.                         else    dup @rel>abs
  168.                                 ['] emit @rel>abs =
  169.                                 if      >is @ cfa-word-ed/br
  170.                                 else    drop
  171.                                         true
  172.                                         " \4 Not a DEFERED word " ?softerror
  173.                                         scrshow
  174.                                 then
  175.                         then
  176.                 else    drop
  177.                         true " \4 No LINKAGE for this word " ?softerror
  178.                         scrshow
  179.                 then    ;
  180.  
  181. ' worddefer alias worddef
  182.  
  183. \ 240 fnset worddefer     \ function for Alt-F9
  184.  
  185. : wordbrowse    ( --- )
  186.                 on> browseset
  187.                 off> ?wordhelp
  188.                 word-ed/br ;
  189.  
  190. \ 176 fnset wordbrowse    \ function value for Alt-B
  191. \ 195 fnset wordbrowse    \ function value for F9
  192.  
  193. : wordfrom      ( -- )                  \ show where word was loaded from
  194.                 on> loadedfrom
  195.                 wordbrowse ;
  196.  
  197. \ 330 fnset wordfrom      \ function value for Ctrl-F9
  198.  
  199. : browse-nln    ( --- )                 \ browse is Enter
  200.                 ?browse
  201.                 if      wordbrowse
  202.                 else    nln
  203.                 then    ;
  204.  
  205. \ control M ctlset browse-nln     \ install into Enter function
  206.  
  207. : wordhelp      ( --- )
  208.                 on> browseset
  209.                 on> ?wordhelp
  210.                 word-ed/br ;
  211.  
  212. \ 163 fnset wordhelp      \ function value for Alt-H
  213.  
  214. : sescALL       ( --- )         \ pop off all extra nest levels
  215.                 on> leavenow
  216.                 sesc
  217.                 off> leavenow
  218.                 on> pop-extra ;
  219.  
  220. \ 221 fnset sescALL       \ function value for Shift-F10
  221.  
  222. defer browbutton        ' noop is browbutton
  223.  
  224. : browsetgl     ( --- )
  225.                 ?browse 0=                              \ if browse is OFF
  226.                 if      changed updated or              \ have things changed
  227.                         if      ['] browbutton save!> dobutton
  228.                                 cursor-off
  229.                                 16 8 64 12 box&fill     \ ask for verification
  230.                                 ."  You have made changes to this file," bcr
  231.                                 ."  do you want to SAVE your changes? "
  232.                                 ." \r Yes \0 \1 No " bcr
  233.                                 ." \s10\1 ESC = Cancel "
  234.                                 begin   key
  235.                                         dup         13 =          \ Enter
  236.                                         over        27 = or       \ ESC
  237.                                         over bl or 'y' = or       \ YES
  238.                                         over bl or 'n' = or 0=    \ NO
  239.                                 while   drop beep
  240.                                 repeat  cursor-on
  241.                             dup 27 <>
  242.                             if  bl or 'n' <>
  243.                                 if      updt            \ then save changes
  244.                                         recover.$$$ ?ferr 0=
  245.                                         if      off> updated
  246.                                                 off> changed
  247.                                                 ?browse 0= =: ?browse
  248.                                         then
  249.                                 else    discard.$$$     \ or don't
  250.                                         off> updated
  251.                                         off> changed
  252.                                         ?browse 0= =: ?browse
  253.                                 then    ['] hypertypeL is typeL
  254.                             else drop                   \ or cancel operation
  255.                             then
  256.                                 restore> dobutton
  257.                                 scrshow
  258.                         else    ?browse 0= =: ?browse
  259.                                 ['] hypertypeL is typeL
  260.                         then
  261.                 else    ?dosio
  262.                         if      ['] (typeL)       is typeL
  263.                         else    (lit) defers typeL is typeL
  264.                         then
  265.                         ?browse 0= =: ?browse
  266.                 then
  267.                 scrshow on> ?border showstat ;
  268.  
  269. \ 220 fnset browsetgl     \ function value for Shift-F9
  270.  
  271. : %sednew       ( --- )
  272.                 off> browseset          \ enter in EDIT mode
  273.                 ['] noop save!> dobutton
  274.                 savescr
  275.                 begin   ?shiftkey
  276.                         if      @word@cur count pad c!
  277.                                 pad count cmove
  278.                         else    pad off
  279.                         then
  280.                         8 8 72 13 box&fill bcr
  281.                         ."  \r Filename to OPEN or CREATE "
  282.                         #out @ 1+ #line @ ( --- x y )
  283.                         bcr bcr
  284.                         ."  Press Enter alone to pick from a list of files "
  285.                         >attrib1
  286.         ( x y --- )     pad 30 lineeditor
  287.                         >norm
  288.                         if      pad c@ 0=
  289.                                 if      getfile ( --- <a1> f1 )
  290.                                         if      pad over c@ 1+ cmove
  291.                                                 true true
  292.                                         else    false
  293.                                         then
  294.                                 else    true true
  295.                                 then
  296.                         else    false true
  297.                         then
  298.                 until
  299.                 if      hndlsave save!> seqhandle
  300.                         pad $file 0=
  301.                         if      hndlsave hclose drop
  302.                                 -1 =: leavesave  \ setup to leave EDIT
  303.                                 browseset =: newbrowse
  304.                                 screenline =: linesave
  305.                                 off> listsave
  306.                         else    cursor-off
  307.                                 20 11 58 14 box&fill
  308.                                 ."  \2  File does not exist, CREATE it?  "
  309.                                 bcr
  310.                                 ." \s07\r Yes \0 No    ESC=Cancel"
  311.                                 0
  312.                                 begin   drop key
  313.                                         dup  27 ( ESC )  =      \ ESC=No
  314.                                         over 13 ( Enter) = or   \ Enter=Yes
  315.                                         over upc 'Y'     = or   \ Y=Yes
  316.                                         over upc 'N'     = or   \ N=No
  317.                                 until   dup 13 =                \ Enter
  318.                                         swap upc 'Y'     = or   \ or Yes
  319.                             if  seqhandle hcreate
  320.                                 20 4 61 6 box&fill space
  321.                                 if
  322.                                    ." \2 Could NOT CREATE the requested file "
  323.                                         beep 1 seconds beep
  324.                                 else
  325.                                    ." \1   CREATING the requested NEW file   "
  326.                                         2573 sp@ 2 seqhandle hwrite 2drop
  327.                                         seqhandle hclose drop
  328.                                         -1 =: leavesave  \ setup to leave EDIT
  329.                                         browseset =: newbrowse
  330.                                         screenline =: linesave
  331.                                         off> listsave
  332.                                 then    >norm 1 seconds
  333.                             then
  334.                         then
  335.                         restore> seqhandle
  336.                         leavesave newfl and
  337.                         if      on> changed     \ write newfile to disk
  338.                         then
  339.                 then    restscr
  340.                 restore> dobutton
  341.                 cursor-on showcur ;
  342.  
  343. ' %sednew is try_to_open
  344.  
  345. : sednew        ( --- )
  346.                 %sednew
  347.                 leavesave
  348.                 if      sesc
  349.                 then    ;
  350.  
  351. \ control O ctlset sednew
  352.  
  353. : togglefiles   ( --- )         \ rotate through open files
  354.                 ?shiftkey >r    \ with SHIFT to rotate backwards.
  355.                 savescr
  356.                 hseg 0= dup
  357.                 " \4 No handle stack segment allocated "      ?softerror
  358.                 hdepth maxh 1- >= dup  " \4 Nest stack FULL " ?softerror
  359.                 or 0=
  360.                 restscr
  361.         if      screenline =: linesave
  362.                 off> leavesave
  363.                 sesc            \ leave this edit
  364.                 ed1>hstack      \ push this edit on stack
  365.                 r@
  366.                 if      hdepth 1- 0MAX 0
  367.                         ?do     hrotate
  368.                         loop
  369.                 else    hrotate \ rotate bottom of file stack to top
  370.                 then
  371.                 on> toggling
  372.         then    r>drop ;
  373.  
  374. \ 232 fnset togglefiles           \ Alt-F1
  375.  
  376. 0 value fliptop
  377. 0 value flipbot
  378.  
  379. : flipfiles     ( --- )
  380.                 ['] noop save!> dobutton
  381.                 savescr
  382.                 hseg 0= dup
  383.                 " \4 No handle stack segment allocated "     ?softerror
  384.                 hdepth maxh 1- >= dup " \4 Nest stack FULL " ?softerror
  385.                 or 0=
  386.                 restscr
  387.         if      cursor-off
  388.                 10 11 hdepth 2+ 2/ - dup 1+ =: fliptop
  389.                 70 14 hdepth 1+ 2/ + dup    =: flipbot box&fill
  390.         ." \r  \1 Press a letter for the file you want to select. \2 Line "
  391.                 bcr
  392.                 ."  A - " ed1hndl count type 64 #out @ - spaces
  393.                 curline 1+ 4 .r bcr
  394.                 hdepth 0
  395.                 ?do     space i 'B' + femit ."  - "
  396.                         hseg b/hstk hdepth i 1+ - * 2dup 2dup c@L
  397.                         swap 1+ swap typeL 64 #out @ - spaces
  398.                         b/hcb + @L 4 .r bcr
  399.                 loop    ." \s20\r ESC = Cancel "
  400.                 begin   key     dup  'A' hdepth 'A' + between
  401.                                 over 'a' hdepth 'a' + between or
  402.                                 over 27 ( ESC ) = or 0=
  403.                 while   drop beep
  404.                 repeat  dup 27 <>
  405.                 cursor-on
  406.                 if      bl or 'a' - 0MAX hdepth swap - 1+ >r
  407.                         screenline =: linesave
  408.                         off> leavesave
  409.                         sesc            \ leave this edit
  410.                         ed1>hstack      \ push this edit on stack
  411.                         r> 0
  412.                         ?do     hrotate \ rotate bottom of file stack to top
  413.                         loop
  414.                 else    drop scrshow
  415.                 then
  416.         then    restore> dobutton ;
  417.  
  418. \ 212 fnset flipfiles             \ Shift-F1
  419.  
  420. : nxtbrowse     beep ;          \ Alt-N
  421.  
  422. forth definitions
  423.  
  424.