123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648 |
- (eval-when-compile
- (require 'cl))
- (require 'org)
- (require 'org-exp)
- (defgroup org-export-taskjuggler nil
- "Options for exporting Org-mode files to TaskJuggler."
- :tag "Org Export TaskJuggler"
- :group 'org-export)
- (defcustom org-export-taskjuggler-extension ".tjp"
- "Extension of TaskJuggler files."
- :group 'org-export-taskjuggler
- :type 'string)
- (defcustom org-export-taskjuggler-project-tag "taskjuggler_project"
- "Tag, property or todo used to find the tree containing all
- the tasks for the project."
- :group 'org-export-taskjuggler
- :type 'string)
- (defcustom org-export-taskjuggler-resource-tag "taskjuggler_resource"
- "Tag, property or todo used to find the tree containing all the
- resources for the project."
- :group 'org-export-taskjuggler
- :type 'string)
- (defcustom org-export-taskjuggler-default-project-version "1.0"
- "Default version string for the project."
- :group 'org-export-taskjuggler
- :type 'string)
- (defcustom org-export-taskjuggler-default-project-duration 280
- "Default project duration if no start and end date have been defined
- in the root node of the task tree, i.e. the tree that has been marked
- with `org-export-taskjuggler-project-tag'"
- :group 'org-export-taskjuggler
- :type 'integer)
- (defcustom org-export-taskjuggler-default-reports
- '("taskreport \"Gantt Chart\" {
- headline \"Project Gantt Chart\"
- columns hierarchindex, name, start, end, effort, duration, completed, chart
- timeformat \"%Y-%m-%d\"
- hideresource 1
- loadunit shortauto
- }"
- "resourcereport \"Resource Graph\" {
- headline \"Resource Allocation Graph\"
- columns no, name, utilization, freeload, chart
- loadunit shortauto
- sorttasks startup
- hidetask ~isleaf()
- }")
- "Default reports for the project."
- :group 'org-export-taskjuggler
- :type '(repeat (string :tag "Report")))
- (defcustom org-export-taskjuggler-default-global-properties
- "shift s40 \"Part time shift\" {
- workinghours wed, thu, fri off
- }
- "
- "Default global properties for the project. Here you typically
- define global properties such as shifts, accounts, rates,
- vacation, macros and flags. Any property that is allowed within
- the TaskJuggler file can be inserted. You could for example
- include another TaskJuggler file.
- The global properties are inserted after the project declaration
- but before any resource and task declarations."
- :group 'org-export-taskjuggler
- :type '(string :tag "Preamble"))
- (defvar org-export-taskjuggler-final-hook nil
- "Hook run at the end of TaskJuggler export, in the new buffer.")
- (defvar org-export-taskjuggler-old-level)
- (defun org-export-as-taskjuggler ()
- "Export parts of the current buffer as a TaskJuggler file.
- The exporter looks for a tree with tag, property or todo that
- matches `org-export-taskjuggler-project-tag' and takes this as
- the tasks for this project. The first node of this tree defines
- the project properties such as project name and project period.
- If there is a tree with tag, property or todo that matches
- `org-export-taskjuggler-resource-tag' this three is taken as
- resources for the project. If no resources are specified, a
- default resource is created and allocated to the project. Also
- the taskjuggler project will be created with default reports as
- defined in `org-export-taskjuggler-default-reports'."
- (interactive)
- (message "Exporting...")
- (setq-default org-done-keywords org-done-keywords)
- (let* ((tasks
- (org-taskjuggler-resolve-dependencies
- (org-taskjuggler-assign-task-ids
- (org-map-entries
- '(org-taskjuggler-components)
- org-export-taskjuggler-project-tag nil 'archive 'comment))))
- (resources
- (org-taskjuggler-assign-resource-ids
- (org-map-entries
- '(org-taskjuggler-components)
- org-export-taskjuggler-resource-tag nil 'archive 'comment)))
- (filename (expand-file-name
- (concat
- (file-name-sans-extension
- (file-name-nondirectory buffer-file-name))
- org-export-taskjuggler-extension)))
- (buffer (find-file-noselect filename))
- (org-export-taskjuggler-old-level 0)
- task resource)
- (unless tasks
- (error "No tasks specified"))
-
- (unless resources
- (setq resources
- `((("resource_id" . ,(user-login-name))
- ("headline" . ,user-full-name)
- ("level" . 1)))))
-
- (unless (assoc "allocate" (car tasks))
- (let ((task (car tasks))
- (resource-id (cdr (assoc "resource_id" (car resources)))))
- (setcar tasks (push (cons "allocate" resource-id) task))))
-
- (unless (assoc "start" (car tasks))
- (let ((task (car tasks))
- (time-string (format-time-string "%Y-%m-%d")))
- (setcar tasks (push (cons "start" time-string) task))))
-
- (unless (assoc "version" (car tasks))
- (let ((task (car tasks))
- (version org-export-taskjuggler-default-project-version))
- (setcar tasks (push (cons "version" version) task))))
- (with-current-buffer buffer
- (erase-buffer)
- (org-taskjuggler-open-project (car tasks))
- (insert org-export-taskjuggler-default-global-properties)
- (insert "\n")
- (dolist (resource resources)
- (let ((level (cdr (assoc "level" resource))))
- (org-taskjuggler-close-maybe level)
- (org-taskjuggler-open-resource resource)
- (setq org-export-taskjuggler-old-level level)))
- (org-taskjuggler-close-maybe 1)
- (setq org-export-taskjuggler-old-level 0)
- (dolist (task tasks)
- (let ((level (cdr (assoc "level" task))))
- (org-taskjuggler-close-maybe level)
- (org-taskjuggler-open-task task)
- (setq org-export-taskjuggler-old-level level)))
- (org-taskjuggler-close-maybe 1)
- (org-taskjuggler-insert-reports)
- (save-buffer)
- (or (org-export-push-to-kill-ring "TaskJuggler")
- (message "Exporting... done"))
- (current-buffer))))
- (defun org-export-as-taskjuggler-and-open ()
- "Export the current buffer as a TaskJuggler file and open it
- with the TaskJuggler GUI."
- (interactive)
- (let* ((file-name (buffer-file-name (org-export-as-taskjuggler)))
- (process-name "TaskJugglerUI")
- (command (concat process-name " " file-name)))
- (start-process-shell-command process-name nil command)))
- (defun org-taskjuggler-parent-is-ordered-p ()
- "Return true if the parent of the current node has a property
- \"ORDERED\". Return nil otherwise."
- (save-excursion
- (and (org-up-heading-safe) (org-entry-get (point) "ORDERED"))))
- (defun org-taskjuggler-components ()
- "Return an alist containing all the pertinent information for
- the current node such as the headline, the level, todo state
- information, all the properties, etc."
- (let* ((props (org-entry-properties))
- (components (org-heading-components))
- (level (nth 1 components))
- (headline (nth 4 components))
- (parent-ordered (org-taskjuggler-parent-is-ordered-p)))
- (push (cons "level" level) props)
- (push (cons "headline" headline) props)
- (push (cons "parent-ordered" parent-ordered) props)))
- (defun org-taskjuggler-assign-task-ids (tasks)
- "Given a list of tasks return the same list assigning a unique id
- and the full path to each task. Taskjuggler takes hierarchical ids.
- For that reason we have to make ids locally unique and we have to keep
- a path to the current task."
- (let ((previous-level 0)
- unique-ids unique-id
- path
- task resolved-tasks tmp)
- (dolist (task tasks resolved-tasks)
- (let ((level (cdr (assoc "level" task))))
- (cond
- ((< previous-level level)
- (setq unique-id (org-taskjuggler-get-unique-id task (car unique-ids)))
- (dotimes (tmp (- level previous-level))
- (push (list unique-id) unique-ids)
- (push unique-id path)))
- ((= previous-level level)
- (setq unique-id (org-taskjuggler-get-unique-id task (car unique-ids)))
- (push unique-id (car unique-ids))
- (setcar path unique-id))
- ((> previous-level level)
- (dotimes (tmp (- previous-level level))
- (pop unique-ids)
- (pop path))
- (setq unique-id (org-taskjuggler-get-unique-id task (car unique-ids)))
- (push unique-id (car unique-ids))
- (setcar path unique-id)))
- (push (cons "unique-id" unique-id) task)
- (push (cons "path" (mapconcat 'identity (reverse path) ".")) task)
- (setq previous-level level)
- (setq resolved-tasks (append resolved-tasks (list task)))))))
- (defun org-taskjuggler-assign-resource-ids (resources &optional unique-ids)
- "Given a list of resources return the same list, assigning a
- unique id to each resource."
- (cond
- ((null resources) nil)
- (t
- (let* ((resource (car resources))
- (unique-id (org-taskjuggler-get-unique-id resource unique-ids)))
- (push (cons "unique-id" unique-id) resource)
- (cons resource
- (org-taskjuggler-assign-resource-ids (cdr resources)
- (cons unique-id unique-ids)))))))
- (defun org-taskjuggler-resolve-dependencies (tasks)
- (let ((previous-level 0)
- siblings
- task resolved-tasks)
- (dolist (task tasks resolved-tasks)
- (let* ((level (cdr (assoc "level" task)))
- (depends (cdr (assoc "depends" task)))
- (parent-ordered (cdr (assoc "parent-ordered" task)))
- (blocker (cdr (assoc "BLOCKER" task)))
- (blocked-on-previous
- (and blocker (string-match "previous-sibling" blocker)))
- (dependencies
- (org-taskjuggler-resolve-explicit-dependencies
- (append
- (and depends (org-taskjuggler-tokenize-dependencies depends))
- (and blocker (org-taskjuggler-tokenize-dependencies blocker)))
- tasks))
- previous-sibling)
-
- (cond
- ((< previous-level level)
- (dotimes (tmp (- level previous-level))
- (push task siblings)))
- ((= previous-level level)
- (setq previous-sibling (car siblings))
- (setcar siblings task))
- ((> previous-level level)
- (dotimes (tmp (- previous-level level))
- (pop siblings))
- (setq previous-sibling (car siblings))
- (setcar siblings task)))
-
-
- (when (or (and previous-sibling parent-ordered) blocked-on-previous)
- (push (format "!%s" (cdr (assoc "unique-id" previous-sibling))) dependencies))
-
- (when dependencies
- (push (cons "depends" (mapconcat 'identity dependencies ", ")) task))
- (setq previous-level level)
- (setq resolved-tasks (append resolved-tasks (list task)))))))
- (defun org-taskjuggler-tokenize-dependencies (dependencies)
- "Split a dependency property value DEPENDENCIES into the
- individual dependencies and return them as a list while keeping
- the optional arguments (such as gapduration) for the
- dependencies. A dependency will have to match `[-a-zA-Z0-9_]+'."
- (cond
- ((string-match "^ *$" dependencies) nil)
- ((string-match "^[ \t]*\\([-a-zA-Z0-9_]+\\([ \t]*{[^}]+}\\)?\\)[ \t,]*" dependencies)
- (cons
- (substring dependencies (match-beginning 1) (match-end 1))
- (org-taskjuggler-tokenize-dependencies (substring dependencies (match-end 0)))))
- (t (error (format "invalid dependency id %s" dependencies)))))
- (defun org-taskjuggler-resolve-explicit-dependencies (dependencies tasks)
- "For each dependency in DEPENDENCIES try to find a
- corresponding task with a matching property \"task_id\" in TASKS.
- Return a list containing the resolved links for all DEPENDENCIES
- where a matching tasks was found. If the dependency is
- \"previous-sibling\" it is ignored (as this is dealt with in
- `org-taskjuggler-resolve-dependencies'). If there is no matching
- task the dependency is ignored and a warning is displayed ."
- (unless (null dependencies)
- (let*
-
-
-
- ((dependency (car dependencies))
- (id (car (split-string dependency)))
- (optional-attributes
- (mapconcat 'identity (cdr (split-string dependency)) " "))
- (path (org-taskjuggler-find-task-with-id id tasks)))
- (cond
-
- ((equal (car dependencies) "previous-sibling")
- (org-taskjuggler-resolve-explicit-dependencies (cdr dependencies) tasks))
-
- ((not (null path))
- (cons (mapconcat 'identity (list path optional-attributes) " ")
- (org-taskjuggler-resolve-explicit-dependencies
- (cdr dependencies) tasks)))
-
- (t (display-warning
- 'org-export-taskjuggler
- (format "No task with matching property \"task_id\" found for id %s" id))
- (org-taskjuggler-resolve-explicit-dependencies (cdr dependencies) tasks))))))
- (defun org-taskjuggler-find-task-with-id (id tasks)
- "Find ID in tasks. If found return the path of task. Otherwise
- return nil."
- (let ((task-id (cdr (assoc "task_id" (car tasks))))
- (path (cdr (assoc "path" (car tasks)))))
- (cond
- ((null tasks) nil)
- ((equal task-id id) path)
- (t (org-taskjuggler-find-task-with-id id (cdr tasks))))))
- (defun org-taskjuggler-get-unique-id (item unique-ids)
- "Return a unique id for an ITEM which can be a task or a resource.
- The id is derived from the headline and made unique against
- UNIQUE-IDS. If the (downcased) first token of the headline is not
- unique try to add more (downcased) tokens of the headline or
- finally add more underscore characters (\"_\")."
- (let* ((headline (cdr (assoc "headline" item)))
- (parts (split-string headline))
- (id (org-taskjuggler-clean-id (downcase (pop parts)))))
-
- (while (and (member id unique-ids) (car parts))
- (setq id (concat id "_" (org-taskjuggler-clean-id (downcase (pop parts))))))
-
- (while (member id unique-ids)
- (setq id (concat id "_")))
- id))
-
- (defun org-taskjuggler-clean-id (id)
- "Clean and return ID to make it acceptable for taskjuggler."
- (and id (replace-regexp-in-string "[^a-zA-Z0-9_]" "_" id)))
- (defun org-taskjuggler-open-project (project)
- "Insert the beginning of a project declaration. All valid
- attributes from the PROJECT alist are inserted. If no end date is
- specified it is calculated
- `org-export-taskjuggler-default-project-duration' days from now."
- (let* ((unique-id (cdr (assoc "unique-id" project)))
- (headline (cdr (assoc "headline" project)))
- (version (cdr (assoc "version" project)))
- (start (cdr (assoc "start" project)))
- (end (cdr (assoc "end" project))))
- (insert
- (format "project %s \"%s\" \"%s\" %s +%sd {\n }\n"
- unique-id headline version start
- org-export-taskjuggler-default-project-duration))))
- (defun org-taskjuggler-filter-and-join (items)
- "Filter all nil elements from ITEMS and join the remaining ones
- with separator \"\n\"."
- (let ((filtered-items (remq nil items)))
- (and filtered-items (mapconcat 'identity filtered-items "\n"))))
-
- (defun org-taskjuggler-get-attributes (item attributes)
- "Return all attribute as a single formated string. ITEM is an
- alist representing either a resource or a task. ATTRIBUTES is a
- list of symbols. Only entries from ITEM are considered that are
- listed in ATTRIBUTES."
- (org-taskjuggler-filter-and-join
- (mapcar
- (lambda (attribute)
- (org-taskjuggler-filter-and-join
- (org-taskjuggler-get-attribute item attribute)))
- attributes)))
- (defun org-taskjuggler-get-attribute (item attribute)
- "Return a list of strings containing the properly formatted
- taskjuggler declaration for a given ATTRIBUTE in ITEM (an alist).
- If the ATTRIBUTE is not in ITEM return nil."
- (cond
- ((null item) nil)
- ((equal (symbol-name attribute) (car (car item)))
- (cons (format "%s %s" (symbol-name attribute) (cdr (car item)))
- (org-taskjuggler-get-attribute (cdr item) attribute)))
- (t (org-taskjuggler-get-attribute (cdr item) attribute))))
- (defun org-taskjuggler-open-resource (resource)
- "Insert the beginning of a resource declaration. All valid
- attributes from the RESOURCE alist are inserted. If the RESOURCE
- defines a property \"resource_id\" it will be used as the id for
- this resource. Otherwise it will use the ID property. If neither
- is defined it will calculate a unique id for the resource using
- `org-taskjuggler-get-unique-id'."
- (let ((id (org-taskjuggler-clean-id
- (or (cdr (assoc "resource_id" resource))
- (cdr (assoc "ID" resource))
- (cdr (assoc "unique-id" resource)))))
- (headline (cdr (assoc "headline" resource)))
- (attributes '(limits vacation shift booking efficiency journalentry rate)))
- (insert
- (concat
- "resource " id " \"" headline "\" {\n "
- (org-taskjuggler-get-attributes resource attributes) "\n"))))
- (defun org-taskjuggler-clean-effort (effort)
- "Translate effort strings into a format acceptable to taskjuggler,
- i.e. REAL UNIT. If the effort string is something like 5:30 it
- will be assumed to be hours and will be translated into 5.5h.
- Otherwise if it contains something like 3.0 it is assumed to be
- days and will be translated into 3.0d. Other formats that
- taskjuggler supports (like weeks, months and years) are currently
- not supported."
- (cond
- ((null effort) effort)
- ((string-match "\\([0-9]+\\):\\([0-9]+\\)" effort)
- (let ((hours (string-to-number (match-string 1 effort)))
- (minutes (string-to-number (match-string 2 effort))))
- (format "%dh" (+ hours (/ minutes 60.0)))))
- ((string-match "\\([0-9]+\\).\\([0-9]+\\)" effort) (concat effort "d"))
- (t (error "Not a valid effort (%s)" effort))))
- (defun org-taskjuggler-get-priority (priority)
- "Return a priority between 1 and 1000 based on PRIORITY, an
- org-mode priority string."
- (max 1 (/ (* 1000 (- org-lowest-priority (string-to-char priority)))
- (- org-lowest-priority org-highest-priority))))
- (defun org-taskjuggler-open-task (task)
- (let* ((unique-id (cdr (assoc "unique-id" task)))
- (headline (cdr (assoc "headline" task)))
- (effort (org-taskjuggler-clean-effort (cdr (assoc org-effort-property task))))
- (depends (cdr (assoc "depends" task)))
- (allocate (cdr (assoc "allocate" task)))
- (priority-raw (cdr (assoc "PRIORITY" task)))
- (priority (and priority-raw (org-taskjuggler-get-priority priority-raw)))
- (state (cdr (assoc "TODO" task)))
- (complete (or (and (member state org-done-keywords) "100")
- (cdr (assoc "complete" task))))
- (parent-ordered (cdr (assoc "parent-ordered" task)))
- (previous-sibling (cdr (assoc "previous-sibling" task)))
- (attributes
- '(account start note duration endbuffer endcredit end
- flags journalentry length maxend maxstart milestone
- minend minstart period reference responsible
- scheduling startbuffer startcredit statusnote)))
- (insert
- (concat
- "task " unique-id " \"" headline "\" {\n"
- (if (and parent-ordered previous-sibling)
- (format " depends %s\n" previous-sibling)
- (and depends (format " depends %s\n" depends)))
- (and allocate (format " purge allocations\n allocate %s\n" allocate))
- (and complete (format " complete %s\n" complete))
- (and effort (format " effort %s\n" effort))
- (and priority (format " priority %s\n" priority))
-
- (org-taskjuggler-get-attributes task attributes)
- "\n"))))
- (defun org-taskjuggler-close-maybe (level)
- (while (> org-export-taskjuggler-old-level level)
- (insert "}\n")
- (setq org-export-taskjuggler-old-level (1- org-export-taskjuggler-old-level)))
- (when (= org-export-taskjuggler-old-level level)
- (insert "}\n")))
- (defun org-taskjuggler-insert-reports ()
- (let (report)
- (dolist (report org-export-taskjuggler-default-reports)
- (insert report "\n"))))
- (provide 'org-taskjuggler)
|