Polish org crm library

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))
+  (narf--org-crm-assert-type type)
-    (user-error "Not a valid type: %s" type))
+  (let* ((prefix
-  (let* ((invoice-p (eq type 'invoice))
-         (prefix
           (replace-regexp-in-string
-           "/+$" "" (symbol-value (intern (format "org-directory-%ss" (symbol-name type))))))
+           "/+$" "" (symbol-value (intern (format "org-directory-%ss" type)))))
-         (last-file (car-safe (f-glob "*.org" prefix)))
+         (last-file (car-safe (sort (f-glob "*.org" prefix) 'string>))))
-         (id-sep (string-match-p (if invoice-p "\\." "-") last-file)))
+    (when last-file
-    (if last-file
+      (let* ((old-id (narf--org-crm-path-to-id last-file type))
-        (let* ((old-id (string-to-number (f-filename (substring last-file 0 id-sep)) 16))
+             (new-id (format "%04X" (1+ old-id))))
-               (new-id (format (if invoice-p "%X" "%03X") (1+ old-id))))
+        (if (eq type 'invoice)
-          (format (if invoice-p "%s/%s.org" "%s/%s-%s.org") prefix new-id
+            (format "%s/%s-%s.org" prefix (format-time-string "%y%m") new-id)
-                  (replace-regexp-in-string "[][ !@#$%^&*()]" "-" name)))
+          (format "%s/%s-%s.org" prefix
-      (user-error "path could not be resolved: type(%s) name(%s)" type name))))
+                  new-id (replace-regexp-in-string "[][ !@#$%^&*()]" "-" name)))))))
 
-(defun narf--org-crm-resolve-id (id type)
+(defun narf--org-crm-path-to-id (path type)
-  (unless (memq type '(project contact invoice))
+  (narf--org-crm-assert-type type)
-    (user-error "Not a valid type: %s" type))
+  (let ((base (f-filename path)))
-  (let* ((invoice-p (eq type 'invoice))
+    (string-to-number
-         (prefix
+     (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)))))))
+           "/+$" "" (symbol-value (intern (format "org-directory-%ss" type))))))
-    (or (car-safe
+    (car-safe
-         (f-glob (format (if invoice-p "%X.org" "%03X*.org") (string-to-number id 16))
+     (f-glob (format (if (eq type 'invoice) "*-%04X.org" "%04X*.org")
-                 org-directory-projects))
+                     (string-to-number id 16))
-        (user-error "id %s could not be resolved in %s" id type))))
+             prefix))))
 
 (defun narf--org-crm (&optional id type new-p)
-  (if (not id)
+  (let ((file (if new-p
-      (funcall (intern (format "narf/helm-org-crm-%ss" type)))
+                  (or (narf--org-crm-new-path id type)
-    (let ((file (narf--org-crm-resolve-id 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)
+         nil (format "%s:%s" (symbol-name type) (narf--org-crm-path-to-id file type))
-         (buffer-substring-no-properties (region-beginning) (region-end))))
+         (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)))))
 
 
 ;;;###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)