(require 'dojo-common-containers) (defun dojo-workspace-stop-processing-p (&optional manual) "Returns wether we should stop processing the workspace as quick as possible, because either the user entered input, or the time is exhausted." (and (not manual) (or (input-pending-p) (and (not (null dojo-process-workspace-start-time)) (> (- (float-time) dojo-process-workspace-start-time) dojo-max-process-workspace-time)))) ) (defun dojo-core-util-get-resource-by-path (workspace path) (let* ((path-to-resources (dojo-workspace-path-to-resources workspace)) (resources (gethash path path-to-resources))) (if (> (length resources) 1) (log-workspace (format "[WARNING] Found [%s] resources for path [%s]" (length resources) path))) (nth 0 resources))) (defun dojo-core-util-get-project-by-path (path) (let* ((resource (dojo-core-util-get-resource-by-path dojo-current-workspace path))) (if resource (dojo-resource-project resource) nil))) (defun dojo-core-util-get-project-by-resource (resource) (let* ((project-name (dojo-resource-project resource)) (name-to-project (dojo-workspace-name-to-project dojo-current-workspace)) (project (gethash project-name name-to-project))) project)) (defun dojo-core-util-get-project-main-css-resource-id (resource) (let* ((project (dojo-core-util-get-project-by-resource resource)) (css-resources (if project (dojo-project-css-resources project) nil)) (main-resource-id (if css-resources (gethash DOJO-PROJECT-CSS-MAIN css-resources) nil))) main-resource-id)) (defun dojo-core-util-get-class-id-for-current-scan (workspace) (let* ((curr-scan-id (dojo-workspace-curr-scan-id workspace)) (scan (if (not (null curr-scan-id)) (gethash curr-scan-id (dojo-workspace-id-to-scan workspace)) nil)) (class-id (if scan (dojo-scan-class-id scan) nil))) class-id)) (defun dojo-core-util-get-current-resource () (let* ((project-and-path (dojo-get-project-and-path buffer-file-name)) (project (nth 0 project-and-path)) (path (nth 1 project-and-path)) (type (nth 2 project-and-path))) ; If we seem to deal with js code, create resource if necessary (usually ; this should not be the case thanks to our previous workspace scan), ; and fetch it. (log-workspace-details (format "get-current-resource finds project [%s], path [%s], type [%s]" project path type)) (if (or (string= type "js") (string= type "blueprint") (string= type "css")) (dojo-workspace-get-or-create-resource dojo-current-workspace project path type buffer-file-name) (log-workspace (format "[WARNING] dojo-core-util-get-current-resource doesn´t return a resource for type [%s]; buffer-file-name is [%s], project is [%s], path is [%s]" type buffer-file-name project path)) nil))) (defun dojo-core-util-get-class-name (class) (if (null class) nil (let* ((path (dojo-class-path class)) (last-dot-pos (last-index-of path "/")) (name (if (null last-dot-pos) path (substring path (1+ last-dot-pos))))) name))) (defun dojo-core-util-get-or-load-class (workspace resource-or-id) (log-load (format "Called dojo-core-util-get-or-load-class for resource-or-id [%s]" (cond ((null resource-or-id) "---") ((numberp resource-or-id) resource-or-id) (t (dojo-resource-id resource-or-id))))) (let ((resource (if (and (not (null resource-or-id)) (numberp resource-or-id)) (gethash resource-or-id (dojo-workspace-id-to-resource workspace)) resource-or-id))) (cond ((null resource) (log-load (format "... resource is nil")) nil) ((and (dojo-core-workspace-is-any-js-resource resource) (string= (dojo-resource-state resource) "parsed")) (log-load (format "... found parsed js resource")) (let* ((local-class-id (dojo-resource-parsed-id resource)) (id-to-class (dojo-workspace-id-to-class workspace)) (local-class (if (null local-class-id) nil (gethash local-class-id id-to-class)))) (if (null local-class) (progn (log-load (format "... local-class is [%s], will load the corresponding class" local-class)) (setq local-class (dojo-core-load-load-class workspace resource)))) (if local-class (if (dojo-class-p local-class) (progn (log-load (format "... Returning local-class [%s]" (dojo-class-id local-class))) local-class) (log-load (format "[WARNING] Loaded class [%s] for resource [%s] is no dojo-class." class (dojo-resource-id resource))) nil) (log-load (format "[WARNING] Class for resource [%s] is no longer present. Will update the resource back to the 'located' state." (dojo-resource-id resource))) (setf (dojo-resource-state resource) "located") (dojo-core-util-register-resource-project-for-save workspace resource) nil))) ((and (dojo-core-workspace-is-css-resource resource) (string= (dojo-resource-state resource) "parsed")) (log-load (format (concat "[WARNING] Parsed CSS resources are not saved in workspace for now. " "Thus, resource [%s:%s:%s] will not be loaded." (if resource (dojo-resource-id resource) "---") (if resource (dojo-resource-project resource) "---") (if resource (dojo-resource-path resource) "---"))))) (t (log-load (format "... none of the cases matched; type is [%s], state is [%s]" (dojo-resource-type resource) (dojo-resource-state resource))) nil)))) (defun dojo-core-util-get-annotation-by-key (class key) (let* ((annotations (dojo-class-annotations class)) (found-annotation nil)) (dolist (annotation annotations) (if (string= (dojo-annotation-key annotation) key) (setq found-annotation annotation))) found-annotation)) (defun dojo-core-util-get-smallest-bigger-annotation-by-value (annotations value) "Assuming a list of annotations, sorted in ascending order by min-pos, this function returns the annotation with the given value, if one exists, regardless of its position in file. Otherwise, if none exists, the smallest annotation with a bigger value (in terms of string<) will be returned." (log-i18n (format "Searching smallest-bigger-annotation with value [%s]" value)) (let* ((annotations (dojo-class-annotations class)) (found-annotation nil)) (dolist (annotation annotations) (if (string= (dojo-annotation-value annotation) value) (setq found-annotation annotation))) (if found-annotation found-annotation (log-i18n (format "... did not find exact annotation match.")) (let* ((annotations-sorted-by-value (sort annotations (lambda (annotation-one annotation-two) (string< (dojo-annotation-value annotation-two) (dojo-annotation-value annotation-one)))))) (dolist (annotation annotations-sorted-by-value) (log-i18n (format "... Checking annotation [%s]" (dojo-annotation-value annotation))) (setq found-annotation annotation) (if (not (string< (dojo-annotation-value annotation) value)) (return nil))) (if (string< (dojo-annotation-value found-annotation) value) (progn (log-i18n (format "... Found annotation is smaller than value, probably there is no bigger one, returning nil.")) (setq found-annotation nil)))) found-annotation))) (defun dojo-core-util-get-class-by-import-symbol (workspace import-symbol) (let* ((resource-id (dojo-symbol-get-import-resource-id import-symbol)) (id-to-resource (dojo-workspace-id-to-resource workspace)) (resource (if resource-id (gethash resource-id id-to-resource) nil)) (class nil)) (log-assign 0 (format "Found resource-id [%s] for resource [%s] (state %s) for import-symbol %s" resource-id (if (dojo-resource-p resource) (dojo-resource-path resource) "nil") (if (dojo-resource-p resource) (dojo-resource-state resource) "nil") (dojo-core-util-symbol-to-short-string import-symbol))) (cond ((null resource) nil) ((string= (dojo-resource-state resource) "parsed") (setq class (dojo-core-util-get-or-load-class workspace resource)) (log-assign 0 (format "After loading class: Class is [%s]" (if (dojo-class-p class) (dojo-class-id class) "nil"))) (if class (progn (if (dojo-class-p class) class (log-completion 0 (format "[WARNING] Loaded class [%s] for resource [%s] is no dojo-class." (dojo-class-id class) (dojo-resource-id resource))) nil)) (log-completion 0 (format "[WARNING] Class for resource [%s] is no longer present. Will update the resource back to the 'located' state." (dojo-resource-id resource))) (setf (dojo-resource-state resource) "located") (dojo-core-util-register-resource-project-for-save workspace resource) nil)) (t nil)))) (defun dojo-core-util-get-this-by-import-symbol (workspace import-symbol) (let* ((class (dojo-core-util-get-class-by-import-symbol workspace import-symbol)) (this-symbol (if class (dojo-class-this-symbol class) nil))) this-symbol)) (defun dojo-core-util-get-member-by-import-symbol (workspace import-symbol member-name) (let* ((class (dojo-core-util-get-class-by-import-symbol workspace import-symbol)) (this-symbol (if class (dojo-class-this-symbol class) nil))) (if (and this-symbol (dojo-core-util-is-object-symbol this-symbol)) (dojo-symbol-get-object-member member-name this-symbol) nil))) (defun dojo-core-util-get-own-main-i18n-symbol () (let* ((class (dojo-core-workspace-get-current-class)) (import-to-symbol (if class (dojo-class-import-to-symbol class) nil)) (current-project (if class (dojo-class-project class) nil)) (i18n-symbol nil)) (cond ((null class) (message "Could not find current class.")) (current-project (maphash (lambda (name symbol) (if (and (null i18n-symbol) symbol (dojo-core-util-is-import-symbol symbol) (eq (dojo-symbol-get-import-type symbol) 'DOJO-IMPORT-I18N) (string= (dojo-core-util-get-project-by-path (dojo-symbol-get-import-path symbol)) current-project)) (setq i18n-symbol symbol))) import-to-symbol))) i18n-symbol)) (defun dojo-core-util-jump-to-resource-file (workspace resource-id) "Opens the file corresponding to the given resource-id, if such a resource could be found. Returns t if this was possible, nil otherwise." (let* ((id-to-resource (dojo-workspace-id-to-resource workspace)) (resource (gethash resource-id id-to-resource)) (file-path (if resource (dojo-resource-file-path resource) nil))) (if file-path (progn (find-file file-path) t) nil))) (defun dojo-core-util-get-import-static-symbol (workspace import-symbol) (let* ((class (dojo-core-util-get-class-by-import-symbol workspace import-symbol)) (static-symbol (if class (dojo-class-static-symbol class) nil))) static-symbol)) (defun dojo-core-util-step-to-function (object-or-function-symbol) (cond ((dojo-core-util-is-object-symbol object-or-function-symbol) (dojo-symbol-get-object-function-symbol object-or-function-symbol)) (t object-or-function-symbol))) (defun dojo-core-util-resource-to-string (resource) (cond ((null resource) "[nil]") ((numberp resource) (format "[%s]" (number-to-string resource))) (t (let* ((id (dojo-resource-id resource)) (state (dojo-resource-state resource)) (type (dojo-resource-type resource)) (parsed-id (dojo-resource-parsed-id resource)) (project (dojo-resource-project resource)) (path (dojo-resource-path resource))) (format "[%s %s:%s %s:%s --> %s]" id project path type state parsed-id))))) (defun dojo-core-util-write-class-to-log (path) (interactive (let* ((curr-word (thing-at-point 'sexp))) (list (read-string "Path (in Dojo sense): " nil nil (if curr-word (substring-no-properties curr-word) nil))))) ; Remove " from start and end of string ((thing-at-point 'sexp) returns a path including that character) (log-assign 0 (format "Received path [%s]" path)) (if (or (null path) (string= (dojo-common-strings-trim path) "")) (let ((project-and-path (dojo-get-project-and-path buffer-file-name))) (setq path (nth 1 project-and-path)))) (log-assign 0 (format "Corrected path to [%s]" path)) (if (starts-with path "\"") (setq path (substring path 1 (length path)))) (if (string/ends-with path "\"") (setq path (substring path 0 (1- (length path))))) (let* ((path-to-resources (dojo-workspace-path-to-resources dojo-current-workspace)) (id-to-class (dojo-workspace-id-to-class dojo-current-workspace)) (resources (gethash path path-to-resources)) (level 0)) (if (null resources) (log-assign 0 (format "Found no resources for path [%s]; size of path-to-resources is [%s]" path (hash-table-count path-to-resources)))) (dolist (resource resources) (let* ((class-id (if resource (dojo-resource-parsed-id resource) nil)) (class (if (null class-id) nil (gethash class-id id-to-class))) (id (if class (dojo-class-id class) nil)) (class-project (if class (dojo-class-project class) nil)) (class-path (if class (dojo-class-path class) nil)) (superclass-paths (if class (dojo-class-superclass-paths class) nil)) (this-symbol (if class (dojo-class-this-symbol class) nil)) (static-symbol (if class (dojo-class-static-symbol class) nil)) ) (if (null class) (log-assign 0 (format "Found no class for path [%s]" path)) (log-assign level "================================================================================") (log-assign level (format "========== Information about class at path [%s] ==========" class-path)) (log-assign level (format "Id = [%s], Project = [%s], Path = [%s]" id class-project class-path)) (log-assign level (format "Superclasses = [%s]" superclass-paths)) (if (null this-symbol) (log-assign level (format "No this-symbol")) (log-assign level (format "== This-symbol ==")) (dojo-js-assign-log-symbol-long (1+ level) this-symbol)) ; (dojo-core-util-write-symbol-to-log (1+ level) this-symbol)) (if (null static-symbol) (log-assign level (format "No static-symbol")) (log-assign level (format "== Static-symbol ==")) (dojo-js-assign-log-symbol-long (1+ level) static-symbol))))))) ; (dojo-core-util-write-symbol-to-log (1+ level) static-symbol))))))) (defun dojo-core-util-symbol-type-to-string (symbol) (dojo-core-util-type-to-string (dojo-symbol-type symbol))) (defun dojo-core-util-type-to-string (type) (cond ((null type) "nil") ((eq type 'DOJO-JSTYPE-ARRAY) "array") ((eq type 'DOJO-JSTYPE-ARRAY-OR-OBJECT) "array-or-object") ((eq type 'DOJO-JSTYPE-BOOLEAN) "boolean") ((eq type 'DOJO-JSTYPE-DOMNODE) "domNode") ((eq type 'DOJO-JSTYPE-DOUBLE) "double") ((eq type 'DOJO-JSTYPE-EXCEPTION) "exception") ((eq type 'DOJO-JSTYPE-FLOAT) "float") ((eq type 'DOJO-JSTYPE-FUNCTION) "function") ((eq type 'DOJO-JSTYPE-IMAGE) "image") ((eq type 'DOJO-JSTYPE-IMPORT) "import") ((eq type 'DOJO-JSTYPE-INSTANCE) "instance") ((eq type 'DOJO-JSTYPE-INTEGER) "int") ((eq type 'DOJO-JSTYPE-LONG) "long") ((eq type 'DOJO-JSTYPE-NUMBER) "number") ((eq type 'DOJO-JSTYPE-OBJECT) "object") ((eq type 'DOJO-JSTYPE-REF) "reference") ((eq type 'DOJO-JSTYPE-REGEXP) "regexp") ((eq type 'DOJO-JSTYPE-STRING) "string") (t (format "" type)))) (defun dojo-core-util-write-symbol-to-log (level symbol) (if (null symbol) (log-assign level "nil") (let* ((id (dojo-symbol-id symbol)) (name (dojo-symbol-name symbol)) (type (dojo-symbol-type symbol)) (type-string (dojo-core-util-symbol-type-to-string symbol)) (parent-id (dojo-symbol-parent-id symbol))) (log-assign level (format "Symbol [%s %s %s]" id type name)) (cond ((eq type 'DOJO-JSTYPE-FUNCTION) (log-assign (1+ level) (format "Arguments:")) (let ((arguments (dojo-symbol-get-function-arguments symbol))) (dolist (argument arguments) (dojo-core-util-write-symbol-to-log (+ level 2) argument))) (log-assign (1+ level) "Return type:") (let ((return-type (dojo-symbol-get-function-return-type symbol))) (dojo-core-util-write-symbol-to-log (+ level 2) return-type))) ((eq type 'DOJO-JSTYPE-OBJECT) (log-assign (1+ level) "Members") (let ((member-to-symbol (dojo-symbol-get-object-members symbol))) (if (null member-to-symbol) (log-assign (+ level 2) "none") ; TODO: Decide wether we actually need a dojo-object struct (in contrast to just placing the hashtable into the value attribute) (let ((member-names (hash-table-get-all-keys member-to-symbol))) (dolist (member-name member-names) (let ((member (gethash member-name member-to-symbol))) (dojo-core-util-write-symbol-to-log (+ level 2) member))))))) ((eq type 'DOJO-JSTYPE-REF) (let ((type (dojo-symbol-get-ref-type symbol)) (symbols (dojo-symbol-get-ref-symbols)) (symbol-string "")) (cond ((eq type 'DOJO-REFTYPE-OBJECT-MEMBER) (dolist (symbol symbols) (setq symbol-string (concat symbol-string " [" (if (stringp symbol) symbol (dojo-core-util-symbol-to-short-string symbol)) "]"))) (log-assign (1+ level) (format "Object / members: %s" symbol-string))) ((eq type 'DOJO-REFTYPE-ANY-OBJECT-MEMBER) (log-assign (1+ level) (format "Object %s, Any Member." (dojo-core-util-symbol-to-short-string (nth 0 symbols))))) (t (log-assign (1+ level) (format "[WARNING] Unknown DOJO-REFTYPE: [%s]" type)))))))))) (defun dojo-core-util-symbol-to-short-string (symbol &optional max-depth) (if (null max-depth) (setq max-depth 5)) (cond ((< max-depth 0) "max-depth-reached") ((null symbol) "nil") ((numberp symbol) (number-to-string symbol)) (t (let* ((id (if (dojo-symbol-p symbol) (dojo-symbol-id symbol) nil)) (class-id (if (dojo-symbol-p symbol) (dojo-symbol-class-id symbol) nil)) (is-api-symbol (if (dojo-symbol-p symbol) (dojo-symbol-is-api-symbol symbol) nil)) (is-api-symbol-string (if is-api-symbol "API " "")) (name (if (dojo-symbol-p symbol) (dojo-symbol-name symbol) nil)) (raw-type (if (dojo-symbol-p symbol) (dojo-symbol-type symbol) nil)) (type (if (dojo-symbol-p symbol) (dojo-core-util-symbol-type-to-string symbol) symbol)) (parent-id (if (dojo-symbol-p symbol) (dojo-symbol-parent-id symbol) nil)) (min-pos (if (dojo-symbol-p symbol) (dojo-symbol-min-pos symbol) nil)) (max-pos (if (dojo-symbol-p symbol) (dojo-symbol-max-pos symbol) nil))) (cond ((eq raw-type 'DOJO-JSTYPE-ARRAY) (let ((value-type (dojo-symbol-get-array-value-type symbol))) (format "[%s/%s %s%s %s; value-type [%s]]" class-id id is-api-symbol-string type name (dojo-core-util-symbol-to-short-string value-type (1- max-depth))))) ((eq raw-type 'DOJO-JSTYPE-FUNCTION) (let* ((arguments (dojo-symbol-get-function-arguments symbol)) (argument-string (dojo-core-util-concat-arg-ids arguments))) (format "[%s/%s %s%s %s (%s-%s), parent [%s], arguments [%s], ret-symbol %s]" class-id id is-api-symbol-string type name min-pos max-pos parent-id argument-string (dojo-core-util-symbol-to-short-string (dojo-symbol-get-function-return-type symbol) (1- max-depth))))) ((or (eq raw-type 'DOJO-JSTYPE-IMPORT) (eq raw-type 'DOJO-JSTYPE-INSTANCE)) (let ((resource-id (dojo-symbol-get-import-resource-id symbol)) (path (dojo-symbol-get-import-path symbol)) (import-type (dojo-symbol-get-import-type symbol))) (format "[%s/%s %s%s %s, Resource [%s], Type [%s], Path [%s]]" class-id id is-api-symbol-string type name resource-id import-type path))) ((or (eq raw-type 'DOJO-JSTYPE-ARRAY-OR-OBJECT) (eq raw-type 'DOJO-JSTYPE-OBJECT)) (let* ((key-type (dojo-symbol-get-object-key-type symbol)) (value-type (dojo-symbol-get-object-value-type symbol)) (name-to-symbol (dojo-symbol-get-object-members symbol)) (fct-symbol (dojo-symbol-get-object-function-symbol symbol)) (object-type (dojo-symbol-get-object-object-type symbol)) (object-info (dojo-symbol-get-object-object-info symbol)) (member-string "") (type-string (cond ((null object-type) "") ((eq object-type 'DOJO-OBJECTTYPE-SERVICE) (format ", SVC-%s" object-info)) ((eq object-type 'DOJO-OBJECTTYPE-STATIC) ", STATIC") ((eq object-type 'DOJO-OBJECTTYPE-THIS) ", THIS"))) (first t)) (catch 'stop-maphash (let* ((member-count 0)) (maphash (lambda (name symbol) (setq member-string (concat member-string (if first "" ", ") (format "%s %s" (if symbol (dojo-symbol-id symbol) "---") name))) (if (>= member-count 10) (progn (setq member-string (concat member-string (format ", [%s] more" (- (hash-table-count name-to-symbol) member-count)))) (throw 'stop-maphash nil))) (incf member-count) (setq first nil)) name-to-symbol))) (format "[%s/%s %s%s %s (%s-%s), key-type [%s], value-type [%s], fct-symbol [%s], members [%s]%s]" class-id id is-api-symbol-string type name min-pos max-pos (dojo-core-util-symbol-to-short-string key-type (1- max-depth)) (dojo-core-util-symbol-to-short-string value-type (1- max-depth)) (dojo-core-util-symbol-to-short-string fct-symbol (1- max-depth )) member-string type-string))) ((eq raw-type 'DOJO-JSTYPE-REF) (let ((ref-type (dojo-symbol-get-ref-type symbol)) (symbols (dojo-symbol-get-ref-symbols symbol)) (symbol-string "")) (cond ((eq ref-type 'DOJO-REFTYPE-OBJECT-MEMBER) (dolist (symbol symbols) (setq symbol-string (concat symbol-string " [" (if (stringp symbol) symbol (dojo-core-util-symbol-to-short-string symbol (1- max-depth))) "]"))) (format "[%s/%s %s%s %s, Object / members %s]" class-id id is-api-symbol-string type name symbol-string)) ((eq ref-type 'DOJO-REFTYPE-ANY-OBJECT-MEMBER) (format "[%s/%s %s%s %s, Any Object member %s]" class-id id is-api-symbol-string type name (dojo-core-util-symbol-to-short-string (nth 0 symbols) (1- max-depth)))) ((null ref-type) (format "[%s/%s %s%s %s, nil]" class-id id is-api-symbol-string type name)) (t (format "[%s/%s %s%s %s, Unknown type.]" class-id id is-api-symbol-string type name))))) (t (format "[%s/%s %s%s %s]" class-id id is-api-symbol-string type name))))))) (defun dojo-core-util-concat-arg-ids (argument-symbols) (let ((first t) (argument-string "")) (dolist (argument-symbol argument-symbols) (setq argument-string (concat argument-string (if (not first) ", " "") (if (numberp argument-symbol) (number-to-string argument-symbol) (number-to-string (dojo-symbol-id argument-symbol))))) (setq first nil)) argument-string)) (defun dojo-core-util-scopes-to-string (scopes) (let* ((scopes-string "")) (dolist (scope scopes) (let* ((scope-name-to-symbol (dojo-scope-name-to-symbol scope)) (first t)) (setq scopes-string (concat scopes-string "(")) (maphash (lambda (name symbol) (cond ((null symbol) (setq scopes-string (concat scopes-string (if first "" " ") "---"))) ((dojo-symbol-p symbol) (setq scopes-string (concat scopes-string (if first "" " ") (format "[%s %s]" (dojo-symbol-id symbol) name)))) ((dojo-scope-p symbol) (setq scopes-string (concat scopes-string (if first "" " ") (format "[%s --> scope %s]" name (dojo-core-util-scopes-to-string (list symbol)))))) (t (setq scopes-string (concat scopes-string (if first "" " ") (format "[%s --> unknown]" name))))) (setq first nil)) scope-name-to-symbol) (setq scopes-string (concat scopes-string ")")))) scopes-string)) (defun dojo-core-util-is-array-symbol (symbol) (eq (dojo-symbol-type symbol) 'DOJO-JSTYPE-ARRAY)) (defun dojo-core-util-is-array-or-object-symbol (symbol) (eq (dojo-symbol-type symbol) 'DOJO-JSTYPE-ARRAY-OR-OBJECT)) (defun dojo-core-util-is-boolean-symbol (symbol) (eq (dojo-symbol-type symbol) 'DOJO-JSTYPE-BOOLEAN)) (defun dojo-core-util-is-domNode-symbol (symbol) (eq (dojo-symbol-type symbol) 'DOJO-JSTYPE-DOMNODE)) (defun dojo-core-util-is-exception-symbol (symbol) (eq (dojo-symbol-type symbol) 'DOJO-JSTYPE-EXCEPTION)) (defun dojo-core-util-is-function-symbol (symbol) (eq (dojo-symbol-type symbol) 'DOJO-JSTYPE-FUNCTION)) (defun dojo-core-util-is-image-symbol (symbol) (eq (dojo-symbol-type symbol) 'DOJO-JSTYPE-IMAGE)) (defun dojo-core-util-is-import-symbol (symbol) (eq (dojo-symbol-type symbol) 'DOJO-JSTYPE-IMPORT)) (defun dojo-core-util-is-instance-symbol (symbol) (eq (dojo-symbol-type symbol) 'DOJO-JSTYPE-INSTANCE)) (defun dojo-core-util-is-number-symbol (symbol) (eq (dojo-symbol-type symbol) 'DOJO-JSTYPE-NUMBER)) (defun dojo-core-util-is-object-symbol (symbol) (eq (dojo-symbol-type symbol) 'DOJO-JSTYPE-OBJECT)) (defun dojo-core-util-is-ref-symbol (symbol) (eq (dojo-symbol-type symbol) 'DOJO-JSTYPE-REF)) (defun dojo-core-util-is-regexp-symbol (symbol) (eq (dojo-symbol-type symbol) 'DOJO-JSTYPE-REGEXP)) (defun dojo-core-util-is-string-symbol (symbol) (eq (dojo-symbol-type symbol) 'DOJO-JSTYPE-STRING)) (defun dojo-core-util-is-async-function (symbol) ; (log-completion 0 (format "is-asyn-function: %s" (dojo-core-util-symbol-to-short-string symbol))) (and symbol (dojo-core-util-is-function-symbol symbol) (dojo-core-util-is-service-this-symbol (dojo-symbol-get-parent dojo-current-workspace symbol)))) (defun dojo-core-util-is-service-this-symbol (symbol) ; (log-completion 0 (format "is-service-this-function: %s" (dojo-core-util-symbol-to-short-string symbol))) (and symbol (dojo-core-util-is-object-symbol symbol) (eq (dojo-symbol-get-object-object-type symbol) 'DOJO-OBJECTTYPE-THIS) (dojo-core-util-is-java-class (let* ((parent-id (dojo-symbol-parent-id symbol)) (is-api-symbol (dojo-symbol-is-api-symbol symbol)) (class (dojo-core-util-get-class is-api-symbol parent-id))) class)))) (defun dojo-core-util-get-class (is-api class-id) ; (log-completion 0 (format "get-class: is-api [%s], class-id [%s]" is-api class-id)) (let* ((id-to-class (if is-api (dojo-workspace-id-to-api-class dojo-current-workspace) (dojo-workspace-id-to-class dojo-current-workspace))) (class (gethash class-id id-to-class))) class)) (defun dojo-core-util-is-java-class (class) ; (log-completion 0 (format "is-java-class: [%s]" (if class (dojo-class-id class) "---"))) (and class (let* ((resource-id (dojo-class-resource-id class)) (id-to-resource (dojo-workspace-id-to-resource dojo-current-workspace)) (resource (if (null resource-id) nil (gethash resource-id id-to-resource))) (resource-type (if resource (dojo-resource-type resource) nil))) ; (log-completion 0 (format "resource-type [%s]" resource-type)) (string= resource-type "java")))) (defun dojo-core-util-clone-symbol (symbol) (let* ((name (dojo-symbol-name symbol)) (parent-id (dojo-symbol-parent-id symbol)) (scan-id (dojo-symbol-scan-id symbol)) (class-id (dojo-symbol-class-id symbol)) (min-pos (dojo-symbol-min-pos symbol)) (max-pos (dojo-symbol-max-pos symbol)) (cloned-symbol (construct-dojo-symbol dojo-current-workspace class-id name))) (setf (dojo-symbol-parent-id cloned-symbol) parent-id) (setf (dojo-symbol-scan-id cloned-symbol) scan-id) (setf (dojo-symbol-min-pos cloned-symbol) min-pos) (setf (dojo-symbol-max-pos cloned-symbol) max-pos) (dojo-core-util-copy-additional-attributes symbol cloned-symbol t) cloned-symbol)) (defun dojo-core-util-copy-additional-attributes (source-symbol dest-symbol &optional set-type) (let ((type (dojo-symbol-type source-symbol))) (if set-type (dojo-symbol-set-type dest-symbol type)) (cond ((eq type 'DOJO-JSTYPE-ARRAY) (setf (dojo-array-value-type (dojo-symbol-details dest-symbol)) (dojo-array-value-type (dojo-symbol-details source-symbol)))) ((or (eq type 'DOJO-JSTYPE-ARRAY-OR-OBJECT) (eq type 'DOJO-JSTYPE-OBJECT)) (setf (dojo-object-key-type (dojo-symbol-details dest-symbol)) (dojo-object-key-type (dojo-symbol-details source-symbol))) (setf (dojo-object-value-type (dojo-symbol-details dest-symbol)) (dojo-object-value-type (dojo-symbol-details source-symbol))) (setf (dojo-object-function-symbol (dojo-symbol-details dest-symbol)) (dojo-object-function-symbol (dojo-symbol-details source-symbol))) (setf (dojo-object-object-type (dojo-symbol-details dest-symbol)) (dojo-object-object-type (dojo-symbol-details source-symbol))) (setf (dojo-object-object-info (dojo-symbol-details dest-symbol)) (dojo-object-object-info (dojo-symbol-details source-symbol))) (setf (dojo-object-name-to-symbol (dojo-symbol-details dest-symbol)) (dojo-object-name-to-symbol (dojo-symbol-details source-symbol)))) ((eq type 'DOJO-JSTYPE-FUNCTION) (setf (dojo-function-arguments (dojo-symbol-details dest-symbol)) (dojo-function-arguments (dojo-symbol-details source-symbol))) (setf (dojo-function-return-type (dojo-symbol-details dest-symbol)) (dojo-function-return-type (dojo-symbol-details source-symbol))) (setf (dojo-function-builtin-fct (dojo-symbol-details dest-symbol)) (dojo-function-builtin-fct (dojo-symbol-details source-symbol))) (setf (dojo-function-scope (dojo-symbol-details dest-symbol)) (dojo-function-scope (dojo-symbol-details source-symbol))) ; These two are defined on symbol level. However, in general, ; the position of a symbol should point to its definition ; (i.e. where the 'var foo' is in source code); thus we should ; avoid copying these properties when processing an assignment. ; However, for function symbols, copying makes sense, as such ; assignments most probably occur in the context of defining ; classes. (setf (dojo-symbol-min-pos dest-symbol) (dojo-symbol-min-pos source-symbol)) (setf (dojo-symbol-max-pos dest-symbol) (dojo-symbol-max-pos source-symbol))) ((or (eq type 'DOJO-JSTYPE-IMPORT) (eq type 'DOJO-JSTYPE-INSTANCE)) (setf (dojo-import-resource-id (dojo-symbol-details dest-symbol)) (dojo-import-resource-id (dojo-symbol-details source-symbol))) (setf (dojo-import-type (dojo-symbol-details dest-symbol)) (dojo-import-type (dojo-symbol-details source-symbol))) (setf (dojo-import-path (dojo-symbol-details dest-symbol)) (dojo-import-path (dojo-symbol-details source-symbol)))) ((eq type 'DOJO-JSTYPE-REF) (setf (dojo-ref-type (dojo-symbol-details dest-symbol)) (dojo-ref-type (dojo-symbol-details source-symbol))) (setf (dojo-ref-symbols (dojo-symbol-details dest-symbol)) (dojo-ref-symbols (dojo-symbol-details source-symbol)))) (t ())))) (defun dojo-core-util-fix-parent-references (class) (let* ((this-symbol (dojo-class-this-symbol class)) (static-symbol (dojo-class-static-symbol class)) (this-symbol-members (if this-symbol (dojo-symbol-get-object-members this-symbol) nil)) (static-symbol-members (if static-symbol (dojo-symbol-get-object-members static-symbol) nil))) (if this-symbol (setf (dojo-symbol-parent-id this-symbol) (dojo-class-id class))) (if static-symbol (setf (dojo-symbol-parent-id static-symbol) (dojo-class-id class))) (if this-symbol-members (maphash (lambda (name symbol) (setf (dojo-symbol-parent-id symbol) (dojo-symbol-id this-symbol))) this-symbol-members)) (if static-symbol-members (maphash (lambda (name symbol) (setf (dojo-symbol-parent-id symbol) (dojo-symbol-id static-symbol))) static-symbol-members)))) (defun dojo-core-util-symbol-or-type-to-type (symbol-or-type) "Given a dojo-symbol, or a dojo-symbol type, this function returns its type. The argument may be nil, then nil is returned." (cond ((null symbol-or-type) ; We received nil nil) ((dojo-symbol-p symbol-or-type) ; We received a dojo-symbol, and fetch its type (dojo-symbol-type symbol-or-type)) (t ; We assume that we received a type, and return it symbol-or-type))) (defun dojo-core-util-register-in-scope (scope var-name symbol) (log-extract (format "[REGISTER-IN-SCOPE] Registering symbol %s under var-name [%s] in scope" (dojo-core-util-symbol-to-short-string symbol) var-name)) (let ((name-to-symbol (dojo-scope-name-to-symbol scope))) (puthash var-name symbol name-to-symbol))) (defun dojo-core-util-get-symbol-from-scope (scope symbol-name) (if scope (let ((name-to-symbol (dojo-scope-name-to-symbol scope))) (gethash symbol-name name-to-symbol)) nil)) (defun dojo-core-util-get-symbol-from-scope-by-key (scope key) (if scope (let ((key-to-symbol (dojo-scope-key-to-symbol scope))) (gethash key key-to-symbol)) nil)) (defun dojo-core-util-get-this-symbol (scopes level base-symbol) "Given a base-symbol, this function returns the corresponding this-symbol. This means: - If the base-symbol is a dojo-function with name constructor, the this-symbol stored in the local function scope of the dojo-function is returned. This matches the case described in dojo-extract-class-process-define-body, case js2-return-node. - If the base-symbol is a dojo-symbol of type DOJO-JSTYPE-IMPORT, then the this-symbol of the corresponding dojo-class is returned. The sense of this function is finding the this-symbol in cases, where some dojo-symbol is derived from source code, which can match several of the above cases. Example: 'lang.extend(AdapterRegistry,', where the AdapterRegistry symbol might be derived from a declare call, or from a constructor function assignment to the symbol." (cond ((and (dojo-core-util-is-object-symbol base-symbol) (eq (dojo-symbol-get-object-object-type base-symbol) 'DOJO-OBJECTTYPE-THIS)) ; We already have the this-symbol, e.g. in a call 'lang.mixin(this, foo)' base-symbol) ((and (dojo-core-util-is-function-symbol base-symbol) (string= (dojo-symbol-name base-symbol) "constructor")) (let* ((base-symbol-scope (dojo-symbol-get-function-scope base-symbol)) (base-scope-name-to-symbol (dojo-scope-name-to-symbol base-symbol-scope)) (base-scope-this-symbol (gethash "this" base-scope-name-to-symbol))) base-scope-this-symbol)) (t (log-assign level (format "The call to dojo-core-util-get-this-symbol with base-symbol %s triggered a not yet supported case. PLEASE INSPECT." (dojo-core-util-symbol-to-short-string base-symbol)))))) (defun dojo-core-util-mixin-object-symbol (base-symbol additional-symbol) "Adds all members stored in additional-symbol to the base-symbol. Both symbols need to be of type DOJO-JSTYPE-OBJECT. Any symbol with the same name already present in base-symbol will be overwritten." (let* ((base-name-to-symbol (dojo-symbol-get-object-members base-symbol)) (additional-name-to-symbol (dojo-symbol-get-object-members additional-symbol))) (dolist (additional-name (hash-table-get-all-keys additional-name-to-symbol)) (puthash additional-name (gethash additional-name additional-name-to-symbol) base-name-to-symbol)))) (defun dojo-core-util-extract-class-contents (class id-to-symbol id-to-scope) "Extracts all dojo-symbols and dojo-scopes that (1) belong to the given class instance, and (2) are reachable from the given class instance via symbols / scopes belonging to that class A symbol belongs to a class if its class-id field indicates this. A scope belongs to a class if it is referenced from a symbol belonging to that class (e.g. a dojo-function has a dojo-scope). Adds all extracted symbols and scopes to the given maps." (let* ((class-id (dojo-class-id class)) (import-to-symbol (dojo-class-import-to-symbol class)) (this-symbol (dojo-class-this-symbol class)) (static-symbol (dojo-class-static-symbol class)) (define-symbol (dojo-class-define-symbol class))) (clrhash id-to-symbol) (clrhash id-to-scope) (maphash (lambda (import-name import-symbol) (dojo-core-util-extract-symbol-to-map class-id import-symbol id-to-symbol id-to-scope)) import-to-symbol) (dojo-core-util-extract-symbol-to-map class-id define-symbol id-to-symbol id-to-scope) (dojo-core-util-extract-symbol-to-map class-id this-symbol id-to-symbol id-to-scope) (dojo-core-util-extract-symbol-to-map class-id static-symbol id-to-symbol id-to-scope))) (defun dojo-core-util-extract-symbol-to-map (class-id symbol id-to-symbol id-to-scope &optional only-functions) "Extracts the given symbol, and all symbols reachable from that symbol (i.e. function arguments, object members, etc.) to the given id-to-symbol map. If id-to-scope is not null, function scopes and all symbols within them are included. If the optional flag only-functions is t, and the given symbol is a dojo-object, only members of kind dojo-function are considered. That flag is *not* propagated to recursive calls. Its sense is to only consider functions for the public API set up in module dojo-js-api." (if (dojo-symbol-p symbol) (let ((symbol-id (dojo-symbol-id symbol)) (symbol-class-id (dojo-symbol-class-id symbol)) (type (dojo-symbol-type symbol))) ; Make sure the symbol belongs to the given class-id, and that it ; wasn't processed yet. The second condition is important, as it ; makes sure that we don't accidentally start endless recursion here. (log-js-api (format "class-id [%s], symbol-class-id [%s], symbol-id [%s]" class-id symbol-class-id symbol-id)) (if (and (= class-id symbol-class-id) (not (gethash symbol-id id-to-symbol))) (progn (log-js-api (format "Adding %s to id-to-symbol, size before: [%s]" (dojo-core-util-symbol-to-short-string symbol) (length (hash-table-get-all-keys id-to-symbol)))) (puthash symbol-id symbol id-to-symbol) (cond ((eq type 'DOJO-JSTYPE-ARRAY) (let ((value-type (dojo-symbol-get-array-value-type symbol))) (dojo-core-util-extract-symbol-to-map class-id value-type id-to-symbol id-to-scope))) ((or (eq type 'DOJO-JSTYPE-ARRAY-OR-OBJECT) (eq type 'DOJO-JSTYPE-OBJECT)) (let ((key-type (dojo-symbol-get-array-or-object-key-type symbol)) (value-type (dojo-symbol-get-array-or-object-key-type symbol)) (function-symbol (dojo-symbol-get-object-function-symbol symbol)) (name-to-symbol (dojo-symbol-get-object-members symbol))) (dojo-core-util-extract-symbol-to-map class-id key-type id-to-symbol id-to-scope) (dojo-core-util-extract-symbol-to-map class-id value-type id-to-symbol id-to-scope) (dojo-core-util-extract-symbol-to-map class-id function-symbol id-to-symbol id-to-scope) (maphash (lambda (name object-member-symbol) (if (or (null only-functions) (dojo-core-util-is-function-symbol object-member-symbol)) (progn (log-js-api (format "Adding symbol %s to public API." (dojo-core-util-symbol-to-short-string object-member-symbol))) (dojo-core-util-extract-symbol-to-map class-id object-member-symbol id-to-symbol id-to-scope)))) name-to-symbol))) ((eq type 'DOJO-JSTYPE-FUNCTION) (let ((arguments (dojo-symbol-get-function-arguments symbol)) (return-type (dojo-symbol-get-function-return-type symbol)) (scope (dojo-symbol-get-function-scope symbol))) (dolist (argument arguments) (dojo-core-util-extract-symbol-to-map class-id argument id-to-symbol id-to-scope)) (dojo-core-util-extract-symbol-to-map class-id return-type id-to-symbol id-to-scope) (if id-to-scope (dojo-core-util-extract-scope-to-map class-id scope id-to-symbol id-to-scope)))) ((eq type 'DOJO-JSTYPE-REF) (let ((symbols (dojo-symbol-get-ref-symbols symbol))) (dolist (symbol symbols) (dojo-core-util-extract-symbol-to-map class-id symbol id-to-symbol id-to-scope)))) (t ()))))))) (defun dojo-core-util-extract-scope-to-map (class-id scope id-to-symbol id-to-scope) (if (dojo-scope-p scope) (let ((scope-id (dojo-scope-id scope)) (name-to-symbol (dojo-scope-name-to-symbol scope))) (if (not (gethash scope-id id-to-scope)) (progn (puthash scope-id scope id-to-scope) (maphash (lambda (name scope-symbol) (dojo-core-util-extract-symbol-to-map class-id scope-symbol id-to-symbol id-to-scope)) name-to-symbol)))))) (defun dojo-core-util-request-own-extraction (workspace) (let* ((own-resource (dojo-workspace-get-or-create-current-resource workspace)) (own-resource-id (if own-resource (dojo-resource-id own-resource) nil))) (if (null own-resource-id) (log-workspace (format "Not scheduling own resource for extraction, since it does not exist (e.g. buffer without file)")) (progn (if (dojo-core-util-own-buffer-modified-size-last-parse-p own-resource) (progn (dojo-core-util-request-extraction workspace own-resource-id 1) (log-workspace (format "[SCHEDULE-OWN-EXTRACTION] Scheduled own resource [%s] for extraction, since its size has changed since last extraction." own-resource-id))) (log-workspace (format "Not scheduling own resource [%s] for extraction, since its size is unchanged since last extraction." own-resource-id))))))) (defun dojo-core-util-register-resource-project-for-save (workspace resource) (let* ((resource-projects-to-save (dojo-workspace-resource-projects-to-save workspace)) (project (dojo-resource-project resource))) (if project (puthash project t resource-projects-to-save)))) (defun dojo-core-util-request-extraction-with-logging (workspace resource-id priority output-string) (let* ((id-to-resource (dojo-workspace-id-to-resource workspace)) (resource (gethash resource-id id-to-resource)) (id (if resource (dojo-resource-id resource) nil)) (project (if resource (dojo-resource-project resource) nil)) (path (if resource (dojo-resource-path resource) nil))) (cond ((null resource) (log-extract-prio (format "[WARNING] Will not extract resource [%s] as it does not exist." resource-id))) ((string= (dojo-resource-state resource) "parse-failed") (log-extract-prio (format "[WARNING] Will not extract resource [%s:%s:%s] as it is in state parse-failed." id project path))) ((not (dojo-core-util-resource-modified-since-last-parse-p resource)) (log-extract-prio (format "Will not extract resource [%s:%s:%s] as it wasn't modified since last parse." id project path))) (t (log-extract-prio (format output-string priority id project path)) (dojo-core-util-request-extraction workspace id priority 1))))) (defun dojo-core-util-request-extraction (workspace resource-id priority &optional count) (if (or (null dojo-js-extract-max-priority) (<= priority dojo-js-extract-max-priority)) (progn (let* ((resource (gethash resource-id (dojo-workspace-id-to-resource workspace)))) ; Automatically trigger extraction of the other languages, ; if extraction of the main i18n resource is triggered. ; CAUTION Don't merge with the let* below, as the maps ; used below (e.g. priority-to-count) are used ; CAUTION in the recursive call as well. Fetching them ; before the recursive call leads to modifying ; CAUTION an outdated copy below the recursive call. (if (dojo-core-workspace-is-js-main-i18n-resource resource) (let* ((project-name (dojo-resource-project resource)) (name-to-project (dojo-workspace-name-to-project dojo-current-workspace)) (project-struct (gethash project-name name-to-project)) (locale-to-i18n-resource (if project-struct (dojo-project-locale-to-i18n-resource project-struct) nil)) (id-to-resource (dojo-workspace-id-to-resource dojo-current-workspace))) (maphash (lambda (locale i18n-resource-id) (let* ((i18n-resource (gethash i18n-resource-id id-to-resource))) (if (dojo-core-workspace-is-js-other-i18n-resource i18n-resource) (dojo-core-util-request-extraction workspace i18n-resource-id priority count)))) locale-to-i18n-resource)))) (let* ((resource-to-priority-to-count (dojo-workspace-resource-to-priority-to-count workspace)) (priority-to-count (gethash resource-id resource-to-priority-to-count)) (priority-to-resource-to-count (dojo-workspace-priority-to-resource-to-count workspace)) (resource-to-count (gethash priority priority-to-resource-to-count)) (resource-projects-to-save (dojo-workspace-resource-projects-to-save workspace)) (resource (gethash resource-id (dojo-workspace-id-to-resource workspace))) (project (if (not count) (dojo-resource-project resource) nil))) ; Register project of resource for save, as parts of the maps above are saved in the resources.xml files. (if project (puthash project t resource-projects-to-save)) (if (null priority-to-count) (progn (setq priority-to-count (make-hash-table :test 'equal)) (puthash resource-id priority-to-count resource-to-priority-to-count))) (if (null resource-to-count) (progn (setq resource-to-count (make-hash-table :test 'equal)) (puthash priority resource-to-count priority-to-resource-to-count))) (let* ((old-count (gethash priority priority-to-count)) (new-count (if (null count) (if (null old-count) 1 (1+ old-count)) (if (null old-count) count (+ old-count count)))) (id-to-resource (dojo-workspace-id-to-resource workspace)) (resource (gethash resource-id id-to-resource))) (log-extract-prio (format "......... Requesting extraction for resource [%s] with path [%s] with prio [%s], count now [%s]" resource-id (if resource (dojo-resource-path resource) "") priority new-count)) (remhash priority priority-to-count) (puthash priority new-count priority-to-count) (remhash resource-id resource-to-count) (puthash resource-id new-count resource-to-count) (setf (dojo-workspace-max-priority workspace) (max priority (dojo-workspace-max-priority workspace))) ; Update the counts displayed in the mode lines. (dojo-core-window-update-js-mode-line) (force-mode-line-update t)))) (let ((resource (gethash resource-id (dojo-workspace-id-to-resource workspace)))) (log-extract-prio (format "......... Ignoring request to extract resource [%s] with path [%s], because the requested priority is [%s] > [%s]" resource-id (if resource (dojo-resource-path resource) "") priority dojo-js-extract-max-priority))))) (defun dojo-core-util-cleanup-on-done-extraction (workspace resource-id) (let* ((resource-to-priority-to-count (dojo-workspace-resource-to-priority-to-count workspace)) (priority-to-count (gethash resource-id resource-to-priority-to-count)) (priority-to-resource-to-count (dojo-workspace-priority-to-resource-to-count workspace)) (id-to-resource (dojo-workspace-id-to-resource workspace)) (resource (gethash resource-id id-to-resource))) (log-extract (format "Marking extraction of resource-id [%s] with path [%s] done." resource-id (if resource (dojo-resource-path resource) ""))) (maphash (lambda (priority count) (let* ((resource-to-count (gethash priority priority-to-resource-to-count))) (if resource-to-count (remhash resource-id resource-to-count)) ; If no more entries are left for that priority, remove the entry from the map (if (or (null resource-to-count) (= (hash-table-count resource-to-count) 0)) (progn (remhash priority priority-to-resource-to-count) ; If the priority whose entry we just removed is the max-priority, recalculate the (decreased) max-priority (if (= priority (dojo-workspace-max-priority workspace)) (let* ((new-max-priority 0)) (maphash (lambda (priority resource-to-count) (setq new-max-priority (max new-max-priority priority))) priority-to-resource-to-count) (setf (dojo-workspace-max-priority workspace) new-max-priority))))))) priority-to-count) ; Theoretically, we might remove the priority entry from the priority-to-resource-to-count map ; as well, if there is no resource left with that priority. As we won't get that many priorities, ; we omit that step here. (remhash resource-id resource-to-priority-to-count) ; Update the counts displayed in the mode lines. (dojo-core-window-update-js-mode-line) (force-mode-line-update t))) (defun dojo-core-util-check-resource-ids (workspace) "Check the existing resource ids as loaded from the resource.xmls and stored in id-to-resource against dojo-workspace-next-free-resource-id. Correct the latter if necessary. This function is for cleaning up the next-free-resource-id in case emacs was killed and could not properly write the workspace.xml file. Then, we might have created resources with new ids, but not updated next-free-resource-id." (let* ((id-to-resource (dojo-workspace-id-to-resource workspace)) (next-free-resource-id (dojo-workspace-next-free-resource-id workspace)) (max-resource-id-seen-so-far -1)) (maphash (lambda (id resource) (setq max-resource-id-seen-so-far (max max-resource-id-seen-so-far id))) id-to-resource) (if (= (1+ max-resource-id-seen-so-far) next-free-resource-id) (log-load (format "[CHECK-PASSED] Checked next-free-resource-id [%s], is consistent with id-to-resource map." next-free-resource-id)) (log-load (format "[CHECK-FAILED] Checked next-free-resource-id [%s], differs from next free id [%s] calculated from id-to-resource map." next-free-resource-id (1+ max-resource-id-seen-so-far))) (setf (dojo-workspace-next-free-resource-id workspace) (1+ max-resource-id-seen-so-far)) (log-load (format "... [CORRECTION] Corrected next-free-resource-id to calculated value [%s]" (1+ max-resource-id-seen-so-far)))))) (defun dojo-core-util-log-extract-priorities () (log-extract-prio (format "[PRIORITIES] Current extraction priorities")) (let ((id-to-resource (dojo-workspace-id-to-resource dojo-current-workspace)) (priority-to-resource-to-count (dojo-workspace-priority-to-resource-to-count dojo-current-workspace))) (maphash (lambda (priority resource-to-count) (log-extract-prio (format "- Priority [%s]" priority)) (maphash (lambda (resource-id count) (let* ((resource (gethash resource-id id-to-resource)) (project (if resource (dojo-resource-project resource) "---")) (path (if resource (dojo-resource-path resource) "---"))) (log-extract-prio (format " - Count [%s]: Resource [%s:%s:%s]" count resource-id project path)))) resource-to-count)) priority-to-resource-to-count))) (defun dojo-core-util-get-min-priority-and-count (workspace resource-id) (let* ((resource-to-priority-to-count (dojo-workspace-resource-to-priority-to-count workspace)) (priority-to-count (gethash resource-id resource-to-priority-to-count )) (min-priority nil)) (if priority-to-count (progn (maphash (lambda (priority count) (if (or (null min-priority) (< priority min-priority)) (setq min-priority priority))) priority-to-count) (if (null min-priority) nil (list min-priority (gethash min-priority priority-to-count)))) nil))) (defun dojo-core-util-resource-modified-since-last-parse-p (resource) (let* ((state (dojo-resource-state resource)) (file-path (dojo-resource-file-path resource)) (last-mod-tist (if (file-exists-p file-path) (float-time (nth 5 (file-attributes file-path))) nil)) (last-parse-tist (dojo-resource-last-parsed-utc-seconds resource))) (and last-mod-tist ; A non-existing file cannot be modified (or (null last-parse-tist) ; A file never parsed so far is definitely modified since last parse (string= state "located") ; The same. (> last-mod-tist last-parse-tist))))) ; File was modified since last parse (defun dojo-core-util-own-buffer-modified-size-last-parse-p (resource) (let* ((last-parsed-size (dojo-resource-last-parsed-size resource)) (curr-buffer (current-buffer)) (curr-size (if curr-buffer (buffer-size curr-buffer) nil))) (and curr-buffer (or (null last-parsed-size) (not (= curr-size last-parsed-size)))))) (defun dojo-core-util-mark-class-needed (class) (if (numberp class) (let ((id-to-class (dojo-workspace-id-to-class class))) (setq class (gethash class id-to-class)))) (setf (dojo-class-last-needed-utcseconds class) (float-time)) (log-data (format "Marked class [%s] needed: Utcseconds = [%s]" (dojo-class-id class) (dojo-class-last-needed-utcseconds class)))) (defun dojo-core-util-has-named-argument (function-symbol) "Returns wether the given function-symbol has at least one named argument, i.e. an argument whose dojo-symbol-name is set." (let* ((has-named-argument nil) (arguments (dojo-symbol-get-function-arguments function-symbol))) (dolist (argument arguments) (setq has-named-argument (or has-named-argument (not (null (dojo-symbol-name argument)))))) has-named-argument)) (defun dojo-core-util-get-named-argument-map (function-symbol) (let* ((name-to-argument (make-hash-table :test 'equal)) (arguments (dojo-symbol-get-function-arguments function-symbol))) (dolist (argument arguments) (let ((name (dojo-symbol-name argument))) (puthash name argument name-to-argument))) name-to-argument)) (defun dojo-core-util-delete-symbol-recursively (class symbol) (if (and symbol (dojo-symbol-p symbol)) (let* ((id-to-symbol (dojo-class-id-to-symbol class)) (id (dojo-symbol-id symbol)) (symbol-from-map (gethash id id-to-symbol))) ; Check wether the symbol is actually in the id-to-symbol map, to prevent endless recursion (if symbol-from-map (progn (remhash id id-to-symbol) (cond ((or (dojo-core-util-is-object-symbol symbol) (dojo-core-util-is-array-or-object-symbol symbol)) (let* ((key-type (dojo-symbol-get-object-key-type symbol)) (value-type (dojo-symbol-get-object-value-type symbol)) (object-members (dojo-symbol-get-object-members symbol))) (dojo-core-util-delete-symbol-recursively class key-type) (dojo-core-util-delete-symbol-recursively class value-type) (maphash (lambda (name member) (dojo-core-util-delete-symbol-recursively class member)) object-members))) ((dojo-core-util-is-array-symbol symbol) (let* ((value-type (dojo-symbol-get-array-value-type symbol))) (dojo-core-util-delete-symbol-recursively class value-type))) ((dojo-core-util-is-function-symbol symbol) (let* ((arguments (dojo-symbol-get-function-arguments symbol)) (return-type (dojo-symbol-get-function-return-type symbol))) (dolist (argument arguments) (dojo-core-util-delete-symbol-recursively class argument)) (dojo-core-util-delete-symbol-recursively class return-type))) ((dojo-core-util-is-ref-symbol symbol) (let* ((ref-symbols (dojo-symbol-get-ref-symbols symbol))) (dolist (ref-symbol ref-symbols) (dojo-core-util-delete-symbol-recursively class ref-symbol)))))))))) (provide 'dojo-core-util)