@prog show.MUF
1 99999 d
1 i
( show-re - Property displayer with mild pattern matching.
`
  Syntax: show thing prop
`
  Prop can contain * as any string, ? as a single character
  or [a-z], [^a-z] for set set of a-z or the set NOT a-z.
  The characters []{}?* and \ should be escaped with \
`
 Prop can also be @desc, @succ etc. See: show @help
)
: seekprop ( prop db# "first seek" -- )
  "/" strcat
  begin
    over swap nextprop dup while
    dup 4 pick smatch if
      over over getpropval dup if
        over " (Number) : " rot intostr strcat strcat .tell
      else
        pop over over getpropstr over " (String) : " rot strcat strcat .tell
      then
    then
    over over propdir? if
      3 pick 3 pick 3 pick seekprop
    then
  repeat
( prop db "" )
  pop pop pop
;
: main ( s -- )
  dup " " rinstr dup not if pop
    "@help" over strcmp not if pop
      1
      begin
        prog "_help#/" 3 pick intostr strcat getpropstr dup while
        .tell 1 +
      repeat
      pop pop exit
    then
    "@version" over strcmp not if pop pop
      command @ ": There is no version number!  Hahahahaa!" strcat .tell exit
    then
    pop
    "Format: " command @ " <object> <property-match>" strcat strcat .tell
    "        " command @ " @help    for more." strcat strcat .tell exit
  then
  1 -
  strcut 1 strcut swap pop swap
  dup " " rinstr dup if strcut swap then pop
( "prop" "name" )
  dup "#" 1 strncmp if match else
    1 strcut swap pop atoi dbref
  then
  dup int 0 < if
    pop pop command @ ": A bad DBref occurred." strcat .tell exit
  then
  "me" match over owner over mlevel 3 > swap rot dbcmp or not if
    pop pop command @ ": You don't own that!" strcat .tell exit
  then
  ( Check for @loc @name @num  and other stuff)
  over "@" 1 strncmp not if
    "@name@location@number@dbref@link" 3 pick instr if
      swap pop dup unparseobj "The object " swap strcat " is in " strcat
      over location unparseobj strcat
      swap getlink #-1 over dbcmp if
        pop " and is unlinked."
      else
        " and is linked to " swap unparseobj strcat
      then
      strcat .tell
      exit
    then
    "@desc @succ @osucc@fail @ofail@drop @odrop" 3 pick instr dup if
      1 - 6 / 5 *
      "/_/de/_/sc_/osc/_/fl_/ofl/_/dr_/odr" swap strcut swap pop
      5 strcut pop 2 put
    else
      pop command @ ": unrecognised @-thing. Use /@prop for @props" strcat .tell
    then
  then
( "prop" db )
  over "/" 1 strncmp if "/" rot strcat swap then ( Glue / to start of pattern )
  "" seekprop ( prop db# "" -- )
  " ** Done **" .tell
;
84 lines displayed.
.
c
q
@register #me show.MUF=tmp/prog1
@set $tmp/prog1=L
@set $tmp/prog1=3
@propset $tmp/prog1=int:/.debug/errcount:1
@propset $tmp/prog1=int:/.debug/lastcrash:852087430
@propset $tmp/prog1=str:/.debug/lasterr:show.MUF(#26774), line 64; GETLINK: Illegal object referenced.
@propset $tmp/prog1=str:/_/de:A scroll containing a spell called show.MUF
@propset $tmp/prog1=str:/_help#:16
@propset $tmp/prog1=str:/_help#/1:Help for show-re:    (Mercilessly snaffled from Karrejanshi)
@propset $tmp/prog1=str:/_help#/10:        - Couldn't imagine.
@propset $tmp/prog1=str:/_help#/11: @help  - This help (no object should be specified)
@propset $tmp/prog1=str:/_help#/12: @, @loc, @name, @link, @num
@propset $tmp/prog1=str:/_help#/13:        - These *all* display location, name, number and link of object.
@propset $tmp/prog1=str:/_help#/14:          A link means different things for different types of object.
@propset $tmp/prog1=str:/_help#/15:` 
@propset $tmp/prog1=str:/_help#/16:** done **
@propset $tmp/prog1=str:/_help#/2:----------------
@propset $tmp/prog1=str:/_help#/3:Format: show <object> <property name>        eg  show me _*sce*
@propset $tmp/prog1=str:/_help#/4:Property name may be a regexp as defined in: man smatch
@propset $tmp/prog1=str:/_help#/5: Simply, use *s as wildcards. Set matching [a-z] etc is available too.
@propset $tmp/prog1=str:/_help#/6:`
@propset $tmp/prog1=str:/_help#/7: The following additional commands are available:
@propset $tmp/prog1=str:/_help#/8: @desc  - Show object's description
@propset $tmp/prog1=str:/_help#/9: @succ, @osucc, @fail, @ofail, @drop, @odrop