@prog lib-wfcommand
1 99999 d
1 i
(  
    lib-wfcommand 1.0.1
 
    This file is part of the MUF Globals by, Peter A Torkelson.
    Copyright [C] 1993, 1994  Peter Torkelson.
 
    This 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.
 
    This software 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 this software; see the file COPYING.  If not, write to
    the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
    You may contact the author by:
       e-mail:  wfire@tcp.com
)

(-------------------------------------------------------------------)
(-------------------------------------------------------------------
 
  This library provides some basic functions to global type
  command MUF, such as cmd-hand. The functions it curently
  provides are:
 
  lib-command-help  [ d s -- ] Muti-subject help system for #help 
        commands.
  
  lib-command-parse [ s -- s s s ] Command to parse the command 
        line of the format: #<command> <arg1>=<arg2>.
 
  See docs below for further information.
  [ and yes, they were at one time individual macros. :]
 
  Changes:
      1.0.1    Added GNU Copyleft, added version numbering.
   
 -------------------------------------------------------------------)
(-------------------------------------------------------------------)


( gen-help.muf - 1991-93 WhiteFire                                  )
( Version 1.2.0 - 1-13-93   - Update to use propdirs and "." props  )
( Version 1.1.0 - 10-1-92   - FB update                             )
( Version 1.0.0 - 10-17-91  - Initial                               )
(                                                                   )
( Parameters: lib-command-help [ d s -- ]                           )
(                                                                   )
( This function is desiged to provide a help system to just tie into)
( your program. You pass it the subject or a "" and the dbref of    )
( where to find the help, and it will look up that subject, and     )
( print it with a defined header and footer. All the text is stored )
( in property lists, they are:                                      )
(                                                                   )
( _help/default:<subject>       Subject to print out if a "" is     )
(                               given as the subject.               )
( _help/subject/<n>:<subject>   A list of subjects, one per line.   )
( _help/header/<n>:<text>       The text of the header.             )
( _help/footer/<n>:<text>       The text of the footer.             )
( _help/txt/<subject>/<n>:<text> The text for each of the subjects. )
(                                                                   )
( Lists may contain lines reading just "." that will come out as a  )
( blank line for use with @archive and other things that use @set   )
( wich does not allow " " as a property value.                      )

lvar    subject
lvar    hobj

: hgetprop  hobj @ swap getpropstr ;

: tell-me   
    dup strip "." stringcmp 0 =
    if
        pop " "
    then
    me @ swap notify 
;

: show-list-loop ( s i -- ) 
    over over intostr strcat hgetprop
    dup
    if
        subject @ "%subject" subst
        command @ "%command" subst
        
        tell-me
        1 +
        show-list-loop
    else
        pop pop pop
    then
;

: show-list ( d s -- ) 
    1 show-list-loop
;

: show-help ( -- ) 
    "_help/header/"                             show-list
    "_help/txt/" subject @ strcat "/" strcat    show-list
    "_help/footer/"                             show-list
;

: find-help ( s -- s ) 
    1
    begin
        "_help/subject/" over intostr strcat hgetprop
        dup
        if
            3 pick                      ( s i sx s )
            strlen                      ( s i sx i )
            over                        ( s i sx i sx )
            swap strcut pop             ( s i sx ~sx )
            4 pick                      ( s i sx ~sx s )
            stringcmp 0 =               ( s i sx i )
            if
                ( Found it )            ( s i sx )
                -3 rotate pop pop
                exit
            else
                ( Another? )
                pop
                1 +
            then
        else
            ( out of subjects and out of luck!)
            pop pop
            ""
            exit
        then
    repeat
;

: lib-help ( d s -- )
    
    swap hobj !

    ( get default subject.. )
    dup not
    if
        pop
        "_help/default" hgetprop
    then
    
    ( Check to see if its a valid help topic.. )
    dup find-help
    dup not 
    if
        pop
        " is not a valid topic." strcat tell-me
        pop
        exit
    else
        swap pop
    then
    
    subject !
    
    show-help
;

: lib-command-help
    lib-help
;

(-------------------------------------------------------------------)
(-------------------------------------------------------------------)
(
    cmd-command-parse [ s -- command arg1 arg2 ]
 
    This takes a command line in the format of:

    #<command> <arg1> = <arg2> 

    and returns the individual parts, or "" if for those parts
    that are not present. All are stripped of leading and trailing
    spaces.
)
: lib-command-parse ( s -- s1 s2 s3 )

    strip

    ( *s1* if it starts with a # or a - strip off the option.. )
    dup 1 strcut pop
    dup "#" stringcmp 0 = swap
        "-" stringcmp 0 = or
    if
        dup " " instr
        dup
        if
            strcut 
            strip
            swap
            strip
        else
            pop
            ""
            swap
        then
        
        1 strcut swap pop (strip #/-)
    else
        ""
    then
    
    swap ( stack: s1 s )
    
    ( *s3* Is there a =? )
    dup "=" instr
    dup
    if
        1 -
        strcut 
        1 strcut swap pop ( strip = )
        strip
        swap
    else
        pop
        ""
        swap
    then
    
    ( stack: s1 s3 s )
    
    ( *s2* Finish it.. )
    strip swap
;


(-------------------------------------------------------------------)
(-------------------------------------------------------------------)

PUBLIC lib-command-help
PUBLIC lib-help
PUBLIC lib-command-parse

( test code, normaly safe to ignore. :)
: main
    trig swap lib-help
;

.
c
q
@register lib-wfcommand=lib/wfcommand
@register #me lib-wfcommand=tmp/prog1
@set $tmp/prog1=L
@set $tmp/prog1=3
@set $tmp/prog1=/_/de:A scroll containing a spell called lib-wfcommand
@set $tmp/prog1=/_defs/lib-command-help:"$lib/wfcommand" match "lib-command-help" call
@set $tmp/prog1=/_defs/lib-command-parse:"$lib/wfcommand" match "lib-command-parse" call
@set $tmp/prog1=/_defs/lib-help:"$lib/wfcommand" match "lib-help" call

