diff --git a/modules/lib/defuns-org-crm.el b/modules/lib/defuns-org-crm.el index 31eee6901..15b57b706 100644 --- a/modules/lib/defuns-org-crm.el +++ b/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 ((narf--helm-org-dir (or directory default-directory))) - (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*"))) + (let ((helm-deft-dir-list `(,(or directory default-directory)))) + (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) - (let ((file (org-iread-file-name ">>> "))) - (delete-file file) - (message "Deleted %s" file))) +(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 + (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 "") + (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 "") + (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 diff --git a/modules/module-org.el b/modules/module-org.el index f6067da36..8bf547102 100644 --- a/modules/module-org.el +++ b/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))) diff --git a/private/my-bindings.el b/private/my-bindings.el index 76eb4a5ea..a8d4399fa 100644 --- a/private/my-bindings.el +++ b/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 "xc" 'narf/helm-org-contacts - :nv "xi" 'narf/helm-org-invoices + :nv "xp" 'narf/helm-org-crm-projects + :nv "xc" 'narf/helm-org-crm-contacts + :nv "xi" 'narf/helm-org-crm-invoices :nv "xw" 'narf/helm-org-writing) (:localleader diff --git a/private/my-commands.el b/private/my-commands.el index 06b398c04..0900f41bc 100644 --- a/private/my-commands.el +++ b/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))))