emenel/doomemacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Polish org crm library

Browse source
This commit is contained in:
Henrik Lissner 2015-12-04 03:35:06 -05:00
parent fa9f197c4e
commit 32647ff112
1 changed files with 57 additions and 41 deletions
Download patch file Download diff file Expand all files Collapse all files

98
modules/lib/defuns-org-crm.el
View file

@ -33,13 +33,13 @@
;;;###autoload
(defun narf/org-crm-link-contact (id)
(org-open-file (narf--org-crm-resolve-id id 'contact) t))
(org-open-file (narf--org-crm-id-to-path id 'contact) t))
;;;###autoload
(defun narf/org-crm-link-project (id)
(org-open-file (narf--org-crm-resolve-id id 'project) t))
(org-open-file (narf--org-crm-id-to-path id 'project) t))
;;;###autoload
(defun narf/org-crm-link-invoice (id)
(org-open-file (narf--org-crm-resolve-id id 'invoice) t))
(org-open-file (narf--org-crm-id-to-path id 'invoice) t))
(defun narf--org-complete (type)
(let ((default-directory (symbol-value (intern (format "org-directory-%ss" type)))))
@ -53,66 +53,82 @@
(format "%s:%s" type (cadr match)))))
;;;###autoload
(defun org-contact-complete-link () (narf--org-complete "contact"))
(defun org-contact-complete-link () (narf--org-complete 'contact))
;;;###autoload
(defun org-project-complete-link () (narf--org-complete "project"))
(defun org-project-complete-link () (narf--org-complete 'project))
;;;###autoload
(defun org-invoice-complete-link () (narf--org-complete "invoice"))
(defun org-invoice-complete-link () (narf--org-complete 'invoice))
(defun narf--org-crm-assert-type (type)
(unless (memq type '(project contact invoice))
(user-error "Not a valid type: %s" type)))
(defun narf--org-crm-new-path (name type)
(unless (memq type '(project contact invoice))
(user-error "Not a valid type: %s" type))
(let* ((invoice-p (eq type 'invoice))
(prefix
(narf--org-crm-assert-type type)
(let* ((prefix
(replace-regexp-in-string
"/+$" "" (symbol-value (intern (format "org-directory-%ss" (symbol-name type))))))
(last-file (car-safe (f-glob "*.org" prefix)))
(id-sep (string-match-p (if invoice-p "\\." "-") last-file)))
(if last-file
(let* ((old-id (string-to-number (f-filename (substring last-file 0 id-sep)) 16))
(new-id (format (if invoice-p "%X" "%03X") (1+ old-id))))
(format (if invoice-p "%s/%s.org" "%s/%s-%s.org") prefix new-id
(replace-regexp-in-string "[][ !@#$%^&*()]" "-" name)))
(user-error "path could not be resolved: type(%s) name(%s)" type name))))
"/+$" "" (symbol-value (intern (format "org-directory-%ss" type)))))
(last-file (car-safe (sort (f-glob "*.org" prefix) 'string>))))
(when last-file
(let* ((old-id (narf--org-crm-path-to-id last-file type))
(new-id (format "%04X" (1+ old-id))))
(if (eq type 'invoice)
(format "%s/%s-%s.org" prefix (format-time-string "%y%m") new-id)
(format "%s/%s-%s.org" prefix
new-id (replace-regexp-in-string "[][ !@#$%^&*()]" "-" name)))))))
(defun narf--org-crm-resolve-id (id type)
(unless (memq type '(project contact invoice))
(user-error "Not a valid type: %s" type))
(let* ((invoice-p (eq type 'invoice))
(prefix
(defun narf--org-crm-path-to-id (path type)
(narf--org-crm-assert-type type)
(let ((base (f-filename path)))
(string-to-number
(if (eq type 'invoice)
(substring base (1+ (string-match-p "-" base)) (string-match-p ".org" base))
(substring base 0 (string-match-p "[-.]" base)))
16)))
(defun narf--org-crm-id-to-path (id type)
(narf--org-crm-assert-type type)
(let* ((prefix
(replace-regexp-in-string
"/+$" "" (symbol-value (intern (format "org-directory-%ss" (symbol-name type)))))))
(or (car-safe
(f-glob (format (if invoice-p "%X.org" "%03X*.org") (string-to-number id 16))
org-directory-projects))
(user-error "id %s could not be resolved in %s" id type))))
"/+$" "" (symbol-value (intern (format "org-directory-%ss" type))))))
(car-safe
(f-glob (format (if (eq type 'invoice) "*-%04X.org" "%04X*.org")
(string-to-number id 16))
prefix))))
(defun narf--org-crm (&optional id type new-p)
(if (not id)
(funcall (intern (format "narf/helm-org-crm-%ss" type)))
(let ((file (narf--org-crm-resolve-id id type)))
(let ((file (if new-p
(or (narf--org-crm-new-path id type)
(user-error "path could not be resolved: type(%s) name(%s)" type name))
(or (narf--org-crm-id-to-path id type)
(user-error "id %s could not be resolved in %s" id type))))
(old-buffer (current-buffer)))
(find-file file)
(with-current-buffer old-buffer
(when (evil-visual-state-p)
(org-insert-link
nil (format "%s:%s" (symbol-name type) id)
(buffer-substring-no-properties (region-beginning) (region-end))))
(if new-p
(when (y-or-n-p (format "Create %s?" (f-filename file)))
(find-file file))
(find-file file)))))
nil (format "%s:%s" (symbol-name type) (narf--org-crm-path-to-id file type))
(buffer-substring-no-properties (region-beginning) (region-end)))))))
;;;###autoload (autoload 'narf:org-crm-project "defuns-org-crm" nil t)
(evil-define-command narf:org-crm-project (&optional bang name)
(interactive "<!><a>")
(narf--org-crm name 'project bang))
(if bang
(narf--org-crm name 'project t)
(narf/helm-org-crm-projects)))
;;;###autoload (autoload 'narf:org-crm-contact "defuns-org-crm" nil t)
(evil-define-command narf:org-crm-contact (&optional bang name)
(interactive "<!><a>")
(narf--org-crm name 'contact bang))
(if bang
(narf--org-crm name 'contact t)
(narf/helm-org-crm-contacts)))
;;;###autoload (autoload 'narf:org-crm-invoice "defuns-org-crm" nil t)
(evil-define-command narf:org-crm-invoice (&optional bang)
(interactive "<!>")
(narf--org-crm "" 'invoice bang))
(if bang
(narf--org-crm nil 'invoice t)
(narf/helm-org-crm-invoices)))
(provide 'defuns-org-crm)