english version "1.0" identify "xyz" #: Copyright (c) 1995, 1996, 2002 by Wayne C. Gramlich. #, All rights reserved. #, #, Permission to use, copy, modify, distribute, and sell this software #, for any purpose is hereby granted without fee provided that the above #, copyright notice and this permission are retained. The author makes #, no representations about the suitability of this software for any purpose. #, It is provided "as is" without express or implied warranty. module project #: This module implements four project abstractions for SVMS. #, #, {project_name} #, A {project_name} is a project name consisting of nickname #, and timestamp (for good measure.) #, {project} #, A {project} represents a project. All {project} objects have #, a corresponding {project_name}, but the reverse is not true. #, Each {project} has a corresponding root {project_directory} #, object. There is a 1-to-1 correspondence between a {project} #, and the SVMS/p.project file. #, {project_directory} #, A {project_directory} is one directory of a project. #, A {project_directory} object names both the actual project #, directory that the user sees and the shadow project d. #, directory under the SVMS shadow directory tree. A #, {project_directory} can have zero, one, or more #, sub-{project_directory}'s. In addition, there is a #, 1-to-1 correspondance between {project_directory} objects #, and p.listing files. #, {project_file} #, A {project_file} is the name of a history file within a project #, directory. A {project_file} names both the actual file that #, the user sees and the corresponding h. history file under the #, SVMS shadow directory tree. #, #, Thus, a {project} contains a tree of {project_directory}'s, where #, each {project_directory} contains zero, one, or more {project_file}'s. #, #, The code in this module automatically migrates information between #, the p.listing files on disk and the in memory representation. Other #, than calling {flush}@{project}() at the end, no other effort is #, required to keep the various p.listing files up-to-date. #, #, What happens if a crash occurs between updating the p.listing files? #, First, no individual p.listing file will be corrupted because we #, always write the new p.listing file to a temporary file and rename #, it afterwards. Second, the {has_open_sub_directory} flag is only #, cleared for a directory when all of the child files and directories #, are closed. If a crash occurs before all of the p.listing files are #, updated to be closed, the remaining updates will be detected and #, deferred the next time an SVMS command is executed. import address character data_io directory errors file_name file_system format history in_stream integer logical out_stream resources set status string svms system timer table unsigned vector define project #: Information about a project record current_directory_name file_name #: Current directory (from /) directory_table table[file_name, project_directory] #: dir. table file_table table[file_name, project_file] #: file table global global #: Global information host_url string #: Host URL (or "") lazy logical #: {true}=>Fetch from parent lazily lazy_timestamp unsigned #: Time of lazy bringover parent_project_directory file_name #: Parent project or ?? if no parent project_directory_name file_name #: Project directory (from /) project_name project_name #: Project name for this {project} proxy_url string #: URL for proxy (or "") resources resources #: Associated {resources} root_project_directory project_directory #: Root {project_directory} generate address_get, allocate, erase, identical define project_directory #: A project directory record actual_directory_name file_name #: Full dir. name starting from "/" hash unsigned #: Hash of all {project}'s and dirs listing_file_name file_name #: Assoc. p.listing file name modified logical #: {true}=>assoc. p.listing out-of-date open_directories unsigned #: Number of open {project_directory)'s open_files unsigned #: Number of open {project_file}'s parent project_directory #: Parent proj. dir. (or ?? for root) project project #: Overall {project}. project_directorys project_directorys #: All sub-dirs project_file project_file #: Corresponding {project_file} project_files project_files #: {project_file}'s in dir. relative_directory_name file_name #: Proj. rel. dir. name ("." for ":") restored logical #: {true}=>assoc. p.listing file read resources resources #: Associated {resources} shadow_directory_name file_name #: Full shadow dir. name from "/" generate address_get, allocate, erase, identical define project_directorys #: A list of {project_directory}'s record list vector[project_directory] #: The list of {project_directory}'s resources resources #: {resources} allocated from generate address_get, allocate, erase, identical, print define project_file #: A project file record actual_file_name file_name #: Actual file name starting from "/" bringover_file_name file_name #: Bringover file name bringover_hash unsigned #: Bringover file hash value (or 0) conflict_file_name file_name #: Conflict file name conflict_hash unsigned #: Conflict file hash value (or 0) history_file_name file_name #: History file name history_hash unsigned #: History file hash value (or 0) lock_file_name file_name #: Lock file name lock_hash unsigned #: Lock file hash value (or 0) modified logical #: {true}=>file contents/state changed parent project_directory #: Project dir. containing file project project #: {project} containing file project_directory project_directory #: Assoc. {project_directory} or ?? relative_file_name file_name #: Project relative file name resources resources #: Associated {resources} timestamp unsigned #: Timestamp for file generate address_get, allocate, erase, identical define project_files #: A list of {project_file}'s record list vector[project_file] #: The list of {project_file}'s project_directory project_directory #: Containing {project_directory} resources resources #: {resources} allocated from generate address_get, allocate, erase, identical, print define project_name #: A project name record nickname string #: Project nickname resources resources #: Associcated {resources} timestamp unsigned #: Project timestamp generate address_get, allocate, erase, identical, print #: {project} procedures: procedure xallocate@project takes resources resources returns project #: This procedure will allocate a new {project} object from {resoruces} #, and return it. assert resources !== ?? project :@= project_allocate@(resources) erase@(project) project.resources := resources return project procedure compare@project takes project1 project project2 project returns integer #: This procedure will return -1, 0, or 1 depending upon whether #, {project1} is less that, equal to, or greater than {project2}. assert project1 !== ?? assert project2 !== ?? result :@= compare@(project1.project_name, project2.project_name) return result procedure create@project takes project_name project_name project_directory_name file_name current_directory_name file_name refresh logical global global returns project #: This procedure will create and return a new {project} object #, refering to {project_directory_name}, {current_directory_name}, #, {project_name}, and {global}. If {refresh} is {true}, no #, p.listing file will be read. resources :@= global.resources #debug_stream :@= global.debug_stream #format@format4[string, unsigned, file_name, file_name](debug_stream, # 'create@project(%ds%:%d%, %ds%, %ds%)\n\', # project_name.nickname, project_name.timestamp, # project_directory_name, current_directory_name) project :@= xallocate@project(resources) directory_table :@= project.directory_table if directory_table == ?? directory_table := xcreate@table[file_name, project_directory](10) file_table :@= project.file_table if file_table == ?? file_table := xcreate@table[file_name, project_file](10) project.current_directory_name := current_directory_name project.directory_table := directory_table project.file_table := file_table project.global := global project.host_url := allocate@string() project.lazy := false project.lazy_timestamp := 1 # {timestamp_write}() does not like 0! project.parent_project_directory := ?? project.project_directory_name := project_directory_name project.project_name := project_name project.proxy_url := allocate@string() project.resources := resources # Note: {project}.{table} must exist before calling {root_create} project.root_project_directory := root_create@project_directory(project, refresh) assert project.file_table !== ?? assert project.directory_table !== ?? return project procedure deallocate@project takes project project returns_nothing #: This procedure will deallocate {project] and make it available #, for {subsequent} reallocation. assert project !== ?? resources :@= project.resources #debug_stream :@= resources.global.debug_stream #format@format1[address](debug_stream, # "deallocate@project(%X%)\n\", project.address) root_project_directory :@= project.root_project_directory if root_project_directory !== ?? deallocate@(root_project_directory) file_table :@= project.file_table assert file_table.size = 0 directory_table :@= project.directory_table assert directory_table.size = 0 assert resources !== ?? deallocate@(project.project_name) erase@(project) project.resources := resources project.file_table := file_table project.directory_table := directory_table project_deallocate@(resources, project) procedure fetch1@project takes project project file_name file_name returns project_file #: This procedure will fetch and return the {project_file} associated #, it {file_name} in {project}. If {project_file} association does #, not exist, ??@{project_file} is returned. assert project !== ?? assert file_name !== ?? file_table :@= project.file_table project_file :@= file_table[file_name] return project_file procedure find@project takes refresh logical global global returns project #: This procedure will find the SVMS directory and load the #, project information and return it. ??@{project} is returned #, if no project is found, an error message is output to {errors}; #, otherwise the the appropriate {project} is returned. If {refresh} #, is {true}, no p.listing files will be read. errors :@= global.errors relative :@= global.file_system.relative current_directory_name :@= canonicalize@(relative) #debug_stream :@= global.debug_stream #format@format1[file_name](debug_stream, # 'find@project: cwd: %ds%\n\', current_directory_name) project :@= lookup@project(current_directory_name, refresh, global) return project procedure lookup@project takes directory_name file_name refresh logical global global returns project #: This procedure will find and return the {project} associated #, with {directory_name}. If no project is found, an error #, message is output to ??@{errors} and ??@{project} is returned. #, If {refresh} is {true}, no p.listing files are read. errors :@= global.errors # Find the first (and hopefully only) SVMS directory: svms_directory_name :@= svms_directory_find@project(directory_name) if svms_directory_name == ?? format@errors1[file_name](errors, '%ds% has no associated project directory!\n\', directory_name) return ?? # Look for a second (hopefully non-existant) `enclosing' SVMS directory. # There is a small chance that the current SVMS directory is at root #, (i.e. "/SMVS"), hence we are a little parinoid: assert has_parent@(svms_directory_name) project_directory_name :@= svms_directory_name.parent if has_parent@(project_directory_name) nested_svms_directory_name :@= svms_directory_find@project(project_directory_name.parent) if nested_svms_directory_name !== ?? format@errors2[file_name, file_name](errors, 'There are two nested project directories at %ds% and %ds%!\n\', svms_directory_name, nested_svms_directory_name) return ?? # Create and return the {project} object: resources :@= global.resources project_name :@= xallocate@project_name(resources) project :@= create@project(project_name, project_directory_name, directory_name, refresh, global) if !refresh restore@project(project) return project procedure flush@project takes project project returns_nothing #: This procedure will cause all backing files for {project} to be #, prepared for a commit (if there are no pending errors). If there #, pending errors, nothing occurs. if !(project.global.errors.exist) save@(project) procedure show@project takes project project out_stream out_stream returns_nothing #: This procedure will dump the {project_directory} tree associated #, with {project} to {out_stream}. show@(project.root_project_directory, out_stream, 0) procedure store1@project takes project project file_name file_name project_file project_file returns_nothing #: This procedure will associate {file_name} with {project_file} #, in {project}. assert project !== ?? assert file_name !== ?? assert project_file !== ?? file_table :@= project.file_table file_table[file_name] := project_file procedure print@project takes project project out_stream out_stream returns_nothing #: This procedure will output {project} to {out_stream}. format@format4[file_name, file_name, string, unsigned](out_stream, '{cwd:%ds% dir:%ds% nick:%ds% time:%d%}', project.current_directory_name, project.project_directory_name, project.project_name.nickname, project.project_name.timestamp) procedure refresh@project takes project project delete logical no_action logical verbose logical timer timer returns_nothing #: This procedure will refresh all of the p.listing files in {project}. #, If {delete} is {true}, any extraneous files that are encountered #, in the shadow directories are deleted. If {no_action} is {true}, #, no actual refreshing occurs; just reporting occurs. If {verbose} #, is {true}, additional messages are output. refresh@(project.root_project_directory, delete, no_action, verbose, timer) procedure restore@project takes project project returns_nothing #: This procedure will read in a project from {file_name} and return it. resources :@= project.resources global :@= resources.global errors :@= global.errors root_project_directory :@= project.root_project_directory #debug_stream :@= global.debug_stream #format@format1[file_name](debug_stream, # 'restore@project(%ds%)\n\', # root_project_directory.actual_directory_name) file_name :@= name_append@(root_project_directory.shadow_directory_name, "p.project") data_in_stream :@= xallocate@data_in_stream(resources) if open@data_in_stream(data_in_stream, file_name, project, errors) #FIXME: do_nothing file_name := file_name else # Read in the header: header_read@(data_in_stream, "H"[0], "SVMS Project", 1, 3) # Read in project name: tag_check@(data_in_stream, "N"[0]) project_name :@= project.project_name nickname :@= project_name.nickname assert nickname.is_buffered trim@(nickname, 0) string_read@(data_in_stream, nickname) project_name.timestamp := timestamp_read@(data_in_stream) new_line_read@(data_in_stream) # Write out parent information: tag_check@(data_in_stream, "P"[0]) project.lazy := logical_read@(data_in_stream) project.parent_project_directory := file_name_read@(data_in_stream) string_read@(data_in_stream, project.host_url) string_read@(data_in_stream, project.proxy_url) project.lazy_timestamp := timestamp_read@(data_in_stream) new_line_read@(data_in_stream) close@(data_in_stream) deallocate@(data_in_stream) procedure save@project takes project project returns_nothing #: This procedure will cause {project} to save itself to disk. #, {true} is returned if any errors occur; otherwise {false} is returned. assert project !== ?? resources :@= project.resources global :@= project.global errors :@= global.errors #debug_stream :@= global.error_stream #format@format1[address](debug_stream, # "save@project(%X%)\n\", project.address) root_project_directory :@= project.root_project_directory file_name :@= name_append@(root_project_directory.shadow_directory_name, "p.project") data_out_stream :@= open@data_out_stream(file_name, resources, errors) if data_out_stream !== ?? #format@format1[file_name](debug_stream, # "save@project() writing to %ds%\n\", file_name) # Write out header: header_write@(data_out_stream, "H"[0], "SVMS Project", 1, 3) # Write out {project_name}: tag_write@(data_out_stream, "N"[0]) write@(project.project_name, data_out_stream) new_line_write@(data_out_stream) # Write out parent information: tag_write@(data_out_stream, "P"[0]) logical_write@(data_out_stream, project.lazy) file_name_write@(data_out_stream, project.parent_project_directory) string_write@(data_out_stream, project.host_url) string_write@(data_out_stream, project.proxy_url) timestamp_write@(data_out_stream, project.lazy_timestamp) new_line_write@(data_out_stream) close@(data_out_stream, global.data_out_delays) deallocate@(data_out_stream) save@(project.root_project_directory) procedure svms_directory_find@project takes directory_name file_name returns file_name #: This procedure will search for a directory containing an SVMS #, directory starting from {directory_name} and working towards root. #, The SVMS directory name is returned. If no such directory #, containing an SVMS sub-directory is found, ??@{file_name} is #, returned. #debug_stream :@= errors.error_stream #original_directory_name :@= directory_name # Canonicalize the starting directory name: if !(is_absolute@(directory_name)) directory_name :@= canonicalize@(directory_name) # Start searching: loop svms_directory_name :@= name_append@(directory_name, 'SVMS') if is_directory@(svms_directory_name) #format@format2[file_name, file_name](debug_stream, #, 'svms_directory_find(%ds%) => %ds%\n\', #, original_directory_name, directory_name) return svms_directory_name while has_parent@(directory_name) directory_name := directory_name.parent #format@format1[file_name](debug_stream, #, 'svms_directory_find(%ds%)=>??\n\', original_directory_name) return ?? #: {project_directory} procedures: procedure create@project_directory takes project project parent project_directory base_name string refresh logical returns project_directory #: This procedure will create and return an initialized {project_directory} #, object. If {parent} is ?? and {base_name} is empty, a root #, {project_directory} object for {project} is returned; otherwise, #, the {base_name} sub-directory of {parent} is created and returned. #, If {refresh} is {true}, restorationg of directory state from p.listing #, files is supressed. assert project !== ?? resources :@= project.resources assert resources !== ?? #debug_stream :@= resources.global.debug_stream #format@format3[address, address, string](debug_stream, # "create@project_directory(%X%, %X%, %ds%)\n\", # project.address, parent.address, base_name) create_root :@= parent == ?? && base_name = "" actual_directory_name:: file_name := ?? relative_directory_name:: file_name := ?? shadow_directory_name:: file_name := ?? project_file:: project_file := ?? if create_root root_directory_name :@= project.project_directory_name actual_directory_name := root_directory_name shadow_directory_name := name_append@(root_directory_name, "SVMS") relative_directory_name := root_directory_name.file_system.relative else assert base_name != "" actual_directory_name := name_append@(parent.actual_directory_name, base_name) assert base_name = actual_directory_name.name base_name := actual_directory_name.name shadow_base_name :@= string_allocate@(resources) assert shadow_base_name.size = 0 string_append@(shadow_base_name, "d.") string_append@(shadow_base_name, base_name) shadow_directory_name := name_append@(parent.shadow_directory_name, shadow_base_name) string_deallocate@(resources, shadow_base_name) relative_directory_name := name_append@(parent.relative_directory_name, base_name) project_file := create@project_file(parent, base_name) directory_table :@= project.directory_table project_directory :@= directory_table[relative_directory_name] if project_directory == ?? project_directory :@= project_directory_allocate@(resources) project_directory.actual_directory_name := actual_directory_name project_directory.hash := 0 project_directory.listing_file_name := name_append@(shadow_directory_name, "p.listing") project_directory.open_directories := 0 project_directory.open_files := 0 project_directory.parent := parent project_directory.project := project project_directory.project_directorys := xallocate@project_directorys(resources) project_directory.project_file := project_file project_directory.relative_directory_name := relative_directory_name project_directory.restored := false project_directory.resources := resources project_directory.shadow_directory_name := shadow_directory_name project_directory.modified := true # {project_directory}.{resources} must be set before calling #, {create}@{project_files}(). project_directory.project_files := create@project_files(project_directory) directory_table[relative_directory_name] := project_directory if !create_root append@(parent.project_directorys, project_directory) if !refresh restore@(project_directory) #format@format2[string, address](debug_stream, # "create@project_directory(%ds%)=>%X%\n\", # base_name, project_directory.address) return project_directory procedure deallocate@project_directory takes project_directory project_directory returns_nothing #: This procedure will deallocate {project_directory} for subsequent #, reallocation. Any nested {project_directory}'s and {project_file}'s #, are deallocated as well. resources :@= project_directory.resources #debug_stream :@= resources.global.debug_stream #format@format1[address](debug_stream, # "deallocate@project_directory(%X%)\n\", project_directory.address) deallocate@(project_directory.project_files) deallocate@(project_directory.project_directorys) project :@= project_directory.project directory_table :@= project.directory_table delete@(directory_table, project_directory.relative_directory_name) erase@(project_directory) project_directory.resources := resources project_directory_deallocate@(resources, project_directory) procedure directory_create@project_directory takes project_directory project_directory create logical duplicates_ok logical returns logical #: This procedure will create a directory for {project_directory}. #, If {create} is {true}, the corresponding actual directory is #, is created as well. If {duplicates_ok} is {true}, no error #, message is generated if the directory already exists. Any #, errors are recorded into {errors}. {true} is returned if #, any errors have occured. project :@= project_directory.project assert project !== ?? actual_directory_name :@= project_directory.actual_directory_name global :@= project.global errors :@= global.errors #debug_stream :@= project.global.debug_stream, # If requested, create the user directory: actual_status :@= actual_directory_name.status actual_mode :@= actual_status.mode if create if actual_mode = deleted # Create the directory: if directory_create@(actual_directory_name, errors) || access_mode_change@(actual_directory_name, 0775, errors) return true status_update@(actual_directory_name) actual_mode := actual_status.mode else_if actual_mode = directory && !duplicates_ok # File already exists: format@errors1[file_name](errors, 'The directory %ds% already exists!\n\', actual_directory_name) return true if actual_mode != directory # It already exists and is not a directory: format@errors1[file_name](errors, '%ds% should be a directory and it is not!\n\', actual_directory_name) return true # Now create the d. file: shadow_directory_name :@= project_directory.shadow_directory_name #format@format1[file_name](debug_stream, # 'shadow_directory_name: %ds%!\n\', shadow_directory_name) status_update@(shadow_directory_name) shadow_status :@= shadow_directory_name.status shadow_mode :@= shadow_status.mode if shadow_mode = deleted if directory_create@(shadow_directory_name, errors) || access_mode_change@(shadow_directory_name, 0775, errors) return true status_update@(shadow_directory_name) shadow_mode := shadow_status.mode else_if shadow_mode = directory && !duplicates_ok format@errors1[file_name](errors, 'Directory %ds% already exists!\n\', shadow_directory_name) return true if shadow_mode != directory format@errors1[file_name](errors, '%ds% is not a directory and it should be!\n\', shadow_directory_name) return true parent_project_directory :@= project_directory.parent base_name :@= actual_directory_name.name project_file :@= create@project_file(parent_project_directory, base_name) project_file.timestamp := actual_status.modification_time # Create an directory version for {directory_file_name}: base_name :@= actual_directory_name.name project_file.project_directory := create@project_directory(project, parent_project_directory, base_name, false) error :@= errors.exist return error procedure expand@project_directory takes project_directory project_directory slice_project_files project_files open_only logical returns_nothing #: This procedure will add all of the {project_files} contained #, in {project_directory} and its sub-directorys to the end of #, {slice_project_files}. If {open_only} is {true}, only the open #, project files will be appended; otherwise all are appended. assert project_directory !== ?? assert slice_project_files !== ?? resources :@= project_directory.resources #debug_stream :@= resources.global.debug_stream #format@format3[file_name, address, address](debug_stream, # "expand@project_directory(%ds%=%X%, %X%)\n\", # project_directory.relative_directory_name, # project_directory.address, slice_project_files.address) # First append the {project_files}: project_files :@= project_directory.project_files size :@= project_files.size #format@format1[unsigned](debug_stream, "project files size: %d%\n\", size) #format@format1[unsigned](debug_stream, # "slice_project_files: %d%\n\", slice_project_files.size) index :@= 0 loop while index < size project_file :@= project_files[index] if !(open_only) || open_only && (project_file.lock_hash != 0) append@(slice_project_files, project_file) index :+= 1 # Now visit the sub-directorys: project_directorys :@= project_directory.project_directorys size := project_directorys.size #format@format1[unsigned](debug_stream, "sub-dirs size: %d%\n\", size) #format@format1[unsigned](debug_stream, # "slice_project_files: %d%\n\", slice_project_files.size) index :@= 0 loop while index < size expand@(project_directorys[index], slice_project_files, open_only) index :+= 1 procedure parse@project_directory takes directory_name file_name project project returns project_directory #: This procedure will parse {directory_name} into {project_directory} #, in {project} and return it. ?? is returned if any errors #, occur during parsing. assert directory_name !== ?? assert project !== ?? #debug_stream :@= project.resources.global.debug_stream #format@format2[file_name, address](debug_stream, # "parse@project_directory(%ds%, %X%)\n\", # directory_name, project.address) project_directory:: project_directory := ?? root :@= directory_name[0] switch root.type case cwd # "name/...": if directory_name.depth >= 1 && directory_name[1].name = ":" # {directory_name} is project relative. directory_name :@= normalize@(tail@(directory_name, directory_name[1])) project_directory := relative_parse@project_directory(directory_name, project) else # {directory_name} is relative to current working directory: directory_name := join@(project.current_directory_name, directory_name) directory_name := normalize@(directory_name) directory_name := tail@(directory_name, project.project_directory_name) project_directory := relative_parse@project_directory(directory_name, project) case login # "/...": assert false case next # Should be impossible assert false case root # "/...": directory_name :@= canonicalize@(directory_name) directory_name :@= normalize@(tail@(directory_name, project.project_directory_name)) project_directory :@= relative_parse@project_directory(directory_name, project) case user # "~user_name/...": assert false assert project_directory !== ?? assert project_directory.project !== ?? return project_directory procedure refresh@project_directory takes project_directory project_directory delete logical no_action logical verbose logical timer timer returns unsigned #: This procedure will update the p.listing file for {directory_name}. # Get at some global values: project :@= project_directory.project global :@= project.global resources :@= global.resources debug_stream :@= global.debug_stream errors :@= global.errors error_stream :@= global.error_stream shadow_directory_name :@= project_directory.shadow_directory_name directory_name :@= project_directory.actual_directory_name if verbose format@format1[file_name](debug_stream, "%ds%: Visiting directory\n\", shadow_directory_name) # Phase 1: Scan the directory and partition files based on first character: base_strings :@= strings_allocate@(resources) bringover_strings :@= strings_allocate@(resources) conflict_strings :@= strings_allocate@(resources) directory_strings :@= strings_allocate@(resources) extraneous_strings :@= strings_allocate@(resources) history_strings :@= strings_allocate@(resources) lock_strings :@= strings_allocate@(resources) project_strings :@= strings_allocate@(resources) temporary_strings :@= strings_allocate@(resources) dot :@= "."[0] little_b :@= "b"[0] little_c :@= "c"[0] little_d :@= "d"[0] little_h :@= "h"[0] little_l :@= "l"[0] little_p :@= "p"[0] little_t :@= "t"[0] zero :@= integer_convert@(0) one :@= integer_convert@(1) minus_one :@= zero - one directory :@= directory_open@(shadow_directory_name) if directory == ?? format@errors1[file_name](errors, "%ds%: Unable to open directory!\n\", shadow_directory_name) return 0 base_name:: string := ?? loop file_string :@= string_allocate@(resources) if !file_name_string_next@(directory, file_string) string_deallocate@(resources, file_string) break #format@format2[address, string](debug_stream, # "%X%: %ds%\n\", file_string.address, file_string) length :@= file_string.size if length >= 2 && file_string[1] = dot character :@= file_string[0] base_string :@= string_allocate@(resources) sub_string_append@(base_string, file_string, 2, length - 2) if character = little_b append@(bringover_strings, file_string) else_if character = little_c append@(conflict_strings, file_string) else_if character = little_d append@(directory_strings, file_string) else_if character = little_h append@(history_strings, file_string) else_if character = little_l append@(lock_strings, file_string) else_if character = little_p append@(project_strings, file_string) string_deallocate@(resources, base_string) base_string := ?? else_if character = little_t append@(project_strings, file_string) string_deallocate@(resources, base_string) base_string := ?? else append@(extraneous_strings, file_string) string_deallocate@(resources, base_string) base_string := ?? if base_string !== ?? append@(base_strings, base_string) else append@(extraneous_strings, file_string) close@(directory) # Phase 2: Delete extraneous files: # Only allow valid 'p.' files. Throw extras onto extraneous list: size :@= project_strings.size index :@= 0 loop while index < size project_string :@= project_strings[index] if project_string = "p.listing" || project_string = "p.project" string_deallocate@(resources, project_string) else append@(extraneous_strings, project_string) index :+= 1 truncate@(project_strings, 0) strings_deallocate@(resources, project_strings) # Delete/list extraneous files: sort@(extraneous_strings) size := extraneous_strings.size index := 0 loop while index < size extraneous_string :@= extraneous_strings[index] extraneous_name :@= name_append@(shadow_directory_name, extraneous_string) if delete && !no_action if file_delete@(extraneous_name) format@errors1[file_name](errors, '%ds%: Unable to delete extraneous file!\n\', extraneous_name) else format@format1[file_name](error_stream, '%ds%: Deleted extraneous file!\n\', extraneous_name) else format@errors1[file_name](errors, '%ds%: Extraneous file found!\n\', extraneous_name) index :+= 1 strings_deallocate@(resources, extraneous_strings) # Delete/list temporary files: sort@(temporary_strings) size :@= temporary_strings.size index := 0 loop while index < size temporary_string :@= temporary_strings[index] temporary_name :@= name_append@(shadow_directory_name, temporary_string) if delete && !no_action if file_delete@(temporary_name) format@errors1[file_name](errors, '%ds%: Unable to delete extraneous temporary file!\n\', temporary_name) else format@format1[file_name](error_stream, '%ds%: Deleted extraneous temporary file!\n\', temporary_name) else format@errors1[file_name](errors, '%ds%: Extraneous temporary file found!\n\', temporary_name) index :+= 1 strings_deallocate@(resources, temporary_strings) # Phase 3: Visit all of the files in alphabetcial order: # Throw out duplicate base names: sort@(base_strings) from_index :@= 0 to_index :@= 0 base_string :@= "" base_size :@= base_strings.size loop while from_index < base_size previous_base_string :@= base_string base_string := base_strings[from_index] if base_string = previous_base_string string_deallocate@(resources, base_string) else base_strings[to_index] := base_string to_index :+= 1 from_index :+= 1 base_size :@= to_index truncate@(base_strings, base_size) # Open the p.listing file: listing_file_name :@= name_append@(shadow_directory_name, "p.listing") listing_out_stream :@= open@data_out_stream(listing_file_name, resources, errors) if listing_out_stream == ?? strings_deallocate@(resources, base_strings) strings_deallocate@(resources, bringover_strings) strings_deallocate@(resources, conflict_strings) strings_deallocate@(resources, directory_strings) strings_deallocate@(resources, history_strings) strings_deallocate@(resources, lock_strings) return 0 # Write out p.listing header and size records: header_write@(listing_out_stream, "H"[0], "SVMS Listing", 1, 2) tag_write@(listing_out_stream, "C"[0]) unsigned_write@(listing_out_stream, base_size) new_line_write@(listing_out_stream) sort@(bringover_strings) sort@(conflict_strings) sort@(directory_strings) sort@(history_strings) sort@(lock_strings) bringover_size :@= bringover_strings.size conflict_size :@= conflict_strings.size directory_size :@= directory_strings.size history_size :@= history_strings.size lock_size :@= lock_strings.size base_index :@= 0 bringover_index :@= 0 conflict_index :@= 0 directory_index :@= 0 history_index :@= 0 lock_index :@= 0 base_index :@= 0 loop while base_index < base_size base_string :@= base_strings[base_index] base_length :@= base_string.size # Figure out which files are available: bringover_present:: logical := false if bringover_index < bringover_size bringover_string :@= bringover_strings[bringover_index] bringover_length :@= bringover_string.size if sub_string_equal@(base_string, 0, base_length, bringover_string, 2, bringover_length - 2) bringover_present := true bringover_index :+= 1 conflict_present:: logical := false if conflict_index < conflict_size conflict_string :@= conflict_strings[conflict_index] conflict_length :@= conflict_string.size if sub_string_equal@(base_string, 0, base_length, conflict_string, 2, conflict_length - 2) conflict_present := true conflict_index :+= 1 directory_present:: logical := false if directory_index < directory_size directory_string :@= directory_strings[directory_index] directory_length :@= directory_string.size if sub_string_equal@(base_string, 0, base_length, directory_string, 2, directory_length - 2) directory_present := true directory_index :+= 1 history_present:: logical := false if history_index < history_size history_string :@= history_strings[history_index] history_length :@= history_string.size if sub_string_equal@(base_string, 0, base_length, history_string, 2, history_length - 2) history_present := true history_index :+= 1 lock_present:: logical := false if lock_index < lock_size lock_string :@=lock_strings[lock_index] lock_length :@=lock_string.size if sub_string_equal@(base_string, 0, base_length, lock_string, 2, lock_length - 2) lock_present := true lock_index :+= 1 # Process the directory if it is present: directory_hash :@= 0 if directory_present shadow_sub_directory_name :@= name_append@(shadow_directory_name, directory_string) sub_directory_name :@= name_append@(directory_name, base_string) sub_project_directory :@= create@project_directory(project, project_directory, base_string, true) directory_hash := refresh@(sub_project_directory, delete, no_action, verbose, timer) # Process the history file if it is present: project_file :@= create@project_file(project_directory, base_string) if history_present # Process the h. file: history_name :@= project_file.history_file_name if verbose format@format1[file_name](debug_stream, '%ds%: History file\n\', history_name) history_hash :@= 0 history_timestamp :@= 0 history_in_stream :@= xallocate@data_in_stream(resources) if open@(history_in_stream, history_name, project, errors) deallocate@(history_in_stream) else history :@= read@history(history_in_stream, project_file, timer) history_timestamp :@= history.create_timestamp history_hash := close@(history_in_stream) deallocate@(history_in_stream) deallocate@(history) # Process the lock file if it is present: lock_hash :@= 0 if lock_present # Process the l. file: lock_hash :@= lock_read@(project_file) # We should have everything by now: tag_write@(listing_out_stream, "F"[0]) string_write@(listing_out_stream, base_string) timestamp_write@(listing_out_stream, history_timestamp) hash_write@(listing_out_stream, history_hash) hash_write@(listing_out_stream, lock_hash) logical_write@(listing_out_stream, directory_present) new_line_write@(listing_out_stream) base_index :+= 1 # Write out the end record: tag_write@(listing_out_stream, "E"[0]) new_line_write@(listing_out_stream) close@(listing_out_stream, global.data_out_delays) deallocate@(listing_out_stream) strings_deallocate@(resources, base_strings) strings_deallocate@(resources, bringover_strings) strings_deallocate@(resources, conflict_strings) strings_deallocate@(resources, directory_strings) strings_deallocate@(resources, history_strings) strings_deallocate@(resources, lock_strings) # Write out the p.listing file: return 0 procedure relative_parse@project_directory takes directory_name file_name project project returns project_directory #: This procedure will parse {directory_name} (which must be relative) #, into {project_directory} in {project} and return it. ?? is returned #, if any errors occur during parsing. assert directory_name !== ?? assert project !== ?? #debug_stream :@= project.resources.global.debug_stream #format@format2[file_name, address](debug_stream, # "relative_parse@project_directory(%ds%, %X%)\n\", # directory_name, project.address) assert is_relative@(directory_name) if directory_name.depth = 0 return project.root_project_directory parent_project_directory :@= relative_parse@project_directory(directory_name.parent, project) project_directory :@= create@project_directory(project, parent_project_directory, directory_name.name, false) return project_directory procedure restore@project_directory takes project_directory project_directory returns_nothing #: This procedure will restore the contents of {project_directory} #, from its p.listing file (if it exists). assert project_directory !== ?? resources :@= project_directory.resources assert resources !== ?? #debug_stream :@= resources.global.debug_stream #format@format1[address](debug_stream, # "restore@project_directory(%X%)\n\", project_directory.address) listing_file_name :@= project_directory.listing_file_name if file_exists@(listing_file_name) project :@= project_directory.project errors :@= resources.global.errors data_in_stream :@= xallocate@data_in_stream(resources) if open@(data_in_stream, listing_file_name, project, errors) errors := errors #FIXME: do_nothing else # Read header: if !header_read@(data_in_stream, "H"[0], "SVMS Listing", 1, 2) # Read count: tag_check@(data_in_stream, "C"[0]) size :@= unsigned_read@(data_in_stream) new_line_read@(data_in_stream) # Read in all of the {project_file_records}: project_files :@= project_directory.project_files index :@= 0 loop while index < size project_file :@= restore@project_file(data_in_stream, project_directory) index :+= 1 # Read end record: tag_check@(data_in_stream, "E"[0]) new_line_read@(data_in_stream) close@(data_in_stream) deallocate@(data_in_stream) project_directory.modified := false procedure print@project_directory takes project_directory project_directory out_stream out_stream returns_nothing #: This procedure will print {project_directory} to {out_stream}. format@format1[file_name](out_stream, ":/%ds", project_directory.relative_directory_name) procedure root_create@project_directory takes project project refresh logical returns project_directory #: This procedure will create and return the root {project_directory} #, for {project}. If {refresh} is {true}, no p.listing files will be #, read. assert project !== ?? root_project_directory :@= create@project_directory(project, ??, "", refresh) #debug_stream :@= project.resources.global.debug_stream #format@format2[address, address](debug_stream, # "root_create@project_directory(%X%)=>%X%\n\", # project.address, root_project_directory.address) return root_project_directory procedure save@project_directory takes project_directory project_directory returns_nothing #: This procedure will cause a p.listing file to be created for #, {project_directory}. resources :@= project_directory.resources global :@= resources.global #debug_stream :@= global.debug_stream #format@format1[address](debug_stream, # "save@project_directory(%X%))\n\", project_directory.address) save@(project_directory.project_directorys) if project_directory.modified listing_file_name :@= project_directory.listing_file_name #format@format1[file_name](debug_stream, # "save@project_directory writing to %ds%\n\", listing_file_name) data_out_stream :@= open@data_out_stream(listing_file_name, resources, global.errors) if data_out_stream !== ?? # Write out the header: header_write@(data_out_stream, "H"[0], "SVMS Listing", 1, 2) # Write out the number of records: project_files :@= project_directory.project_files tag_write@(data_out_stream, "C"[0]) unsigned_write@(data_out_stream, project_files.size) new_line_write@(data_out_stream) # Write out the records themselves: sort@(project_files) save@(project_files, data_out_stream) # Write an end record: tag_write@(data_out_stream, "E"[0]) new_line_write@(data_out_stream) close@(data_out_stream, global.data_out_delays) deallocate@(data_out_stream) procedure show@project_directory takes project_directory project_directory out_stream out_stream indent unsigned returns_nothing #: This procedure will show the contents of {project_directory} to #, {out_stream} indented by {indent}. format@format1[address](out_stream, "show@project_directory(%X%)\n\", project_directory.address) show_no_newline@(project_directory, out_stream, indent) put@("\n\", out_stream) indent :+= 1 show@(project_directory.project_files, out_stream, indent) show@(project_directory.project_directorys, out_stream, indent) procedure show_no_newline@project_directory takes project_directory project_directory out_stream out_stream indent unsigned returns_nothing #: This procedure will output {project_directory} to {out_stream} indented #, by {indent} indentation units. No trailing newline is output. index :@= 0 loop while index < indent put@(" ", out_stream) index :+= 1 format@format1[file_name](out_stream, ":/%s%", project_directory.relative_directory_name) #: {project_directorys} procedures: procedure xallocate@project_directorys takes resources resources returns project_directorys #: This procedure will allocate a new {project_directorys} object #, from {resources} and return it. project_directorys :@= project_directorys_allocate@(resources) list :@= project_directorys.list if list == ?? list := allocate@vector[project_directory]() else truncate@(list, 0) project_directorys.list := list project_directorys.resources := resources return project_directorys procedure append@project_directorys takes project_directorys project_directorys project_directory project_directory returns_nothing #: This procedure will append {project_directory} to the end of #, {project_directorys}. append@(project_directorys.list, project_directory) procedure deallocate@project_directorys takes project_directorys project_directorys returns_nothing #: This procedure will deallocate {project_directorys} for #, subsequent reuse. assert project_directorys !== ?? resources :@= project_directorys.resources list :@= project_directorys.list size :@= list.size #debug_stream :@= resources.global.debug_stream #format@format2[address, unsigned](debug_stream, # "deallocate@project_directorys(%X%) size:%d%\n\", # project_directorys.address, size) index :@= 0 loop while index < size project_directory :@= list[index] deallocate@(project_directory) index :+= 1 truncate@(list, 0) project_directorys_deallocate@(resources, project_directorys) procedure fetch1@project_directorys takes project_directorys project_directorys index unsigned returns project_directory #: This procedure will return the {index}'th {project_directory} from #, {project_directorys}. project_directory :@= project_directorys.list[index] return project_directory procedure save@project_directorys takes project_directorys project_directorys returns_nothing #: This procedure will cause p.listing files to be generated #, for each {project_directory} in {project_directorys}. list :@= project_directorys.list size :@= list.size index :@= 0 loop while index < size project_directory :@= project_directorys[index] save@(project_directory) index :+= 1 procedure show@project_directorys takes project_directorys project_directorys out_stream out_stream indent unsigned returns_nothing #: This procedure will output {project_directorys} to {out_stream} #, indented by {indent} indentation stops. list :@= project_directorys.list size :@= list.size format@format2[address, unsigned](out_stream, "show@project_directorys(%X%) size:%d%\n\", project_directorys.address, size) index :@= 0 loop while index < size project_directory :@= project_directorys[index] show@(project_directory, out_stream, indent) index :+= 1 procedure size_get@project_directorys takes project_directorys project_directorys returns unsigned #: This procedure will return the size of {project_directorys} size :@= project_directorys.list.size return size procedure truncate@project_directorys takes project_directorys project_directorys new_size unsigned returns_nothing #: This procedure will make {project_directorys} have a size #, {new_size}. truncate@(project_directorys.list, new_size) #: {project_file} procedures: procedure compare@project_file takes project_file1 project_file project_file2 project_file returns integer #: This procedure will return -1, 0, or 1, depending upon whether #, {project_file1} is less than, equal to, or greater than #, {project_file2}. relative_file_name1 :@= project_file1.relative_file_name relative_file_name2 :@= project_file2.relative_file_name result :@= compare@(relative_file_name1, relative_file_name2) return result procedure create@project_file takes parent project_directory base_name string returns project_file #: This procedure will create and return a new {project_file} object #, that refers to the {base_name} file in {project_directory}. assert parent !== ?? project :@= parent.project assert project !== ?? resources :@= project.resources #debug_stream :@= resources.global.debug_stream #format@format2[address, string](debug_stream, # "create@project_file(%X%, %s%)\n\", parent.address, base_name) # First see if we have already created the {project_file}: relative_file_name :@= name_append@(parent.relative_directory_name, base_name) assert base_name = relative_file_name.name base_name := relative_file_name.name file_table :@= project.file_table project_file :@= file_table[relative_file_name] if project_file == ?? # Figure out the various file names: directory_file_name :@= parent.shadow_directory_name file_string :@= string_allocate@(resources) string_append@(file_string, "b.") string_append@(file_string, base_name) bringover_file_name :@= name_append@(directory_file_name, file_string) file_string[0] := "c"[0] conflict_file_name :@= name_append@(directory_file_name, file_string) file_string[0] := "h"[0] history_file_name :@= name_append@(directory_file_name, file_string) file_string[0] := "l"[0] lock_file_name :@= name_append@(directory_file_name, file_string) string_deallocate@(resources, file_string) # Fill in all of the fields: project_file :@= project_file_allocate@(resources) project_file.actual_file_name := name_append@(parent.actual_directory_name, base_name) project_file.bringover_file_name := bringover_file_name project_file.bringover_hash := 0 project_file.conflict_file_name := conflict_file_name project_file.conflict_hash := 0 project_file.history_file_name := history_file_name project_file.history_hash := 0 project_file.lock_file_name := lock_file_name project_file.lock_hash := 0 project_file.modified := true project_file.parent := parent project_file.project := project project_file.project_directory := ?? project_file.relative_file_name := relative_file_name project_file.resources := resources project_file.timestamp := 0 file_table[relative_file_name] := project_file # Insert {project_file} into the various data structures: append@(parent.project_files, project_file) assert project_file.parent !== ?? assert project_file.project !== ?? return project_file procedure deallocate@project_file takes project_file project_file returns_nothing #: This procedure will deallocate {project_file} for subsequent #, reallocation. assert project_file !== ?? resources :@= project_file.resources assert resources !== ?? #debug_stream :@= resources.global.debug_stream #format@format1[address](debug_stream, # "deallocate@project_file(%X%)\n\", project_file.address) parent :@= project_file.parent if parent !== ?? project :@= parent.project file_table :@= project.file_table assert file_table !== ?? delete@(file_table, project_file.relative_file_name) erase@(project_file) project_file.resources := resources project_file_deallocate@(resources, project_file) procedure directory_create@project_file takes project_file project_file create logical duplicates_ok logical returns logical #: This procedure will create a directory for {project_file}. #, If {create} is {true}, the corresponding actual directory is #, is created as well. If {duplicates_ok} is {true}, no error #, message is generated if the directory already exists. Any #, errors are recorded into {errors}. {true} is returned if #, any errors have occured. assert project_file !== ?? parent_project_directory :@= project_file.parent project :@= parent_project_directory.project base_name :@= project_file.actual_file_name.name project_directory :@= create@project_directory(project, parent_project_directory, base_name, false) result :@= directory_create@(project_directory, create, duplicates_ok) return result procedure equal@project_file takes project_file1 project_file project_file2 project_file returns logical #: This procedure will return {true} if {project_file1} is equal to #, {project_file1} and {false} otherwise. zero :@= integer_convert@(0) result :@= compare@(project_file1, project_file2) = zero return result procedure format@project_file takes project_file project_file out_stream out_stream format string offset unsigned returns logical #: This procedure will output {project_file} to {out_stream} using #, the formating characters in {format} starting at {offset} until #, a terminating '%' is encountered. See the {format} module #, to find out more about formatted output. # We will cheese out for now: put@(":/", out_stream) print@(project_file, out_stream) procedure hash@project_file takes project_file project_file returns unsigned #: This procedure will return a hash value for {project_file}. return hash@(project_file.relative_file_name) procedure lock_read@project_file takes project_file project_file returns unsigned #: This procedure will write out an l. file for {project_file}. resources :@= project_file.resources global :@= resources.global errors :@= global.errors project :@= project_file.project lock_hash :@= 0 lock_file_name :@= project_file.lock_file_name lock_in_stream :@= xallocate@data_in_stream(resources) if open@data_in_stream(lock_in_stream, lock_file_name, project, errors) #FIXME: do_nothing lock_hash := 0 else # Read in the header: header_read@(lock_in_stream, "H"[0], "SVMS Lock", 1, 0) # Write out the user record: lock_base_name :@= string_allocate@(resources) lock_user :@= string_allocate@(resources) lock_email :@= string_allocate@(resources) tag_check@(lock_in_stream, "U"[0]) string_read@(lock_in_stream, lock_base_name) string_read@(lock_in_stream, lock_user) lock_timestamp :@= timestamp_read@(lock_in_stream) string_read@(lock_in_stream, lock_email) new_line_read@(lock_in_stream) string_deallocate@(resources, lock_base_name) string_deallocate@(resources, lock_user) string_deallocate@(resources, lock_email) # Write out the end record: tag_check@(lock_in_stream, "E"[0]) new_line_read@(lock_in_stream) # Close the file and record the hash value: lock_hash := close@(lock_in_stream) project_file.lock_hash := lock_hash deallocate@(lock_in_stream) return lock_hash procedure lock_write@project_file takes project_file project_file returns_nothing #: This procedure will write out an l. file for {project_file}. resources :@= project_file.resources global :@= resources.global errors :@= global.errors lock_file_name :@= project_file.lock_file_name lock_out_stream :@= open@data_out_stream(lock_file_name, resources, errors) if lock_out_stream !== ?? # Write out the header: header_write@(lock_out_stream, "H"[0], "SVMS Lock", 1, 0) # Figure out the user name and E-mail address: lock_user :@= "Wayne Gramlich" #FIXME: Wrong! lock_email :@= "Wayne.Gramlich@RogueWave.Com" # Figure out the lock timestamp: lock_side_file_name :@= lock_out_stream.side_file_name status_update@(lock_side_file_name) lock_status :@= lock_side_file_name.status lock_timestamp :@= lock_status.modification_time assert lock_timestamp != 0 # Write out the user record: tag_write@(lock_out_stream, "U"[0]) lock_base_name :@= lock_file_name.name string_write@(lock_out_stream, lock_base_name) string_write@(lock_out_stream, lock_user) timestamp_write@(lock_out_stream, lock_timestamp) string_write@(lock_out_stream, lock_email) new_line_write@(lock_out_stream) # Write out the end record: tag_write@(lock_out_stream, "E"[0]) new_line_write@(lock_out_stream) # Close the file and record the hash value: lock_hash :@= close@(lock_out_stream, global.data_out_delays) deallocate@(lock_out_stream) project_file.lock_hash := lock_hash procedure lock_remove@project_file takes project_file project_file returns_nothing #: This procedure will remove the lock file associated with {project_file}. lock_file_name :@= project_file.lock_file_name file_delete@(lock_file_name) project_file.lock_hash := 0 procedure print@project_file takes project_file project_file out_stream out_stream returns_nothing #: This procedure will print {project_file} to {out_stream}. format@format1[file_name](out_stream, "%ds", project_file.relative_file_name) procedure restore@project_file takes data_in_stream data_in_stream project_directory project_directory returns project_file #: This procedure will read in one {project_file} record from #, {data_in_stream} and return the corresponding {project_file} object #, where {project_directory} is the containing project directory. assert data_in_stream !== ?? assert project_directory !== ?? resources :@= project_directory.resources assert resources !== ?? #debug_stream :@= resources.global.debug_stream #format@format1[address](debug_stream, # "restore@project_file(%X%)\n\", project_directory.address) tag_check@(data_in_stream, "F"[0]) base_name :@= string_allocate@(resources) string_read@(data_in_stream, base_name) timestamp :@= timestamp_read@(data_in_stream) history_hash :@= hash_read@(data_in_stream) lock_hash :@= hash_read@(data_in_stream) has_sub_directory :@= logical_read@(data_in_stream) new_line_read@(data_in_stream) project_file :@= create@project_file(project_directory, base_name) project_file.timestamp := timestamp project_file.history_hash := history_hash project_file.lock_hash := lock_hash if has_sub_directory project_file.project_directory := create@project_directory(project_file.project, project_directory, base_name, false) else project_file.project_directory := ?? string_deallocate@(resources, base_name) return project_file procedure save@project_file takes project_file project_file data_out_stream data_out_stream returns_nothing #: This procedure will save one record corresponding to {project_file} #, to {data_out_stream}. assert project_file !== ?? assert data_out_stream !== ?? resources :@= data_out_stream.resources #debug_stream :@= resources.global.debug_stream #format@format2[address, file_name](debug_stream, # "save@project_file(%X%(=%ds%))\n\", # project_file.address, project_file.actual_file_name) timestamp :@= project_file.timestamp assert timestamp != 0 tag_write@(data_out_stream, "F"[0]) string_write@(data_out_stream, project_file.relative_file_name.name) timestamp_write@(data_out_stream, timestamp) hash_write@(data_out_stream, project_file.history_hash) hash_write@(data_out_stream, project_file.lock_hash) logical_write@(data_out_stream, project_file.project_directory !== ??) new_line_write@(data_out_stream) procedure show@project_file takes project_file project_file out_stream out_stream indent unsigned returns_nothing #: This procedure will show the contents of {project_file} to #, {out_stream} indented by {indent}. #format@format1[address](out_stream, # "show@project_file(%X%)\n\", project_file.address) # Print out {project_file}: show_no_newline@(project_file.parent, out_stream, indent) format@format1[string](out_stream, "/%s%\n\", project_file.relative_file_name.name) #: {project_files} procedures: procedure xallocate@project_files takes resources resources returns project_files #: This procedure will allocate and return a new {project_files} object #, from {resources}. project_files :@= project_files_allocate@(resources) list :@= project_files.list if list == ?? list := allocate@vector[project_file]() else truncate@(list, 0) project_files.project_directory := ?? project_files.list := list project_files.resources := resources return project_files procedure append@project_files takes project_files project_files project_file project_file returns_nothing #: This procedure will append {project_file} to {project_files}. assert project_files !== ?? assert project_file !== ?? resources :@= project_file.resources #debug_stream :@= resources.global.debug_stream #format@format2[address, address](debug_stream, # "append@project_files(%X%, %X%)\n\", # project_files.address, project_file.address) # A quick little test for bogosity: list :@= project_files.list size :@= list.size if size != 0 assert list[size - 1] !== project_file append@(list, project_file) # Figure out if we have to mark the parent directory as modified: project_directory :@= project_files.project_directory if project_directory !== ?? project_directory.modified := true procedure create@project_files takes project_directory project_directory returns project_files #: This procedure will allocate and return a {project_files} object #, whose containing {project_directory} is {project_directory}. assert project_directory !== ?? resources :@= project_directory.resources assert resources !== ?? project_files :@= xallocate@project_files(resources) project_files.project_directory := project_directory return project_files procedure deallocate@project_files takes project_files project_files returns_nothing #: This procedure will deallocate {project_files} for subsequent #, reallocation. assert project_files !== ?? resources :@= project_files.resources assert resources !== ?? list :@= project_files.list size :@= list.size #debug_stream :@= resources.global.debug_stream #format@format2[address, unsigned](debug_stream, # "deallocate@project_files(%X%) %d%\n\", project_files.address, size) index :@= 0 loop while index < size project_file :@= list[index] deallocate@(project_file) index :+= 1 truncate@(list, 0) project_files_deallocate@(resources, project_files) procedure fetch1@project_files takes project_files project_files index unsigned returns project_file #: This procedure will returnt the {index}'th {project_file} from #, {project_files}. return project_files.list[index] procedure save@project_files takes project_files project_files data_out_stream data_out_stream returns_nothing #: This procedure will cause a each {project_file} in {project_files} #, to be saved to {data_out_stream}. assert project_files !== ?? assert data_out_stream !== ?? #debug_stream :@= data_out_stream.resources.global.debug_stream #format@format1[address](debug_stream, # "save@project_files(%X%)\n\", project_files.address) list :@= project_files.list size :@= list.size index :@= 0 loop while index < size project_file :@= project_files[index] #format@format2[unsigned, address](debug_stream, # "save@project_files: [%d%]: %X%\n\", index, project_file.address) save@(project_file, data_out_stream) index :+= 1 procedure show@project_files takes project_files project_files out_stream out_stream indent unsigned returns_nothing #: This procedure will output {project_files} to {out_stream} #, indented by {indent} indentation stops. list :@= project_files.list size :@= list.size format@format2[address, unsigned](out_stream, "show@project_files(%X%) size:%d%\n\", project_files.address, size) index :@= 0 loop while index < size project_file :@= project_files[index] show@(project_file, out_stream, indent) index :+= 1 procedure size_get@project_files takes project_files project_files returns unsigned #: This procedure will return the size of {project_files} return project_files.list.size procedure sort@project_files takes project_files project_files returns_nothing #: This procedure will sort {project_files}. sort@(project_files.list) procedure truncate@project_files takes project_files project_files new_size unsigned returns_nothing #: This procedure will truncate {project_files} to contain only #, {new_size} {project_file}'s. truncate@(project_files.list, new_size) procedure unique@project_files takes project_files project_files returns_nothing #: This procedure will cull {project_files} so that all files are unique. unique@(project_files.list) #: {project_name} procedures: procedure xallocate@project_name takes resources resources returns project_name #: This procedure will allocate and return an empty {project_name} object #, allocated from {resources}. assert resources !== ?? project_name :@= project_name_allocate@(resources) project_name.nickname := string_allocate@(resources) project_name.resources := resources project_name.timestamp := 0 #debug_stream :@= resources.global.debug_stream #format@format1[address](debug_stream, # "allocate@project_name()=>%X%\n\", project_name.address) return project_name procedure create@project_name takes nickname string timestamp unsigned resources resources returns project_name #: This procedure will allocate a {project_name} object from {resources} #, and initialize it to contain {nickname} and {timestamp}. assert nickname.size != 0 assert timestamp != 0 project_name :@= xallocate@project_name(resources) string_append@(project_name.nickname, nickname) project_name.timestamp := timestamp project_name :@= share@(project_name) #debug_stream :@= resources.global.debug_stream #format@format3[string, unsigned, address](debug_stream, # "create@project_name(%ds%, %d%)=>%X%\n\", # nickname, timestamp, project_name.address) return project_name procedure compare@project_name takes project_name1 project_name project_name2 project_name returns integer #: This procedure will return -1, 0, or 1 depending upon whether #, {project_name1} is less than, equal to, or greater than {project_name2}. zero :@= integer_convert@(0) result :@= compare@(project_name1.timestamp, project_name2.timestamp) if result = zero result := compare@(project_name1.nickname, project_name2.nickname) return result procedure deallocate@project_name takes project_name project_name returns_nothing #: This procedure will deallocate {project_name} for subsequent #, reallocation. This deallocation routine does not get upset #, {project_name} is already deallocated. assert project_name !== ?? resources :@= project_name.resources assert resources !== ?? #debug_stream :@= resources.global.debug_stream #format@format1[address](debug_stream, # 'deallocate@project_name(%X%)\n\', project_name.address) if project_name.nickname !== ?? string_deallocate@(resources, project_name.nickname) erase@(project_name) project_name.resources := resources project_name_deallocate@(resources, project_name) procedure equal@project_name takes project_name1 project_name project_name2 project_name returns logical #: This procedure will return {true} if {project_name1} is equal to #, {project_name2} and {false} otherwise. return compare@(project_name1, project_name2) = integer_convert@(0) procedure hash@project_name takes project_name project_name returns unsigned #: This procedure will return a hash value for {project_name}. return hash@(project_name.nickname) + project_name.timestamp procedure read@project_name takes data_in_stream data_in_stream returns project_name #: This procedure will read a {project_name} from {data_in_stream} and #, return it. assert data_in_stream !== ?? resources :@= data_in_stream.resources assert resources !== ?? project_name :@= xallocate@project_name(resources) string_read@(data_in_stream, project_name.nickname) project_name.timestamp := timestamp_read@(data_in_stream) project_name :@= share@(project_name) return project_name procedure share@project_name takes project_name project_name returns project_name #: This procedure will return a single sharable copy of {project_name}. assert project_name !== ?? resources :@= project_name.resources assert resources !== ?? global :@= resources.global project_name_table :@= global.project_name_table shared_project_name :@= project_name_table[project_name] if shared_project_name == ?? insert@(project_name_table, project_name) append@(global.project_names, project_name) shared_project_name := project_name else deallocate@(project_name) # debug_stream :@= global.debug_stream # format@format4[address, string, unsigned, address](debug_stream, # 'share@project_name(%X%=%ds%@%d%)=>%X%\n\', project_name.address, # project_name.nickname, project_name.timestamp, # shared_project_name.address) return shared_project_name procedure write@project_name takes project_name project_name data_out_stream data_out_stream returns_nothing #: This procedure will write {project_name} to {data_out_stream}. assert project_name !== ?? nickname :@= project_name.nickname timestamp :@= project_name.timestamp #resources :@= data_out_stream.resources #debug_stream :@= resources.global.debug_stream #format@format3[address, string, unsigned](debug_stream, # "write@project_name(%X% = (%ds%@%d%))\n\", # project_name.address, nickname, timestamp) assert timestamp != 0 assert nickname.size != 0 string_write@(data_out_stream, nickname) timestamp_write@(data_out_stream, timestamp)