@q
@program plib.muf
1 9999 d
i
$def Version "Public Programs Lister 1.1 - Ruffin@Furtoonia - 15 Feb 96"
(
Distribute freely.  Modify if you need to, though please indicate the changes
below, and leave the original credits intact.  I'd be interested in any nifty
changes or ideas you have.
   V1.1 15 Feb 96  Ruffin  Change so 'plib' alone doesn't spam.
   V1.0a 5 Nov 95  Ruffin  Initial release 
A public program listing manager.  Very simple.  Should be M3.
)
$def progdir "_progs/"
$def progcnt 7
$def Header "---DBRef-Name---------------------Owner----------------Modified-Docs---------"
$def Footer "-----------------------------------------[ %n program%s found ]--------------"
var found
: nametell ( s -- ; print, substituting trigger name for %m )
  command @ "%m" subst .tell
;
: help
  Version .tell
  "\rThis is a simple public program listing manager." .tell
  "  %m *       - Show all programs." nametell
  "  %m string  - Show programs with 'string' in the name or descriptions." nametell
  "  %m #mine   - Show programs belonging to you." nametell
  "  %m #new 12 - Show programs new/changed in the last 12 days." nametell
  "  %m #add #1234 - Add/readd your program #1234 to the list." nametell
  "  %m #del #1234 - Remove your program #1234 from the list." nametell
  "  %m #help   - This screen." nametell
;
: format ( s1 -- s2 ; s1 is prop name, s2 is two lines about program )
  trigger @ over getpropstr swap
  progcnt strcut swap pop atoi dbref
  dup program? over "L" flag? and not if pop pop "" exit then
  "     #" over intostr strcat dup strlen 6 - strcut swap pop
     " " strcat "- " swap strcat
  over name "                        " strcat 24 strcut pop strcat " " strcat
  over owner name "                         " strcat 20 strcut pop strcat
    " " strcat over timestamps pop pop swap pop "%D" swap timefmt strcat
    " " strcat over "_docs" getpropstr if "@view" else "@list" then strcat
  "\r" strcat swap pop "  " rot strcat 78 strcut pop strcat
;
: showfooter ( -- ; print the 'found' footer )
  Footer found @ intostr "%n" subst
  found @ 1 = if "" else "s" then "%s" subst .tell
;
: cmdlist ( s -- ; list programs with string s )
  Header .tell 0 found !
  strip dup not if pop " " then progdir
  begin
    trigger @ swap nextprop dup while
    dup format dup if dup 4 pick instring if
      found @ 1 + found ! .tell else pop then else pop then
  repeat pop showfooter
;
: cmdnew ( s -- ; list all new/changed programs within s days )
  atoi dup not if pop 1 then 24 * 3600 * systime swap -
  Header .tell 0 found !
  progdir begin
    trigger @ swap nextprop dup while
    dup progcnt strcut swap pop atoi dbref
    timestamps pop pop swap pop 3 pick > if
      dup format dup if found @ 1 + found ! .tell else pop then then
  repeat pop showfooter
;
: cmdmine ( -- ; list all my programs )
  Header .tell 0 found !
  progdir begin
    trigger @ swap nextprop dup while
    dup progcnt strcut swap pop atoi dbref owner me @ dbcmp if
      dup format dup if found @ 1 + found ! .tell else pop then then
  repeat pop showfooter
;
: dbtoprop ( d -- s ; convert dbref to string for prop )
  "000000" swap intostr strcat dup strlen 7 - strcut swap pop
;
: checkprog ( s -- d i ; convert string to dbref, check validity,
      i is 0 if valid program )
  "" "#" subst atoi dbref
  dup owner me @ dbcmp me @ "W" flag? or not if
    "You don't own that program." .tell pop 1 exit then
  dup program? not if
    "That's not a program." .tell pop 1 exit then
  dup "L" flag? not if
    "That isn't linkable." .tell pop 1 exit then
  0
;
: cmdadd ( s -- ; add program )
  checkprog if exit then
  "Program " over unparseobj strcat " - please enter 1 line desc." strcat
  .tell read 78 strcut pop
  progdir rot dbtoprop strcat swap over trigger @ swap rot 0 addprop
  format .tell
;
: cmddel ( s -- ; delete program )
  checkprog if exit then
  progdir swap dbtoprop strcat trigger @ over getpropstr not if
    pop "That's not a program in the list." .tell exit then
  dup format .tell  "-- Delete this program from the list (y/n)?" .tell
  read tolower "y" stringpfx if
    trigger @ swap remove_prop "Program removed." .tell else
    pop "Program not removed." .tell then
;
: main ( s -- )
  strip dup " " strcat " " instr strcut strip swap strip
  dup not if help exit then
  dup "*" strcmp not if pop "" cmdlist exit then
  dup "#h" stringpfx if pop pop help exit then
  dup "#a" stringpfx if pop cmdadd exit then
  dup "#d" stringpfx if pop cmddel exit then
  dup "#m" stringpfx if pop pop cmdmine exit then
  dup "#n" stringpfx if pop cmdnew exit then
  cmdlist
;
.
c
q