Annotation of gforth/status.fs, revision 1.2

1.1       anton       1: \ display status in a separate X-terminal
                      2: 
                      3: \ Copyright (C) 2004 Free Software Foundation, Inc.
                      4: 
                      5: \ This file is part of Gforth.
                      6: 
                      7: \ Gforth is free software; you can redistribute it and/or
                      8: \ modify it under the terms of the GNU General Public License
1.2     ! anton       9: \ as published by the Free Software Foundation, either version 3
1.1       anton      10: \ of the License, or (at your option) any later version.
                     11: 
                     12: \ This program is distributed in the hope that it will be useful,
                     13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
                     14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     15: \ GNU General Public License for more details.
                     16: 
                     17: \ You should have received a copy of the GNU General Public License
1.2     ! anton      18: \ along with this program. If not, see http://www.gnu.org/licenses/.
1.1       anton      19: 
                     20: 
                     21: \ Activate by loading status.fs.  No deactivation, and you have to
                     22: \ kill the xterm yourself after exiting gforth.
                     23: 
                     24: s" xterm -g 100x4 -Sab0" w/o open-pipe throw constant status-fid
                     25: 
                     26: \ This does not work:
                     27: 
                     28: \ :noname ( -- )
                     29: \     status-fid close-pipe throw drop
                     30: \     defers bye ;
                     31: \ is bye
                     32: 
                     33: : .status1 ( -- )
                     34:     #cr emit cr ." base= " base @ dec.
                     35:     #cr emit cr .s
                     36:     #cr emit cr f.s
                     37:     #cr emit cr order ;
                     38: 
                     39: : .status2 ( -- )
                     40:     outfile-id >r
                     41:     status-fid to outfile-id
                     42:     ['] .status1 catch
                     43:     r> to outfile-id
                     44:     throw
                     45:     status-fid flush-file throw
                     46:     defers .status ;
                     47: 
                     48: ' .status2 is .status

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>