Improve org-based CRM library

modules/lib/defuns-org-crm.el

@@ -1,78 +1,8 @@
 ;;; defuns-org-crm.el --- for my custom org-based CRM
 
-;;; Personal CRM
-;; (defvar narf--helm-org-cache '())
-(defvar narf--helm-org-files '())
-
-(defvar narf--helm-org-title "Org files")
-(defvar narf--helm-org-dir org-directory)
-(defvar narf--helm-org-params '(created contact email country issued paid))
-
-(defun narf--helm-org-init ()
-  (setq narf--helm-org-files
-        (mapcar 'narf--helm-org-metadata
-                (f-entries narf--helm-org-dir (lambda (f) (and (f-ext? f "org") (> (f-size f) 0))) t))))
-
-(defun narf--helm-org-metadata (file &optional params)
-  (let ((params (or params narf--helm-org-params))
-        (base (f-base file))
-        alist content title)
-    (with-temp-buffer
-      (insert-file-contents file nil nil nil t)
-      (setq content (concat (buffer-string))))
-    (setq title (let ((title (deft-parse-title file content)))
-                  (if (string= title "")
-                      "-"
-                    title)))
-    (setq alist
-          (list file
-                (cons 'id (substring base 0 (string-match "-" base)))
-                (cons 'path file)
-                (cons 'title title)
-                (cons 'summary (truncate-string-to-width
-                                (replace-regexp-in-string
-                                 "[\n\t]" " "
-                                 (if title
-                                     (if (string-match (regexp-quote "#+end_src") content)
-                                         (deft-chomp (substring content (match-end 0)
-                                                                (string-match "^\\* " content (match-end 0))))
-                                       "")
-                                   content)
-                                 content)
-                                (window-width)))))
-    (mapc (lambda (p)
-            (let ((value (if (string-match (concat "^" (symbol-name p) ": +\\(.*\\)$") content)
-                             (substring content (match-beginning 1) (match-end 1)))))
-              (when value
-                (add-to-list 'alist (cons p value) t))))
-          params)
-    alist))
-
-;; TODO Make these defun names consistent!
-(defun narf--helm-org-candidates ()
-  narf--helm-org-files)
-(defun narf--helm-org-real-to-display (alist)
-  (format "[%s] [%s] %-20s -- (%s) %s"
-          (cdr-safe (assoc 'id alist))
-          (cdr-safe (assoc 'created alist))
-          (cdr-safe (assoc 'title alist))
-          (or (cdr-safe (assoc 'contact alist))
-              (cdr-safe (assoc 'email alist))
-              (cdr-safe (assoc 'country alist))
-              "")
-          (cdr-safe (assoc 'summary alist))))
-(defun narf--helm-org-action (alist)
-  (find-file (cdr-safe (assoc 'path alist))))
-
 (defun narf--helm-org (&optional directory)
-  (require 'deft)
+  (let ((helm-deft-dir-list `(,(or directory default-directory))))
-  (let ((narf--helm-org-dir (or directory default-directory)))
+    (helm-deft)))
-    (helm :sources (helm-build-sync-source narf--helm-org-title
-                     :init 'narf--helm-org-init
-                     :candidates 'narf-helm-org-candidates
-                     :real-to-display 'narf--helm-org-real-to-display
-                     :action 'narf--helm-org-action)
-          :buffer "*helm-deft*")))
 
 ;;;###autoload
 (defun narf/helm-org ()
@@ -96,28 +26,20 @@
   (narf--helm-org org-directory-invoices))
 
 ;;;###autoload
-(defun narf/helm-org-crm-writing ()
+(defun narf/helm-org-writing ()
   (interactive)
   (let ((narf--helm-org-params '()))
     (narf--helm-org (expand-file-name "writing/" org-directory))))
 
-;;; Custom links
-(defun narf--org-crm-id-to-file (id dir &optional pattern)
-  (let* ((glob (f-glob (format (concat "%s" (or pattern "%s-*.org")) dir id)))
-         (glob-len (length glob)))
-    (when (zerop glob-len)
-      (user-error "Could not find file with that ID"))
-    (car glob)))
-
 ;;;###autoload
 (defun narf/org-crm-link-contact (id)
-  (org-open-file (narf--org-crm-id-to-file id org-directory-contacts) t))
+  (org-open-file (narf--org-crm-resolve-id id 'contact) t))
 ;;;###autoload
 (defun narf/org-crm-link-project (id)
-  (org-open-file (narf--org-crm-id-to-file id org-directory-projects) t))
+  (org-open-file (narf--org-crm-resolve-id id 'project) t))
 ;;;###autoload
 (defun narf/org-crm-link-invoice (id)
-  (org-open-file (narf--org-crm-id-to-file id org-directory-invoices "%s.org") t))
+  (org-open-file (narf--org-crm-resolve-id id 'invoice) t))
 
 (defun narf--org-complete (type)
   (let ((default-directory (symbol-value (intern (format "org-directory-%ss" type)))))
@@ -137,17 +59,61 @@
 ;;;###autoload
 (defun org-invoice-complete-link () (narf--org-complete "invoice"))
 
-(defun narf--org-crm-delete (&optional directory)
+(defun narf--org-crm-new-path (name type)
-  (let ((file (org-iread-file-name ">>> ")))
+  (unless (memq type '(project contact invoice))
-    (delete-file file)
+    (user-error "Not a valid type: %s" type))
-    (message "Deleted %s" file)))
+  (let* ((invoice-p (eq type 'invoice))
+         (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))))
+
+(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
+          (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))))
+
+(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)))
+      (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)))))
+
+
+;;;###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))
+;;;###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))
+;;;###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))
 
-;;;###autoload
-(defun narf/org-crm-contact-delete () (interactive) (narf--org-crm-delete org-directory-contacts))
-;;;###autoload
-(defun narf/org-crm-project-delete () (interactive) (narf--org-crm-delete org-directory-projects))
-;;;###autoload
-(defun narf/org-crm-invoice-delete () (interactive) (narf--org-crm-delete org-directory-invoices))
 
 (provide 'defuns-org-crm)
 ;;; defuns-org-crm.el ends here

modules/module-org.el

@@ -326,11 +326,6 @@ will function properly."
   (exmap! "wc"       'narf/org-word-count)
   (exmap! "at[tach]" 'narf:org-attach)
   (exmap! "export"   'narf:org-export)
-
-  ;; TODO
-  ;; (exmap! "newc[ontact]" 'narf:org-new-contact)
-  ;; (exmap! "newp[roject]" 'narf:org-new-project)
-  ;; (exmap! "newi[nvoice]" 'narf:org-new-invoice)
   )
 
 (defun narf|org-init ()
@@ -472,6 +467,10 @@ will function properly."
            :n  "T"  'org-todo
            :n  "r"  'org-refile
            :n  "s"  'org-schedule
+
+           :n  "op" 'narf/org-open-project-at-pt
+           :n  "oc" 'narf/org-open-contact-at-pt
+           :n  "oi" 'narf/org-open-invoice-at-pt
            )
 
           :n  "za"  'org-cycle
@@ -589,7 +588,12 @@ will function properly."
                   (add-text-properties (min (point-max) (1+ end)) (min (point-max) (1+ end1))
                                        '(face org-block-end-line))
                   t))
-               ((member dc1 '("+title:" "+author:" "+email:" "+date:"))
+               ((string-match-p
+                 (format "^\\+%s+:$"
+                         (regexp-opt '("title" "author" "email" "date" "address" "location" "contact"
+                                       "project" "country" "city" "created" "issued" "paid" "currency")))
+                                        dc1)
+                ;; (member dc1 '("+title:" "+author:" "+email:" "+date:" "+address:" "+location:" "+contact:" "+project:"))
                 (org-remove-flyspell-overlays-in
                  (match-beginning 0)
                  (if (equal "+title:" dc1) (match-end 2) (match-end 0)))

private/my-bindings.el

@@ -141,9 +141,9 @@
   ;; Org notes
   :nv "x."  (λ (in! org-directory (let ((helm-ff-skip-boring-files t)) (helm-find-files-1 org-directory))))
   :nv "x/"  'narf/helm-org
-  :nv "xp"  'narf/helm-org-projects
+  :nv "xp"  'narf/helm-org-crm-projects
-  :nv "xc"  'narf/helm-org-contacts
+  :nv "xc"  'narf/helm-org-crm-contacts
-  :nv "xi"  'narf/helm-org-invoices
+  :nv "xi"  'narf/helm-org-crm-invoices
   :nv "xw"  'narf/helm-org-writing)
 
  (:localleader

private/my-commands.el

@@ -50,6 +50,10 @@
 (exmap "t[mux]"          'narf:send-to-tmux)
 (exmap "tcd"             (λ (narf:send-to-tmux (format "cd '%s'" default-directory))))
 
+(exmap "cont[act]"       'narf:org-crm-contact)
+(exmap "proj[ect]"       'narf:org-crm-project)
+(exmap "invo[ice]"       'narf:org-crm-invoice)
+
 (after! flycheck
   (exmap "er[rors]"      (λ (flycheck-buffer) (flycheck-list-errors))))