123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849 |
- (eval-when-compile (require 'cl))
- (require 'ox)
- (defgroup org-export-taskjuggler nil
- "Options specific for TaskJuggler export back-end."
- :tag "Org Export TaskJuggler"
- :group 'org-export)
- (defcustom org-taskjuggler-extension ".tjp"
- "Extension of TaskJuggler files."
- :group 'org-export-taskjuggler
- :type 'string)
- (defcustom org-taskjuggler-project-tag "taskjuggler_project"
- "Tag marking project's tasks.
- This tag is used to find the tree containing all the tasks for
- the project."
- :group 'org-export-taskjuggler
- :type 'string)
- (defcustom org-taskjuggler-resource-tag "taskjuggler_resource"
- "Tag marking project's resources.
- This tag is used to find the tree containing all the resources
- for the project."
- :group 'org-export-taskjuggler
- :type 'string)
- (defcustom org-taskjuggler-report-tag "taskjuggler_report"
- "Tag marking project's reports.
- This tag is used to find the tree containing all the reports for
- the project."
- :group 'org-export-taskjuggler
- :type 'string)
- (defcustom org-taskjuggler-target-version 3.0
- "Which version of TaskJuggler the exporter is targeting."
- :group 'org-export-taskjuggler
- :type 'number)
- (defcustom org-taskjuggler-default-project-version "1.0"
- "Default version string for the project.
- This value can also be set with the \":VERSION:\" property
- associated to the headline defining the project."
- :group 'org-export-taskjuggler
- :type 'string)
- (defcustom org-taskjuggler-default-project-duration 280
- "Default project duration.
- The value will be used 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-taskjuggler-project-tag'"
- :group 'org-export-taskjuggler
- :type 'integer)
- (defcustom org-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-taskjuggler-default-global-header ""
- "Default global header for the project.
- This goes before project declaration, and might be useful for
- early macros."
- :group 'org-export-taskjuggler
- :type '(string :tag "Preamble"))
- (defcustom org-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"))
- (defcustom org-taskjuggler-valid-task-attributes
- '(account start note duration endbuffer endcredit end
- flags journalentry length limits maxend maxstart minend
- minstart period reference responsible scheduling
- startbuffer startcredit statusnote chargeset charge)
- "Valid attributes for Taskjuggler tasks.
- If one of these appears as a property for a headline, it will be
- exported with the corresponding task."
- :group 'org-export-taskjuggler)
- (defcustom org-taskjuggler-valid-resource-attributes
- '(limits vacation shift booking efficiency journalentry rate
- workinghours flags)
- "Valid attributes for Taskjuggler resources.
- If one of these appears as a property for a headline, it will be
- exported with the corresponding resource."
- :group 'org-export-taskjuggler)
- (defcustom org-taskjuggler-valid-report-attributes
- '(headline columns definitions timeformat hideresource hidetask
- loadunit sorttasks formats period)
- "Valid attributes for Taskjuggler reports.
- If one of these appears as a property for a headline, it will be
- exported with the corresponding report."
- :group 'org-export-taskjuggler)
- (defcustom org-taskjuggler-keep-project-as-task t
- "Non-nil keeps the project headline as an umbrella task for all tasks.
- Setting this to nil will allow maintaining completely separated
- task buckets, while still sharing the same resources pool."
- :group 'org-export-taskjuggler
- :type 'boolean)
- (defvar org-taskjuggler-final-hook nil
- "Hook run after a TaskJuggler files has been saved.
- This hook is run with the name of the file as argument.")
- (org-export-define-backend 'taskjuggler
- '((template . org-taskjuggler-project-plan))
- :menu-entry
- '(?J "Export to TaskJuggler"
- ((?j "As TJP file" (lambda (a s v b) (org-taskjuggler-export a s v)))
- (?o "As TJP file and open"
- (lambda (a s v b)
- (if a (org-taskjuggler-export a s v)
- (org-taskjuggler-export-and-open s v))))))
-
-
- :options-alist '((:taskjuggler-unique-ids nil nil nil)))
- (defun org-taskjuggler-assign-task-ids (tasks info)
- "Assign a unique ID to each task in TASKS.
- TASKS is a list of headlines. Return value is an alist between
- headlines and their associated ID. IDs are hierarchical, which
- means they only need to be unique among the task siblings."
- (let* (alist
- (build-id
- (lambda (tasks local-ids)
- (org-element-map tasks 'headline
- (lambda (task)
- (let ((id (org-taskjuggler--build-unique-id task local-ids)))
- (push id local-ids)
- (push (cons task id) alist)
- (funcall build-id (org-element-contents task) nil)))
- info nil 'headline))))
- (funcall build-id tasks nil)
- alist))
- (defun org-taskjuggler-assign-resource-ids (resources info)
- "Assign a unique ID to each resource within RESOURCES.
- RESOURCES is a list of headlines. Return value is an alist
- between headlines and their associated ID."
- (let (ids)
- (org-element-map resources 'headline
- (lambda (resource)
- (let ((id (org-taskjuggler--build-unique-id resource ids)))
- (push id ids)
- (cons resource id)))
- info)))
- (defun org-taskjuggler-get-project (info)
- "Return project in parse tree.
- INFO is a plist used as a communication channel. First headline
- in buffer with `org-taskjuggler-project-tag' defines the project.
- If no such task is defined, pick the first headline in buffer.
- If there is no headline at all, return nil."
- (or (org-element-map (plist-get info :parse-tree) 'headline
- (lambda (hl)
- (and (member org-taskjuggler-project-tag
- (org-export-get-tags hl info))
- hl))
- info t)
- (org-element-map tree 'headline 'identity info t)))
- (defun org-taskjuggler-get-id (item info)
- "Return id for task or resource ITEM.
- ITEM is a headline. Return value is a string."
- (cdr (assq item (plist-get info :taskjuggler-unique-ids))))
- (defun org-taskjuggler-get-name (item)
- "Return name for task or resource ITEM.
- ITEM is a headline. Return value is a string."
-
- (replace-regexp-in-string
- "\"" "\\\"" (org-element-property :raw-value item) t t))
- (defun org-taskjuggler-get-start (item)
- "Return start date for task or resource ITEM.
- ITEM is a headline. Return value is a string or nil if ITEM
- doesn't have any start date defined.."
- (let ((scheduled (org-element-property :scheduled item)))
- (and scheduled (org-timestamp-format scheduled "%Y-%02m-%02d"))))
- (defun org-taskjuggler-get-end (item)
- "Return end date for task or resource ITEM.
- ITEM is a headline. Return value is a string or nil if ITEM
- doesn't have any end date defined.."
- (let ((deadline (org-element-property :deadline item)))
- (and deadline (org-timestamp-format deadline "%Y-%02m-%02d"))))
- (defun org-taskjuggler--indent-string (s)
- "Indent string S by 2 spaces.
- Return new string. If S is the empty string, return it."
- (if (equal "" s) s (replace-regexp-in-string "^ *\\S-" " \\&" s)))
- (defun org-taskjuggler--build-attributes (item attributes)
- "Return attributes string for task, resource or report ITEM.
- ITEM is a headline. ATTRIBUTES is a list of symbols
- representing valid attributes for ITEM."
- (mapconcat
- (lambda (attribute)
- (let ((value (org-element-property
- (intern (upcase (format ":%s" attribute)))
- item)))
- (and value (format "%s %s\n" attribute value))))
- (remq nil attributes) ""))
- (defun org-taskjuggler--build-unique-id (item unique-ids)
- "Return a unique id for a given task or a resource.
- ITEM is an `headline' type element representing the task or
- resource. Its id is derived from its name 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 ((id (org-string-nw-p (org-element-property :TASK_ID item))))
-
- (if (and id (not (member id unique-ids))) id
- (let* ((parts (org-split-string (org-element-property :raw-value item)))
- (id (org-taskjuggler--clean-id (downcase (pop parts)))))
-
- (while (and (car parts) (member id unique-ids))
- (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.
- ID is a string."
-
- (replace-regexp-in-string
- "[^a-zA-Z0-9_]" "_"
-
- (replace-regexp-in-string "^\\([0-9]\\)" "_\\1" id)))
- (defun org-taskjuggler-resolve-dependencies (task info)
- "Return a list of all tasks TASK depends on.
- TASK is a headline. INFO is a plist used as a communication
- channel."
- (let ((deps-ids
-
-
- (let ((deps (concat (org-element-property :BLOCKER task)
- (org-element-property :DEPENDS task))))
- (and deps
- (org-split-string (replace-regexp-in-string "{.*?}" "" deps)
- "[ ,]* +"))))
- depends)
- (when deps-ids
-
-
- (let* ((project (org-taskjuggler-get-project info))
- (tasks (if org-taskjuggler-keep-project-as-task project
- (org-element-contents project))))
- (setq depends
- (org-element-map tasks 'headline
- (lambda (task)
- (let ((task-id (org-element-property :TASK_ID task)))
- (and task-id (member task-id deps-ids) task)))
- info)))
-
-
- (when (and (member-ignore-case "previous-sibling" deps-ids)
- (not (org-export-first-sibling-p task info)))
- (let ((prev (org-export-get-previous-element task info)))
- (and (not (memq prev depends)) (push prev depends)))))
-
- (let ((parent (org-export-get-parent task)))
- (when (and parent
- (org-element-property :ORDERED parent)
- (not (org-export-first-sibling-p task info)))
- (push (org-export-get-previous-element task info) depends)))
-
- depends))
- (defun org-taskjuggler-format-dependencies (dependencies task info)
- "Format DEPENDENCIES to match TaskJuggler syntax.
- DEPENDENCIES is list of dependencies for TASK, as returned by
- `org-taskjuggler-resolve-depedencies'. TASK is a headline.
- INFO is a plist used as a communication channel. Return value
- doesn't include leading \"depends\"."
- (let ((dep-str (concat (org-element-property :BLOCKER task)
- " "
- (org-element-property :DEPENDS task)))
- (get-path
- (lambda (dep)
-
- (let ((parent (org-export-get-parent dep))
- (exclamations 1)
- (option
- (let ((id (org-element-property :TASK_ID dep)))
- (and id
- (string-match (concat id " +\\({.*?}\\)") dep-str)
- (org-match-string-no-properties 1))))
- path)
-
- (while (not (org-element-map parent 'headline
- (lambda (task) (eq task dep))))
- (incf exclamations)
- (setq parent (org-export-get-parent parent)))
-
- (while (not (eq parent dep))
- (push (org-taskjuggler-get-id dep info) path)
- (setq dep (org-export-get-parent dep)))
-
- (concat (make-string exclamations ?!)
- (mapconcat 'identity path ".")
- (and option (concat " " option)))))))
-
- (mapconcat (lambda (dep) (funcall get-path dep)) dependencies ", ")))
- (defun org-taskjuggler-project-plan (contents info)
- "Build TaskJuggler project plan.
- CONTENTS is ignored. INFO is a plist holding export options.
- Return complete project plan as a string in TaskJuggler syntax."
- (let* ((tree (plist-get info :parse-tree))
- (project (or (org-taskjuggler-get-project info)
- (error "No project specified"))))
- (concat
-
- (org-element-normalize-string org-taskjuggler-default-global-header)
-
- (org-taskjuggler--build-project project info)
-
- (org-element-normalize-string org-taskjuggler-default-global-properties)
-
-
- (let ((main-resources
-
-
-
- (apply 'append
- (org-element-map tree 'headline
- (lambda (hl)
- (and (member org-taskjuggler-resource-tag
- (org-export-get-tags hl info))
- (org-element-map (org-element-contents hl) 'headline
- 'identity info nil 'headline)))
- info nil 'headline))))
-
-
- (setq info
- (plist-put info :taskjuggler-unique-ids
- (org-taskjuggler-assign-resource-ids
- main-resources info)))
- (concat
- (if main-resources
- (mapconcat
- (lambda (resource) (org-taskjuggler--build-resource resource info))
- main-resources "")
- (format "resource %s \"%s\" {\n}\n" (user-login-name) user-full-name))
-
- (let ((main-tasks
-
-
-
- (if org-taskjuggler-keep-project-as-task (list project)
- (or (org-element-map (org-element-contents project) 'headline
- 'identity info nil 'headline)
- (error "No task specified")))))
-
-
- (setq info
- (plist-put info :taskjuggler-unique-ids
- (append
- (org-taskjuggler-assign-task-ids main-tasks info)
- (plist-get info :taskjuggler-unique-ids))))
-
-
- (unless (org-element-map main-tasks 'headline
- (lambda (task) (org-element-property :ALLOCATE task))
- info t)
- (org-element-put-property
- (car main-tasks) :ALLOCATE
- (or (org-taskjuggler-get-id (car main-resources) info)
- (user-login-name))))
- (mapconcat
- (lambda (task) (org-taskjuggler--build-task task info))
- main-tasks ""))
-
-
- (let ((main-reports
-
-
-
- (apply 'append
- (org-element-map tree 'headline
- (lambda (hl)
- (and (member org-taskjuggler-report-tag
- (org-export-get-tags hl info))
- (org-element-map (org-element-contents hl)
- 'headline 'identity info nil 'headline)))
- info nil 'headline))))
- (if main-reports
- (mapconcat
- (lambda (report) (org-taskjuggler--build-report report info))
- main-reports "")
- (mapconcat 'org-element-normalize-string
- org-taskjuggler-default-reports ""))))))))
- (defun org-taskjuggler--build-project (project info)
- "Return a project declaration.
- PROJECT is a headline. INFO is a plist used as a communication
- channel. If no start date is specified, start today. If no end
- date is specified, end `org-taskjuggler-default-project-duration'
- days from now."
- (format "project %s \"%s\" \"%s\" %s %s {\n}\n"
- (org-taskjuggler-get-id project info)
- (org-taskjuggler-get-name project)
-
-
- (or (org-element-property :VERSION project)
- org-taskjuggler-default-project-version)
- (or (org-taskjuggler-get-start project)
- (format-time-string "%Y-%m-%d"))
- (let ((end (org-taskjuggler-get-end project)))
- (or (and end (format "- %s" end))
- (format "+%sd" org-taskjuggler-default-project-duration)))))
- (defun org-taskjuggler--build-resource (resource info)
- "Return a resource declaration.
- RESOURCE is a headline. INFO is a plist used as a communication
- channel.
- All valid attributes from RESOURCE are inserted. If 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 a unique id will be associated to it."
- (concat
-
- (format "resource %s \"%s\" {\n"
- (org-taskjuggler--clean-id
- (or (org-element-property :RESOURCE_ID resource)
- (org-element-property :ID resource)
- (org-taskjuggler-get-id resource info)))
- (org-taskjuggler-get-name resource))
-
- (org-taskjuggler--indent-string
- (org-taskjuggler--build-attributes
- resource org-taskjuggler-valid-resource-attributes))
-
- (org-taskjuggler--indent-string
- (mapconcat
- 'identity
- (org-element-map (org-element-contents resource) 'headline
- (lambda (hl) (org-taskjuggler--build-resource hl info))
- info nil 'headline)
- ""))
-
- "}\n"))
- (defun org-taskjuggler--build-report (report)
- "Return a report declaration.
- REPORT is a headline. INFO is a plist used as a communication
- channel."
- (concat
-
- (format "%s \"%s\" {\n"
- (or (org-element-property :REPORT_KIND report) "taskreport")
- (org-taskjuggler-get-name report))
-
- (org-taskjuggler--indent-string
- (org-taskjuggler--build-attributes
- report org-taskjuggler-valid-report-attributes))
-
- (org-taskjuggler--indent-string
- (mapconcat
- 'identity
- (org-element-map (org-element-contents report) 'headline
- (lambda (hl) (org-taskjuggler--build-report hl info))
- info nil 'headline)
- ""))
-
- "}\n"))
- (defun org-taskjuggler--build-task (task info)
- "Return a task declaration.
- TASK is a headline. INFO is a plist used as a communication
- channel.
- All valid attributes from TASK are inserted. If TASK defines
- a property \"task_id\" it will be used as the id for this task.
- Otherwise it will use the ID property. If neither is defined
- a unique id will be associated to it."
- (let* ((allocate (org-element-property :ALLOCATE task))
- (complete
- (if (eq (org-element-property :todo-type task) 'done) "100"
- (org-element-property :COMPLETE task)))
- (depends (org-taskjuggler-resolve-dependencies task info))
- (effort (org-element-property :EFFORT task))
- (milestone
- (or (org-element-property :MILESTONE task)
- (not (or (org-element-map (org-element-contents task) 'headline
- 'identity info t)
- effort
- (org-element-property :LENGTH task)
- (org-element-property :DURATION task)
- (and (org-taskjuggler-get-start task)
- (org-taskjuggler-get-end task))
- (org-element-property :PERIOD task)))))
- (priority
- (let ((pri (org-element-property :priority task)))
- (and pri
- (max 1 (/ (* 1000 (- org-lowest-priority pri))
- (- org-lowest-priority org-highest-priority)))))))
- (concat
-
- (format "task %s \"%s\" {\n"
- (org-taskjuggler-get-id task info)
- (org-taskjuggler-get-name task))
-
- (and depends
- (format " depends %s\n"
- (org-taskjuggler-format-dependencies depends task info)))
- (and allocate
- (format " purge %s\n allocate %s\n"
-
- (if (>= org-taskjuggler-target-version 3.0) "allocate"
- "allocations")
- allocate))
- (and complete (format " complete %s\n" comptete))
- (and effort
- (format " effort %s\n"
- (let* ((minutes (org-duration-string-to-minutes effort))
- (hours (/ minutes 60.0)))
- (format "%.1fh" hours))))
- (and priority (format " priority %s\n" complete))
- (and milestone " milestone\n")
-
- (org-taskjuggler--indent-string
- (org-taskjuggler--build-attributes
- task org-taskjuggler-valid-task-attributes))
-
- (org-taskjuggler--indent-string
- (mapconcat 'identity
- (org-element-map (org-element-contents task) 'headline
- (lambda (hl) (org-taskjuggler--build-task hl info))
- info nil 'headline)
- ""))
-
- "}\n")))
- (defun org-taskjuggler-export (&optional async subtreep visible-only)
- "Export current buffer to a TaskJuggler file.
- The exporter looks for a tree with tag that matches
- `org-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 that matches
- `org-taskjuggler-resource-tag' this tree 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-taskjuggler-default-reports'.
- If narrowing is active in the current buffer, only export its
- narrowed part.
- If a region is active, export that region.
- A non-nil optional argument ASYNC means the process should happen
- asynchronously. The resulting file should be accessible through
- the `org-export-stack' interface.
- When optional argument SUBTREEP is non-nil, export the sub-tree
- at point, extracting information from the headline properties
- first.
- When optional argument VISIBLE-ONLY is non-nil, don't export
- contents of hidden elements.
- Return output file's name."
- (interactive)
- (let ((outfile
- (org-export-output-file-name org-taskjuggler-extension subtreep)))
- (if async
- (org-export-async-start
- (lambda (f)
- (org-export-add-to-stack f 'taskjuggler)
- (run-hook-with-args 'org-taskjuggler-final-hook f))
- `(expand-file-name
- (org-export-to-file 'taskjuggler ,outfile ,subtreep ,visible-only)))
- (org-export-to-file 'taskjuggler outfile subtreep visible-only)
- (run-hook-with-args 'org-taskjuggler-final-hook outfile)
- outfile)))
- (defun org-taskjuggler-export-and-open (&optional subtreep visible-only)
- "Export current buffer to a TaskJuggler file and open it.
- The exporter looks for a tree with tag that matches
- `org-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 that matches
- `org-taskjuggler-resource-tag' this tree 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-taskjuggler-default-reports'.
- If narrowing is active in the current buffer, only export its
- narrowed part.
- If a region is active, export that region.
- When optional argument SUBTREEP is non-nil, export the sub-tree
- at point, extracting information from the headline properties
- first.
- When optional argument VISIBLE-ONLY is non-nil, don't export
- contents of hidden elements.
- Open file with the TaskJuggler GUI."
- (interactive)
- (let* ((file (org-taskjuggler-export nil subtreep visible-only))
- (process-name "TaskJugglerUI")
- (command (concat process-name " " file)))
- (start-process-shell-command process-name nil command)))
- (provide 'ox-taskjuggler)
|