From 32647ff112bb6376eafd0a845bddbe8ee029f4d2 Mon Sep 17 00:00:00 2001 From: Henrik Lissner Date: Fri, 4 Dec 2015 03:35:06 -0500 Subject: [PATCH] Polish org crm library --- modules/lib/defuns-org-crm.el | 98 ++++++++++++++++++++--------------- 1 file changed, 57 insertions(+), 41 deletions(-) diff --git a/modules/lib/defuns-org-crm.el b/modules/lib/defuns-org-crm.el index 15b57b706..217ddd5f6 100644 --- a/modules/lib/defuns-org-crm.el +++ b/modules/lib/defuns-org-crm.el @@ -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 "") - (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 "") - (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)