Improve org-based CRM library
This commit is contained in:
Henrik Lissner
parent
dd067002ae
commit
4adee58ce9
4 changed files with 77 additions and 103 deletions
|
|
@ -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 "<!><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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue