From: CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 2-AUG-1989 02:20 To: MRGATE::"ARISIA::EVERHART" Subj: CD for VMS DOES check for valid directories, etc. CD.COM, CD.HLP Received: From KL.SRI.COM by GIZMO.SRI.COM with TCP; Tue, 1 AUG 89 22:18:40 PDT Received: from ucbvax.Berkeley.EDU by KL.SRI.COM with TCP; Tue, 1 Aug 89 22:00:51 PDT Received: by ucbvax.Berkeley.EDU (5.61/1.37) id AA26237; Tue, 1 Aug 89 22:01:14 -0700 Received: from USENET by ucbvax.Berkeley.EDU with netnews for info-vax@kl.sri.com (info-vax@kl.sri.com) (contact usenet@ucbvax.Berkeley.EDU if you have questions) Date: 2 Aug 89 04:46:28 GMT From: barbour@boulder.colorado.edu (Jim Barbour) Organization: University of Colorado, Boulder Subject: CD for VMS DOES check for valid directories, etc. CD.COM, CD.HLP Message-Id: <10427@boulder.Colorado.EDU> Sender: info-vax-request@kl.sri.com To: info-vax@kl.sri.com This is a CD for VMS. it recognizes necessary enteties (parrent dirs and so on), checks for the existance for directories and will search up a tree to find a given directory name. Also, it allows the pwd to be incorperated into your VMS system prompt. ENJOY!!! Jim Barbour ------------ Beginning of cd.hlp --------------- 1 CD CD V10.0 Written By James W Barbour (11/29/88) Format: $ CD dir-list $ CD prompt-switch prompt-model $ CD .USERNAME dir-list $ CD @USERNAME dir-list $ CD DEVICE-NAME: dir-list $ CD LOGICAL-NAME/L dir-list $ CD DEVICE-NAME: LOGICAL-NAME/L dir-list 2 prompts Instructs CD to enable/disable the updating of your system prompt with your current device and/or directory. Your VMS system prompt can only be 32 characters long. If a prompt would be too long, CD asks you if you want to delete characters from the left or right of your string. The enable/disable switch and the prompt-model are the only two things you can specify for this call to CD. 3 enable > [prompt-model] Allows CD to reset your system prompt to your new device and/or directory. If prompt-model is specified, it is used as the model for the prompt. if you don't specify a prompt-model, CD uses a default. In the prompt-model string, you can place three sets of special characters. $x will instruct CD to insert your current device. $d will instruct CD to insert your current directory without brackets. $$ will instruct CD to place a $ in the prompt at that point. $ CD > "$x:[$d] " 3 disable < [prompt] Instructs CD not to update your system prompt. if you specify a prompt, CD will set your prompt to that and then leave it alone. If not, CD will reset your prompt to $ CD < "GOLD> " 2 DEVICE-NAME DEVICE-NAME: (Colon (:) required) CD will put you at DEVICE-NAME:[000000]. First checks to see if the device DEVICE-NAME exists and is available. This must be the first argument given to CD. 2 LOGICAL-NAME LOGICAL-NAME/L or LOGICAL-NAME/L/N The /L following the logical name is required. CD first checks to see if the logical name exists and if it points to a valid directory. If so, CD places you there. If you specify /N, only the existence of the logical name is checked. this must either be the first argument to CD or immediately follow DEVICE-NAME. 2 USERNAMES Instruct CD to go to the home directory of USERNAME. This must be the first argument to CD. The .USERNAME options tells CD that you do not have SYSPRV and can not access the SYSUAF file. @USERNAME tells CD that you are privileged and have defined the command SETHOME elsewhere. NOTE: This is an implementation dependent argument. It may not be implemented on your machine. 2 dir-list Zero or more directory names (without brackets) separated by spaces instead of periods. CD will examine these one at a time and attempt to find a match for [.name*]. if it finds one, it puts your there. If it finds MORE than one, you are prompted for a more specific choice. If it can not find any, it will search in parent directories until a match is found, or the top of the directory tree is reached. if the top is reached, the program resets you to where you started and exits. CD by itself is the same as CD . CD will also recognize the following special directory names. .. or ^ mean the parent directory. . means your home directory Note that these special names must be the first name in the list. Also, you can not use logical-names, device-names or usernames with these special names. -------------- END OF CD.HLP ----------- ----------- BEGINNING OF CD.COM --------- $ if p1 .nes. "?" then goto begin_program $ write sys$error "CD now has real help!!! Use HELP CD instead..." $ exit $ begin_program: $ if p1 .eqs. ">" then goto enable_prompt_reset ! Allow reset of prompt. $ if p1 .eqs. "<" then goto disable_prompt_reset $ starting_def = f$environment("default") ! $ starting_dir = f$parse(starting_def,,,"directory") $ is_a_root = 0 $ if f$extract(0,7,starting_dir) .eqs. "[000000" then is_a_root = 1 $ on error then goto starting $ on control_c then goto starting $! $init: $! $! if arg is a dot or if no args then go to home directory. $! $ if p1 .nes. "." .and. p1 .nes. "" then goto to_up $ set def sys$login $ write sys$output " - set to ''f$environment(""default"")'" $ gosub getp1 $ goto parse_for_qual $! $! If ^ or .. then go up one directory. $! $ to_up: $ if p1.nes."^" .and. p1 .nes. ".." then goto check_unix $ working_def = f$environment("default") $ working_dir = f$parse(working_def,,,"directory") $ is_a_root = 0 $ if f$extract(0,7,working_dir) .eqs. "[000000" then is_a_root = 1 $ if is_a_root .eq. 1 then goto at_top $ on error then goto at_top $ set def [-] $ write sys$output " - set to ''f$environment(""default"")'" $ gosub getp1 $ goto to_up $ at_top: ! find out if the device is a rooted logical and if so expand it. $ dir = f$trnlnm("sys$disk","lnm$process_table") - ":" $ if dir .eqs. "" then goto not_up $ dir = f$trnlnm(dir,"lnm$dcl_logical") $ if dir .eqs. "" then goto not_up $ dir = dir - ".]" $ dir = dir + "]" $ set def 'dir' $ goto to_up $ not_up: write sys$error "You're at the top of the tree." $ goto starting $! $! see if p1 is a unix style directory nsme. If it begins with a slash (/) or $! a (./) then assume it is a unix directory. $ check_unix: $! if f$extract(0,1,p1) .nes. "/" .and. f$extract(0,2,p1) .nes. "./" then - $ goto dev_check $ if f$search("sys$system:vforkcomm.gbl") .nes. "" then goto is_unix $ write sys$error "This machine is not running UNIX, ''p1' is invalid." $ goto starting $ is_unix: $! Next make SD be the foreign command for unix's cd $ sd := $ bin:cd.exe sd $! UNIX's cd requires a home logical. (enveronment variable) $ define/user home "''f$logical(""sys$login"")'" $ sd 'p1' $ write sys$error "--- set to ''f$environment("default")'" $ gosub getp1 $ goto parse_for_qual $ dev_check: $ if f$extract(f$length(p1)-1,1,p1) .nes. ":" then goto fast_username $ dir = f$parse("''p1'[000000]") - ".;" $ if dir .eqs. "" then got bad_dev $ set def 'dir' $ write sys$output "-- set to ''f$environment(""default"")'" $ gosub getp1 $ goto parse_for_qual $ bad_dev: $ write sys$output "Bad device specifided. ====> ''p1'" $ goto starting $ fast_username: $ if f$extract(0,1,p1).nes."@" then goto username $ m1 = "Sorry, you are not privileged to use FAST_USERNAME." $ m2 = "Sorry, there is no symbol SETHOME defined." $ mp = 2 $ if f$type(sethome) .nes. "STRING" then goto fast_error $ mp = 1 $ if (f$getjpi("","grp") .gt. 7) .and. .not. (f$privilege("SYSPRV")) then - goto fast_error $ sethome 'f$extract(1,f$length(p1),p1)' $ write sys$output "-- set to ''f$environment(""default"")'" $ gosub getp1 $ goto parse_for_qual $ fast_error: $ write sys$error m'mp' $ write sys$error "Using standard USERNAME search." $ p1[0,1] := "." $ username: $! Find and goto people's home directories. $! cd .username [subdir ...] $ if f$extract(0,1,p1) .nes. "." then goto parse_for_qual $ p1 = p1 - "." ! remove the beginning dot $! find out if we are looking for a logname or not. $ if f$logical(p1) .nes. "" then p1 = f$logical(p1) $! $! THIS IS MACHINE DEPENDENT. You can remove it altogether if you $! don't have a means to do this. $! START PASTE $ resolve/user/nohead/output=sys$login:cdtemp.cdd 'p1' $ open infile sys$login:cdtemp.cdd $ read infile a $ read infile a $ read infile a $ close infile $ delete sys$login:cdtemp.cdd;* $ if a .nes. "No such username..." then goto fine $ write sys$error a $ goto starting $ fine: len = 'f$length(a)' - 47 $ a = f$extract(47,len,a) $! END PASTE $ a = a - "000000." $ set def 'a' $ write sys$output "-- set to ''f$environment(""default"")'" $ gosub getp1 $ goto parse_for_qual $! $! Parse the parameter for qualifiers on the end of it. right now the only $! qualifier in use is /LOGICAL. Added /NOCHECK to set defaults without $! trying to expand or confirm existants of directory specified. $! $! NOTE: This awsome, slick method for doing this only works if the qualifiers $! are STRICTLY unique. $ parse_for_qual: $ if f$locate("/",p1) .eq. f$length(p1) then goto parse_directory $ qual_logical = 0 $ qual_nocheck = 0 $! You must have a variable here for your qualifer. qual_qual-name is format. $ elem = 0 $ next_qual: $ elem = elem + 1 $ qual_recognized = 0 $ qual = f$element(elem,"/",p1) $ if qual .eqs. "/" then goto eval_logical $ qual = "/" + qual $ l = f$length(qual) $ comp = f$extract(0,l,"/LOGICAL") $ if comp .eqs. qual then qual_logical = 1 $ if comp .eqs. qual then qual_recognized = 1 $ comp = f$extract(0,l,"/NOCHECK") $ if comp .eqs. qual then qual_nocheck = 1 $ if comp .eqs. qual then qual_recognized = 1 $! Put other tests here... $ comp = ... $ if comp .eqs. qual then goto label. $ if qual_recognized .eq. 1 then goto next_qual $ write sys$output "ERROR: UNKNOWN QUALIFIER ''qual' IN parametER ''p1'." $ goto starting $! Should never execute this piece of cede. It's here for error checking only $ system_trap: $ write sys$error "PROGRAMMER ERROR, NO CODE ASSOCIATED WITH PARAMETER." $ goto starting $! if a name ends with '/LOG[ICAL]' then assume it is a logical name. $! This is to say that logname/logical is the logical name logname $ eval_logical: $ if qual_logical .ne. 1 then goto set_no_check $ p1 = f$element(0,"/",p1) $ if f$logical(p1) .nes. "" then goto setlog $ write sys$error "Undefined logical name ''p1'. " $ goto starting $ setlog: $ p1 = f$logical(p1) $! Check and make sure that the directory exists $ if (qual_nocheck .eq. 1) then goto sd $ a = f$parse(p1,,,"directory") $ if a .eqs. "" then goto nfound $ sd:set def 'p1' $ write sys$output "-- set to ''f$environment(""default"")'" $ gosub getp1 $ goto parse_for_qual $ nfound: $ write sys$error "''p1' not found" $ badlog: $ write sys$output "bad logical name specified" $ goto starting $ set_no_check: $ if qual_nocheck .ne. 1 then goto system_trap $ p1 = f$element(0,"/",p1) $ root = f$directory() - "]" $ root = root + "." $ root = root - "000000." $! $ set def 'root''p1'] $ write sys$output "-- set to ''f$environment(""default"")'" $ gosub getp1 $ goto parse_for_qual $! END OF QUAL PARSE $ parse_directory: $ root = f$directory() - "]" $ root = root + "." $ root = root - "000000." $! $! count the matches $! $ found="" $ count=0 $ file=p1+"*.dir" $ perfect_match = "" $countdir: $ found=f$search("''file'") $ if "''found'".eqs."" then goto endcount $ count=count+1 $ dir'count'=f$parse("''found'",,,"name") $ if dir'count'.nes.p1 then goto countdir $ perfect_match = p1 $ goto countdir $endcount: $! $! if only 1 match then set default and out of here $! $ if count.ne.1 then goto not1 $ set def 'root''dir1'] $ write sys$output " - set to ''f$environment(""default"")'" $ gosub getp1 $ goto parse_for_qual $! $! if no matches then maybe go up in the tree $! $not1: $ if count.ne.0 then goto not1or0 $! $! is top of directory structure reached? if yes then quit $! $ if root.nes."[" then goto not_top $ write sys$output " - ''root'''p1'*] not found" $ write sys$output " - top of directory tree reached $ goto starting $not_top: $ write sys$output " - ''root'.''p1'*] not found - will search up" $ set def [-] $ goto parse_directory $! $! more than one match - find out which one is desired $! $not1or0: $ index=0 $ write sys$output " - ambiguous parameter -> ''p1' - directories found:" $loop: $ index=index+1 $ if index.gt.count then goto end_loop $ dirname="dir"'index' $ dirname='dirname' $q1: $ dname = "''root'''dirname'] " $ write sys$output " --- " + dname $ if dirname .eqs. perfect_match then perfect_match = dname $ goto loop $end_loop: $ write sys$output " --- Please specify this step unambiguously." $ if perfect_match .nes. "" then - write sys$output " --- Please press to go to ''perfect_match'" $ inquire/nopunct p1 "$_Step: " $ if (p1 .nes. "") then goto parse_directory $ if perfect_match .eqs. "" then goto end_loop $ p1 = perfect_match $ set def 'p1' $ write sys$output " - set to ''f$environment(""default"")'" $! $! after processing p1 check for p2 and bump down if not empty $! $getp1: $ if (p2.eqs."") then goto exit $ p1=p2 $ p2=p3 $ p3=p4 $ p4=p5 $ p5=p6 $ p6=p7 $ p7=p8 $ return $! $! error - set back to starting directory $! $starting: $ set def 'starting_def' $ write sys$output - " - set back to ''starting_def'" $ exit $status $ exit: ! go here if a successful exit will occur. $ if f$type(cd_should_reset_prompt) .eqs. "" then cd_should_reset_prompt == 0 $ if .not. cd_should_reset_prompt then exit $ prompt_model = "''cd_prompt_model'" $ if prompt_model .eqs. "" then prompt_model = "$d> " $ dft = f$environment("default") $ new_prompt = "" $ i = 0 $ l = f$length(prompt_model) $prloop:if prompt_model .eqs. "" then goto do_prompt $ ch = f$element(0,"$",prompt_model) $ if ch .eqs. "" then ch = "$" $ prompt_model = prompt_model - ch $ if ch .eqs. "$" then gosub parse_prompt_char $ new_prompt = new_prompt + ch $ goto prloop $ do_prompt: if f$length(new_prompt) .gt. 32 then gosub prompt_too_long $ set prompt="''new_prompt'" $ exit $ parse_prompt_char: $ if prompt_model .eqs. "" then goto parse_prompt_error $ ch = f$edit(f$extract(0,1,prompt_model),"upcase") $ prompt_model = f$extract(1,l,prompt_model) $ c = "" $ if ch .eqs. "X" then c = f$parse(dft,,,"device") $ if ch .eqs. "D" then c = f$parse(dft,,,"directory") - "[" - "]" $ if ch .eqs. "$" then c = "$" $ if c .eqs. "" then goto parse_prompt_error $ ch = c $ return $ parse_prompt_error: $ if i .eq. l then message = - "$ found with no following character, this is illegal. Prompt not reset." $ if i .lt. l then message = - "''ch' is an unrecognized flag after a $. this is illegal. Prompt not reset." $ write sys$error "" $ write sys$error message $ write sys$error - "Flags: $x = device, $d = directory, $$ = a single $ sign. Any other keys are" $ write sys$error "not allowed and will cause an error." $ write sys$error "" $ write sys$error - "Prompts can not exceed 32 characters, therefore, it is suggested that you" $ write sys$error "useeither $x or $d but not both." $ exit $ prompt_too_long: $ l = f$length(new_prompt) $ write sys$error - "The resulting prompt is too long (more then 32 characters). Prompt =" $ write sys$error "''new_prompt'" $ prompt_re_prompt: $ read/prompt="Should I truncate from the L)eft, R)ight, or E)xit? " - sys$command a $ a = f$edit(a,"upcase") $ if a .eqs. "L" then new_prompt = f$extract((l-32),32,new_prompt) $ if a .eqs. "R" then new_prompt = f$extract(0,32,new_prompt) $ if a .eqs. "E" then exit $ if a .nes. "L" .and. a .nes. "R" then goto prompt_re_prompt $ return $ enable_prompt_reset: $ cd_should_reset_prompt == 1 $ cd_prompt_model == p2 $ goto exit $ disable_prompt_reset: $ cd_should_reset_prompt == 0 $ cd_prompt_model == "" $ if p2.eqs."" then p2="$ " $ set prompt="''p2'" $ exit