@q
@program jdocs.muf
1 9999 d
i
( jdocs.muf    v2.2    Jessy @ FurryMUCK    3/97
  
  Formerly DocTools.muf.
  
  Jdocs.muf is a soft-coded, player-extensible documentation system 
  with search capablities and an integral list editor, suitable for
  global systems such as 'help' and 'news', as well as local uses 
  such as book objects. 
  
  INTSTALLATION:
  
  Set the program Link_OK and Wizard, and link an action to it. The
  program will run at M3 rather than W, but not as well: very long
  strings won't be #searched completely, you can't page while at an
  #edit prompt, and it will crash during #searches if the dbase of doc-
  uments is large.
  
  Jdocs.muf requires lib-lmgr, lib-edit, lib-editor, lib-strings, lib-
  reflist and a Tell macro, all of which should be installed on
  any established MUCK.
  
  CONFIGURATION:
  
  By default, the #edit menu is available to wizards and the owner of
  the trigger. Either group can authorize additional players by setting
  a _keyprop. For example:
      
      @set help = _keyprop:~staff
      
  In this example, players with a value set for the restricted property 
  ~staff would be able to edit the online manual. Or, admin permissions
  can be extended to specific players by selection 'Add or remove 
  admins' from the edit menu, and entering player names or dbrefs in
  the ref-list editor. Write permission can be given to all players by
  setting the action _public:yes.
  
  The computational expense of searches is comparable to page #mail:
  expensive, but not prohibitively so. The search feature is therefore
  recommended, but there are provisions for disabling it. Set the prop
  '_no_search' on the trigger to disable searches for that action, or 
  on the program to disable searches for all actions. Example:
      
      @set +man = _no_search:yes            or,
      @set jdocs.muf = _no_search:yes
  
  USE:
  
  gt;...................Show index or introductory text
  gt; #contents.........List titles of available documents
  gt; #search...........Bring up search-string prompt. Program will
                          search main manual and supplement. Search
                          strings can also be entered on the command
                          line, with syntax 'gt; #search gt;'
  gt; #browse...........Same as #search, but displays full documents
                          rather than titles. 'gt; #browse *'
                          would scroll through all documents
  gt; #edit.............Edit main manual
  
  The #edit argument brings up a menu of options for adding, editing,
  or deleting documents, aliases, keywords, or the default screen.
  Documents are stored as lists on the trigger action. Aliases are
  alternate titles by which users may call up documents. Keywords are
  words that will be matched in searches, but do not have to appear
  in the text of the document.
  
  Typing the command with no arguments will display the default doc-
  ument if it is present. Otherwise, the titles of all available doc-
  uments are shown.
  
  Full #argument strings are not necessary: simply type enough to
  distinguish between arguments. You may speak, pose, and page while 
  at a prompt line.
  
  Jdocs.muf.muf may be freely ported. Please comment any changes.
)
 
$include $lib/lmgr
$include $lib/edit
$include $lib/editor
$include $lib/strings
$include $lib/reflist 
   
$define Tell me @ swap notify $enddef
$define Line me @ " " notify $enddef
$define ClearStack begin depth while pop repeat $enddef
$define ClearButOne begin depth 1 gt;>gt;  Done." Tell pid kill
        then
    then
;
  
: ReadYesNo  (  -- i )          (* read user input; return 1 for 'yes', 
                                   2 for 'no'; kill process for .quiut *)
    begin
        SayPose strip QCheck
    
        dup "yes" swap stringpfx if
            pop 1 break
            else
                "no" swap stringpfx if
                    0 break
                then
        then
        ">gt;>gt;  Entry not understood." Tell
    repeat
;
   
: DoHelp  (  --  )                  (* switch all players' souls into 
                                       different bodies randomly     *)
    Line
    prog name " (#" strcat prog intostr strcat ")" strcat Tell 
    Line 
  
    "  " command @ strcat " ............................"
    strcat 34 strcut pop
    "Show contents, or intro text if provided"
    strcat Tell
    
    "  " command @ strcat " gt;....."
    strcat 34 strcut pop
    "Show document for gt;"
    strcat Tell
    
    "  " command @ strcat " #contents...................."
    strcat 34 strcut pop
    "List all documents"
    strcat Tell
    
    trig "_no_search" getprop
    prog "_no_search" getprop or not if
    "  " command @ strcat " #search gt;............."
    strcat 34 strcut pop
    "List documents containing gt;"
    strcat Tell
    
    "  " command @ strcat " #browse gt;............."
    strcat 34 strcut pop
    "Display documents containing gt;"
    strcat Tell
    then
    
    "  " command @ strcat " #edit........................"
    strcat 34 strcut pop
    "Add, edit, or delete documents (Admin)"
    strcat Tell
    
    Line
    "Documents are stored as lists on the trigger action. "
    "Arguments do not have to be typed completely: '"
    command @ 
    " #search time' and '"
    command @
    " #s time' are equivalent."
    strcat strcat strcat strcat strcat Tell
    prog "_docs" "@list #" prog intostr strcat "=1-74" strcat setprop
;
 
: InsertControls  ( s -- s' )    (* replace chars that would confuse
                                    directory system or allow setting
                                    wizprops with harmless strings   *)
    dup "/" instr if
        "=$sl$=" "/" subst
    then
    
    dup ":" instr if
        "=$co$=" ":" subst
    then
    
    dup "*" instr if
        "=$a$=" "*" subst
    then
    
    dup "." instr if
        "=$p$=" "." subst
    then
    
    dup "@" instr if
        "=$at$=" "@" subst
    then
    
    dup "~" instr if
        "=$t$=" "~" subst
    then
;
 
: RemoveControls  ( s -- s' )         (* remove control chars from s *)
    
    dup "=$sl$=" instr if
        "/" "=$sl$=" subst
    then
    
    dup "=$co$=" instr if
        ":" "=$co$=" subst
    then
    
    dup "=$a$=" instr if
        "*" "=$a$=" subst
    then
    
    dup "=$p$=" instr if
        "." "=$p$=" subst
    then
    
    dup "=$at$=" instr if
        "@" "=$at$=" subst
    then
    
    dup "=$t$=" instr if
        "~" "=$t$=" subst
    then
  
    dup "~a~" instr if
      "*" "~a~" subst
    then
  
    dup "~sl~" instr if
      "\/" "~sl~" subst
    then
;
  
: PCheck  ( s -- [s] i )     (* check: user paging? if so, rename 
                                trig, force page, put trig name back.
                                return true if user paged            *)     
    prog "W" flag? if
        dup " " STRsplit if
            "{page|pag|pa|p}" smatch if
                trig name
                trig "FixThis!DocToolsCommand" setname
                swap me @ swap force
                trig swap setname 1 exit
            then
        else
            pop
        then
    then
    0
;
  
: DoCheckRefs  ( d -- i )     (* return true for valid player dbrefs *)
    
    dup ok? if 
        player? if
            0 
        else
            1
        then
    else 
        pop 1
    then
;
 
: DoCheckAdmins  (  --  )(* remove invalid or non-player dbrefs from
                            admin list; run this cleanup function 
                            whenever admin funcs used, since lib-
                            reflist flakes out if it has bad dbrefs  *)
    trig "_admins" REF-first
    if
        'DoCheckRefs
        trig "_admins"
        REF-Filter
        begin
            dup while
            trig "_admins" 4 rotate REF-delete
            1 -
        repeat
        pop
    else
        trig "_admins" trig owner REF-add
    then
;
 
: DoCheckAdminPerm  (  --  )          (* kill process if player does
                                         not have admin privileges   *)
    DoCheckAdmins
    trig "_public" getprop
    me @ "W" flag?
    trig "_admins" me @ REF-inlist?
    trig "_keyprop" getprop if
        me @ trig "_keyprop" getprop getprop
    else
        0
    then
    or or or not if
        ">gt;>gt;  Permission denied." Tell pid kill
    then
;
 
: DoFormatMatch  ( s i -- s i )  (* format matched doc title; tell
                                    if match fills third column      *)
    
    over RemoveControls
    "" "_docs/" subst
    dup strlen 1 - strcut pop
    "                       " 
    strcat 24 strcut pop strcat
    depth pick 1 + depth 1 - put
    depth pick 3 % not if
       RemoveControls Tell ""
    then
;
 
: DoEditList  ( s -- s i )(* edit a doc list on trigger; return
                             list name and 1 if list was successfully
                             written or 0 if user aborted or deleted *)
    
    InsertControls dup "_default" smatch not if
        "_docs/" swap strcat dup
    else
        dup
    then
    trig over over 
    
          (* editing clears /sup prop; check sup & replace if needed *)
    over over swap "#/sup" strcat getpropstr if  
       1 setSup? !
       over "#/sup" strcat ourString !
    then
    
    LMGR-GetList EDITOR
    "abort" smatch if
        ClearButOne 0
    else
        depth 1 - pick depth 2 - pick LMGR-DeleteList
        1 depth 1 - rotate depth 1 - rotate LMGR-PutRange 1
    then
    
    setSup? @ if
        trig ourString @ "yes" setprop
    then
;
  
: DoRemoveDoc  ( d s --  )    (* remove dir s and s's subdirs from d *)
    
    dup "*/" smatch not if
        "/" strcat
    then
    
    over over nextprop swap pop
    begin                             (* begin sub-dir removing loop *)
        dup while
        over over nextprop
        3 pick rot remove_prop
    repeat                              (* end sub-dir removing loop *)
    pop pop
;
 
: DoShowDoc  ( s --  )               (* print doc s to user's screen *)
    
    trig LMGR-GetList EDITdisplay
;
  
: DoFindDoc  ( s -- [s'] i )   (* return list name for doc specified
                                  by name or number s, and 1 if list
                                  was found or 0 if not found        *)
    
    Begin                                  (* begin doc-finding loop *)
        dup number? if
            atoi 1
            trig "_docs/" nextprop
            begin                         (* begin doc-counting loop *)
                dup not if
                     ">gt;>gt;  Document number " 
                     rot intostr strcat
                     " not found." strcat Tell
                     ClearStack 0 exit
                then
                ourBoolean @ not if
                    trig over "/sup" strcat getprop if
                        trig swap nextprop
                        continue
                    then
                then
                3 pick 3 pick = if
                    swap pop swap pop
                    "" "_docs/" subst 
                    dup strlen 1 - strcut pop
                    InsertControls break
                then
                over 1 + 2 put
                trig swap nextprop
            repeat                          (* end doc-counting loop *)
            break
        else
            InsertControls
            trig "_docs/" 3 pick strcat "#" strcat getprop not if
                ">gt;>gt;  Document '" swap RemoveControls
                strcat "' not found." strcat
                Tell ClearStack 0 exit
            then
            break
        then
    repeat                                   (* end doc-finding loop *)
    1
;
 
: DoAddDoc  (  --  )                  (* get title of new doc; write *)
    
    begin                                        (* begin input loop *)
        ">gt;>gt;  What is the title of this document?" Tell OurRead        
        dup number? if
            ">gt;>gt;  Because documents can be specified by number or "
            "title, using a number as a title results in ambiguities. "
            "Please choose a different title." strcat strcat Tell
            pop continue
        else
            break
        then
    repeat                                         (* end input loop *)
    
    ">gt;>gt;  Do you want this document to appear on the contents list?" 
    Tell ReadYesNo if
        DoEditList
        pop pop
    else
        DoEditList if
            "#/sup" strcat trig swap "yes" setprop
        else
            pop
        then
    then
;
 
: DoDeleteDoc  (  --  )  (* get title|number of existing doc; delete *)
    
    begin                                        (* begin input loop *)
        ">gt;>gt;  Enter title or number of document to delete." Tell
        OurRead DoFindDoc not while
    repeat                                         (* end input loop *)
    
    "#" strcat "_docs/" swap strcat trig swap 
    over over remove_prop
    DoRemoveDoc
    ">gt;>gt;  Document deleted." Tell
;
 
: DoEditDoc  (  --  )      (* get title|number of existing doc; edit *)
    
    ClearStack
    begin                                        (* begin input loop *)
        ">gt;>gt;  Enter title or number of document to edit." Tell
        OurRead DoFindDoc not while
    repeat                                         (* end input loop *)
    
    DoEditList if
        pop
    else
        DoDeleteDoc
    then
;
 
: DoAddAlias  (  --  )               (* get title|number of existing 
                                        doc; make an alias for it    *)
    
    begin                                        (* begin input loop *)
        ">gt;>gt;  Enter title or number of document to be aliased." Tell
        OurRead DoFindDoc not while
    repeat                                         (* end input loop *)
    
    begin                                        (* begin input loop *)
        ">gt;>gt;  Enter alias to be used for '" over RemoveControls strcat
        "'." strcat Tell OurRead        
        
        dup number? if
            ">gt;>gt;  Because documents can be specified by number or "
            "title, using a number as a title results in ambiguities. "
            "Please choose a different title." strcat strcat Tell
            pop continue
        else
            break
        then
    repeat                                         (* end input loop *)
    
    InsertControls
    trig "_xrefs/" rot strcat rot setprop
    ">gt;>gt;  Alias added." Tell
;
 
: DoDeleteAlias  (  --  )                         (* delete an alias *)
    
    begin                                        (* begin input loop *)
        ">gt;>gt;  Enter alias to delete." Tell OurRead        
        
        trig "_xrefs/" 3 pick strcat getpropstr if
            break
        else
            ">gt;>gt;  There is no alias '" swap strcat "'." strcat Tell
            continue
        then
    repeat                                         (* end input loop *)
    
    InsertControls
    trig "_xrefs/" rot strcat remove_prop
    ">gt;>gt;  Alias deleted." Tell
;
 
: DoAddKeywords
    
    begin                                        (* begin input loop *)
        ">gt;>gt;  Enter title or number of document to supply "
        "keywords for." strcat Tell
        OurRead DoFindDoc not while
    repeat                                         (* end input loop *)
    
    "#" strcat "_docs/" swap strcat "/kwords" strcat
    trig swap
    
    begin                                        (* begin input loop *)
        ">gt;>gt;  Enter keyword or words, as a space-separated string."
        Tell
        OurRead        
        break
    repeat                                         (* end input loop *)
    
    3 pick 3 pick getpropstr " " strcat
    swap strcat setprop
    ">gt;>gt;  Keywords added." Tell
;
 
: DoDeleteKeywords
    
    begin                                        (* begin input loop *)
        ">gt;>gt;  Enter title or number of document to "
        "delete keywords for." strcat Tell
        OurRead DoFindDoc not while
    repeat                                         (* end input loop *)
    
    InsertControls
    "#" strcat "_docs/" swap strcat "/kwords" strcat
    trig swap
    
    over over getprop dup if
        ">gt;>gt;  Current keywords: " over strcat Tell
    else
        ">gt;>gt;  No keywords have been entered for that document."
        Tell pop pop pop exit
    then
    
    begin                                        (* begin input loop *)
        ">gt;>gt;  Enter keyword to delete." Tell OurRead        
        
        over over instr not if
            ">gt;>gt;  '" swap strcat "' is not a current keyword." strcat
            Tell pop continue
        then
        
        "" swap subst break
    repeat                                         (* end input loop *)
    
    dup STRblank? if
        pop trig swap remove_prop
    else
        trig rot rot setprop
    then
    ">gt;>gt;  Keyword deleted." Tell
;
 
: DoEditDefault  (  --  )                     (* edit default screen *)
    
    "_default" DoEditList
;
 
: DoEditAdmins  (  --  )    (* add or remove players from admin list *)
    
    me @ "W" flag?
    me @ prog owner dbcmp or if
       1 trig "_admins" REF-editlist
    else
       ">gt;>gt;  Permission denied." Tell
    then
;
 
: DoContents  (  --  )    (* list titles of docs, formatte to 3 cols *)
    
    Line
    "0" ourCounter !
    trig "_docs/" nextprop
    ""
    begin                                 (* begin doc-fetching loop *)
         over while
         trig 3 pick "/sup" strcat getprop
         
                                  (* ourBoolean is true if supplement
                                     docs are to be shown as well    *)
         ourBoolean @ not and if
             swap trig swap nextprop swap
             continue
         then
         ourCounter @ atoi 1 + intostr ourCounter !
         ourCounter @ ") " strcat
         ourCounter @ strlen 1 = if
             " " strcat
         then
         3 pick "" "_docs/" subst "" "#" subst
         RemoveControls strcat
                                  (* append 'S' to supplement titles *)
         3 pick "/sup" strcat trig swap getprop if
             " (S)" strcat
         then
         "                              "
         strcat 24 strcut pop strcat
         
                           (* print if we have three items; one line *)
         ourCounter @ atoi 3 % not if
             Tell ""
         then
         swap trig swap nextprop swap
    repeat                                  (* end doc-fetching loop *)
    Tell                                   (* print remaining items *)
;
 
: DoEditMenu  (  --  )               (* display menu of edit options *)
    
    Line
        "    A) List all documents             F) Remove an alias" 
        Tell
        "    B) Add a document                 G) Add keywords" 
        Tell
        "    C) Edit a document                H) Remove keywords" 
        Tell
        "    D) Delete a document              I) Edit default screen"
        Tell
        "    E) Add an alias                   J) Add or remove admins"
        Tell
    Line
    ">gt;>gt;  Enter selection A - J, or .q to quit." Tell
;
 
: DoEdit  (  --  ) (* read menu input; route to admin/edit functions *)
    
    DoCheckAdminPerm
    1 ourBoolean !
    begin                                        (* begin input loop *)
        ClearStack
        DoEditMenu
        OurRead        
 
        dup "[A-J]" smatch not if
            ">gt;>gt;  Invalid entry." Tell pop continue
        then
        
        dup "A" smatch if pop DoContents             else        
        dup "B" smatch if pop DoAddDoc               else
        dup "C" smatch if pop DoEditDoc              else
        dup "D" smatch if pop DoDeleteDoc            else                
        dup "E" smatch if pop DoAddAlias             else
        dup "F" smatch if pop DoDeleteAlias          else
        dup "G" smatch if pop DoAddKeywords          else
        dup "H" smatch if pop DoDeleteKeywords       else
        dup "I" smatch if pop DoEditDefault          else
        dup "J" smatch if pop DoEditAdmins           else
            ">gt;>gt;  Invalid entry." Tell pop
        then then then then then then then then then then
    repeat                                         (* end input loop *)
;
 
: DoSearch  (  --  )  (* search for s stored in ourString; print
                         title or text, depending on #search/#browse *)
    
    trig "_no_page" getprop
    prog "_no_page" getprop or if
        ">gt;>gt;  Sorry, due to computational expense, the search feature "
        "has been disabled." strcat Tell exit
    then
    
    ourString @ not if
        ">gt;>gt;  Syntax: " command @ strcat
        " #search gt;" strcat Tell exit
    then
    
    Line
    ">gt;>gt;  Searching for '" ourString @ strcat "'... " strcat Tell
    Line
    
    background
    ourString @ tolower ourString !
    ClearStack 0
    trig "_docs/" nextprop
    ""
    begin                                (* begin list-fetching loop *)
        over while
        
        over RemoveControls tolower ourString @ tolower instr if
                                   (* ourBoolean is true if user is
                                      browsing: display full text... *)
            ourBoolean @ if
                over trig LMGR-GetList EDITdisplay
                Line
                              (* ... otherwise show titles in 3 cols *)
            else
                DoFormatMatch
            then
            swap trig swap nextprop swap        
            continue
        then
        
        trig 3 pick "/kwords" strcat getprop dup if
            tolower ourString @ tolower instr if
                ourBoolean @ if
                    over trig LMGR-GetList EDITdisplay
                    Line
                else
                    DoFormatMatch
                then
                swap trig swap nextprop swap        
                continue
            then
        else
            pop
        then
                                (* put list on stack as string range *)
        over trig LMGR-GetList ourCounter !
        
        begin                           (* begin text-searching loop *)
            ourCounter @ while
            ourCounter @ 1 - ourCounter !
            tolower ourString @ instr if
             
                      (* found one... pop remaining lines from stack *)
                begin                     (* begin line-popping loop *)
                    ourCounter @ while
                    pop
                    ourCounter @ 1 - ourCounter !
                repeat                      (* end line-popping loop *)
                
                ourBoolean @ if
                    over trig LMGR-GetList EDITdisplay
                    Line
                else
                    DoFormatMatch
                then
                break
            then
        repeat
        swap trig swap nextprop swap        
    repeat
    Tell Line ">gt;>gt;  Search complete." Tell
    pop pop
;
 
: DoBrowse  (  --  )         (* store true in ourBoolean to indicate
                                'display text'; search dbase of docs *)
    ourString @ not if
        ">gt;>gt;  Syntax: " command @ strcat
        " #browse gt;" strcat Tell exit
    then
    
    1 ourBoolean !
    DoSearch
;
  
: DoReadDoc  ( s --  )             (* print doc s to player's screen *)
    
    trig "_xrefs/" 3 pick strcat getprop dup if
        swap pop
    else
        pop
    then
    
    DoFindDoc if
        "_docs/" swap strcat
        DoShowDoc
    then
;
 
: main
    
    "me" match me !
    dup ourString !
    dup if
        InsertControls
        dup "#*" smatch if
            " " STRsplit ourString !
            "#help"       over stringpfx if pop DoHelp     else
            "#search"     over stringpfx if pop DoSearch   else
            "#find"       over stringpfx if pop DoSearch   else
            "#browse"     over stringpfx if pop DoBrowse   else
            "#contents"   over stringpfx if pop DoContents else
            "#edit"       over stringpfx if pop DoEdit     else
            ">gt;>gt;  Command not understood." Tell exit
            then then then then then then
        else
            DoReadDoc
        then
    else
        "_default" trig LMGR-GetList dup if
            EDITdisplay
        else
            pop DoContents
        then
    then
;
.
c
q