From dc6ab10260b62ea5476d7e3d6f22db7749cec2e6 Mon Sep 17 00:00:00 2001 From: Henrik Lissner Date: Wed, 25 Nov 2015 17:24:06 -0500 Subject: [PATCH] Extract org defuns into separate files --- modules/lib/defuns-org-attach.el | 81 +++++++++++++++++ modules/lib/defuns-org-crm.el | 147 +++++++++++++++++++++++++++++++ 2 files changed, 228 insertions(+) create mode 100644 modules/lib/defuns-org-attach.el create mode 100644 modules/lib/defuns-org-crm.el diff --git a/modules/lib/defuns-org-attach.el b/modules/lib/defuns-org-attach.el new file mode 100644 index 000000000..715b99140 --- /dev/null +++ b/modules/lib/defuns-org-attach.el @@ -0,0 +1,81 @@ +;;; defuns-org-attach.el --- custom attachment system + +;;;###autoload (autoload 'narf:org-attach "defuns-org-attach" nil t) +(evil-define-command narf:org-attach (&optional bang link) + (interactive "") + (if (not link) + (narf/org-attachment-list) + (require 'org-download) + (let ((new-path (if bang + (format "%s/%s" (expand-file-name org-download-image-dir org-directory) + (format "%s%s.%s" + (f-base link) + (format-time-string org-download-timestamp) + (file-name-extension link))) buffer-file-name + (org-download--fullname link)))) + (when new-path + (cond ((string-match-p "^https?://" link) + (url-copy-file link new-path)) + (t (copy-file link new-path))) + (insert (format "[[./%s]]" (f-relative new-path default-directory))))))) + +;; TODO Improve +(defun narf/org-reveal-attachments () + (interactive) + (let ((context (org-element-context))) + (narf-open-with + nil + (if (and context (eq (org-element-type context) 'link)) + (f-dirname (org-element-property :path context)) + org-download-image-dir)))) + +;;;###autoload +(defun narf--org-attachments () + (org-element-map (org-element-parse-buffer) 'link + (lambda (link) + (when (and (string= (org-element-property :type link) "file") + (string-prefix-p (format "./%s" org-download-image-dir) + (org-element-property :path link))) + (org-element-property :path link))))) + +;; (defun narf--org-attachments-in-dir () +;; (-map (lambda (f) (concat "./" (f-relative f))) +;; (append (f-entries org-download-image-dir) +;; (unless (f-same? +;; (expand-file-name org-download-image-dir) +;; (expand-file-name org-download-image-dir org-directory)) +;; (f-entries (expand-file-name org-download-image-dir org-directory))))) +;; ) + +(defun narf--org-attachment-real-to-display (real) + (format "[%s] %s" + (if (file-exists-p real) "X" "") + (f-filename real))) + +;; TODO Add delete action +;; TODO Goto link on select +(defun narf-org-attachment-source () + (helm-build-sync-source "Attachments" + :candidates (narf--org-attachments) + :real-to-display 'narf--org-attachment-real-to-display + :action (lambda (f) (narf-open-with nil (f-dirname f))))) + +;; TODO Organize this better +;;;###autoload +(defun narf/org-attachment-list () + (interactive) + (helm :sources (narf-org-attachment-source))) + +;; TODO +;; (defun narf/org-attachment-cleanup (&optional file) +;; (interactive) +;; ) + +;; TODO +;; (defun narf/org-attachment-cleanup-all () +;; (interactive) +;; (dolist (file org-agenda-files) +;; (narf/org-attachment-cleanup file))) + +(provide 'defuns-org-attach) +;;; defuns-org-attach.el ends here diff --git a/modules/lib/defuns-org-crm.el b/modules/lib/defuns-org-crm.el new file mode 100644 index 000000000..882887e98 --- /dev/null +++ b/modules/lib/defuns-org-crm.el @@ -0,0 +1,147 @@ +;;; 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*"))) + +;;;###autoload +(defun narf/helm-org-crm-projects () + (interactive) + (narf--helm-org org-directory-projects)) + +;;;###autoload +(defun narf/helm-org-crm-contacts () + (interactive) + (narf--helm-org org-directory-contacts)) + +;;;###autoload +(defun narf/helm-org-crm-invoices () + (interactive) + (narf--helm-org org-directory-invoices)) + +;;;###autoload +(defun narf/helm-org-crm-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)) +;;;###autoload +(defun narf/org-crm-link-project (id) + (org-open-file (narf--org-crm-id-to-file id org-directory-projects) 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)) + +(defun narf--org-complete (type) + (let ((default-directory (symbol-value (intern (format "org-directory-%ss" type))))) + (let* ((file (org-iread-file-name ">>> ")) + (match (s-match "^\\([0-9]+\\)[-.]" (f-filename file)))) + (unless (file-exists-p file) + (message "Created %s" file) + (write-region "" nil file)) + (unless match + (user-error "Invalid file ID")) + (format "%s:%s" type (cadr match))))) + +;;;###autoload +(defun org-contact-complete-link () (narf--org-complete "contact")) +;;;###autoload +(defun org-project-complete-link () (narf--org-complete "project")) +;;;###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))) + +;;;###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