emenel/doomemacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Refactor defuns-org-attach + more :attach helm actions

Browse source
This commit is contained in:
Henrik Lissner 2015-11-27 03:37:09 -05:00
parent 88da533cf8
commit 00a0038fcc
1 changed files with 45 additions and 43 deletions
Download patch file Download diff file Expand all files Collapse all files

88
modules/lib/defuns-org-attach.el
View file

@ -1,10 +1,12 @@
;;; defuns-org-attach.el --- custom attachment system ;;; defuns-org-attach.el --- custom attachment system
;; I know Org has its own attachment system, but I don't like it.
;;;###autoload (autoload 'narf:org-attach "defuns-org-attach" nil t) ;;;###autoload (autoload 'narf:org-attach "defuns-org-attach" nil t)
(evil-define-command narf:org-attach (&optional bang link) (evil-define-command narf:org-attach (&optional bang link)
(interactive "<!><a>") (interactive "<!><a>")
(if (not link) (if (not link)
(narf/org-attachment-list) (narf:org-attachment-list bang)
(require 'org-download) (require 'org-download)
(let ((new-path (if bang (let ((new-path (if bang
(format "%s/%s" (expand-file-name org-download-image-dir org-directory) (format "%s/%s" (expand-file-name org-download-image-dir org-directory)
@ -13,14 +15,33 @@
(format-time-string org-download-timestamp) (format-time-string org-download-timestamp)
(file-name-extension link))) buffer-file-name (file-name-extension link))) buffer-file-name
(org-download--fullname link)))) (org-download--fullname link))))
(when new-path (unless new-path
(cond ((string-match-p "^https?://" link) (user-error "No file was provided"))
(url-copy-file link new-path)) (cond ((string-match-p "^https?://" link)
(t (copy-file link new-path))) (url-copy-file link new-path))
(insert (format "[[./%s]]" (f-relative new-path default-directory))))))) (t (copy-file link new-path)))
(insert (format "[[./%s]]" (f-relative new-path default-directory))))))
;;;###autoload (autoload 'narf:org-attachment-list "defuns-org-attach" nil t)
(evil-define-command narf:org-attachment-list (&optional bang)
(interactive "<!>")
(if bang
(narf:org-attachment-cleanup)
(let ((attachments (narf-org--get-attachments)))
(unless attachments
(user-error "No attachments in this file"))
(helm :sources
(helm-build-sync-source "Attachments"
:candidates attachments
:real-to-display 'narf-org--attachment-real-to-display
:action '(("Go to Attachment in Buffer" . narf-org--attachment-find)
("Reveal Attachment in Finder" . narf-org--attachment-reveal)
("Open Attachment" . narf-org--attachment-open)
("Delete Attachment" . narf-org--attachment-delete)))))))
;; TODO Improve ;; TODO Improve
(defun narf/org-reveal-attachments () ;;;###autoload
(defun narf/org-attachment-reveal ()
(interactive) (interactive)
(let ((context (org-element-context))) (let ((context (org-element-context)))
(narf-open-with (narf-open-with
@ -29,8 +50,7 @@
(f-dirname (org-element-property :path context)) (f-dirname (org-element-property :path context))
org-download-image-dir)))) org-download-image-dir))))
;;;###autoload (defun narf-org--get-attachments ()
(defun narf--org-attachments ()
(org-element-map (org-element-parse-buffer) 'link (org-element-map (org-element-parse-buffer) 'link
(lambda (link) (lambda (link)
(when (and (string= (org-element-property :type link) "file") (when (and (string= (org-element-property :type link) "file")
@ -38,44 +58,26 @@
(org-element-property :path link))) (org-element-property :path link)))
(org-element-property :path link))))) (org-element-property :path link)))))
;; (defun narf--org-attachments-in-dir () (defun narf-org--attachment-real-to-display (real)
;; (-map (lambda (f) (concat "./" (f-relative f))) (propertize (f-filename real) 'face (if (file-exists-p real) 'helm-ff-file 'shadow)))
;; (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) (defun narf-org--attachment-find (file)
(format "[%s] %s" (search-forward-regexp (format "[[\\(file:\\)?%s]]" file) nil t)
(if (file-exists-p real) "X" "") (ignore-errors
(f-filename real))) (save-excursion
(outline-previous-visible-heading 1)
(org-show-subtree))))
;; TODO Add delete action (defun narf-org--attachment-reveal (file)
;; TODO Goto link on select (narf-open-with nil (f-dirname file)))
(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 (defun narf-org--attachment-open (file)
;;;###autoload (narf-open-with nil file))
(defun narf/org-attachment-list ()
(interactive)
(helm :sources (narf-org-attachment-source)))
;; TODO (defun narf-org--attachment-delete (file)
;; (defun narf/org-attachment-cleanup (&optional file) (delete-file file)
;; (interactive) (narf-org--attachment-find file)
;; ) (message "File deleted, now delete the link! (%s)" file))
;; TODO
;; (defun narf/org-attachment-cleanup-all ()
;; (interactive)
;; (dolist (file org-agenda-files)
;; (narf/org-attachment-cleanup file)))
(provide 'defuns-org-attach) (provide 'defuns-org-attach)
;;; defuns-org-attach.el ends here ;;; defuns-org-attach.el ends here