(require 'dojo-common-containers) (require 'dojo-common-strings) (defun dojo-core-workspace-toggle-timer () (interactive) (if (not (null dojo-process-workspace-timer)) (progn (cancel-timer dojo-process-workspace-timer) (setq dojo-process-workspace-timer nil)) (setq dojo-process-workspace-timer (run-at-time dojo-process-workspace-interval dojo-process-workspace-interval 'dojo-process-workspace))) (dojo-core-window-update-js-mode-line) (force-mode-line-update t)) (defun dojo-workspace-get-current-class () (let* ((project-and-path (dojo-get-current-project-and-path)) (project (nth 0 project-and-path)) (path (nth 1 project-and-path)) (current-class (dojo-workspace-get-class dojo-current-workspace project path))) current-class ) ) (defun dojo-core-workspace-get-resource (workspace project path &optional file-path) (let* ((path-to-resources (dojo-workspace-path-to-resources workspace)) (resources (gethash path path-to-resources)) (found-resource nil)) (if (null resources) (setq resources ())) ; Find out which of the dojo-resources as determined above match the given file-path. (if (null file-path) (nth 0 resources) (let ((found-resource nil)) (dolist (resource resources) (if (string= (dojo-resource-file-path resource) file-path) (setq found-resource resource))) found-resource)))) (defun dojo-core-workspace-get-class (workspace project path &optional file-path) (let ((resource (dojo-core-workspace-get-resource workspace project path file-path))) (if (and resource (or (string= (dojo-resource-state resource) "parsed") (string= (dojo-resource-state resource) "derived")) (or (dojo-core-workspace-is-any-js-resource resource) (dojo-core-workspace-is-css-resource resource))) (let* ((class-id (dojo-resource-parsed-id resource)) (id-to-class (dojo-workspace-id-to-class workspace))) (if (null class-id) nil (gethash class-id id-to-class))) nil))) (defun dojo-workspace-get-or-create-resource (workspace project path type file-path) "Returns the resource with the given file-path and path from the given workspace. Project and path are assumed to be determined based on file-path using dojo-get-project-and-path. If no such resource exists, one is created, registered and returned. A special case occurs, when file-path is nil. Then we search the one single resource for the given path (project is assumed to be nil as well in that case), that represents 'a resource of this path, as fetched from an import list, but it's unknown where (in which project) the corresponding file is located." ; path-to-resources maps Dojo import paths to lists of corresponding dojo-resources. ; As the same import path may exist in multiple projects, the values are lists, ; not just dojo-resources. ; TODO: Normalize paths, in Dojo library code sometimes, relative paths like ./_base/kernel are used. (let* ((path-to-resources (dojo-workspace-path-to-resources workspace)) (resources (gethash path path-to-resources)) (resource-id-to-project (dojo-workspace-resource-id-to-project workspace)) (found-resource nil)) (if (null resources) (setq resources ()) ) ; Find out which of the dojo-resources as determined above match the given file-path. (dolist (resource resources) (cond ((null file-path) (if (null (dojo-resource-file-path resource)) (setq found-resource resource))) (t (if (string= (dojo-resource-file-path resource) file-path) (setq found-resource resource))))) (if found-resource ; If one is found, return it. (progn found-resource) ; Otherwise, we need to construct the dojo-resource newly. (setq found-resource (construct-dojo-resource workspace)) (setf (dojo-resource-state found-resource) "located") (setf (dojo-resource-last-located-utc-seconds found-resource) (float-time)) (setf (dojo-resource-last-parsed-utc-seconds found-resource) nil) (setf (dojo-resource-last-parsed-size found-resource) nil) (setf (dojo-resource-file-hash found-resource) nil) (setf (dojo-resource-type found-resource) type) (setf (dojo-resource-parsed-id found-resource) nil) (setf (dojo-resource-project found-resource) project) (setf (dojo-resource-path found-resource) path) (setf (dojo-resource-file-path found-resource) file-path) (puthash (dojo-resource-id found-resource) project resource-id-to-project) ; Register it (push found-resource resources) (puthash path resources path-to-resources) ; ... and return it. found-resource ) ) ) (defun dojo-core-workspace-get-or-create-resource (buffer) (let* ((file-name (buffer-file-name buffer))) (if (and file-name (string-match-p "^[^\\*]*\\(\\.js\\|\\.xml\\|\\.java\\|\\.css\\)$" file-name)) (let* ((project-and-path (dojo-get-project-and-path file-name)) (project (nth 0 project-and-path)) (path (nth 1 project-and-path)) (type (nth 2 project-and-path)) (resource (if (and project path) (dojo-workspace-get-or-create-resource dojo-current-workspace project path type file-name) nil))) resource) nil))) (defun dojo-workspace-get-or-create-current-resource (workspace) (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. (resource (if (and project path) (dojo-workspace-get-or-create-resource dojo-current-workspace project path type buffer-file-name) nil ) ) ) resource ) ) (defun dojo-workspace-get-resource-from-resources (resources project) "Given a list of resources (matching some path we are not interested here), this function returns the dojo-resource which is located in the given project." (let ((found-resource nil) ) (dolist (resource resources) (if (string= (dojo-resource-project resource) project) (setq found-resource resource) ) ) found-resource ) ) (defun dojo-core-workspace-is-any-js-resource (resource) "Returns wether the given resource is a js resource of any kind. This includes special resources like the i18n files." (and resource (let* ((type (dojo-resource-type resource))) (or (string= type "js") (string= type "js-i18n-main") (string= type "js-i18n-other"))))) (defun dojo-core-workspace-is-js-module-resource (resource) (and resource (let* ((type (dojo-resource-type resource))) (string= type "js")))) (defun dojo-core-workspace-is-js-main-i18n-resource (resource) (and resource (let* ((type (dojo-resource-type resource))) (string= type "js-i18n-main")))) (defun dojo-core-workspace-is-js-other-i18n-resource (resource) (and resource (let* ((type (dojo-resource-type resource))) (string= type "js-i18n-other")))) (defun dojo-core-workspace-is-css-resource (resource) (and resource (let* ((type (dojo-resource-type resource))) (string= type "css")))) (defun dojo-core-workspace-get-resource-by-symbol (symbol) (let* ((resource-id (cond ((null symbol) nil) ((dojo-core-util-is-import-symbol symbol) (dojo-symbol-get-import-resource-id symbol)) (t (let* ((class-id (dojo-symbol-class-id symbol)) (api-class (if (null class-id) nil (dojo-js-api-get-class-by-id class-id)))) (if api-class (dojo-class-resource-id api-class) nil))))) (id-to-resource (dojo-workspace-id-to-resource dojo-current-workspace)) (resource (if (null resource-id) nil (gethash resource-id id-to-resource)))) resource)) (defun dojo-core-workspace-get-or-create-class (resource workspace project path) (let* ((class-id (dojo-resource-parsed-id resource)) (id-to-class (dojo-workspace-id-to-class workspace)) (class (if (null class-id) nil (gethash class-id id-to-class)))) (if (dojo-class-p class) class (construct-dojo-class workspace (dojo-resource-id resource) project path)))) (defun dojo-core-workspace-get-path-key (class-or-resource) (let* ((project nil) (path nil)) (cond ((dojo-class-p class-or-resource) (log-js-api (format "get-path-key called for class [%s:%s:%s]" (dojo-class-id class-or-resource) (dojo-class-project class-or-resource) (dojo-class-path class-or-resource))) (setq project (dojo-class-project class-or-resource)) (setq path (dojo-class-path class-or-resource))) ((dojo-resource-p class-or-resource) (log-js-api (format "get-path-key called for resource [%s:%s:%s]" (dojo-resource-id class-or-resource) (dojo-resource-project class-or-resource) (dojo-resource-path class-or-resource))) (setq project (dojo-resource-project class-or-resource)) (setq path (dojo-resource-path class-or-resource))) (t (log-workspace (format "[WARNING] Illegal argument [%s] for dojo-core-workspace-get-path-key" class-or-resource)))) (let* ((last-slash-index (last-index-of path "/"))) (if (not (null last-slash-index)) (setq path (substring path 0 last-slash-index)))) (log-js-api (format "... get-path-key returns [%s]" (concat project ":" path))) (concat project ":" path))) (defun dojo-core-workspace-get-project-by-path-key (path-key) (let* ((colon-index (string-match-p ":" path-key))) (if (null colon-index) (progn (log-workspace (format "[WARNING] Called dojo-core-workspace-get-project-by-path-key with illegal argument [%s], does not contain a colon ':'")) nil) (substring path-key 0 colon-index)))) (defun dojo-core-workspace-get-path-by-path-key (path-key) (let* ((colon-index (string-match-p ":" path-key))) (if (null colon-index) (progn (log-workspace (format "[WARNING] Called dojo-core-workspace-get-path-by-path-key with illegal argument [%s], does not contain a colon ':'")) nil) (substring path-key (1+ colon-index))))) (defun dojo-core-workspace-extract-own-class () (interactive) (dojo-core-util-request-own-extraction dojo-current-workspace) (setf (dojo-workspace-last-extract-own-utcseconds dojo-current-workspace) (float-time)) (setf (dojo-workspace-extraction-pending dojo-current-workspace) t)) ; Once dojo-process-workspace is called (which happens based on a timer, in a regular ; manner), work corresponding to the current work state (see DOJO-WORKSTATE-* variables ; in dojo-core-api) needs to be performed. ; In more detail: ; - DOJO-WORKSTATE-NEXT-EXEC-MAP contains information, when the different pieces of ; work are supposed to be executed next. ; - The work state decides which piece of work should be done next. Initially, it is ; IDLE. ; - If the work state is IDLE, decide about the next work state based on NEXT-EXEC-MAP. ; If an entry is nil, decide about the next execution time, based on the execution ; intervals defined in the configuration variables, and on the last execution ; utcseconds in DOJO-WORKSTATE-LAST-EXEC-MAP. ; If the particular WORKSTATE wasn't executed before according to the LAST-EXEC-MAP, ; add the current utcseconds to trigger it as soon as possible. ; - Otherwise, if the work state is not IDLE, call the corresponding function of ; DOJO-WORKSTATE-WORK-MAP to do the actual work. Those functions may ; - decide to delay their work to a later point in time (to keep emacs responsive) ; - may do their work, ; - may decide that their work is completely done. ; To signal the latter case, they need to set the work state to IDLE. ; If those function stop because of user input, they need to return false, otherwise ; true. ; - If such a function returned with false because of user input, no more work is to be ; performed in the current timer execution. Otherwise, more work may be done as ; appropriate. ; - Example: If user input happened recently, a function might not want to execute a ; code extraction that is expected to need a lot of time, but another function might ; want to continue some cheaper / easier interruptable workspace scan. (defun dojo-core-workspace-set-workstate (work-state) (setf (dojo-workspace-work-state dojo-current-workspace) work-state)) (defun dojo-core-workspace-goto-next-workstate () (let* ((workstate (dojo-workspace-work-state dojo-current-workspace)) (exec-map (dojo-workspace-exec-map dojo-current-workspace)) (already-found nil) (next-found nil) (current-utcseconds (float-time))) (dolist (curr-workstate DOJO-WORKSTATE-DEFAULT-ORDER) (if (eq curr-workstate workstate) (setq already-found t) (if already-found (let* ((workstate-struct (gethash workstate exec-map)) (next-exec-utcseconds (dojo-workstate-next-exec-utcseconds workstate-struct))) (if (or (null next-exec-utcseconds) (<= next-exec-utcseconds current-utcseconds)) (progn (setq workstate curr-workstate) (setq next-found t) (return nil)))) ()))) (if next-found (progn (dojo-core-workspace-set-workstate workstate)) ; (log-workloop (format "... [%s] activated by goto-next-workstate" workstate))) (dojo-core-workspace-set-workstate 'DOJO-WORKSTATE-IDLE)))) ; (log-workloop (format "... [DOJO-WORKSTATE-IDLE] activated since goto-next-workstate could not find any further workstate."))))) (defun dojo-core-workspace-get-current-workstate () (gethash (dojo-workspace-work-state dojo-current-workspace) (dojo-workspace-exec-map dojo-current-workspace))) (defun dojo-core-workspace-is-in-idle-state () (eq (dojo-workspace-work-state dojo-current-workspace) 'DOJO-WORKSTATE-IDLE)) (defun dojo-core-workspace-get-time-since-last-input () (if (null dojo-last-input-timestamp) ; Needs call of cl-float-limits when initializing mode, otherwise it's nil most-positive-float (- (float-time) dojo-last-input-timestamp))) (defun dojo-core-workspace-register-next-execution (work-state delta) (let* ((current-time (float-time))) (setf (dojo-workstate-last-exec-utcseconds work-state) current-time) (setf (dojo-workstate-next-exec-utcseconds work-state) (+ current-time delta)) (dojo-core-workspace-goto-next-workstate))) (defun dojo-core-workspace-trigger-execution (work-state-symbol) (let* ((work-state (gethash work-state-symbol (dojo-workspace-exec-map dojo-current-workspace)))) (setf (dojo-workstate-next-exec-utcseconds work-state) (float-time)))) (defun dojo-core-workspace-trigger-workspace-scan () (interactive) (dojo-core-workspace-trigger-execution 'DOJO-WORKSTATE-SCAN)) (defun dojo-core-workspace-trigger-derive-imports () (interactive) (dojo-core-workspace-trigger-execution 'DOJO-WORKSTATE-IMPORTS)) (defun dojo-core-workspace-trigger-plan-extractions () (interactive) (dojo-core-workspace-trigger-execution 'DOJO-WORKSTATE-PLAN-EXTRACT)) (defun dojo-core-workspace-trigger-extractions () (interactive) (dojo-core-workspace-trigger-execution 'DOJO-WORKSTATE-DO-EXTRACT)) (defun dojo-core-workspace-trigger-save () (interactive) (dojo-core-workspace-trigger-execution 'DOJO-WORKSTATE-SAVE)) (defun dojo-core-workspace-check-for-input () "Check for input. Set dojo-record-input-timestamp, since the case exists, that after a call to (input-pending-p) which returns true, first a subsequent timer is executed, and then the hook in dojo-minor-mode sets dojo-record-input-timestamp." (if (input-pending-p) (progn (dojo-record-input-timestamp) t) nil)) (defvar dojo-core-workspace-last-process-workspace-start-tist 0.0 "Utcseconds at the beginning of the previous call to dojo-process-workspace") (defun dojo-process-workspace () (interactive) (log-workloop (format "Called dojo-process-workspace, last-input-tist [%s], time [%s], time-since-last-input [%s]" dojo-last-input-timestamp (float-time) (dojo-core-workspace-get-time-since-last-input))) (let ((do-continue t) (before-time (float-time))) (if (< (- before-time dojo-core-workspace-last-process-workspace-start-tist) (/ dojo-process-workspace-interval 2)) (progn (setq do-continue nil) (log-workloop (format "Aborting timer call since it runs to often, probably due to a long running job before.")))) (setq dojo-core-workspace-last-process-workspace-start-tist before-time) (if do-continue (progn (dojo-common-log-limit-all-log-buffers) ; Only parse current resource, if the workspace has already been scanned. ; This ensures, that when parsing it, the resources referenced by its ; imports already exist. (log-extract-prio (format "[CHECK-BUFFER] dojo-process-workspace checks current buffer for reparse.")) (if (not (null (dojo-workspace-last-scan-utcseconds dojo-current-workspace))) (dojo-core-workspace-check-buffer (current-buffer) 1 t)))) (while do-continue (let* ((work-state-symbol (dojo-workspace-work-state dojo-current-workspace)) (work-state (dojo-core-workspace-get-current-workstate)) (work-state-fct (if work-state (dojo-workstate-work-fct work-state) nil))) (cond ((null work-state) (log-workloop (format "[WARNING] Found no current workstate struct, will revert to work state IDLE.")) (dojo-core-workspace-set-workstate 'DOJO-WORKSTATE-IDLE) (setq do-continue nil)) ((null work-state-fct) (log-workloop (format "[WARNING] Found no workstate function for work state [%s], will revert to work state IDLE." (dojo-workspace-work-state dojo-current-workspace))) (dojo-core-workspace-set-workstate 'DOJO-WORKSTATE-IDLE) (setq do-continue nil)) (t (log-workloop (format "... [%s] Will call work function." work-state-symbol)) ; The workstate function decides wether we may continue at all. (setq do-continue (funcall work-state-fct work-state)) (log-workloop (format "... [%s] finished, we may %s with [%s]" work-state-symbol (if do-continue "continue" "not continue") (dojo-workspace-work-state dojo-current-workspace))) (if do-continue (cond ((dojo-core-workspace-check-for-input) (log-workloop (format "... Input detected, stopping work loop.")) (setq do-continue nil)) ((dojo-core-workspace-is-in-idle-state) (log-workloop (format "... No other senseful work could be found, exiting work loop.")) (setq do-continue nil)) (t ()))))))) (log-workloop (format "Finished workloop after [%s]s." (- (float-time) before-time))))) (defun dojo-core-workspace-check-buffer (buffer priority &optional no-check) "Checks wether the current buffer contains a file, that needs to be parsed on changes, and that looks like needing a reparse." (log-extract-prio (format "... Checking reparse of buffer [%s]" (buffer-file-name buffer))) (let* ((resource (dojo-core-workspace-get-or-create-resource buffer)) (type (if resource (dojo-resource-type resource) nil)) (is-current-buffer-resource (and resource (string= (dojo-resource-file-path resource) buffer-file-name)))) (log-extract-prio (format "...... resource [%s:%s:%s], type [%s], curr-buf-resource [%s], already-checked [%s]" (if resource (dojo-resource-id resource) "---") (if resource (dojo-resource-project resource) "---") (if resource (dojo-resource-path resource) "---") type is-current-buffer-resource (if resource (dojo-resource-extraction-checked resource) "---"))) ; If a buffer becomes current, it needs to be checked always, and not just the first time (if is-current-buffer-resource (setf (dojo-resource-extraction-checked resource) nil)) (cond ((null resource) (log-extract-prio (format "...... no resource matching the buffer [%s] could be found or created, nothing to be done here." (buffer-name buffer))) nil) ((and (not no-check) (dojo-resource-extraction-checked resource)) (log-extract-prio (format "...... extraction of resource [%s:%s:%s] corresponding to non-current-buffer was already checked, not doing this again." (dojo-resource-id resource) (dojo-resource-project resource) (dojo-resource-path resource)))) ((and (or (dojo-core-workspace-is-any-js-resource resource) (dojo-core-workspace-is-css-resource resource)) (dojo-core-workspace-was-buffer-size-modified-since-last-parse resource buffer)) (if (not is-current-buffer-resource) (setf (dojo-resource-extraction-checked resource) t)) (log-extract-prio (format "...... [REPARSE] [%s:%s:%s] due to size change." (if resource (dojo-resource-id resource) "---") (if resource (dojo-resource-project resource) "---") (if resource (dojo-resource-path resource) "---"))) (dojo-core-util-request-extraction dojo-current-workspace (dojo-resource-id resource) priority) t) (t (if (not is-current-buffer-resource) (setf (dojo-resource-extraction-checked resource) t)) (log-extract-prio (format "...... found resource [%s:%s:%s] which does not look like we are interested in reparsing it." (if resource (dojo-resource-id resource) "---") (if resource (dojo-resource-project resource) "---") (if resource (dojo-resource-path resource) "---"))) nil)))) (defun dojo-core-workspace-was-buffer-size-modified-since-last-parse (resource buffer) (let* ((last-parsed-size (dojo-resource-last-parsed-size resource)) (size (buffer-size buffer))) (log-workloop (format "......... last-parsed-size [%s], size [%s]" last-parsed-size size)) (or (null last-parsed-size) (not (= size last-parsed-size))))) (defun dojo-core-workspace-garbage-collect (workspace) (let* ((id-to-class (dojo-workspace-id-to-class workspace)) (class-count (hash-table-count id-to-class)) (aborted nil)) (cond ((> class-count dojo-max-loaded-classes) (log-workspace-details (format "Having [%s] classes; more than the limit [%s]..." class-count dojo-max-loaded-classes)) (let* ((class-list ())) (maphash (lambda (id class) (log-workspace-details (format "... Registering class [%s], with last-needed-utcseconds [%s]" id (dojo-class-last-needed-utcseconds class))) (push (list id (dojo-class-last-needed-utcseconds class)) class-list)) id-to-class) (setq class-list (sort class-list (lambda (class-info-one class-info-two) (let ((last-needed-utcseconds-one (nth 1 class-info-one)) (last-needed-utcseconds-two (nth 1 class-info-two))) (or (null last-needed-utcseconds-one) (and (not (null last-needed-utcseconds-two)) (< last-needed-utcseconds-one last-needed-utcseconds-two))))))) (log-workspace-details (format "Having [%s] classes, more than the allowed [%s], will garbage collect them..." class-count dojo-max-loaded-classes)) (log-workspace-details (format "... class list has length [%s]" (length class-list))) (dolist (class-info class-list) (log-workspace-details (format "... Class [%s] has last-needed-utcseconds [%s]" (nth 0 class-info) (nth 1 class-info)))) (dotimes (n (length class-list)) (if (< n (- (length class-list) dojo-max-loaded-classes)) (let* ((class-info (nth n class-list)) (class-id (nth 0 class-info)) (class-ids-to-save (dojo-workspace-class-ids-to-save workspace))) (log-workspace-details (format "... Will remove class [%s] due to garbage collection." class-id)) (if (gethash class-id class-ids-to-save) (progn (log-workspace (format "...... but will save it before.")) (dojo-core-save-write-class (gethash class-id id-to-class)))) (log-workspace-details (format "Will garbage-collect class [%s], .... MEMORY: %s" class-id (dojo-common-log-get-memory-info))) (remhash class-id id-to-class) (log-workspace-details (format "After garbage-collecting class [%s], .... MEMORY: %s" class-id (dojo-common-log-get-memory-info))) ; (if (dojo-workspace-stop-processing-p) (if t (progn (log-workspace-details (format "... Aborting garbage collection due to time exhaustion, or user input.")) (setq aborted t) (return nil)))) (return nil))) (log-workspace-details (format "Finished garbage-collecting classes."))))) ; If garbage collection was aborted due to time exhaustion, or user input, we need to continue ; as soon as possible. ; Otherwise, other jobs might create data faster than we can discard it here. (if (null aborted) (progn (setf (dojo-workspace-last-garbage-collect-utcseconds workspace) (float-time)) (setf (dojo-workspace-garbage-collection-pending workspace) nil) (not (dojo-workspace-stop-processing-p))) nil))) (defun dojo-core-workspace-scan-current-workspace-interactively () (interactive) (dojo-core-workspace-scan-workspace t) (log-assign 0 (format "Extracted path-to-resources: [%s]" (dojo-workspace-path-to-resources dojo-current-workspace)))) ; (log-assign 0 (format "Extracted file-path-to-path-info: [%s]" (dojo-workspace-file-path-to-path-info dojo-current-workspace)))) (defun dojo-core-workspace-scan-workspace (workstate &optional manual) (if (< (dojo-core-workspace-get-time-since-last-input) dojo-post-input-silence-interval) (progn (log-workloop (format "...... [DOJO-WORKSTATE-SCAN] will not do any work, since last input is too near.")) (dojo-core-workspace-goto-next-workstate) t) (log-user "[SCAN] Will start or proceed scanning the workspace") (log-workspace-details "Called dojo-scan-workspace") (log-workspace-details "==========================") ; Determine the relevant projects in the workspace. (let* ((workspace-dir-files (directory-files dojo-workspace-path)) (name-to-project (dojo-workspace-name-to-project dojo-current-workspace)) (project-names ())) ; Loop over all directories inside the workspace (dolist (dir-file workspace-dir-files) ; ... ignore hidden directories, and only consider projects that have the src/main/resources/OSGI-INF/webapp path. (if (not (starts-with dir-file ".")) (let* ((base-file (concat dojo-workspace-path dir-file))) (if (and (file-directory-p base-file) (file-directory-p (concat base-file "/src/main")) (null (gethash dir-file name-to-project))) (construct-dojo-project dir-file))))) ; (push dir-file project-names))))) ; (setq project-names (sort project-names 'string<)) ; (setf (dojo-workspace-project-names dojo-current-workspace) project-names)) (setf project-names (sort (hash-table-get-all-keys name-to-project) 'string<)) ; Either proceed with the last-scanned-project, or start at the very first one. ; Note that (nth 0 ...) returns nil for an empty list. (if (null (dojo-workspace-last-scanned-project dojo-current-workspace)) (progn ; We are in the case that we start a scan for the resources in the workspace. ; Thus, empty the curr-scan-project-resources list. It will be filled subsequently ; during the scan, and after the scan of some particular project has completed, ; the corresponding resources file is written immediately. ; (if we would write all those files at once, this might cause a significant ; delay to the user, thus we want to write them project-wis) (setf (dojo-workspace-last-scanned-project dojo-current-workspace) (nth 0 project-names)) (setf (dojo-workspace-curr-scan-project-resources dojo-current-workspace) nil))) (log-workspace-details (format "... last-scanned-project is [%s]" (dojo-workspace-last-scanned-project dojo-current-workspace))) ; Check for the corner case that we have no project at all in the workspace (if (not (null (dojo-workspace-last-scanned-project dojo-current-workspace))) ; Process the projects in the workspace, starting at the last-scanned-project. (dojo-core-workspace-scan-project dojo-current-workspace project-names manual)) ; If the scan was interrupted either because of running time, or because of user input, ; the workspace-scan-interrupted flag is set here. If this is not the case, the ; scan terminated normally, and did all its work. In this case, we reset all the ; bookkeeping information. The result is that dojo-process-workspace may proceed ; to the next item of work. (if (not (dojo-workspace-workspace-scan-interrupted dojo-current-workspace)) (progn (log-workspace "... Resetting workspace scan info since we completed successfully.") (setf (dojo-workspace-workspace-scan-pending dojo-current-workspace) nil) (setf (dojo-workspace-last-scanned-project dojo-current-workspace) nil) (setf (dojo-workspace-last-scanned-tokens dojo-current-workspace) nil) (setf (dojo-workspace-last-scan-utcseconds dojo-current-workspace) (float-time)) (log-save "Workspace scan completed, saving workspace file...") (dojo-core-save-save-workspace-file dojo-current-workspace) ; (dojo-core-workspace-derive-css-files dojo-current-workspace) ; (dojo-core-save-save-resource-files workspace) (log-save "... done."))) ; Return wether dojo-process-workspace may continue doing its work. (let* ((interrupted (dojo-workspace-workspace-scan-interrupted dojo-current-workspace)) (finished (not interrupted))) (log-workloop (format "...... [DOJO-WORKSTATE-SCAN] %s" (if interrupted "interrupted" "finished"))) (if finished (dojo-core-workspace-register-next-execution workstate dojo-scan-workspace-interval)) (if finished (log-user "... [FINISHED] Finished scanning the workspace.") (log-user "... [INTERRUPTED] Interrupted while scanning the workspace, will proceed as soon as we can.")) finished)))) (defun dojo-get-workspace-path-from-tokens (workspace tokens) (let ((path "") ) (dolist (token tokens) (setq path (concat path "/" token)) ) path ) ) (defun dojo-core-workspace-mark-dojo-projects () (let* ((name-to-project (dojo-workspace-name-to-project dojo-current-workspace))) (maphash (lambda (name project) ) name-to-project))) (defun dojo-core-workspace-scan-project (workspace project-names manual) "Processes the project level while scanning the workspace for interesting resource files. Starts at the position indicated by last-scanned-project and last-scanned-tokens, i.e. can continue a previous scan at the same position. Aborts as quick as possible, if user input is pending." ; Iterate over projects. Note that they are sorted in ascending order. (dolist (project-name project-names) (log-workspace-details (format "scan-project scans project [%s]" project-name)) (log-workspace-details (format "===============================" project-name)) ; If no input was entered, but the flag is set, this indicates that it is set from a previous ; execution. Thus clear the flag. (if (dojo-workspace-workspace-scan-interrupted workspace) (setf (dojo-workspace-workspace-scan-interrupted workspace) nil)) ; Only consider projects that are greater or equal (in a string comparison sense) to ; the last-scanned-project. This ensures that we can continue at the correct point of ; processing, if we break processing because of user input or exhausted processing time. (if (string< project-name (dojo-workspace-last-scanned-project workspace)) () (progn (setf (dojo-workspace-last-scanned-project workspace) project-name) (let* ((last-scanned-project project-name) (name-to-project (dojo-workspace-name-to-project workspace)) (project (gethash project-name name-to-project)) ; (base-dir (concat dojo-workspace-path last-scanned-project dojo-webapp-path)) ; (base-dir (concat dojo-workspace-path last-scanned-project "/src/main")) (base-dir (concat dojo-workspace-path last-scanned-project "")) (webapp-path (concat dojo-workspace-path last-scanned-project "/src/main/resources/OSGI-INF/webapp")) (path-tokens (dojo-workspace-last-scanned-tokens workspace))) (if (null project) (log-workloop (format "[WARNING] Did not find project struct for project name [%s]" project-name))) (if (file-exists-p webapp-path) (setf (dojo-project-webapp-path project) webapp-path)) ; Start or continue processing the project (log-workloop (format "...... Starting with project [%s]" project-name)) (log-workspace-details (format "process-project starts or continues at [%s] with path-tokens [%s]" base-dir path-tokens)) (dojo-core-window-trigger-redisplay) (dojo-scan-workspace-process-path workspace project base-dir path-tokens 0 manual) ; If processing terminated normally (i.e. was not interrupted), we need to clear ; the last-scanned-tokens, in order to start properly with the next project (if (dojo-workspace-workspace-scan-interrupted workspace) (return nil) ; Write resources.xml for that project ; There is at least one corner case where we need a duplicate check here: ; If we exit dojo-minor-mode while scanning a project, we exit after scanning ; some arbitrary file, in the directory identified by path-tokens. ; That file is not necessarily the first file in that directory. When we ; proceed the scan after dojo-minor-mode has been started for the next time, ; it will start at the first file in the directory denoted by path-tokens, ; i.e. the files in the range ; [beginning of path-tokens directory, interruption point] will be processed ; twice. While adapting the path-tokens array to fix that might be possible, ; an explicit duplicate check sounds more robust, and doesn't cost that much ; time (e.g. 8ms for writing a 1.3MB file full of dojo-provider resources). (let ((resources-to-pass nil) (found-file-paths (make-hash-table :test 'equal)) (curr-scan-project-resources (dojo-workspace-curr-scan-project-resources workspace))) (dolist (curr-scan-project-resource curr-scan-project-resources) (let ((file-path (dojo-resource-file-path curr-scan-project-resource))) (if (not (gethash file-path found-file-paths)) (progn (push curr-scan-project-resource resources-to-pass) (puthash file-path t found-file-paths))))) (log-save (format "Resource scan of project [%s] completed, found [%s] resources, saving resources.xml..." project-name (length curr-scan-project-resources))) (dojo-core-save-write-project-resources workspace project-name resources-to-pass) (log-save "... done.")) ; Reset the list of resources scanned so far for the current project ; (the next thing we will do is stepping to the next project) (setf (dojo-workspace-curr-scan-project-resources workspace) nil) (setf (dojo-workspace-last-scanned-tokens workspace) ()))))))) (defun dojo-scan-workspace-process-path (workspace project curr-dir path-tokens depth manual) "While scanning the workspace for setting up the dojo-resources, this function processes the given curr-dir. The given depth indicates the currently reached depth (in a hierarchical sense) starting at the dojo-webapp-path of the project at hand. The path-tokens indicate the point to process next, starting at the dojo-webapp-path. If depth is smaller than (length path-tokens), this indicates that we need to dive further into the directory tree, to find the point were we need to resume a previously interrupted scan. If depth is equal to (length path-tokens), we just need to process the file or directory at hand. Thus: depth == (length path-tokens) if scanning, depth < (length path-tokens) if finding the place to proceed" (setf (dojo-workspace-last-scanned-tokens workspace) path-tokens) (if (file-directory-p curr-dir) (if (starts-with curr-dir "\\.") (log-workspace (format "Workspace scan ignores hidden directory [%s]" curr-dir)) (dojo-scan-workspace-process-directory workspace project curr-dir path-tokens depth manual)) (dojo-scan-workspace-process-file workspace project curr-dir path-tokens depth manual))) (defun dojo-scan-workspace-process-directory (workspace project curr-dir path-tokens depth manual) (log-workspace-details (format "process-directory [%s], path-tokens [%s]" curr-dir path-tokens)) (let* ((curr-files (directory-files curr-dir)) (curr-token (nth depth path-tokens)) (curr-depth-tokens (butlast path-tokens (- (length path-tokens) depth)))) (dolist (curr-file curr-files) (if (dojo-core-workspace-check-for-input) ; Time exhausted, or interrupted by user (progn (setf (dojo-workspace-workspace-scan-interrupted workspace) t) (return nil)) ; Ignore hidden directories, especially "." and ".." (if (not (starts-with curr-file ".")) ; If the depth is smaller than the length of the path-tokens, this indicates that we continue ; a previously interrupted processing run, and did not yet reach the point of abortion yet ; (in a hierarchical sense). Example: Abort at "foo/bar/baz". Then enter this function for ; "foo", at depth 0, although (length ("foo" "bar" "baz")) is 3 (if (< depth (length path-tokens)) ; If curr-file is exactly the depth-th token, dive into the tree with unchanged path-tokens. ; This is the case that we dive from ("foo") to ("foo" "bar") in the example above. (cond ((string= curr-token curr-file) (dojo-scan-workspace-process-path workspace project (concat curr-dir "/" curr-file) path-tokens (1+ depth) manual)) ; Otherwise, if we inspect a subsequent token at the level at hand, proceed as usual. ; This is the case, that we already processed the ("foo" "bar") completely in the example above, ; and now also need to process the ("foo" "cde") tree. ((string< curr-token curr-file) (dojo-scan-workspace-process-path workspace project (concat curr-dir "/" curr-file) (append curr-depth-tokens (list curr-file)) (1+ depth) manual))) ; Usual processing, we just dive into the tree without having a previously (partly) processed path. ; TODO: A more sophisticated check, maybe with a configuration variable (if (not (and (= depth 0) (string= curr-file "target"))) (dojo-scan-workspace-process-path workspace project (concat curr-dir "/" curr-file) (append curr-depth-tokens (list curr-file)) (1+ depth) manual)))))))) (defun dojo-scan-workspace-process-file (workspace project curr-dir path-tokens depth manual) (let* ((type (dojo-core-workspace-get-resource-type (dojo-workspace-last-scanned-project workspace) curr-dir)) (resource-id-to-project (dojo-workspace-resource-id-to-project workspace))) (if (not (null type)) (let* ((path-to-resources (dojo-workspace-path-to-resources workspace)) (curr-scan-project-resources (dojo-workspace-curr-scan-project-resources workspace)) (project-name (dojo-workspace-last-scanned-project workspace)) (project-base-dir (concat dojo-workspace-path project-name)) (path (dojo-workspace-get-path-from-tokens type project-name path-tokens)) (existing-resources (if path (gethash path path-to-resources) nil)) (existing-resource (if (and existing-resources project-name) (dojo-workspace-get-resource-from-resources existing-resources project-name) nil)) (resource nil) (existing-resource-p nil)) (if (and existing-resource (string= (dojo-resource-file-path existing-resource) curr-dir)) (progn (setq existing-resource-p t) (setq resource existing-resource)) (setq resource (construct-dojo-resource workspace))) (cond ((string= type "js") (let* ((token-count (length path-tokens)) (prev-last-token (if (>= token-count 2) (nth (- token-count 2) path-tokens) nil)) (prev-prev-last-token (if (>= token-count 3) (nth (- token-count 3) path-tokens) nil))) (cond ((string= prev-last-token "nls") (log-i18n (format "Will register resource [%s:%s:%s] as main i18n resource of project [%s]" (dojo-resource-id resource) (dojo-resource-project resource) (dojo-resource-path resource) project)) (puthash DOJO-PROJECT-I18N-MAIN (dojo-resource-id resource) (dojo-project-locale-to-i18n-resource project)) (setq type "js-i18n-main")) ((string= prev-prev-last-token "nls") (log-i18n (format "Will register resource [%s:%s:%s] as other i18n resource of project [%s] and locale [%s]" (dojo-resource-id resource) (dojo-resource-project resource) (dojo-resource-path resource) project prev-last-token)) (puthash prev-last-token (dojo-resource-id resource) (dojo-project-locale-to-i18n-resource project)) (setq type "js-i18n-other"))))) ((string= type "pom") (setf (dojo-project-pom-resource-id project) (dojo-resource-id resource)) (setf (dojo-project-is-js-dojo-project project) (dojo-core-workspace-detect-dojo-project curr-dir)))) ; Record start time once we do some actual work, which we do once we actually record a file. (if (null dojo-process-workspace-start-time) (setq dojo-process-workspace-start-time (float-time))) ; Do nothing, if the resource was already registered. This avoids the case, ; that already parsed resource classes disappear from the workspace, after ; they were found again here, but before the class is parsed again. (if existing-resource-p (progn (push existing-resource curr-scan-project-resources) (if (string= type "css") (let* ((resource-id (dojo-resource-id existing-resource))) (puthash resource-id resource-id (dojo-project-css-resources project)) (if (dojo-css-parse-is-main-css-resource existing-resource) (puthash DOJO-PROJECT-CSS-MAIN resource-id (dojo-project-css-resources project)))))) (let* ((file-path-to-path-info (dojo-workspace-file-path-to-path-info workspace)) (resources (gethash path path-to-resources))) (setf (dojo-resource-state resource) "located") (setf (dojo-resource-last-located-utc-seconds resource) (float-time)) (setf (dojo-resource-last-parsed-utc-seconds resource) nil) (setf (dojo-resource-last-parsed-size resource) nil) (setf (dojo-resource-file-hash resource) nil) (setf (dojo-resource-type resource) type) (setf (dojo-resource-parsed-id resource) nil) (setf (dojo-resource-project resource) project-name) (setf (dojo-resource-path resource) path) (setf (dojo-resource-file-path resource) curr-dir) (puthash (dojo-resource-id resource) project-name resource-id-to-project) (puthash curr-dir (list project-name path) file-path-to-path-info) ; Register blueprint services.xml resource ids in map (cond ((string= type "blueprint") (let* ((project-to-services-resource (dojo-workspace-project-to-services-resource workspace)) (resource-id (dojo-resource-id resource))) (log-workspace-details (format "Registering blueprint file [%s] for project [%s]" curr-dir project-name)) (puthash project-name resource-id project-to-services-resource))) ((string= type "css") (let* ((resource-id (dojo-resource-id resource))) (puthash resource-id resource-id (dojo-project-css-resources project)) (if (dojo-css-parse-is-main-css-resource resource) (puthash DOJO-PROJECT-CSS-MAIN resource-id (dojo-project-css-resources project)))))) (if (null resources) ; File path not yet registered, register a list with the new resource as ; its only element (progn (puthash path (list resource) path-to-resources) (push resource curr-scan-project-resources)) (push resource resources) (puthash path resources path-to-resources) (push resource curr-scan-project-resources)))) (setf (dojo-workspace-curr-scan-project-resources workspace) curr-scan-project-resources))))) ; TODO: A more sophisticated check for that (defun dojo-core-workspace-detect-dojo-project (pom-file-path) (with-temp-buffer (buffer-disable-undo (current-buffer)) (insert-file-contents pom-file-path) (goto-char (point-min)) (let* ((found (search-forward "dojo-provider" nil t))) (not (null found))))) (defun dojo-core-workspace-get-project-by-resource (resource) (let* ((project-name (dojo-resource-project resource)) (name-to-project (dojo-workspace-name-to-project dojo-current-workspace))) (gethash project-name name-to-project))) (defun dojo-core-workspace-get-project-by-class (class) (let* ((project-name (dojo-class-project class)) (name-to-project (dojo-workspace-name-to-project dojo-current-workspace))) (gethash project-name name-to-project))) (defun dojo-core-workspace-get-project-by-name (project-name) (let* ((name-to-project (dojo-workspace-name-to-project dojo-current-workspace))) (gethash project-name name-to-project))) (defun dojo-core-workspace-get-blueprint-file-by-project (project-name) (let* ((name-to-project (dojo-workspace-name-to-project dojo-current-workspace)) (project (gethash project-name name-to-project))) (if project (dojo-project-blueprint-file project) nil))) (defun dojo-core-workspace-extract-imports (workstate) (if (< (dojo-core-workspace-get-time-since-last-input) dojo-post-input-silence-interval) (progn (log-workloop (format "...... EXTRACT-IMPORTS will not do any work, since last input is too near.")) (dojo-core-workspace-goto-next-workstate) t) (log-user (format "[EXTRACT-IMPORTS] Extracting imports.")) (let ((extract-import-resource-ids (dojo-workspace-extract-import-resource-ids dojo-current-workspace)) (id-to-resource (dojo-workspace-id-to-resource dojo-current-workspace))) (if (null extract-import-resource-ids) (progn (setq extract-import-resource-ids (make-hash-table :test 'equal)) (maphash (lambda (id resource) (if (dojo-core-workspace-is-js-module-resource resource) (puthash id t extract-import-resource-ids))) id-to-resource) (setf (dojo-workspace-extract-import-resource-ids dojo-current-workspace) extract-import-resource-ids)))) (let* ((extract-import-resource-ids (dojo-workspace-extract-import-resource-ids dojo-current-workspace)) (id-to-resource (dojo-workspace-id-to-resource dojo-current-workspace)) (processed-resource-ids ()) (processed-this-loop 0) (total-count (hash-table-count extract-import-resource-ids))) (catch 'stop-import-maphash (maphash (lambda (resource-id ignored) (if (dojo-core-workspace-check-for-input) (throw 'stop-import-maphash nil)) (let* ((resource (gethash resource-id id-to-resource)) (import-resources (dojo-js-extract-get-heuristic-import-resources-by-resource resource))) ; (log-workspace (format "Found [%s] imports for resource [%s]" (length import-resources) resource-id)) (dolist (import-resource import-resources) (dojo-core-dep-register-dependency-by-resources resource-id (dojo-resource-id import-resource) 'DOJO-DEP-IMPORT nil)) (push resource-id processed-resource-ids)) (incf processed-this-loop) (if (= (% processed-this-loop 100) 0) (progn (log-workloop (format "...... Extracted imports of [%s] resources this time, [%s] left." processed-this-loop (- total-count processed-this-loop))) (dojo-core-window-trigger-redisplay)))) extract-import-resource-ids)) (dolist (processed-resource-id processed-resource-ids) (remhash processed-resource-id extract-import-resource-ids)) (log-workspace (format "[%s] resource ids left for import extraction." (hash-table-count extract-import-resource-ids))) (if (= (hash-table-count extract-import-resource-ids) 0) (progn (setf (dojo-workspace-extract-import-resource-ids dojo-current-workspace) nil) (dojo-core-workspace-trigger-plan-extractions) (dojo-core-workspace-register-next-execution workstate dojo-extract-imports-interval) (log-user (format "... [FINISHED] Finished extracting imports.")) t) (setf (dojo-workspace-extract-import-resource-ids dojo-current-workspace) extract-import-resource-ids) (log-user (format "... [INTERRUPTED] Interrupted while extracting imports, [%s] left." (hash-table-count extract-import-resource-ids))) nil)))) (defun dojo-core-workspace-plan-extractions (workstate) ; 1. Parse imports of own resource ; 2. Derive all inverse import resources; example: PageChooser creates PersonPage creates PersonListWidget. ; 3. Starting from the root, for each of those resources: First parse resource, then all its imports ; For now increase that silence interval to avoid disturbing the user too often, but we need a better solution for that ; (if (< (dojo-core-workspace-get-time-since-last-input) (* 10 dojo-post-input-silence-interval)) (if (< (dojo-core-workspace-get-time-since-last-input) dojo-post-input-silence-interval) (progn (log-workloop (format "...... PLAN-EXTRACT will not do any work, since last input is too near.")) (dojo-core-workspace-goto-next-workstate) t) (log-user (format "[PLAN-EXTRACTIONS] Planning future extractions (see log-extract-prio for details) ...")) (log-extract-prio (format "[PLAN-EXTRACTIONS] Planning future extractions...")) ; Register some set of related resources to parse, e.g. imports of the current resource. ; This is done based on the dependency-maps in the workspace, which are not necessarily ; a result of actually parsing and extracting the resources (see heuristic extraction ; of dependencies) (dojo-core-workspace-derive-own-resources-to-parse) ; Extract other buffers, but for now don't jump to their imports, to avoid doing too much work here. (log-extract-prio (format "... [CHECK-REPARSE] Will check buffers of buffer list for reparse.")) (dolist (buffer (buffer-list)) (dojo-core-workspace-check-buffer buffer 2)) (setf (dojo-workspace-plan-extract-pending dojo-current-workspace) nil) (setf (dojo-workspace-last-plan-extract-utcseconds dojo-current-workspace) (float-time)) ; Only trigger this explicitely, by calls of (dojo-core-workspace-trigger-plan-extractions) (dojo-core-workspace-register-next-execution workstate most-positive-float) (log-user (format "... Done.")) (log-extract-prio (format "... Done.")) t)) (defun dojo-core-workspace-derive-own-resources-to-parse () (let* ((own-resource (dojo-core-util-get-current-resource)) (own-resource-id (if own-resource (dojo-resource-id own-resource) nil))) (if (null own-resource-id) (log-workspace (format "Did not find own resource, will not register dependent resources to parse.")) (log-extract-prio (format "... Dependent resources of resource [%s:%s:%s]:" (dojo-resource-id own-resource) (dojo-resource-project own-resource) (dojo-resource-path own-resource))) (let* ((main-css-resource-id (dojo-core-util-get-project-main-css-resource-id own-resource))) (if (not (null main-css-resource-id)) (dojo-core-util-request-extraction-with-logging dojo-current-workspace main-css-resource-id 2 (concat "...... Prio [%s]: Main CSS [%s:%s:%s]")))) (let* ((dependency-resource-ids (dojo-core-dep-get-dep-resource-ids own-resource-id))) (dolist (dependency-resource-id dependency-resource-ids) (dojo-core-util-request-extraction-with-logging dojo-current-workspace dependency-resource-id 2 (concat "...... Prio [%s]: Import [%s:%s:%s]")))) (let* ((inverse-dep-sets (dojo-core-dep-get-all-inverse-dep-resource-ids own-resource-id)) (level 0)) (dojo-core-dep-log-inverse-dep-sets inverse-dep-sets) (dolist (inverse-dep-set inverse-dep-sets) (maphash (lambda (inverse-dep-resource-id ignored) (let* ((id-to-resource (dojo-workspace-id-to-resource dojo-current-workspace)) (inverse-dep-resource (gethash inverse-dep-resource-id id-to-resource)) (inverse-dep-deps (dojo-core-dep-get-dep-resource-ids inverse-dep-resource-id))) (dolist (inverse-dep-dep inverse-dep-deps) (dojo-core-util-request-extraction-with-logging dojo-current-workspace inverse-dep-dep (+ 3 (* 2 level)) (concat "...... Prio [%s]: Import [%s:%s:%s] of inverse dependency " (format "[%s:%s:%s]" (if inverse-dep-resource (dojo-resource-id inverse-dep-resource) "---") (if inverse-dep-resource (dojo-resource-project inverse-dep-resource) "---") (if inverse-dep-resource (dojo-resource-path inverse-dep-resource) "---")))))) (dojo-core-util-request-extraction-with-logging dojo-current-workspace inverse-dep-resource-id (+ 2 (* 2 level)) (concat "...... Prio [%s]: Inverse dependency [%s:%s:%s] at level " (format "[%s]" (- (length inverse-dep-sets) level))))) inverse-dep-set) (incf level))) (log-extract-prio (format "... Done.")) (dojo-core-util-log-extract-priorities)))) (defun dojo-core-workspace-get-resource-type (project file-path) (cond ((or (and (not (string= project "dojo-provider")) (string/ends-with file-path ".js")) (and (string= project "dojo-provider") (string/ends-with file-path ".js.uncompressed.js"))) "js") ((string/ends-with file-path "services.xml") "blueprint") ((string/ends-with file-path ".java") "java") ((string/ends-with file-path ".css") "css") ((string/ends-with file-path "/pom.xml") "pom") (t nil))) (defun dojo-core-workspace-choose-extract-resource (workstate) ; (if (< (dojo-core-workspace-get-time-since-last-input) dojo-post-input-silence-interval) ; (progn ; (log-workloop (format "...... DO-EXTRACT will not do any work, since last input is too near.")) ; (dojo-core-workspace-goto-next-workstate) ; t) ; If an extraction was interrupted after extracting the AST, and before ; interpreting it, continue here. (let* ((do-continue t) (interrupted nil) (done nil) (time-since-last-input (dojo-core-workspace-get-time-since-last-input)) (estimation-factor (if (null dojo-post-input-estimation-factor) 1 dojo-post-input-estimation-factor)) (estimated-time-limit (if (null time-since-last-input) nil (/ time-since-last-input estimation-factor)))) (while do-continue (cond ((not (null (dojo-workspace-curr-parse-ast dojo-current-workspace))) (let ((ast (dojo-workspace-curr-parse-ast dojo-current-workspace)) (resource (dojo-workspace-curr-parse-resource dojo-current-workspace))) (log-workloop (format "...... [RESUME] Will continue extraction of resource [%s:%s:%s]" (dojo-resource-id resource) (dojo-resource-project resource) (dojo-resource-path resource))) (log-workspace (format "[RESUME ] Will continue extraction of resource %s:%s" (dojo-resource-project resource) (dojo-resource-path resource))) (log-extract-prio (format "[RESUME] Will continue extraction of resource [%s:%s:%s]" (dojo-resource-id resource) (dojo-resource-project resource) (dojo-resource-path resource))) (dojo-core-window-trigger-redisplay) (dojo-js-extract-extract-from-current-buffer dojo-current-workspace resource dojo-catch-extract-errors ast) (dojo-core-util-cleanup-on-done-extraction dojo-current-workspace (dojo-resource-id resource)) (setf (dojo-workspace-curr-parse-ast dojo-current-workspace) nil) (setf (dojo-workspace-curr-parse-resource dojo-current-workspace) nil) (setq done t))) (t (let* ((priority-to-resource-to-count (dojo-workspace-priority-to-resource-to-count dojo-current-workspace)) (max-priority (dojo-workspace-max-priority dojo-current-workspace)) (curr-priority max-priority) (done-this-time nil) (id-to-resource (dojo-workspace-id-to-resource dojo-current-workspace))) (log-workspace-details (format "... done = [%s], curr-priority = [%s], max-priority = [%s], time-limit [%s]" done curr-priority max-priority estimated-time-limit)) (log-workspace-details (format "... loop: done = [%s], done-this-time [%s], curr-priority = [%s], max-priority = [%s]" done done-this-time curr-priority max-priority)) (let ((resource-to-count (gethash curr-priority priority-to-resource-to-count))) (log-workspace-details (format "... resource-to-count [%s]" resource-to-count)) (if resource-to-count (let* ((max-count 0) (max-count-resource-id nil) ; We want to process the resource with maximum count first (because it was requested first). ; But because finding it is an O(n) loop, for safety, we limit the number of iterations ; while searching. (max-search-count 50) (curr-search-count 0)) (catch 'stop-loop (maphash (lambda (resource-id count) (log-workspace-details (format "Considering resource-id [%s], count [%s], max-count [%s]" resource-id count max-count)) (if (> count max-count) (let* ((resource (gethash resource-id id-to-resource)) (state (if resource (dojo-resource-state resource) nil)) (type (if resource (dojo-resource-type resource) nil))) ; In generally, exclude classes which were already registered as parse-failed. ; But make an exception for the own class, as it might change with a high ; probabiliy, which might resolve the cause for parse-failed. (log-workspace-details (format "... type [%s], state [%s], curr-priority [%s]" type state curr-priority)) (if (or (dojo-core-workspace-is-any-js-resource resource) (dojo-core-workspace-is-css-resource resource)) (if (or (< curr-priority 2) (not (string= state "parse-failed"))) (let* ((estimated-extract-time (dojo-core-workspace-estimate-extract-time resource)) (choose (or (null estimated-time-limit) (< estimated-extract-time estimated-time-limit)))) (log-workloop (format "......... %s resource [%s:%s:%s], since estimated extract time: [%s] and time limit [%s]" (if choose "Choosing" "Skipping") (dojo-resource-id resource) (dojo-resource-project resource) (dojo-resource-path resource) estimated-extract-time estimated-time-limit)) (if choose (progn (setq max-count count) (setq max-count-resource-id resource-id) (incf curr-search-count)))) (log-workspace (format (concat "[WARNING] Will not extract resource [%s:%s:%s] with priority [%s], " "since it is in state 'parse-failed'.") resource-id (dojo-resource-project resource) (dojo-resource-path resource) curr-priority)))))) (if (>= curr-search-count max-search-count) (throw 'stop-loop nil))) resource-to-count)) (if max-count-resource-id (progn (let* ((id-to-class (dojo-workspace-id-to-class dojo-current-workspace)) (max-count-resource (gethash max-count-resource-id id-to-resource)) (max-count-state (dojo-resource-state max-count-resource)) (max-count-class-id (dojo-resource-parsed-id max-count-resource)) (max-count-class (if (null max-count-class-id) nil (gethash max-count-class-id id-to-class))) (aborted nil)) (log-workspace-details (format (concat "Will check wether we want to extract " "resource-id [%s:%s:%s] with priority [%s]") max-count-resource-id (if max-count-resource (dojo-resource-project max-count-resource) "---") (if max-count-resource (dojo-resource-path max-count-resource) "---") curr-priority)) (setf (dojo-workspace-curr-priority dojo-current-workspace) curr-priority) (unwind-protect (progn (setf (dojo-workspace-curr-parse-ast dojo-current-workspace) nil) (setf (dojo-workspace-curr-parse-resource dojo-current-workspace) nil) (log-extract-prio (format "[EXTRACT] Prio [%s]: Will extract resource [%s:%s:%s]" curr-priority (dojo-resource-id max-count-resource) (dojo-resource-project max-count-resource) (dojo-resource-path max-count-resource))) (log-workloop (format "...... [EXTRACT] Will extract resource [%s:%s:%s]" (dojo-resource-id max-count-resource) (dojo-resource-project max-count-resource) (dojo-resource-path max-count-resource))) (dojo-core-window-trigger-redisplay) (let* ((max-count-resource (gethash max-count-resource-id id-to-resource))) (cond ((dojo-core-workspace-is-any-js-resource max-count-resource) (dojo-do-extract-js dojo-current-workspace max-count-resource dojo-catch-extract-errors) (log-workloop (format "......... Done."))) ((dojo-core-workspace-is-css-resource max-count-resource) (dojo-css-parse-extract-resource max-count-resource) (log-workloop (format "......... Done."))) (t (log-workloop (format "...... [IGNORED] Kind of resource [%s]" (dojo-resource-type resource))))))) (if (null (dojo-workspace-curr-parse-ast dojo-current-workspace)) (progn (log-workspace-details (format "... Having no curr-parse-ast.")) (setf (dojo-workspace-curr-priority dojo-current-workspace) nil)))) ; If the curr-parse-ast is not null at this point, we ran out of time / were ; interrupted by user input after extracting the AST, and before interpreting it. ; Thus, in that case at this point we are not really finished, but just want to go ; out of this function. (if (null (dojo-workspace-curr-parse-ast dojo-current-workspace)) (progn (log-workspace-details (format "... Having no curr-parse-ast, will do cleanup tasks.")) (dojo-core-util-cleanup-on-done-extraction dojo-current-workspace max-count-resource-id) (setf (dojo-workspace-last-extract-utcseconds dojo-current-workspace) (float-time)))) (setq done-this-time t))))))) (if done-this-time (setq done t) (setq do-continue nil))))) (if (dojo-core-workspace-check-for-input) (progn (log-workloop (format "......... choose-extract was interrupted by user input.")) (setq interrupted t) (setq do-continue nil))) (if (not done) (setq do-continue nil)) (dojo-core-window-trigger-redisplay)) (if done (dojo-core-workspace-register-next-execution workstate 0) (dojo-core-workspace-register-next-execution workstate dojo-extract-interval)) (not interrupted))) (defun dojo-core-workspace-estimate-extract-time (resource) (let* ((last-ast-time (dojo-resource-last-ast-time resource)) (last-parse-time (dojo-resource-last-parse-time resource)) (last-parsed-size (dojo-resource-last-parsed-size resource))) (cond ((dojo-core-workspace-is-any-js-resource resource) (if (or (null last-ast-time) (null last-parse-time)) (let* ((total-js-extract-time (dojo-workspace-total-js-extract-time dojo-current-workspace)) (total-js-extract-size (dojo-workspace-total-js-extract-size dojo-current-workspace)) (total-js-extract-count (dojo-workspace-total-js-extract-count dojo-current-workspace)) (average-time-per-byte (if (and (> total-js-extract-time 0) (> total-js-extract-size 0)) (/ total-js-extract-time (float total-js-extract-size)) nil))) (if (or (null average-time-per-byte) (null last-parsed-size)) 1.0 (* last-parsed-size average-time-per-byte))) (+ last-ast-time last-parse-time))) ((dojo-core-workspace-is-css-resource resource) ; Maybe TODO: Do some kind of calculation here. 0.1) (t 1.0)))) (defun dojo-core-workspace-goto-next-savestate-with-work (save-workstate) "Starting at the current savestate, this function moves to the next save state for which work needs to be done at the moment. 'Work needs to be done' is defined by (1) the sets with dirty projects, classes, etc. (2) the save intervals as defined by dojo-save-*-interval --- don't save things, if the previous save is too near. This function sets the state of the given workstate as appropriate, and returns wether for that workstate, work needs to be done at the moment. If this function returns nil, DOJO-WORKSTATE-SAVE does not have any pending work to be done at the moment." (let* ((savestate (dojo-workstate-state save-workstate)) (initial-savestate nil) (do-continue t) (work-needs-to-be-done nil) (current-time (float-time)) (last-save-api-utcseconds (dojo-workspace-last-save-api-utcseconds dojo-current-workspace)) (last-save-classes-utcseconds (dojo-workspace-last-save-classes-utcseconds dojo-current-workspace)) (last-save-dependencies-utcseconds (dojo-workspace-last-save-dependencies-utcseconds dojo-current-workspace)) (last-save-resources-utcseconds (dojo-workspace-last-save-resources-utcseconds dojo-current-workspace))) (if (null savestate) (progn (log-workloop (format "...... [DOJO-SAVESTATE-API] is the initial savestate.")) (setq savestate 'DOJO-SAVESTATE-API)) (log-workloop (format "...... [%s] is the current savestate we start with." savestate))) (log-workloop (format "......... Last utcseconds: api [%s], classes [%s], dependencies [%s], resources [%s]" last-save-api-utcseconds last-save-classes-utcseconds last-save-dependencies-utcseconds last-save-resources-utcseconds)) (log-workloop (format "......... Intervals: api [%s], classes [%s], dependencies [%s], resources [%s]" dojo-save-api-interval dojo-save-classes-interval dojo-save-dependencies-interval dojo-save-resources-interval)) (log-workloop (format "......... Time-since: api [%s], classes [%s], dependencies [%s], resources [%s]" (if (null last-save-api-utcseconds) "---" (- current-time last-save-api-utcseconds)) (if (null last-save-classes-utcseconds) "---" (- current-time last-save-classes-utcseconds)) (if (null last-save-dependencies-utcseconds) "---" (- current-time last-save-dependencies-utcseconds)) (if (null last-save-resources-utcseconds) "---" (- current-time last-save-resources-utcseconds)))) (log-workloop (format "......... Remaining work counts: api [%s], classes [%s], dependencies [%s], resources [%s]" (hash-table-count (dojo-workspace-dirty-api-path-keys dojo-current-workspace)) (hash-table-count (dojo-workspace-class-ids-to-save dojo-current-workspace)) (hash-table-count (dojo-workspace-dirty-dep-projects dojo-current-workspace)) (hash-table-count (dojo-workspace-resource-projects-to-save dojo-current-workspace)))) ; Record where we started, to break out of the loop before we do things for the second time. (setq initial-savestate savestate) (while do-continue ; Check wether for the current save state, work needs to be done. ; This in particular can have the result, that we stay in the current save state. (cond ((eq savestate 'DOJO-SAVESTATE-API) (setq work-needs-to-be-done (and (> (hash-table-count (dojo-workspace-dirty-api-path-keys dojo-current-workspace)) 0) (or (null last-save-api-utcseconds) (> (- current-time last-save-api-utcseconds) dojo-save-api-interval))))) ((eq savestate 'DOJO-SAVESTATE-CLASSES) (setq work-needs-to-be-done (and (> (hash-table-count (dojo-workspace-class-ids-to-save dojo-current-workspace)) 0) (or (null last-save-classes-utcseconds) (> (- current-time last-save-classes-utcseconds) dojo-save-classes-interval))))) ((eq savestate 'DOJO-SAVESTATE-DEPENDENCIES) (setq work-needs-to-be-done (and (> (hash-table-count (dojo-workspace-dirty-dep-projects dojo-current-workspace)) 0) (or (null last-save-dependencies-utcseconds) (> (- current-time last-save-dependencies-utcseconds) dojo-save-dependencies-interval))))) ((eq savestate 'DOJO-SAVESTATE-RESOURCES) (setq work-needs-to-be-done (and (> (hash-table-count (dojo-workspace-resource-projects-to-save dojo-current-workspace)) 0) (or (null last-save-resources-utcseconds) (> (- current-time last-save-resources-utcseconds) dojo-save-resources-interval)))))) (log-workloop (format "......... [%s]: [%s] needs to be done." savestate (if work-needs-to-be-done "Work" "No work"))) ; Work for the current SAVESTATE needs to be done, stop the loop. (if work-needs-to-be-done (setq do-continue nil) ; Move savestate to the next one. (cond ((eq savestate 'DOJO-SAVESTATE-API) (setq savestate 'DOJO-SAVESTATE-CLASSES)) ((eq savestate 'DOJO-SAVESTATE-CLASSES) (setq savestate 'DOJO-SAVESTATE-DEPENDENCIES)) ((eq savestate 'DOJO-SAVESTATE-DEPENDENCIES) (setq savestate 'DOJO-SAVESTATE-RESOURCES)) ((eq savestate 'DOJO-SAVESTATE-RESOURCES) (setq savestate 'DOJO-SAVESTATE-API)) (t (log-workloop (format "[WARNING] Found illegal savestate [%s], will abort here." savestate)) (setq do-continue nil))) ; We tried every savestate, for none additional work needs to be done at the moment. (if (eq savestate initial-savestate) (progn (setq work-needs-to-be-done nil) (setq do-continue nil))))) (log-workloop (format "......... [%s] is the new savestate, with [%s] to be done." savestate (if work-needs-to-be-done "work" "no work"))) (setf (dojo-workstate-state save-workstate) savestate) work-needs-to-be-done)) (defun dojo-core-workspace-save-in-timer (workstate) (let* ((interrupted nil) (do-continue t) (work-needs-to-be-done nil) (work-done nil)) ; Save order: First API, then classes, then dependencies, then resources. (while do-continue (let* ((savestate nil) (result nil)) (setq work-needs-to-be-done (dojo-core-workspace-goto-next-savestate-with-work workstate)) (setq work-done nil) (setq savestate (dojo-workstate-state workstate)) (cond ((not work-needs-to-be-done) (log-workloop (format "......... [%s] no work needs to be done at the moment." savestate)) (setq do-continue nil)) ; Call the different work functions. They should try to perform as much work as possible ; in a loop / maphash / etc., but check (dojo-core-workspace-check-for-input) quite often ; (e.g. after each saved file). If input was recorded, they need to abort quickly. ; The return value stored in variable 'result' needs to be a list with two elements, ; (list interrupted any-work-done). ((eq savestate 'DOJO-SAVESTATE-API) (setq result (dojo-core-workspace-save-api-classes))) ((eq savestate 'DOJO-SAVESTATE-CLASSES) (setq result (dojo-core-workspace-save-classes))) ((eq savestate 'DOJO-SAVESTATE-DEPENDENCIES) (setq result (dojo-core-workspace-save-dependency-files))) ((eq savestate 'DOJO-SAVESTATE-RESOURCES) (setq result (dojo-core-workspace-save-resource-files))) (t (log-workloop (format "[WARNING] Found illegal savestate [%s], will abort save main loop here." savestate)) (setq do-continue nil))) ; Process results. (if (not (null result)) (progn (setq interrupted (nth 0 result)) (setq work-done (nth 1 result)))) (log-workloop (format "......... [%s] has [%s] work, interrupted [%s]" savestate (if work-done "done" "not done") interrupted)) (if (or interrupted (not work-done)) (progn (log-workloop (format "......... [%s] No work has been done, aborting save main loop here." savestate)) (setq do-continue nil))))) (cond (interrupted ; Interrupted by user input, we want to continue next time we can (log-workloop (format "......... Interrupted by user input, will continue later.")) nil) ((not work-needs-to-be-done) ; No more work needs to be done, we are finished. (log-workloop (format "......... No more work needs to be done, will register the next execution.")) (dojo-core-workspace-register-next-execution workstate (min dojo-save-api-interval dojo-save-classes-interval dojo-save-dependencies-interval dojo-save-resources-interval)) t) ; More work needs do be done, but wasn't done (e.g. because the estimated time was too high. ; Don't postpone the SAVE-WORKSTATE, but give others the chance to do their work until we ; can do our work at some time later. (t (dojo-core-workspace-register-next-execution workstate 0) (log-workloop (format "......... More work needs to be done, but wasn't done, e.g. due to high estimated work time. Will continue later.")) t)))) ; (let* ((interrupted (dojo-core-save-save-touched-classes dojo-current-workspace nil))) ; (if (< (dojo-core-workspace-get-time-since-last-input) dojo-post-input-silence-interval) ; (progn ; (log-workloop (format "...... SAVE will not do any work, since last input is too near.")) ; (dojo-core-workspace-goto-next-workstate) ; t) (defun dojo-core-workspace-save-api-classes () (let* ((dirty-api-path-keys (dojo-workspace-dirty-api-path-keys dojo-current-workspace)) (api-path-keys-saved ()) (interrupted nil) (time-since-last-input (dojo-core-workspace-get-time-since-last-input)) (estimation-factor (if (null dojo-post-input-estimation-factor) 1 dojo-post-input-estimation-factor)) (estimated-time-limit (if (null time-since-last-input) nil (/ time-since-last-input estimation-factor)))) (catch 'stop-maphash (maphash (lambda (path-key ignored) (if (dojo-core-workspace-check-for-input) (progn (setq interrupted t) (throw 'stop-maphash nil))) (let* ((estimated-save-time (dojo-core-workspace-get-estimated-api-save-time path-key)) (choose (or (null estimated-time-limit) (< estimated-save-time estimated-time-limit)))) (log-workloop (format "............ [%s] Estimated save time for api.xml is [%s], with limit [%s], will [%s] it now." path-key estimated-save-time estimated-time-limit (if choose "save" "not save"))) (if choose (progn (log-user (format "[SAVE] Saving api.xml for path key [%s]" path-key)) (dojo-core-save-save-api-file dojo-current-workspace path-key) (log-user "... Done.") (push path-key api-path-keys-saved))))) dirty-api-path-keys)) (dolist (api-path-key-saved api-path-keys-saved) (remhash api-path-key-saved dirty-api-path-keys)) (if (not interrupted) (setf (dojo-workspace-last-save-api-utcseconds dojo-current-workspace) (float-time))) (list interrupted (> (length api-path-keys-saved) 0)))) (defun dojo-core-workspace-get-estimated-api-save-time (path-key) 0.5) (defun dojo-core-workspace-save-classes () (let* ((class-ids-to-save (dojo-workspace-class-ids-to-save dojo-current-workspace)) (class-ids-saved ()) (interrupted nil) (time-since-last-input (dojo-core-workspace-get-time-since-last-input)) (estimation-factor (if (null dojo-post-input-estimation-factor) 1 dojo-post-input-estimation-factor)) (estimated-time-limit (if (null time-since-last-input) nil (/ time-since-last-input estimation-factor)))) (catch 'stop-maphash (maphash (lambda (class-id ignored) (if (dojo-core-workspace-check-for-input) (progn (setq interrupted t) (throw 'stop-maphash nil))) (let* ((estimated-save-time (dojo-core-workspace-get-estimated-class-save-time class-id)) (choose (or (null estimated-time-limit) (< estimated-save-time estimated-time-limit))) (id-to-class (dojo-workspace-id-to-class dojo-current-workspace)) (class (gethash class-id id-to-class)) (project (cond ((dojo-class-p class) (dojo-class-project class)) ((dojo-css-file-p class) (dojo-css-file-project class)) (t "---"))) (path (cond ((dojo-class-p class) (dojo-class-path class)) ((dojo-css-file-p class) (dojo-css-file-path class)) (t "---")))) (log-workloop (format "............ [%s:%s:%s] Estimated save time for class is [%s], with limit [%s], will [%s] it now." class-id project path estimated-save-time estimated-time-limit (if choose "save" "not save"))) (if choose (progn (log-user (format "[SAVE] Saving class [%s:%s:%s]" class-id project path)) (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-user (format "[WARNING] Unrecognized case when saving class. Unsupported type, or missing project/path.")))) (log-user (format "... Done.")) (push class-id class-ids-saved))))) class-ids-to-save)) (dolist (class-id-saved class-ids-saved) (remhash class-id-saved class-ids-to-save)) (if (not interrupted) (setf (dojo-workspace-last-save-classes-utcseconds dojo-current-workspace) (float-time))) (list interrupted (> (length class-ids-saved) 0)))) (defun dojo-core-workspace-get-estimated-class-save-time (class-id) 0.5) (defun dojo-core-workspace-save-dependency-files () (let* ((dirty-dep-projects (dojo-workspace-dirty-dep-projects dojo-current-workspace)) (dep-projects-saved ()) (interrupted nil) (time-since-last-input (dojo-core-workspace-get-time-since-last-input)) (estimation-factor (if (null dojo-post-input-estimation-factor) 1 dojo-post-input-estimation-factor)) (estimated-time-limit (if (null time-since-last-input) nil (/ time-since-last-input estimation-factor)))) (catch 'stop-maphash (maphash (lambda (project ignored) (if (dojo-core-workspace-check-for-input) (progn (setq interrupted t) (throw 'stop-maphash nil))) (let* ((estimated-save-time (dojo-core-workspace-get-estimated-dependency-save-time project)) (choose (or (null estimated-time-limit) (< estimated-save-time estimated-time-limit)))) (log-workloop (format "............ [%s] Estimated save time for dependency.xml is [%s], with limit [%s], will [%s] it now." project estimated-save-time estimated-time-limit (if choose "save" "not save"))) (if choose (progn (log-user (format "[SAVE] Saving dependency.xml for project [%s]" project)) (dojo-core-save-save-dep-file dojo-current-workspace project) (log-user "... Done.") (push project dep-projects-saved))))) dirty-dep-projects)) (dolist (dep-project-saved dep-projects-saved) (remhash dep-project-saved dirty-dep-projects)) (if (not interrupted) (setf (dojo-workspace-last-save-dependencies-utcseconds dojo-current-workspace) (float-time))) (list interrupted (> (length dep-projects-saved) 0)))) (defun dojo-core-workspace-get-estimated-dependency-save-time (project) 0.5) (defun dojo-core-workspace-save-resource-files () (let* ((resource-projects-to-save (dojo-workspace-resource-projects-to-save dojo-current-workspace)) (resource-projects-saved ()) (interrupted nil) (time-since-last-input (dojo-core-workspace-get-time-since-last-input)) (estimation-factor (if (null dojo-post-input-estimation-factor) 1 dojo-post-input-estimation-factor)) (estimated-time-limit (if (null time-since-last-input) nil (/ time-since-last-input estimation-factor))) (id-to-resource (dojo-workspace-id-to-resource dojo-current-workspace)) (project-to-resources (make-hash-table :test 'equal))) (maphash (lambda (id resource) (let* ((project (dojo-resource-project resource))) (if (and project (gethash project resource-projects-to-save)) (let* ((resources (gethash project project-to-resources))) (push resource resources) (puthash project resources project-to-resources))))) id-to-resource) (catch 'stop-maphash (maphash (lambda (project ignored) (if (dojo-core-workspace-check-for-input) (progn (setq interrupted t) (throw 'stop-maphash nil))) (let* ((estimated-save-time (dojo-core-workspace-get-estimated-resource-save-time project)) (choose (or (null estimated-time-limit) (< estimated-save-time estimated-time-limit)))) (log-workloop (format "............ [%s] Estimated save time for resources.xml is [%s], with limit [%s], will [%s] it now." project estimated-save-time estimated-time-limit (if choose "save" "not save"))) (if choose (progn (log-workloop (format "............... Saving [%s] resources for project [%s]" (length (gethash project project-to-resources)) project)) (log-user (format "[SAVE] Saving resources.xml for project [%s]" project)) (dojo-core-save-write-project-resources dojo-current-workspace project (gethash project project-to-resources)) (log-user (format "... Done.")) (push project resource-projects-saved))))) resource-projects-to-save)) (dolist (resource-project-saved resource-projects-saved) (remhash resource-project-saved resource-projects-to-save)) (if (not interrupted) (setf (dojo-workspace-last-save-resources-utcseconds dojo-current-workspace) (float-time))) (list interrupted (> (length resource-projects-saved) 0)))) (defun dojo-core-workspace-get-estimated-resource-save-time (project) 0.5) (defun dojo-core-workspace-remove-parse-failed () (interactive) (let* ((id-to-resource (dojo-workspace-id-to-resource dojo-current-workspace)) (resource-projects-to-save (dojo-workspace-resource-projects-to-save dojo-current-workspace))) (maphash (lambda (id resource) (let* ((state (dojo-resource-state resource)) (project (dojo-resource-project resource))) (if (string= state "parse-failed") (progn (log-workspace (format "Setting state of resource [%s:%s:%s] from [parse-failed] back to [located]" id project (dojo-resource-path resource))) (if project (puthash project t resource-projects-to-save)) (setf (dojo-resource-state resource) "located"))))) id-to-resource))) (defun dojo-workspace-get-surplus-resource-path-tokens (type project) ; The path-tokens we get here are against the top level project path. ; The path of the resource is built by cutting away several of the starting path ; tokens, depending on kind of resource and on project. (cond ((or (string= type "js") (string= type "css")) (cond ((string= project "dojo-clazzes") 6) ((string= project "dojo-provider") 6) (t 5))) ((string= type "blueprint") 5) ((string= type "java") 3) (t 0))) (defun dojo-workspace-get-path-from-tokens (type project path-tokens) (let* ((suffix "") (start-index (dojo-workspace-get-surplus-resource-path-tokens type project)) (curr-index nil)) (setq curr-index start-index) (while (< curr-index (length path-tokens)) (setq suffix (concat suffix (if (= curr-index start-index) "" "/") (nth curr-index path-tokens))) (setq curr-index (1+ curr-index))) (cond ((string/ends-with suffix ".js.uncompressed.js") (setq suffix (substring suffix 0 (- (length suffix) (length ".js.uncompressed.js"))))) ((string/ends-with suffix ".js") (setq suffix (substring suffix 0 (- (length suffix) (length ".js"))))) ((string/ends-with suffix ".java") (setq suffix (substring suffix 0 (- (length suffix) (length ".java")))) (setq suffix (replace-regexp-in-string "/" "." suffix)))) suffix)) (defun dojo-get-project-and-path (file-name) "Returns a list with two elements, containing the project and the path for the given file, within the workspace given by dojo-workspace-path. The path is given the same way as you would use it for an import in a Dojo js file, e.g. 'clazzes/TinyLog' Returns nil if the file name is outside the dojo-workspace-path, or doesn't meet the directory hierarchy we expect in some other aspect." ; Path examples: ; /home/wpausch/workspace/dojo-sketch.entities/src/main/resources/OSGI-INF/webapp/dojoSketch/entities/widgets/StrokeStyleDropDown.js ; ==> Workspace /home/wpausch/workspace/; project dojo-sketch.entities; then the magic path part "/src/main/resources/OSGI-INF/webapp/"; ; finally the path dojoSketch/entities/widgets/StrokeStyleDropDown.js ; /home/wpausch/workspace/dojo-clazzes/src/main/resources/OSGI-INF/webapp/dojo/clazzes/canvas/CanvasContext2D.js ; ==> Basically the same, just here the dojo part will be excluded. (if (or (null file-name) (not (starts-with file-name dojo-workspace-path))) nil (let* ((path-within-workspace (substring file-name (length dojo-workspace-path))) (end-project-pos (string-match "/" path-within-workspace)) ) (if (null end-project-pos) nil (let* ((project (substring path-within-workspace 0 end-project-pos)) (type (dojo-core-workspace-get-resource-type project file-name)) (token-count-to-remove (+ (dojo-workspace-get-surplus-resource-path-tokens type project) 1)) (suffix-start-index (dojo-common-string-get-position-after-nth-match path-within-workspace "/" token-count-to-remove)) (raw-path (substring path-within-workspace suffix-start-index)) (path (cond ((string/ends-with raw-path ".js.uncompressed") (substring raw-path 0 (- (length raw-path) 16))) (t (substring raw-path 0 (last-index-of raw-path "\\.")))))) (list project path type)))))) (defun dojo-get-current-project-and-path () (dojo-get-project-and-path buffer-file-name) ) (defun dojo-core-workspace-get-current-class () (let* ((project-and-path (dojo-get-current-project-and-path)) (project (nth 0 project-and-path)) (path (nth 1 project-and-path)) (workspace dojo-current-workspace) (current-class (if (and workspace project path) (dojo-workspace-get-class workspace project path) nil)) ) current-class ) ) (defun dojo-core-workspace-get-or-create-current-class () (let* ((current-class (dojo-core-workspace-get-current-class)) (resource (dojo-core-util-get-current-resource))) (if current-class current-class (dojo-extract-own-class-from-ast dojo-current-workspace resource nil) (let ((current-class-now (dojo-core-workspace-get-current-class))) (if current-class-now current-class-now (log-workspace (format "We tried our very best to (create if necessary) and return a class for file [%s], however we didn't succeed." buffer-file-name)) nil))))) (defun dojo-core-workspace-get-current-css-prefix () (let* ((current-class (dojo-core-workspace-get-current-class)) (annotation (if current-class (dojo-core-util-get-annotation-by-key current-class "css-prefix") nil))) (if annotation (dojo-annotation-value annotation) nil))) (defun dojo-core-workspace-get-current-i18n-prefix () (let* ((current-class (dojo-core-workspace-get-current-class)) (annotation (if current-class (dojo-core-util-get-annotation-by-key current-class "i18n-prefix") nil))) (if annotation (dojo-annotation-value annotation) nil))) (defun dojo-core-workspace-populate-maps-from-class (id-to-class id-to-symbol class) (let* ((import-to-symbol (dojo-class-import-to-symbol class)) (define-var-to-symbol (dojo-class-define-var-to-symbol class)) (this-symbol (dojo-class-this-symbol class)) (static-symbol (dojo-class-static-symbol class))) (dojo-core-workspace-populate-maps-from-symbol-map id-to-symbol import-to-symbol) (dojo-core-workspace-populate-maps-from-symbol-map id-to-symbol define-var-to-symbol) (dojo-core-workspace-populate-maps-from-symbol id-to-symbol this-symbol) (dojo-core-workspace-populate-maps-from-symbol id-to-symbol static-symbol) (puthash (dojo-class-id class) class id-to-class))) (defun dojo-core-workspace-populate-maps-from-symbol-map (id-to-symbol symbol-map) (let ((keys (hash-table-get-all-keys symbol-map))) (dolist (key keys) (dojo-core-workspace-populate-maps-from-symbol id-to-symbol (gethash key symbol-map))))) (defun dojo-core-workspace-populate-maps-from-symbol (id-to-symbol symbol) (if symbol (let ((type (dojo-symbol-type symbol)) (details (dojo-symbol-details symbol))) (puthash (dojo-symbol-id symbol) symbol id-to-symbol) (cond ((eq type 'DOJO-JSTYPE-ARRAY) (dojo-core-workspace-populate-maps-from-array id-to-symbol details)) ((eq type 'DOJO-JSTYPE-ARRAY-OR-OBJECT) (dojo-core-workspace-populate-maps-from-object id-to-symbol details)) ((eq type 'DOJO-JSTYPE-FUNCTION) (dojo-core-workspace-populate-maps-from-function id-to-symbol details)) ((eq type 'DOJO-JSTYPE-OBJECT) (dojo-core-workspace-populate-maps-from-object id-to-symbol details)))))) (defun dojo-core-workspace-populate-maps-from-array (id-to-symbol array-details) (let ((value-type (dojo-array-value-type array-details))) (dojo-core-workspace-populate-maps-from-symbol id-to-symbol value-type))) (defun dojo-core-workspace-populate-maps-from-function (id-to-symbol function-details) (let ((arguments (dojo-function-arguments function-details)) (return-type (dojo-function-return-type function-details)) (builtin-fct (dojo-function-builtin-fct function-details)) (scope (dojo-function-scope function-details))) (dolist (argument arguments) (dojo-core-workspace-populate-maps-from-symbol id-to-symbol argument)) (dojo-core-workspace-populate-maps-from-symbol id-to-symbol return-type) (dojo-core-workspace-populate-maps-from-symbol id-to-symbol builtin-fct) (if scope (dojo-core-workspace-populate-maps-from-scope id-to-symbol scope)))) (defun dojo-core-workspace-populate-maps-from-object (id-to-symbol object-details) (let ((key-type (dojo-object-value-type object-details)) (value-type (dojo-object-value-type object-details)) (name-to-symbol (dojo-object-name-to-symbol object-details))) (dojo-core-workspace-populate-maps-from-symbol id-to-symbol key-type) (dojo-core-workspace-populate-maps-from-symbol id-to-symbol value-type) (dojo-core-workspace-populate-maps-from-symbol-map id-to-symbol name-to-symbol))) (defun dojo-core-workspace-populate-maps-from-scope (id-to-symbol scope) (let* ((name-to-symbol (dojo-scope-name-to-symbol scope)) (names (hash-table-get-all-keys name-to-symbol))) (dolist (name names) (let ((symbol-or-scope (gethash name name-to-symbol))) (cond ((null symbol-or-scope) ()) ((dojo-symbol-p symbol-or-scope) (dojo-core-workspace-populate-maps-from-symbol id-to-symbol symbol-or-scope)) ((dojo-scope-p symbol-or-scope) (dojo-core-workspace-populate-maps-from-scope id-to-symbol symbol-or-scope)) (t (log-workspace (format "[WARNING] dojo-core-workspace-populate-maps-from-scope found unsupported value: [%s]" symbol-or-scope)))))))) (defun dojo-core-workspace-derive-css-files (workspace) (log-workspace (format "Deriving css files...")) (let* ((name-to-project (dojo-workspace-name-to-project workspace)) (id-to-resource (dojo-workspace-id-to-resource workspace))) (maphash (lambda (id resource) (if (string= (dojo-resource-type resource) "css") (let* ((project-name (dojo-resource-project resource)) (project (if project-name (gethash project-name name-to-project) nil)) (key-to-resource-id (if project (dojo-project-css-resources project) nil))) (puthash id id key-to-resource-id) (if (dojo-css-parse-is-main-css-resource resource) (puthash DOJO-PROJECT-CSS-MAIN id key-to-resource-id))))) id-to-resource) (setf (dojo-workspace-project-to-css-resources workspace) project-to-css-resources) (log-workspace (format "... done.")))) (defun dojo-core-workspace-extract-current-file () "Extracts the currently opened file. Detects the file type (e.g. js, blueprint, etc.), and then delegates to specialized code." (interactive) (let* ((own-resource (dojo-core-util-get-current-resource)) (type (if own-resource (dojo-resource-type own-resource) nil))) (log-workspace-details (format "Called dojo-core-workspace-extract-current-file, own-resource is [%s:%s:%s] with type [%s]" (if own-resource (dojo-resource-id own-resource) "---") (if own-resource (dojo-resource-project own-resource) "---") (if own-resource (dojo-resource-path own-resource) "---") type)) (cond ((dojo-core-workspace-is-any-js-resource own-resource) (dojo-js-extract-extract-own-class-manually own-resource)) ((dojo-core-workspace-is-css-resource own-resource) (dojo-css-parse-extract-resource-manually own-resource)) ((string= type "blueprint") (log-workspace-details (format "About to extract blueprint resource %s" (dojo-core-util-resource-to-string own-resource)))) (t (log-workspace-details (format "Extracting resource %s not yet implemented." (dojo-core-util-resource-to-string own-resource))))))) (defun dojo-core-workspace-derive-java-names-if-necessary () (let ((java-classes-sorted-by-name (dojo-workspace-java-classes-sorted-by-name dojo-current-workspace))) (if (null java-classes-sorted-by-name) (progn (log-blueprint-completion (format "Completion data for java classes was not yet calculated, will do that now, wait a moment...")) (dojo-core-workspace-derive-java-names) (log-blueprint-completion (format "... Done. Completion data for java classes successfully calculated.")))))) (defun dojo-core-workspace-derive-java-names () (let* ((id-to-resource (dojo-workspace-id-to-resource dojo-current-workspace)) (java-count 0)) (maphash (lambda (id resource) (if (string= (dojo-resource-type resource) "java") (incf java-count))) id-to-resource) (let* ((classes (make-vector java-count nil)) (index 0)) ; (qualified-class-index-to-resource-id (make-hash-table :test 'equal)) ; (unqualified-class-names (make-vector java-count nil)) ; (unqualified-class-index-to-resource-id (make-hash-table :test 'equal))) (maphash (lambda (id resource) (let* ((type (dojo-resource-type resource)) (path (dojo-resource-path resource))) (if (string= type "java") (let* ((path-without-suffix (substring path 0 (string-match "\\.java" path))) (qualified-class-name (replace-regexp-in-string "/" "." path-without-suffix)) (last-dot-index (last-index-of qualified-class-name "\\.")) (class-name (substring qualified-class-name (1+ last-dot-index))) (class (construct-dojo-java-class qualified-class-name class-name id))) ; (log-workspace-details (format "path [%s], qualified [%s], class [%s]" path qualified-class-name class-name)) (aset classes index class) (incf index))))) id-to-resource) (log-blueprint-completion (format "Will set vectors of [%s] (un)qualified class names." (length classes))) (let* ((java-classes-sorted-by-qualified-name (seq-sort-by (lambda (java-class) (dojo-java-class-qualified-name java-class)) 'string< classes)) (java-classes-sorted-by-name (seq-sort-by (lambda (java-class) (dojo-java-class-name java-class)) 'string< classes))) (setf (dojo-workspace-java-classes-sorted-by-qualified-name dojo-current-workspace) java-classes-sorted-by-qualified-name) (setf (dojo-workspace-java-classes-sorted-by-name dojo-current-workspace) java-classes-sorted-by-name))))) (defun dojo-core-workspace-idle-fct (&optional ignored) (let ((current-utcseconds (float-time)) (do-continue nil) (exec-map (dojo-workspace-exec-map dojo-current-workspace))) (dolist (workstate-symbol DOJO-WORKSTATE-DEFAULT-ORDER) (let* ((workstate (gethash workstate-symbol exec-map)) (next-exec-utcseconds (dojo-workstate-next-exec-utcseconds workstate))) ; (log-workloop (format "... [DOJO-WORKSTATE-IDLE] evaluates workstate [%s] with next-exec-utcseconds [%s]; current-utcseconds is [%s]" ; workstate-symbol next-exec-utcseconds current-utcseconds)) (if (or (null next-exec-utcseconds) (<= next-exec-utcseconds current-utcseconds)) (progn (log-workloop (format "... [DOJO-WORKSTATE-IDLE] activated [%s]" workstate-symbol)) (dojo-core-workspace-set-workstate workstate-symbol) (setq do-continue t) (return nil))))) (if (not do-continue) (log-workloop (format "... [DOJO-WORKSTATE-IDLE] Did not find a next workstate with work to be done, will remain in IDLE."))) do-continue)) (defun dojo-core-workspace-construct-exec-map () (let* ((current-utcseconds (float-time)) (exec-map (make-hash-table :test 'equal))) (puthash 'DOJO-WORKSTATE-IDLE (construct-dojo-workstate 'dojo-core-workspace-idle-fct nil current-utcseconds) exec-map) (puthash 'DOJO-WORKSTATE-SCAN (construct-dojo-workstate 'dojo-core-workspace-scan-workspace nil current-utcseconds) exec-map) (puthash 'DOJO-WORKSTATE-IMPORTS (construct-dojo-workstate 'dojo-core-workspace-extract-imports nil current-utcseconds) exec-map) (puthash 'DOJO-WORKSTATE-PLAN-EXTRACT (construct-dojo-workstate 'dojo-core-workspace-plan-extractions nil current-utcseconds) exec-map) (puthash 'DOJO-WORKSTATE-DO-EXTRACT (construct-dojo-workstate 'dojo-core-workspace-choose-extract-resource nil current-utcseconds) exec-map) (puthash 'DOJO-WORKSTATE-SAVE (construct-dojo-workstate 'dojo-core-workspace-save-in-timer nil current-utcseconds) exec-map) exec-map)) (provide 'dojo-core-workspace)