--- gforth/ds2texi.fs 1997/02/01 14:59:28 1.12 +++ gforth/ds2texi.fs 2007/12/31 19:02:24 1.32 @@ -1,12 +1,12 @@ \ documentation source to texi format converter -\ Copyright (C) 1995 Free Software Foundation, Inc. +\ Copyright (C) 1995,1996,1997,1998,1999,2003,2005,2007 Free Software Foundation, Inc. \ This file is part of Gforth. \ Gforth 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 +\ as published by the Free Software Foundation, either version 3 \ of the License, or (at your option) any later version. \ This program is distributed in the hope that it will be useful, @@ -15,8 +15,7 @@ \ GNU General Public License for more details. \ You should have received a copy of the GNU General Public License -\ along with this program; if not, write to the Free Software -\ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +\ along with this program. If not, see http://www.gnu.org/licenses/. \ documentation source can contain lines in the form `doc-word' and \ `short-word'. These are converted to appropriate full or short @@ -26,22 +25,23 @@ \ `documentation'. Each word resides there under its own name. script? [IF] -warnings off -require search-order.fs -require glocals.fs -require float.fs -require struct.fs -require debugging.fs + warnings off + require search.fs + require extend.fs + require glocals.fs + require float.fs + require struct.fs + require debugs.fs [THEN] wordlist constant documentation struct - 2 cells: field doc-name - 2 cells: field doc-stack-effect - 2 cells: field doc-wordset - 2 cells: field doc-pronounciation - 2 cells: field doc-description + cell% 2* field doc-name + cell% 2* field doc-stack-effect + cell% 2* field doc-wordset + cell% 2* field doc-pronounciation + cell% 2* field doc-description end-struct doc-entry create description-buffer 4096 chars allot @@ -59,6 +59,12 @@ create description-buffer 4096 chars all repeat then description-buffer tuck - ; +: skip-prefix ( c-addr1 u1 -- c-addr2 u2 ) + 2dup s" --" string-prefix? + IF + [char] - skip [char] - scan 1 /string + THEN ; + : replace-_ ( c-addr u -- ) \ replaces _ with - chars bounds @@ -87,14 +93,14 @@ create description-buffer 4096 chars all : make-doc ( -- ) get-current documentation set-current create - last @ name>string 2, \ name + latest name>string skip-prefix 2, \ name [char] ) parse save-mem 2, \ stack-effect - bl parse-word condition-wordset 2, \ wordset - bl parse-word dup \ pronounciation + bl sword condition-wordset 2, \ wordset + bl sword dup \ pronounciation if condition-pronounciation else - 2drop last @ name>string + 2drop latest name>string skip-prefix endif 2, get-description save-mem 2, @@ -126,6 +132,13 @@ create description-buffer 4096 chars all ." @cindex " ." @code{" r@ doc-name 2@ typetexi ." }" cr + r@ doc-name 2@ drop c@ [char] : <> if + \ cut out words starting with :, info-lookup cannot handle them + \ !! deal with : by replacing it here and in info-lookup? + ." @kindex " + r@ doc-name 2@ typetexi + cr + endif ." @format" cr ." @code{" r@ doc-name 2@ typetexi ." } " ." @i{" r@ doc-stack-effect 2@ type ." } " @@ -138,8 +151,9 @@ create description-buffer 4096 chars all r@ print-short r@ doc-description 2@ dup 0<> if - ." @iftex" cr ." @vskip-3ex" cr ." @end iftex" cr - type cr cr \ ." @ifinfo" cr ." @*" cr ." @end ifinfo" cr cr + \ ." @iftex" cr ." @vskip-0ex" cr ." @end iftex" cr + type cr cr + \ ." @ifinfo" cr ." @*" cr ." @end ifinfo" cr cr else 2drop cr endif @@ -150,9 +164,9 @@ create description-buffer 4096 chars all \ with the prefix addr2 u2 and continuing with a word in the \ wordlist `documentation'. f is true if xt is executed. >r dup >r - 3 pick over compare 0= + 3 pick over str= if \ addr2 u2 is a prefix of addr1 u1 - r> /string documentation search-wordlist + r> /string -trailing documentation search-wordlist if \ the rest of addr1 u1 is in documentation execute r> execute true else @@ -188,6 +202,7 @@ create docline doclinelength chars allot : compare-ci ( addr1 u1 addr2 u2 -- n ) \ case insensitive string compare + \ !! works correctly only for comparing for equality 2 pick swap - ?dup-0=-if capscomp