@program list-utils.muf 1 9999 d i ( list-utils.muf version 1.0 by Wog This is designed to replace some insecure MPI I found on feathermuck. INSTALL - Create an action named listcopy;listmove;listdelete;listshow;listprint;listview;listlist;listrm;listrename {whew!} and link it to this program. --- Change History ---------------------------------- v 1.0 Sep 24 2000 Initial Release --- Distribution Information ------------------------ Copyright {C} Charles "Wog" Reiss This program 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 of the License, or {at your option} any later version. This program 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. For a copy of the GPL: a> see: http://www.gnu.org/copyleft/gpl.html b> write to: the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA ) lvar count : is-list? ( d1 s1 -- i ) "#" strcat getpropstr number? ; : list-count ( d1 s1 -- i ) "#" strcat getpropstr atoi ; : list-delete ( d1 s1 -- i ; return 0 when the list is missing ) "#" strcat remove_prop 1 ; : list-copy ( d1 s1 d2 s2 -- ; copy from d1-s1 to d2-s2 ) over over list-delete pop 4 pick 4 pick list-count ( d1 s1 d2 s2 i ) 3 pick 3 pick "#" strcat 3 pick intostr setprop -5 rotate 3 rotate "#/" strcat -3 rotate "#/" strcat 1 begin ( imax d1 s1 d2 s2 i ) 6 pick over = not while 5 pick 5 pick 3 pick intostr strcat getpropstr ( d1 s1 d2 s2 i s ) 4 pick 4 pick ( d1 s1 d2 s2 i s d2 s2 ) 4 pick intostr strcat rot setprop 1 + repeat pop pop pop pop pop pop ; : list-move ( d1 s1 d2 s2 -- ; move from d1-s1 to d2-s2 ) 4 pick 4 pick -6 rotate -6 rotate list-copy list-delete ; : list-show ( d1 s1 -- ; view the list like .l in lsedit ) over over list-count rot rot "#/" strcat rot 1 begin ( d1 s1 i_max_ i ) 4 pick 4 pick 3 pick intostr strcat getpropstr .tell over over = not while 1 + repeat pop pop pop pop ; : rightfit ( s i -- s' ) over strlen - " " swap strcut pop swap strcat ; : list-print ( d1 s1 -- ; view the list like .p in lsedit ) over over list-count rot rot "#/" strcat rot 1 begin ( d1 s1 i_max_ i ) 4 pick 4 pick 3 pick intostr strcat getpropstr over intostr 3 rightfit ": " strcat swap strcat .tell over over = not while 1 + repeat pop pop pop pop ; : check-list-name-perms ( s -- i ; 1 on error. ) "/" swap strcat dup "/@" instr if me @ $ifdef __glowver mlevel "hidden_prop_mlevel" sysparm atoi >= $else "W" flag? $endif not if pop 1 exit then then (.) "/~" instr if me @ $ifdef __glowver mlevel "seeonly_prop_mlevel" sysparm atoi >= $else "W" flag? $endif not if 1 exit then then 0 ; : check-obj-perms ( d -- i ; return 1 on error ) me @ swap controls not if 1 else 0 then ; : check-list-perms ( d s -- i ; return 1 on error ) check-list-name-perms if 1 exit then check-obj-perms if 1 exit then 0 ; : paranoid-list-view-check ( d1 s1 -- i ) over over getpropstr number? if ( d1 s1 ) "/" strcat over swap nextprop begin dup while dup dup "/" rinstr strcut swap pop number? not if ( d s ) pop pop 0 exit then over swap nextprop repeat pop pop 1 else 0 then ; : lists-view-loop ( d1 s1 -- ; list all lists in that propdir, recursive ) over swap nextprop begin dup while dup check-list-name-perms not if dup dup strlen 1 - strcut swap pop "#" strcmp not if over over paranoid-list-view-check if dup dup strlen 1 - strcut pop .tell count @ 1 + count ! then else over over propdir? if over over "/" strcat lists-view-loop then then then over swap nextprop repeat pop pop ; : lists-view ( d1 -- ; view all lists on object. ) 0 count ! "/" lists-view-loop count @ intostr count @ 1 = if " list found." else " lists found." then strcat .tell ; : two-usage ( -- ) "Usage: " command @ strcat " object1=listname1,object2=listname2" strcat .tell " Note that object2 can be omitted, in which case object1 will be assumed." .tell exit ; : two-list-run ( s a -- i ; returns 1 on error ) swap dup "*=*,*=*" smatch not if pop pop two-usage 1 exit then "," .split swap "=" .split swap match dup #-1 dbcmp if "I don't know what you mean!" .tell pop pop pop 1 exit then dup #-2 dbcmp if "I don't know which one you're talking about!" .tell pop pop pop 1 exit then ( s listname d ) swap over over check-list-perms if "Permission denied." .tell pop pop pop pop 1 exit then over over is-list? not if "There's no such list!" .tell pop pop pop pop 1 exit then rot "=" .split swap dup not if pop ( dbref list list2 ) 3 pick else match dup #-1 dbcmp if "I don't know what you mean!" .tell pop pop pop pop 1 exit then dup #-2 dbcmp if "I don't know which one you're talking about!" .tell pop pop pop pop 1 exit then then swap (addy dbref list dbref2 list2 ) dup not if pop over then 3 pick strcmp not ( a d s d2 s2 i ) 5 pick 4 pick dbcmp and if "Useless copy or move." .tell pop pop pop pop exit then over over check-list-perms if "Permission denied." .tell pop pop pop pop exit then 5 rotate execute 0 ; : one-list-usage ( -- ) "Usage: " command @ strcat " object=listname" strcat .tell ; : one-list-run ( "obj=list" a -- i ) swap dup "=" instr not if one-list-usage pop pop 1 exit then "=" .split swap match dup #-1 dbcmp if "I don't know what you mean!" .tell pop pop pop 1 exit then dup #-2 dbcmp if "I don't know which one you mean!" .tell pop pop pop 1 exit then swap over over check-list-perms if "Permission denied." .tell pop pop pop 1 exit then over over is-list? not if "There's not list by that name!" .tell pop pop pop 1 exit then rot execute 0 ; : one-object-run ( "obj" a -- i ) swap match dup #-1 dbcmp if "I don't know what you mean!" .tell pop pop 1 exit then dup #-2 dbcmp if "I don't know which one you mean!" .tell pop pop 1 exit then dup check-obj-perms if "Permission denied." .tell pop pop 1 exit then swap execute 0 ; : do-help pop "List-Utils -- by Wog" "----------------------------------" "[Based on MPI by Crystal]" "Commands:" "Taking two lists:" " listcopy, listmove, listrename" " -- object=listname,object2=listname2" " or object=listname,=listname2" " or object=listname,object2=" " These copy or move from the listname list on object, to the" " listname2 list on object2. If object2 is omitted it is assumed" " to be the same as object1. If listname2 is omitted it is" " assumed to be the same as listname1." " " "Taking one list:" " listshow, listlist, or listprint" " -- object=listname" " These show you the listname list on object. Listprint will" " prefix the line number before the listname." " listdelete, or listrm" " -- object=listname" " This will delete the listname list on object." " " "Taking an object:" " listview" " -- object" " This will list all lists on object." " " "Options:" " #help" " Will display this screen." begin depth dup while rotate .tell repeat pop ; : main dup not over "#h" 2 strncmp not or if do-help exit then command @ tolower dup "list" instr dup if 1 - strcut 4 strcut swap pop strcat else pop then dup "c" instr if pop 'list-copy two-list-run if exit then "Copied." .tell exit then dup "m" instr over "re" instr or if pop 'list-move two-list-run if exit then "Moved." .tell exit then dup "d" instr over "rm" instr or if pop 'list-delete one-list-run if exit then "Deleted." .tell exit then dup "v" instr if pop 'lists-view one-object-run pop exit then dup "s" instr over "l" instr or if pop 'list-show one-list-run pop exit then dup "p" instr if pop 'list-print one-list-run pop exit then "[list-utils] Could not match command." .tell ; . c q @set list-utils.muf=VIEWABLE @set list-utils.muf=W