iorg-projects.el 17 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504
  1. ;;; iorg-projects.el --- functions to create and manage iOrg projects
  2. ;;; Require other packages
  3. (require 'org)
  4. (require 'ob-tangle)
  5. (require 'elnode)
  6. (require 'vc)
  7. ;; (eval-when-compile
  8. ;; (require 'cl)
  9. ;; )
  10. ;;; Other stuff we need
  11. ;; remember this directory
  12. (setq iorg-projects-dir
  13. (expand-file-name
  14. (file-name-directory
  15. (directory-file-name
  16. (file-name-directory
  17. (or load-file-name (buffer-file-name)))))))
  18. ;; (unless (fboundp 'xyz) (defalias 'xyz 'uvw))
  19. ;;; Customs, Constants and Variables
  20. ;; Customisation Groups and Variables
  21. (defgroup iorg-projects nil
  22. "Creating and managing iOrg projects"
  23. :tag "iOrg-Projects"
  24. :group 'iorg)
  25. (defcustom iorg-projects-load-hook nil
  26. "Hook that is run after iorg-projects.el has been loaded."
  27. :group 'org-iorg
  28. :type 'hook)
  29. (defcustom iorg-projects-elnode-customisation nil
  30. "Project-related elnode customisations"
  31. :group 'iorg-projects
  32. :type 'plist)
  33. (defun iorg-projects--get-project-info (project key)
  34. "Return the value of KEY for PROJECT."
  35. (if (not (and (non-empty-string-p project)
  36. (assoc project iorg-projects-config)))
  37. (error (concat "Project not registered in customizable "
  38. "variable 'iorg-projects-config'"))
  39. (cond
  40. ((member
  41. key '(:docroot :logiv :view :controller :objects :doc :test))
  42. (iorg-projects--normalize-existing-dir-name
  43. (concat
  44. (iorg-projects--normalize-existing-dir-name
  45. (cdr (assoc :dir (cdr (assoc project iorg-projects-config)))))
  46. (cdr (assoc key (cdr (assoc project iorg-projects-config)))))))
  47. ((or (member key '(:dir :host :port))
  48. (assoc key (cdr (assoc project iorg-projects-config))))
  49. (cdr (assoc key (cdr (assoc project iorg-projects-config)))))
  50. (t (error "KEY not found or wrong format - missing leading colon?")))))
  51. ;; FIXME make directory names more generic/portable for multi-person
  52. ;; projects on multiple platforms
  53. (defcustom iorg-projects-config
  54. '(("test" . ((:dir . "~/git/test/")
  55. (:host . "localhost")
  56. (:port . "8088")
  57. (:docroot . "docroot")
  58. (:logic . "db")
  59. (:view . "view")
  60. (:controller . "server")
  61. (:objects . "objects")
  62. (:test . "test")
  63. (:doc . "doc")))
  64. ("bugpile" . ((:dir . "~/git/bugpile/")
  65. (:host . "localhost")
  66. (:port . "8008")
  67. (:docroot . "docroot")
  68. (:logic . "logic")
  69. (:view . "view")
  70. (:controller . "controller")
  71. (:objects . "objects")
  72. (:test . "test")
  73. (:doc . "doc"))))
  74. "Alist of iOrg projects with configuration.
  75. The project name is used as a key, project configuration as an
  76. alist for that key. DIR defines the directory of the project,
  77. DOCROOT the webserver root directory, MODEL, VIEW, CONTROLLER the
  78. directories were the related elisp and Org files are stored, TEST
  79. and DOC the directories for tests and documentation and
  80. PERSISTENCE the directory for Org files used as data storage.
  81. Thus, the projects view directory would be defined as
  82. 'DIR/VIEW/' (e.g. ~/git/bugpile/view), the projects controller
  83. directory as 'DIR/CONTROLLER/'(e.g. ~/git/bugpile/server/).
  84. HOST and PORT are used to configure the projects elnode webserver
  85. as 'http://HOST:PORT', e.g. 'http://localhost:8008'"
  86. :group 'iorg-projects
  87. :type '(alist :key-type string
  88. :value-type alist))
  89. (defcustom iorg-projects-urls
  90. '(("bugpile" . (("^$" . bugpile-controller-init-handler)
  91. ("^edit/$" . iorg-controller-edit-handler)
  92. ("^send/$" . iorg-controller-send-handler)
  93. ("^reset/$" . iorg-controller-reset-handler)))
  94. ("test" . (("^$" . test-controller-init-handler)
  95. ("^edit/$" . iorg-controller-edit-handler)
  96. ("^send/$" . iorg-controller-send-handler)
  97. ("^reset/$" . iorg-controller-reset-handler))))
  98. ;; (("^$" . iorg-initialize-simple-handler)
  99. ;; ("^edit/$" . iorg-change-state-handler)
  100. ;; ("^send/$" . iorg-change-state-handler)
  101. ;; ("^reset/$" . iorg-edit-headline-handler))))
  102. "Alist of iOrg projects with urls.
  103. The project name is used as a key, project urls as an alist for
  104. that key. Each key in that alist represents an url, the
  105. associated value a function that handles http-requests to that
  106. url."
  107. :group 'iorg-projects
  108. :type '(alist :key-type string
  109. :value-type alist))
  110. ;;; Variables
  111. (defvar iorg-projects-plantuml-diagram-type-repexp
  112. (concat "<\\(soa\\|csa\\|dcm\\)>")
  113. "Regexp used to identify plantuml diagramtypes from the
  114. plantuml 'titel' line in the Org-mode source block")
  115. ;; (defvar org-babel-src-block-regexp
  116. ;; (concat
  117. ;; ;; (1) indentation (2) lang
  118. ;; "^\\([ \t]*\\)#\\+begin_src[ \t]+\\([^ \f\t\n\r\v]+\\)[ \t]*"
  119. ;; ;; (3) switches
  120. ;; "\\([^\":\n]*\"[^\"\n*]*\"[^\":\n]*\\|[^\":\n]*\\)"
  121. ;; ;; (4) header arguments
  122. ;; "\\([^\n]*\\)\n"
  123. ;; ;; (5) body
  124. ;; "\\([^\000]*?\n\\)?[ \t]*#\\+end_src")
  125. ;; "Regexp used to identify code blocks.")
  126. ;;; Functions
  127. ;; Declare functions
  128. (declare-function org-check-for-org-mode "org-agenda" nil)
  129. (declare-function org-entry-is-todo-p "org" nil)
  130. (declare-function org-get-todo-state "org" nil)
  131. ;; Private functions
  132. ;; iOrg meta data
  133. (defun iorg-projects--update-iorg-config (prop val)
  134. "Update property PROP with value VAL in the global iOrg
  135. configuration file."
  136. (org-entry-add-to-multivalued-property
  137. (iorg-projects--goto-first-entry
  138. (expand-file-name "iorg-projects-config.org" iorg-projects-dir)) prop val))
  139. (defun iorg-projects--meta-data ()
  140. "Return a list with meta-data about the current iOrg projects,
  141. gathered from the iorg-projects-config.org file."
  142. (iorg-projects--goto-first-entry (expand-file-name "iorg-projects-config.org" iorg-projects-dir))
  143. (let* ((proj (org-entry-get (point) "projects"))
  144. (unnamed-proj (iorg-projects--filter-multival-property proj "project[0-9]+$"))
  145. (unnamed-max 0))
  146. ;; get the highest numbering of unnamed projects
  147. (mapc
  148. (lambda (x)
  149. (string-match "(project)([0-9]+)($)" x)
  150. (let ((proj-count
  151. (string-to-number
  152. (match-string 2 x))))
  153. (and (> proj-count unnamed-max)
  154. (setq unnamed-max proj-count))))
  155. unnamed-proj)
  156. ;; kill iorg-projects-config.org buffer
  157. (kill-buffer (current-buffer))
  158. ;; build the retpurn list
  159. (list
  160. (length proj) ; total number of projects
  161. (length unnamed-proj) ; number of unnamed projects
  162. unnamed-max))) ; highest numbering of unnamed project
  163. (defun iorg-projects--number-of-projects ()
  164. "Return the total number of current iOrg projects."
  165. (nth 0 (iorg-projects--meta-data)))
  166. (defun iorg-projects--number-of-unnamed-projects ()
  167. "Return the number of current unnamed iOrg projects."
  168. (nth 1 (iorg-projects--meta-data)))
  169. (defun iorg-projects--max-numbering-unnamed-projects ()
  170. "Return the highest numbering of unnamed iOrg projects."
  171. (nth 2 (iorg-projects--meta-data)))
  172. ;;; Project management
  173. (defun iorg-projects--update-project-config (prop val &optional dir)
  174. "Update the iOrg project configuration of project in present
  175. working directory or DIR."
  176. (org-entry-add-to-multivalued-property
  177. (iorg-projects--goto-first-entry
  178. (if dir
  179. (expand-file-name
  180. (concat
  181. (file-name-nondirectory
  182. (directory-file-name
  183. (iorg-projects--normalize-existing-dir-name dir))) "-config.org")
  184. (iorg-projects--normalize-existing-dir-name dir))
  185. (expand-file-name
  186. (concat
  187. (file-name-nondirectory
  188. (directory-file-name
  189. (iorg-projects--pwd))) "-config.org")
  190. (iorg-projects--pwd)))
  191. prop val)))
  192. (defun iorg-projects--rename-project-files (&optional name dir)
  193. "Rename all prefixed files in the present working directory or
  194. DIR, replacing the old prefix (taken from <<project>>-config.org)
  195. with `file-name-nondirectory' of the project directory."
  196. (let* ((proj
  197. (if dir
  198. (iorg-projects--normalize-existing-dir-name dir)
  199. (iorg-projects--pwd)))
  200. (dir-files (directory-files proj))
  201. (new-prefix
  202. (if (and name (non-empty-string-p name))
  203. name
  204. (file-name-nondirectory (directory-file-name proj))))
  205. (old-prefix))
  206. ;; get the old prefix
  207. (mapc
  208. (lambda (x)
  209. (and
  210. (string-match "\\(^\\)\\(.+\\)\\(-config.org\\)\\($\\)" x)
  211. (match-string 2 x)
  212. (setq old-prefix (match-string 2 x))))
  213. dir-files)
  214. ;; replace old-prefix with new-prefix
  215. ;; project directory
  216. (iorg-projects--replace-filename-prefix old-prefix new-prefix proj)
  217. ;; subdirectories (1st level)
  218. (mapc
  219. (lambda (x)
  220. (unless (string-match-p "^\\.+" x)
  221. (let ((f (iorg-projects--normalize-new-dir-name
  222. (concat proj x))))
  223. (and
  224. (file-directory-p f)
  225. (iorg-projects--replace-filename-prefix
  226. old-prefix new-prefix f)))))
  227. dir-files)))
  228. (defun iorg-projects--project-directory-structure-p (&optional dir)
  229. "Return t if present working directory or DIR confirms to the
  230. iOrg project directory structure, nil otherwise."
  231. (let* ((project-dir
  232. (if dir
  233. (iorg-projects--normalize-existing-dir-name dir)
  234. (iorg-projects--pwd)))
  235. (dir-files (directory-files project-dir)))
  236. (not
  237. (cond
  238. ((not (member
  239. (concat
  240. (file-name-nondirectory
  241. (directory-file-name project-dir)) "-config.org")
  242. dir-files)))
  243. ;; ((not (member "blob" dir-files)))
  244. ((not (member "controller" dir-files)))
  245. ;; ((not (member "dat" dir-files)))
  246. ((not (member "objects" dir-files)))
  247. ((not (member "img" dir-files)))
  248. ;; ((not (member "loc" dir-files)))
  249. ;; ((not (member "log" dir-files)))
  250. ((not (member "logic" dir-files)))
  251. ((not (member "test" dir-files)))
  252. ((not (member "view" dir-files)))))))
  253. ;;; Modified or new Emacs functionality
  254. (defmacro iorg-projects-in-file (file &rest body)
  255. "Execute BODY in a buffer visiting FILE.
  256. If no buffer exists visiting FILE then open FILE in a new buffer."
  257. `(save-window-excursion
  258. (condition-case nil
  259. (with-temp-buffer (find-file ,file) ,@body)
  260. (error (message "iorg: there has been an error")))))
  261. ;; (iorg-projects-in-file "/tmp/something.org" (message "in %s" (current-buffer)))
  262. (defun iorg-projects--pwd ()
  263. "Return the (normalized) directory part of the function `pwd'."
  264. (expand-file-name
  265. (file-name-as-directory
  266. (cadr (split-string (pwd) " ")))))
  267. (defun iorg-projects--replace-filename-prefix (old-prefix new-prefix &optional dir)
  268. "Replace OLD-PREFIX with NEW-PREFIX in filename of
  269. all (non-directory) files in present working directory or DIR."
  270. (let ((proj
  271. (if dir
  272. (iorg-projects--normalize-existing-dir-name dir)
  273. (iorg-projects--pwd))))
  274. (condition-case err
  275. (mapc
  276. (lambda (x)
  277. (and
  278. (string-match
  279. (concat "\\(^\\)\\(" old-prefix "\\)\\(.+\\)\\($\\)") x)
  280. (not (file-directory-p (concat proj x)))
  281. (let* ((first-part (match-string 2 x))
  282. (last-part (match-string 3 x)))
  283. (and first-part last-part
  284. (rename-file
  285. (concat proj first-part last-part)
  286. (concat proj new-prefix last-part) t)))))
  287. (directory-files proj))
  288. ;; error handler
  289. (error
  290. (princ
  291. (format
  292. "Error replacing the filename-prefix: %s" err))
  293. nil))))
  294. (defun iorg-projects--normalize-existing-dir-name (dir)
  295. "Return name of existing DIR in canonical form"
  296. (if (file-directory-p dir)
  297. (expand-file-name (file-name-as-directory dir))
  298. (message "Not a directory name")))
  299. (defun iorg-projects--normalize-new-dir-name (name)
  300. "Return NAME for a new directory in canonical form"
  301. (and (non-empty-string-p name)
  302. (expand-file-name (file-name-as-directory name))))
  303. ;;; Modified or new Org-mode functionality
  304. (defun iorg-projects--goto-first-entry (&optional file)
  305. "Move point to the beginning of line of the first entry in the
  306. current buffer or FILE."
  307. (with-current-buffer
  308. (if (and file (file-exists-p file))
  309. (find-file-existing file)
  310. (current-buffer))
  311. (org-goto-line 1)
  312. (or (looking-at org-outline-regexp)
  313. (re-search-forward org-outline-regexp-bol nil t))
  314. (beginning-of-line)))
  315. (defun iorg-projects--goto-last-entry (&optional file)
  316. "Move point to the beginning of line of the last entry in the
  317. current buffer or FILE."
  318. (with-current-buffer
  319. (if (and file (file-exists-p file))
  320. (find-file-existing file)
  321. (current-buffer))
  322. (org-goto-line
  323. (line-number-at-pos (point-max))
  324. (or (looking-at org-outline-regexp)
  325. (re-search-backward org-outline-regexp-bol nil t))
  326. (beginning-of-line))))
  327. (defun iorg-projects--filter-multival-property (prop reg)
  328. "Returns a list of strings with all elements of MULTIVAL-PROP
  329. that match REGEXP."
  330. (remove nil
  331. (mapcar
  332. (lambda (x)
  333. (and (string-match-p reg x) x))
  334. prop)))
  335. ;;;; Public functions and user commands
  336. ;;; Project management
  337. (defun iorg-projects-initialize-project (&optional dir name)
  338. "Copy the iOrg project template into DIR and rename the project."
  339. (interactive "DProject directory: \nsProject name: ")
  340. (let* ((directory
  341. (if dir
  342. (iorg-projects--normalize-existing-dir-name dir)
  343. (iorg-projects--pwd)))
  344. (project-name
  345. (if (and name (non-empty-string-p name))
  346. name
  347. (concat
  348. "project"
  349. (number-to-string
  350. (1+ (iorg-projects--max-numbering-unnamed-projects))))))
  351. (project-dir (concat directory project-name)))
  352. (copy-directory
  353. (concat
  354. iorg-projects-dir "project")
  355. project-dir)
  356. (iorg-projects-update-project project-dir)))
  357. (defun iorg-projects-update-project (&optional dir)
  358. "Update filenames and configuration file for iOrg project in
  359. present working directory or DIR."
  360. (interactive "DProject directory: ")
  361. (let ((proj
  362. (if dir
  363. (iorg-projects--normalize-existing-dir-name dir)
  364. (iorg-projects--pwd))))
  365. (iorg-projects--rename-project-files nil proj)
  366. ;; (iorg-projects--update-project-config proj)
  367. ;; (iorg-projects--update-iorg-projects-config proj)
  368. ))
  369. (defun iorg-projects-rename-project (name &optional dir)
  370. "Rename iOrg project in present working directory of DIR."
  371. (interactive "sNew project name: \nDProject directory: ")
  372. (let ((proj
  373. (if dir
  374. (iorg-projects--normalize-existing-dir-name dir)
  375. (iorg-projects--pwd))))
  376. (cond
  377. ((not (iorg-projects--project-directory-structure-p proj))
  378. (message "Directory does not confirm to iOrg directory structure."))
  379. ((not (non-empty-string-p name))
  380. (message "New project name must be a string of length > 0"))
  381. (t
  382. (condition-case err
  383. ;; rename and update project
  384. (let ((new-proj
  385. (iorg-projects--normalize-new-dir-name
  386. (concat
  387. (file-name-directory
  388. (directory-file-name proj)) name))))
  389. (rename-file
  390. (directory-file-name proj)
  391. new-proj)
  392. (iorg-projects-update-project new-proj))
  393. (error
  394. (princ
  395. (format
  396. "Error while renaming project: %s" err))
  397. nil))))))
  398. (defun iorg-projects-delete-project (&optional project)
  399. "Delete directory of current project or PROJECT and eliminate
  400. it from the `iorg-projects-projects-plist'")
  401. (defun iorg-projects-export-project (dir &optional server)
  402. "Export project defined in the current directory or in DIR, and
  403. start the elnode server when SERVER is non-nil"
  404. (interactive "DProject directory: ")
  405. (if (file-directory-p dir)
  406. () ;check dir structure, tangle ob files, export org files
  407. (message "Not a valid directory name")))
  408. ;;; PlantUML transformation
  409. (defun iorg-projects-plantuml-to-code (&optional file)
  410. "Transform all PlantUML source blocks in Org-file FILE into
  411. Org-mode files (with entries) and Emacs Lisp files (with
  412. functions and variables), following the transformation rules of
  413. the iOrg framework."
  414. (with-current-buffer
  415. (if (and file (file-exists-p file))
  416. (find-file-existing file)
  417. (current-buffer))
  418. (case-fold-search t)
  419. (save-excursion
  420. (save-restriction
  421. (widen)
  422. (org-goto-line 1)
  423. (while (not (eobp))
  424. (if (not (looking-at org-babel-src-block-regexp))
  425. (forward-line)
  426. (while (not (eolp))
  427. (if (not (looking-at "plantuml"))
  428. (forward-word)
  429. (forward-line)
  430. (while (not (looking-at "#+end_src")))))))))))
  431. ;; ...
  432. ;; Key bindings
  433. ;; Documentation
  434. ;; Miscellaneous stuff
  435. ;; Integration with and fixes for other packages
  436. ;; Experimental code
  437. ;; Finish up
  438. (provide 'iorg)