(require 'dojo-common-containers)
(defun dojo-save-print-lisp ()
(interactive)
(let* ((save-dir (dojo-core-save-get-or-create-save-dir))
(workspace-file-name (concat save-dir "lisp_workspace.el")))
(with-temp-buffer
(buffer-disable-undo (current-buffer))
(prin1 dojo-current-workspace (current-buffer))
(write-file workspace-file-name))))
(defun dojo-save-current-workspace ()
"This function performs all necessary save tasks once we
leave dojo-minor-mode.
Note that at that point, we only want to do the absolute
minimum of save tasks, to save processing time and avoid
the situation that emacs is blocked for seconds saving files."
(log-save "Saving workspace.xml...")
(dojo-core-save-save-workspace-file dojo-current-workspace)
(log-save "... done.")
(let* ((workspace-scan-pending (dojo-workspace-workspace-scan-pending dojo-current-workspace))
(last-scanned-project (dojo-workspace-last-scanned-project dojo-current-workspace))
(last-scanned-tokens (dojo-workspace-last-scanned-tokens dojo-current-workspace))
(curr-scan-project-resources (dojo-workspace-curr-scan-project-resources dojo-current-workspace)))
(if (and workspace-scan-pending
last-scanned-project
last-scanned-tokens)
(progn
(log-save (format "Saving [%s] resources derived in not yet completed scan of project [%s]..." (length curr-scan-project-resources) last-scanned-project))
(dojo-core-save-write-project-resources dojo-current-workspace last-scanned-project curr-scan-project-resources nil "curr_scan_resources.xml")
(log-save "...done."))))
; Save resource index, i.e. the mapping from resource id to project.
; It is necessary for deciding, given a resource id, which resources
; xml is to be loaded in order to get more information about the
; resource.
(dojo-core-save-write-resource-index-file dojo-current-workspace)
; Save all resources.xml for projects where something has changed (i.e. classes were parsed)
(dojo-core-save-save-resource-files dojo-current-workspace)
; Save API
(dojo-core-save-save-api-files dojo-current-workspace)
; Save Dependencies (i.e. which resource uses which other resource)
(dojo-core-save-save-dep-files dojo-current-workspace)
; Save scans.xml containing the dojo-scan instances
(dojo-core-save-save-scan-file dojo-current-workspace)
; Save all classes that weren't yet saved by the workspace loop.
(dojo-core-save-save-touched-classes dojo-current-workspace t)
; Finally remove the lock
(let* ((save-dir (dojo-core-save-get-or-create-save-dir))
(lock-file-name (concat save-dir "lock")))
(delete-file lock-file-name)))
(defun dojo-core-save-get-or-create-save-dir ()
(if (= (length dojo-workspace-dir) 0)
(log-save "Please provide a non-empty dojo-workspace-dir")
(let ((full-dir-name (concat (file-name-as-directory dojo-workspace-path) (file-name-as-directory dojo-workspace-dir))))
(if (not (file-exists-p full-dir-name))
(make-directory full-dir-name nil))
full-dir-name)))
(defun dojo-core-save-save-workspace-file (workspace)
(let* ((work-state (dojo-workspace-work-state workspace))
(exec-map (dojo-workspace-exec-map workspace))
(save-dir (dojo-core-save-get-or-create-save-dir))
(workspace-file-name (concat save-dir "workspace.xml"))
(id-to-project (dojo-workspace-id-to-project workspace))
(project-names (dojo-workspace-project-names workspace))
(last-scanned-project (dojo-workspace-last-scanned-project workspace))
(last-scanned-tokens (dojo-workspace-last-scanned-tokens workspace))
(workspace-scan-pending (dojo-workspace-workspace-scan-pending workspace))
(workspace-scan-interrupted (dojo-workspace-workspace-scan-interrupted workspace))
(last-scan-utcseconds (dojo-workspace-last-scan-utcseconds workspace))
(last-extract-own-utcseconds (dojo-workspace-last-extract-own-utcseconds workspace))
(last-extract-imports-utcseconds (dojo-workspace-last-extract-imports-utcseconds workspace))
(last-plan-extract-utcseconds (dojo-workspace-last-plan-extract-utcseconds workspace))
(last-extract-referenced-utcseconds (dojo-workspace-last-extract-referenced-utcseconds workspace))
(own-class-extraction-pending (dojo-workspace-own-class-extraction-pending workspace))
(extract-imports-pending (dojo-workspace-extract-imports-pending workspace))
(referenced-extraction-pending (dojo-workspace-referenced-extraction-pending workspace))
(pending-extractions (dojo-workspace-pending-extractions workspace))
(plan-extract-pending (dojo-workspace-plan-extract-pending workspace))
(file-path-to-path-info (dojo-workspace-file-path-to-path-info workspace))
(next-free-scan-id (dojo-workspace-next-free-scan-id workspace))
(next-free-project-id (dojo-workspace-next-free-project-id workspace))
(next-free-resource-id (dojo-workspace-next-free-resource-id workspace))
(next-free-class-id (dojo-workspace-next-free-class-id workspace))
(dirty-symbol-ids (dojo-workspace-dirty-symbol-ids workspace)))
(with-temp-buffer
; We explicitely don't save the curr-scan-id, as the field is only used temporarily
; while setting up dojo-classes.
(buffer-disable-undo (current-buffer))
(insert "")
(newline)
(dojo-core-save-write-exec-map exec-map)
(dojo-core-save-write-projects id-to-project)
; (dojo-core-save-write-string-list project-names "projects" "project")
(dojo-core-save-write-string-list last-scanned-tokens "last-scanned-tokens" "token")
(dojo-core-save-write-string-list (hash-table-get-all-keys pending-extractions) "pending-extractions" "extraction")
(dojo-core-save-write-dirty-symbol-ids dirty-symbol-ids)
(insert "")
(newline)
(write-file workspace-file-name))))
(defun dojo-core-save-write-exec-map (exec-map)
(insert "")
(newline)
(dolist (workstate-symbol DOJO-WORKSTATE-DEFAULT-ORDER)
(let* ((workstate (gethash workstate-symbol exec-map))
(last-exec-utcseconds (dojo-workstate-last-exec-utcseconds workstate))
(next-exec-utcseconds (dojo-workstate-next-exec-utcseconds workstate)))
(insert "")
(newline)))
(insert "")
(newline))
(defun dojo-core-save-write-projects (id-to-project)
(insert "")
(maphash (lambda (id project)
(dojo-core-save-write-project project))
id-to-project)
(insert "")
(newline))
(defun dojo-core-save-write-project (project)
(let* ((id (dojo-project-id project))
(name (dojo-project-name project))
(is-js-dojo-project (dojo-project-is-js-dojo-project project))
(locale-to-i18n-resource (dojo-project-locale-to-i18n-resource project))
(css-resources (dojo-project-css-resources project))
(pom-resource-id (dojo-project-pom-resource-id project))
(blueprint-resource-id (dojo-project-blueprint-resource-id project))
(datamodel-resource-id (dojo-project-datamodel-resource-id project))
(last-save-api-time (dojo-project-last-save-api-time project))
(last-save-dep-time (dojo-project-last-save-dep-time project))
(last-save-resources-time (dojo-project-last-save-resources-time project)))
(insert "")
(newline)
(insert "")
(newline)
(maphash (lambda (locale i18n-resource-id)
(insert "")
(newline))
locale-to-i18n-resource)
(insert "")
(newline)
(insert "")
(newline)
(maphash (lambda (resource-id-key resource-id-value)
(insert "")
(newline))
css-resources)
(insert "")
(newline)
(insert "")
(newline)))
(defun dojo-core-save-write-dirty-symbol-ids (dirty-symbol-ids)
(insert "")
(newline)
(maphash (lambda (dirty-symbol-id void)
(insert (concat ""))
(newline)) dirty-symbol-ids)
(insert "")
(newline))
(defun dojo-core-save-save-scan-file (workspace)
(let* ((save-dir (dojo-core-save-get-or-create-save-dir))
(scan-file-name (concat save-dir "scans.xml"))
(id-to-scan (dojo-workspace-id-to-scan workspace)))
(with-temp-buffer
(buffer-disable-undo (current-buffer))
(insert "")
(newline)
(maphash (lambda (id scan)
(let ((class-id (dojo-scan-class-id scan))
(start-utcseconds (dojo-scan-start-utcseconds scan))
(end-utcseconds (dojo-scan-end-utcseconds scan))
(length (dojo-scan-length scan))
(discarded (dojo-scan-discarded scan)))
(insert "")
(newline)))
id-to-scan)
(insert "")
(newline)
(write-file scan-file-name))))
(defun dojo-core-save-save-class-files (save-dir workspace)
(let* ((id-to-class (dojo-workspace-id-to-class workspace))
(project-to-classes (make-hash-table :test 'equal))
(id-to-scan (dojo-workspace-id-to-scan workspace)))
(dolist (class-id (hash-table-get-all-keys id-to-class))
(let* ((class (gethash class-id id-to-class))
(path (dojo-class-path class))
(project (dojo-class-project class)))
(if (null project)
(log-save (format "[WARNING] Class with id [%s] and path [%s] does not contain a project, and thus cannot be saved." class-id path))
(if (eq (gethash project project-to-classes -1) -1)
(puthash project () project-to-classes))
(let ((classes (gethash project project-to-classes)))
(push class classes)
(puthash project classes project-to-classes)))))
(dolist (project (hash-table-get-all-keys project-to-classes))
(dolist (class (gethash project project-to-classes))
; Check wether class is a dojo-class, as we store other
; kinds of data as well in the id-to-class map (e.g.
; css-files).
(cond ((and (dojo-class-p class) (dojo-class-project class) (dojo-class-path class))
(dojo-core-save-write-class class))
((and (dojo-css-file-p class) (dojo-css-file-project class) (dojo-css-file-path class))
(dojo-core-save-write-css-file class))
(t
(log-save (format "[WARNING] Unrecognized case when saving class. Unsupported type, or missing project/path."))))))))
(defun dojo-core-save-write-class (class)
(let* ((id (dojo-class-id class))
(resource-id (dojo-class-resource-id class))
(project (dojo-class-project class))
(path (dojo-class-path class))
(scan-id (dojo-class-scan-id class))
(superclass-paths (dojo-class-superclass-paths class))
(import-to-symbol (dojo-class-import-to-symbol class))
(annotations (dojo-class-annotations class))
(next-free-symbol-id (dojo-class-next-free-symbol-id class))
(define-symbol (dojo-class-define-symbol class))
(this-symbol (dojo-class-this-symbol class))
(static-symbol (dojo-class-static-symbol class))
; At this point, we expect path to be something like 'clazzes/util/ErrorHelper'
(path-without-name (if path (dojo-common-strings-get-without-last-token path "/") nil))
(save-dir (dojo-core-save-get-or-create-save-dir))
(class-dir (concat save-dir (file-name-as-directory "classes") (file-name-as-directory project) (file-name-as-directory path-without-name)))
(class-file-name (concat class-dir (get-last-token path "/") ".xml"))
(id-to-symbol (dojo-class-id-to-symbol class))
(id-to-scope (dojo-class-id-to-scope class))
(in-assignment-map (dojo-class-in-assignment-map class))
(out-assignment-map (dojo-class-out-assignment-map class)))
; Create directory to save the xml file to, something like 'workspace/.emacs-workspace/dojo-clazzes/clazzes/util'
(if (not (file-exists-p class-dir))
(make-directory class-dir t))
(with-temp-buffer
(buffer-disable-undo (current-buffer))
(insert "")
(newline)
(dojo-core-save-write-string-list superclass-paths "superclass-paths" "superclass-path")
(dojo-core-save-write-annotations annotations)
(dojo-core-save-write-symbol-map import-to-symbol "imports" "import" "id" "name")
; (log-save (format "About to write [%s] symbols for class-id [%s]" (length symbols) id))
; We need to extract the id-to-scope map here.
; (dojo-core-util-extract-class-contents class (make-hash-table :test 'equal) id-to-scope)
(dojo-core-save-write-symbols id-to-symbol)
(dojo-core-save-write-scopes id-to-scope)
; Write out-assignments. Writing them at the moment is more for debugging, we don't actually
; want to load them. And thus, we don't write the in-assignments either.
(dojo-core-save-write-out-assignments out-assignment-map)
(insert "")
(newline)
(write-file class-file-name))))
(defun dojo-core-save-write-symbols (id-to-symbol)
(insert "")
(newline)
(let ((symbol-ids (hash-table-get-all-keys id-to-symbol)))
(setq symbol-ids (sort symbol-ids (lambda (symbol-id-one symbol-id-two) (< symbol-id-one symbol-id-two))))
(dolist (symbol-id symbol-ids)
(if (dojo-symbol-p (gethash symbol-id id-to-symbol))
(let* ((symbol (gethash symbol-id id-to-symbol))
(id (dojo-symbol-id symbol))
(name (dojo-symbol-name symbol))
(value (dojo-common-string-make-xml-safe (dojo-symbol-value symbol)))
(type (dojo-symbol-type symbol))
(parent-id (dojo-symbol-parent-id symbol))
(class-id (dojo-symbol-class-id symbol))
(scan-id (dojo-symbol-scan-id symbol))
(min-pos (dojo-symbol-min-pos symbol))
(max-pos (dojo-symbol-max-pos symbol)))
(insert "")
(newline)
(cond ((or (eq type 'DOJO-JSTYPE-ARRAY-OR-OBJECT) (eq type 'DOJO-JSTYPE-OBJECT))
(let ((name-to-symbol (dojo-symbol-get-object-members symbol)))
(maphash (lambda (name member-symbol)
(if (dojo-symbol-p member-symbol)
(progn
; (log-save (format "Processing member [%s] --> %s" name member-symbol))
(insert (concat "")))
(message "[WARNING] Member-symbol [%s] is no dojo-symbol" member-symbol)))
name-to-symbol)))
((eq type 'DOJO-JSTYPE-FUNCTION)
(let ((arguments (dojo-symbol-get-function-arguments symbol))
(scope (dojo-symbol-get-function-scope symbol)))
(dolist (argument arguments)
(insert (concat "")))
(if scope
(insert (concat "")))))
((eq type 'DOJO-JSTYPE-REF)
(let ((ref-symbols (dojo-symbol-get-ref-symbols symbol)))
(dolist (ref-symbol ref-symbols)
(let ((ref-symbol-string (cond ((stringp ref-symbol)
(dojo-core-save-get-string-param-string "ref" ref-symbol))
((dojo-symbol-p ref-symbol)
(dojo-core-save-get-number-param-string "id" (dojo-symbol-id ref-symbol)))
(t
(log-save (format "[WARNING] Unsupported type of ref-symbol: [%s]" ref-symbol))))))
(insert (concat "")))))))
(insert "")
(newline))
(message "Found [%s] which is no dojo-symbol." (gethash symbol-id id-to-symbol)))))
(insert "")
(newline))
(defun dojo-core-save-save-api-files (workspace)
(let* ((dirty-api-path-keys (dojo-workspace-dirty-api-path-keys workspace)))
(maphash (lambda (path-key b)
(dojo-core-save-save-api-file workspace path-key))
dirty-api-path-keys)))
(defun dojo-core-save-save-api-file (workspace path-key)
(log-save (format "Saving api file for path key [%s]" path-key))
(let* ((save-dir (dojo-core-save-get-or-create-save-dir))
(project (dojo-core-workspace-get-project-by-path-key path-key))
(path (dojo-core-workspace-get-path-by-path-key path-key))
(path-dir (concat save-dir (file-name-as-directory "api") (file-name-as-directory project) (file-name-as-directory path)))
(api-file-name (concat path-dir "api.xml"))
(path-key-to-id-to-api-class (dojo-workspace-path-key-to-id-to-api-class dojo-current-workspace))
(id-to-api-class (gethash path-key path-key-to-id-to-api-class)))
(if (not (file-exists-p path-dir))
(make-directory path-dir t))
(with-temp-buffer
(buffer-disable-undo (current-buffer))
(insert "")
(newline)
(maphash (lambda (id class)
(log-save (format "... Saving api-class with id [%s], project [%s] and path [%s]."
(dojo-class-id class) (dojo-class-project class) (dojo-class-path class)))
(let* ((id (dojo-class-id class))
(resource-id (dojo-class-resource-id class))
(project (dojo-class-project class))
(path (dojo-class-path class))
(scan-id (dojo-class-scan-id class))
(superclass-paths (dojo-class-superclass-paths class))
(this-symbol (dojo-class-this-symbol class))
(static-symbol (dojo-class-static-symbol class))
(next-free-symbol-id (dojo-class-next-free-symbol-id class))
(id-to-symbol (dojo-class-id-to-symbol class)))
(insert "")
(newline)
(dojo-core-save-write-string-list superclass-paths "superclass-paths" "superclass-path")
; (dojo-core-save-write-symbol-map import-to-symbol "imports" "import" "id" "name")
(dojo-core-save-write-symbols id-to-symbol)
(insert "")
(newline)))
id-to-api-class)
(insert "")
(newline)
(log-save (format "... Writing api file [%s]" api-file-name))
(write-file api-file-name))))
(defun dojo-core-save-write-css-file (css-file)
(let* ((id (dojo-css-file-id css-file))
(resource-id (dojo-css-file-resource-id css-file))
(project (dojo-css-file-project css-file))
(path (dojo-css-file-path css-file))
(comments (dojo-css-file-comments css-file))
(rules (dojo-css-file-rules css-file))
(path-without-name (if path (dojo-common-strings-get-without-last-token path "/") nil))
(save-dir (dojo-core-save-get-or-create-save-dir))
(class-dir (concat save-dir
(file-name-as-directory "classes")
(file-name-as-directory project)
(file-name-as-directory path-without-name)))
(class-file-name (concat class-dir (get-last-token path "/") ".xml")))
(log-css (format "About to write css file [%s:%s:%s]"
id project path))
(log-css (format "comments are: [%s]" comments))
(log-css (format "rules are: [%s]" rules))
(if (not (file-exists-p class-dir))
(make-directory class-dir t))
(with-temp-buffer
(buffer-disable-undo (current-buffer))
(insert "")
(newline)
(dojo-core-save-write-css-comments comments)
(dojo-core-save-write-css-rules rules)
(insert "")
(newline)
(write-file class-file-name))))
(defun dojo-core-save-write-css-comments (comments)
(insert "")
(newline)
(dolist (comment comments)
(let* ((start-pos (dojo-css-comment-start-pos comment))
(end-pos (dojo-css-comment-end-pos comment))
(extra-star-count (dojo-css-comment-extra-star-count comment))
(content (dojo-common-string-make-xml-safe (dojo-css-comment-content comment))))
(insert "")
(newline)
(insert content)
(insert "")
(newline)))
(insert "")
(newline))
(defun dojo-core-save-write-css-rules (rules)
(insert "")
(newline)
(dolist (rule rules)
(let* ((text (dojo-common-string-make-xml-safe (dojo-css-rule-text rule)))
(sections (dojo-css-rule-sections rule)))
(insert "")
(newline)
(insert text)
(insert "")
(newline)))
(insert "")
(newline))
(defun dojo-core-save-save-dep-files (workspace)
(let* ((dirty-dep-projects (dojo-workspace-dirty-dep-projects workspace)))
(maphash (lambda (project b)
(dojo-core-save-save-dep-file workspace project))
dirty-dep-projects)))
(defun dojo-core-save-save-dep-file (workspace project)
(log-save (format "Saving dependency file for project [%s]" project))
(let* ((save-dir (dojo-core-save-get-or-create-save-dir))
(project-dir (concat save-dir (file-name-as-directory "dependencies") (file-name-as-directory project)))
(dep-file-name (concat project-dir "dependencies.xml"))
(project-to-dep-maps (dojo-workspace-project-to-dep-maps dojo-current-workspace))
(project-to-inverse-dep-maps (dojo-workspace-project-to-inverse-dep-maps dojo-current-workspace))
(resource-id-to-dep-resource-maps (gethash project project-to-dep-maps))
(resource-id-to-inverse-dep-resource-maps (gethash project project-to-inverse-dep-maps)))
(if (not (file-exists-p project-dir))
(make-directory project-dir t))
(with-temp-buffer
(buffer-disable-undo (current-buffer))
(insert "")
(newline)
(dojo-core-save-write-dep-resource-maps resource-id-to-dep-resource-maps "dependency")
(dojo-core-save-write-dep-resource-maps resource-id-to-inverse-dep-resource-maps "inverse-dependency")
(insert "")
(newline)
(write-file dep-file-name))))
(defun dojo-core-save-write-dep-resource-maps (resource-id-to-dep-resource-map tag-name)
; (dojo-core-dep-log-deps)
(if resource-id-to-dep-resource-map
(maphash (lambda (resource-id dep-resource-map)
(maphash (lambda (dep-resource-id dependencies)
(dolist (dependency dependencies)
(dojo-core-save-write-dependency resource-id dependency tag-name)))
dep-resource-map))
resource-id-to-dep-resource-map)))
(defun dojo-core-save-write-dependency (resource-id dependency tag-name)
(let* ((dep-resource-id (dojo-dependency-resource-id dependency))
(type (dojo-dependency-type dependency))
(origin-id (dojo-dependency-origin dependency)))
(insert (concat "<" tag-name))
(insert (dojo-core-save-get-number-param-string "resource" resource-id))
(insert (dojo-core-save-get-number-param-string "dep-resource" dep-resource-id))
(insert (dojo-core-save-get-defvar-param-string "type" type))
(insert (dojo-core-save-get-number-param-string "origin" origin-id))
(insert "/>")
(newline)))
(defun dojo-core-save-save-resource-files (workspace)
(let* ((save-dir (dojo-core-save-get-or-create-save-dir))
(path-to-resources (dojo-workspace-path-to-resources workspace))
(project-to-resources (make-hash-table :test 'equal))
(resource-projects-to-save (dojo-workspace-resource-projects-to-save workspace)))
(log-save "Grouping resources by project...")
(maphash (lambda (path resources)
(dolist (resource resources)
(let* ((project (dojo-resource-project resource))
(curr-resources (gethash project project-to-resources)))
(push resource curr-resources)
(if project
(puthash project curr-resources project-to-resources)
(log-save (format "[WARNING] Found project name [nil], will transform it to [__none__]"))
(puthash "__none__" curr-resources project-to-resources))))) path-to-resources)
(log-save "... done.")
(maphash (lambda (project resources)
(if (gethash project resource-projects-to-save)
(progn
(log-save (format "Saving resources.xml for project [%s] since it was registered for save." project))
(dojo-core-save-write-project-resources workspace project resources save-dir))
(log-save (format "Will not save resources.xml for project [%s]." project)))) project-to-resources)))
(defun dojo-core-save-write-resource-index-file (workspace &optional save-dir file-name)
(log-save (format "About to write resource index (id --> project)."))
(if (null save-dir)
(setq save-dir (dojo-core-save-get-or-create-save-dir)))
(if (null file-name)
(setq file-name "resource-index.xml"))
(let* ((resource-index-file-name (concat save-dir file-name))
(resource-id-to-project (dojo-workspace-resource-id-to-project workspace)))
(with-temp-buffer
(buffer-disable-undo (current-buffer))
(insert "")
(newline)
(maphash (lambda (resource-id project)
(insert "")
(newline))
resource-id-to-project)
(insert "")
(newline)
(log-save (format "Write resource-index file [%s]" resource-index-file-name))
(write-file resource-index-file-name))))
(defun dojo-core-save-write-project-resources (workspace project resources &optional save-dir file-name)
(if (null save-dir)
(setq save-dir (dojo-core-save-get-or-create-save-dir)))
(if (null file-name)
(setq file-name "resources.xml"))
(let* ((project-dir (concat save-dir (file-name-as-directory "resources") (file-name-as-directory project)))
(resources-file-name (concat project-dir file-name)))
(if (not (file-exists-p project-dir))
(make-directory project-dir t))
(with-temp-buffer
(buffer-disable-undo (current-buffer))
(insert "")
(newline)
(dolist (resource resources)
(let* ((id (dojo-resource-id resource))
(state (dojo-resource-state resource))
(last-located-utc-seconds (dojo-resource-last-located-utc-seconds resource))
(last-parsed-utc-seconds (dojo-resource-last-parsed-utc-seconds resource))
(last-parsed-size (dojo-resource-last-parsed-size resource))
(last-ast-time (dojo-resource-last-ast-time resource))
(last-parse-time (dojo-resource-last-parse-time resource))
(file-hash (dojo-resource-file-hash resource))
(last-scan-id (dojo-resource-last-scan-id resource))
(type (dojo-resource-type resource))
(parsed-id (dojo-resource-parsed-id resource))
(project (dojo-resource-project resource))
(path (dojo-resource-path resource))
(file-path (dojo-resource-file-path resource))
(min-priority-and-count (dojo-core-util-get-min-priority-and-count workspace id))
(min-priority (nth 0 min-priority-and-count))
(min-priority-count (nth 1 min-priority-and-count)))
(insert "")
(newline)))
(insert "")
(newline)
(write-file resources-file-name))))
(defun dojo-core-save-write-scopes (id-to-scope)
(insert "")
(newline)
(let ((scope-ids (sort (hash-table-get-all-keys id-to-scope) (lambda (scope-id-one scope-id-two) (< scope-id-one scope-id-two)))))
(dolist (scope-id scope-ids)
(let* ((scope (gethash scope-id id-to-scope))
(id (dojo-scope-id scope))
(scan-id (dojo-scope-scan-id scope))
(level (dojo-scope-level scope))
(description (dojo-scope-description scope))
(name-to-symbol (dojo-scope-name-to-symbol scope))
(key-to-symbol (dojo-scope-key-to-symbol scope)))
; (log-save (format "Writing scope-id [%s]" scope-id))
(insert "")
(newline)
(maphash (lambda (name property-symbol)
(insert (concat ""))) name-to-symbol)
(maphash (lambda (name property-symbol)
(insert (concat ""))) key-to-symbol)
(insert "")
(newline))))
(insert "")
(newline))
(defun dojo-core-save-write-out-assignments (assignment-map)
(insert (concat ""))
(newline)
(maphash (lambda (source-list dest-map)
(let* ((source-class-id (nth 0 source-list))
(source-symbol-id (nth 1 source-list)))
(if dest-map
(maphash (lambda (dest-list something)
(let* ((dest-class-id (nth 0 dest-list))
(dest-symbol-id (nth 1 dest-list)))
(insert "")))
dest-map))))
assignment-map)
(insert (concat ""))
(newline))
(defun dojo-core-save-get-string-param-string (param-name param-value)
(concat " " param-name "=\"" param-value "\""))
(defun dojo-core-save-get-defvar-param-string (param-name param-value)
(concat " " param-name "=\"" (format "%s" param-value) "\""))
(defun dojo-core-save-get-number-param-string (param-name param-value)
(concat " " param-name "=\"" (if (not (null param-value)) (number-to-string param-value) "") "\""))
(defun dojo-core-save-get-number-param-string-to-3-decimal-places (param-name param-value)
(if (null param-value)
(dojo-core-save-get-number-param-string param-name nil)
(let* ((number-multiplied (* param-value 1000))
(number-multiplied-rounded (fround number-multiplied))
(number-rounded (/ number-multiplied-rounded 1000)))
(dojo-core-save-get-number-param-string param-name number-rounded))))
(defun dojo-core-save-get-bool-param-string (param-name param-value)
(concat " " param-name "=\"" (if param-value "true" "false") "\""))
(defun dojo-core-save-write-string-list (string-list list-name item-name)
(insert (concat "<" list-name ">"))
(newline)
(dolist (s string-list)
(insert (concat "<" item-name ">" s "" item-name ">"))
(newline))
(insert (concat "" list-name ">"))
(newline))
(defun dojo-core-save-write-annotations (annotations)
(insert "")
(newline)
(dolist (annotation annotations)
(let* ((key (dojo-annotation-key annotation))
(value (dojo-annotation-value annotation))
(min-pos (dojo-annotation-min-pos annotation))
(max-pos (dojo-annotation-max-pos annotation)))
(insert "")))
(insert ""))
(defun dojo-core-save-write-symbol-map (name-to-symbol list-tag item-tag id-attribute-name name-attribute-name)
(insert (concat "<" list-tag ">"))
(newline)
(dolist (name (hash-table-get-all-keys name-to-symbol))
(let ((symbol (gethash name name-to-symbol)))
(cond ((null symbol)
(log-save (format "[WARNING] Item [%s] in symbol map has no value." name)))
((not (dojo-symbol-p symbol))
(log-save (format "[WARNING] Item [%s] in symbol map is no symbol" name)))
(t
(insert (concat "<" item-tag " " name-attribute-name "=\"" name "\" " id-attribute-name "=\"" (number-to-string (dojo-symbol-id symbol)) "\"/>"))
(newline)))))
(insert (concat "" list-tag ">")))
(defun dojo-core-save-write-symbol-or-type-for-attribute (attribute-name symbol)
(cond ((null symbol)
())
((dojo-symbol-p symbol)
(insert (dojo-core-save-get-number-param-string attribute-name (dojo-symbol-id symbol))))
(t
(insert (dojo-core-save-get-defvar-param-string attribute-name symbol)))))
(defun dojo-core-save-register-class-for-save (workspace class)
(let ((class-id (dojo-class-id class))
(path (dojo-class-path class)))
(log-save (format "Registering class [%s] with path [%s] for save." class-id path))
(puthash class-id (float-time) (dojo-workspace-class-ids-to-save workspace))))
(defun dojo-core-save-drop-class-for-save (workspace class)
(let ((class-id (dojo-class-id class))
(path (dojo-class-path class)))
(log-save (format "Dropping class [%s] with path [%s] from class-ids-to-save map." class-id path))
(remhash class-id (dojo-workspace-class-ids-to-save workspace))))
(defun dojo-core-save-register-css-file-for-save (workspace css-file)
(let ((css-file-id (dojo-css-file-id css-file))
(path (dojo-css-file-path css-file)))
(log-save (format "Registering css-file [%s] with path [%s] for save." css-file-id path))
(puthash css-file-id (float-time) (dojo-workspace-class-ids-to-save workspace))))
(defun dojo-core-save-drop-css-file-for-save (workspace css-file)
(let ((css-file-id (dojo-css-file-id css-file))
(path (dojo-css-file-path css-file)))
(log-save (format "Dropping css-file [%s] with path [%s] from class-ids-to-save map." css-file-id path))
(remhash css-file-id (dojo-workspace-class-ids-to-save workspace))))
(defun dojo-core-save-save-touched-classes (workspace &optional no-interruption)
(let* ((class-ids-to-save (dojo-workspace-class-ids-to-save workspace))
(class-ids (hash-table-get-all-keys class-ids-to-save))
(id-to-class (dojo-workspace-id-to-class workspace))
(interrupted nil))
(dolist (class-id class-ids)
; Save class
(let ((class (gethash class-id id-to-class)))
(cond ((and (dojo-class-p class) (dojo-class-project class) (dojo-class-path class))
(log-save (format "Saving class [%s] with path [%s]..." (dojo-class-id class) (dojo-class-path class)))
(dojo-core-save-write-class class)
(log-save "... done."))
((and (dojo-css-file-p class) (dojo-css-file-project class) (dojo-css-file-path class))
(log-save (format "Saving css-file [%s:%s:%s]..." (dojo-css-file-id class) (dojo-css-file-project class)
(dojo-css-file-path class)))
(dojo-core-save-write-css-file class)
(log-save "... done."))
(t
(log-save (format "[WARNING] Unrecognized case when saving class. Unsupported type, or missing project/path.")))))
; Unregister class as we have just saved it.
(remhash class-id class-ids-to-save)
; Stop if the time interval we have for background work is exhausted.
(if (and (not no-interruption) (dojo-core-workspace-check-for-input))
(progn
(setq interrupted t)
(return nil))))
; If we finished without interruption, record that we are finished.
(if (not interrupted)
(progn
(setf (dojo-workspace-last-save-classes-utcseconds workspace) (float-time))
(setf (dojo-workspace-save-classes-pending workspace) nil)))
; Propagate information, wether the calling code may continue its work,
; or should interrupt for now.
interrupted))
(provide 'dojo-core-save)