Refactor org/org-attach
This commit is contained in:
Henrik Lissner
parent
caf23e239a
commit
e40d991cee
3 changed files with 140 additions and 79 deletions
|
|
@ -1,33 +1,10 @@
|
|||
;;; org/org-attach/autoload/evil.el -*- lexical-binding: t; -*-
|
||||
|
||||
;;;###autoload (autoload '+org-attach:dwim "org/org-attach/autoload/evil" nil t)
|
||||
(evil-define-command +org-attach:dwim (&optional uri)
|
||||
"An evil ex interface to `+org-attach/dwim'."
|
||||
(interactive "<a>")
|
||||
(unless (eq major-mode 'org-mode)
|
||||
(user-error "Not in an org-mode buffer"))
|
||||
(if uri
|
||||
(let* ((rel-path (org-download--fullname uri))
|
||||
(new-path (expand-file-name rel-path))
|
||||
(image-p (image-type-from-file-name uri)))
|
||||
(cond ((string-match-p (concat "^" (regexp-opt '("http" "https" "nfs" "ftp" "file")) ":/") uri)
|
||||
(url-copy-file uri new-path))
|
||||
(t (copy-file uri new-path)))
|
||||
(unless new-path
|
||||
(user-error "No file was provided"))
|
||||
(if (evil-visual-state-p)
|
||||
(org-insert-link nil (format "./%s" rel-path)
|
||||
(concat (buffer-substring-no-properties (region-beginning) (region-end))
|
||||
" " (org-attach--icon rel-path)))
|
||||
;; TODO +org-attach:find
|
||||
|
||||
;;;###autoload (autoload '+org-attach:uri "org/org-attach/autoload/evil" nil t)
|
||||
(evil-define-command +org-attach:uri (uri)
|
||||
"Downloads the file at URL and places an org link to it at the cursor."
|
||||
(interactive "<f>")
|
||||
(+org-attach/uri uri))
|
||||
|
||||
(insert (if image-p
|
||||
(format "[[./%s]] " rel-path)
|
||||
(format "%s [[./%s][%s]] "
|
||||
(org-attach--icon rel-path)
|
||||
rel-path (file-name-nondirectory (directory-file-name rel-path))))))
|
||||
(when (string-match-p (regexp-opt '("jpg" "jpeg" "gif" "png")) (file-name-extension rel-path))
|
||||
(org-redisplay-inline-images)))
|
||||
(let ((default-directory ".attach/"))
|
||||
(if (file-exists-p default-directory)
|
||||
(call-interactively 'find-file)
|
||||
(user-error "No attachments")))))
|
||||
|
|
|
|||
|
|
@ -13,43 +13,104 @@
|
|||
((or "zip" "gz" "tar" "7z" "rar") ?)
|
||||
(_ ?))))
|
||||
|
||||
;;;###autoload
|
||||
(defun +org-attach-cleanup ()
|
||||
;; "Deletes any attachments that are no longer present in the org-mode buffer."
|
||||
(let* ((attachments-local (+org-attachments))
|
||||
(attachments (directory-files org-attach-directory t "^[^.]" t))
|
||||
(to-delete (cl-set-difference attachments-local attachments)))
|
||||
;; TODO
|
||||
to-delete))
|
||||
;; (defun +org-attach-cleanup ()
|
||||
;; ;; "Deletes any attachments that are no longer present in the org-mode buffer."
|
||||
;; (let* ((attachments-local (+org-attachments))
|
||||
;; (attachments (directory-files org-attach-directory t "^[^.]" t))
|
||||
;; (to-delete (cl-set-difference attachments-local attachments)))
|
||||
;; ;; TODO
|
||||
;; to-delete))
|
||||
|
||||
(defun +org-attachments ()
|
||||
"List all attachments in the current buffer."
|
||||
;; (defun +org-attachments ()
|
||||
;; "List all attachments in the current buffer."
|
||||
;; (unless (eq major-mode 'org-mode)
|
||||
;; (user-error "Not an org buffer"))
|
||||
;; (org-save-outline-visibility nil
|
||||
;; (let ((attachments '())
|
||||
;; element)
|
||||
;; (when (and (file-directory-p org-attach-directory)
|
||||
;; (> (length (file-expand-wildcards (expand-file-name "*" org-attach-directory))) 0))
|
||||
;; (save-excursion
|
||||
;; (goto-char (point-min))
|
||||
;; (while (progn (org-next-link) (not org-link-search-failed))
|
||||
;; (setq element (org-element-context))
|
||||
;; (when-let (file (and (eq (org-element-type element) 'link)
|
||||
;; (expand-file-name (org-element-property :path element))))
|
||||
;; (when (and (string= (org-element-property :type element) "file")
|
||||
;; (string= (concat (file-name-base (directory-file-name (file-name-directory file))) "/")
|
||||
;; org-attach-directory)
|
||||
;; (file-exists-p file))
|
||||
;; (push file attachments))))))
|
||||
;; (cl-remove-duplicates attachments))))
|
||||
|
||||
;;;###autoload
|
||||
(defun +org-attach/file (path)
|
||||
"Copies the file at PATH to `+org-attach-dir' and places an org link to it at
|
||||
the cursor."
|
||||
(interactive "fAttach file: ")
|
||||
(+org-attach/uri path))
|
||||
|
||||
;;;###autoload
|
||||
(defun +org-attach/uri (uri)
|
||||
"Downloads the file at URL and place an org link to it at the cursor."
|
||||
(interactive "sUri/file: ")
|
||||
(unless (eq major-mode 'org-mode)
|
||||
(user-error "Not an org buffer"))
|
||||
(org-save-outline-visibility nil
|
||||
(let ((attachments '())
|
||||
element)
|
||||
(when (and (file-directory-p org-attach-directory)
|
||||
(> (length (file-expand-wildcards (expand-file-name "*" org-attach-directory))) 0))
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(while (progn (org-next-link) (not org-link-search-failed))
|
||||
(setq element (org-element-context))
|
||||
(when-let (file (and (eq (org-element-type element) 'link)
|
||||
(expand-file-name (org-element-property :path element))))
|
||||
(when (and (string= (org-element-property :type element) "file")
|
||||
(string= (concat (file-name-base (directory-file-name (file-name-directory file))) "/")
|
||||
org-attach-directory)
|
||||
(file-exists-p file))
|
||||
(push file attachments))))))
|
||||
(cl-remove-duplicates attachments))))
|
||||
(user-error "Not in an org buffer"))
|
||||
(require 'org-download)
|
||||
(condition-case ex
|
||||
(cond ((string-match-p "^data:image/png;base64," uri)
|
||||
(org-download-dnd-base64 uri nil))
|
||||
((and (image-type-from-file-name uri) (not arg))
|
||||
(org-download-image uri))
|
||||
(t
|
||||
(let ((new-path (expand-file-name (org-download--fullname uri))))
|
||||
;; Download the file
|
||||
(if (string-match-p (concat "^" (regexp-opt '("http" "https" "nfs" "ftp" "file")) ":/") uri)
|
||||
(url-copy-file uri new-path)
|
||||
(copy-file uri new-path))
|
||||
;; insert the link
|
||||
(org-download-insert-link uri new-path))))
|
||||
(error
|
||||
(user-error "Failed to attach file: %s" (error-message-string ex)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun +org-attach-download-dnd (uri action)
|
||||
"TODO"
|
||||
(if (eq major-mode 'org-mode)
|
||||
(doom:org-attach uri) ;; FIXME
|
||||
(+org-attach:url uri)
|
||||
(let ((dnd-protocol-alist
|
||||
(rassq-delete-all '+org-attach-download-dnd
|
||||
(copy-alist dnd-protocol-alist))))
|
||||
(dnd-handle-one-url nil action uri))))
|
||||
|
||||
;;;###autoload
|
||||
(defun +org-attach*link-format (filename &optional ext)
|
||||
(format "%s%s.%s"
|
||||
(file-name-sans-extension filename)
|
||||
(format-time-string org-download-timestamp)
|
||||
(or ext (file-name-extension filename))))
|
||||
|
||||
;;;###autoload
|
||||
(defun +org-attach*insert-link (link filename)
|
||||
"TODO"
|
||||
(if (looking-back "^[ \t]+" (line-beginning-position))
|
||||
(delete-region (match-beginning 0) (match-end 0))
|
||||
(newline))
|
||||
(cond ((image-type-from-file-name filename)
|
||||
(insert
|
||||
(concat (if (= org-download-image-html-width 0)
|
||||
""
|
||||
(format "#+attr_html: :width %dpx\n" org-download-image-html-width))
|
||||
(if (= org-download-image-latex-width 0)
|
||||
""
|
||||
(format "#+attr_latex: :width %dcm\n" org-download-image-latex-width))
|
||||
(format org-download-link-format
|
||||
(file-relative-name filename (file-name-directory buffer-file-name)))))
|
||||
(org-display-inline-images))
|
||||
(t
|
||||
(insert
|
||||
(format "%s [[./%s][%s]] "
|
||||
(org-attach--icon filename)
|
||||
(file-relative-name filename buffer-file-name)
|
||||
(file-name-nondirectory (directory-file-name rel-path)))))))
|
||||
|
||||
|
|
|
|||
|
|
@ -4,46 +4,69 @@
|
|||
"Where to store attachments (relative to current org file).")
|
||||
|
||||
|
||||
(add-hook '+org-init-hook #'+org|init-attach t)
|
||||
(add-hook 'org-load-hook #'+org-attach|init t)
|
||||
|
||||
;; FIXME This module is broken and needs to be rewritten.
|
||||
;;
|
||||
;; I believe Org's native attachment system is over-complicated and litters
|
||||
;; files with metadata I don't want.
|
||||
;; files with metadata I don't want. So I wrote my own, which:
|
||||
;;
|
||||
;; This installs my own attachment system. It:
|
||||
;;
|
||||
;; + Centralizes attachment in a global location,
|
||||
;; + Adds drag-and-drop file support
|
||||
;; + TODO ...with attachment icons, and
|
||||
;; + Causes attachments to be placed in a centralized location,
|
||||
;; + Adds drag-and-drop support for images (with inline image preview)
|
||||
;; + Adds drag-and-drop support for media files (pdfs, zips, etc) with a
|
||||
;; filetype icon and short link.
|
||||
;; + TODO Offers an attachment management system.
|
||||
|
||||
;; Some commands of interest:
|
||||
;; + `org-download-screenshot'
|
||||
;; + `+org-attach/file'
|
||||
;; + `+org-attach/url'
|
||||
;; + :org [FILE/URL]
|
||||
|
||||
(def-package! org-download
|
||||
:commands (org-download-dnd org-download-dnd-base64)
|
||||
:init
|
||||
;; Add these myself, so that org-download is lazy-loaded...
|
||||
(setq dnd-protocol-alist
|
||||
`(("^\\(https?\\|ftp\\|file\\|nfs\\):" . +org-attach-download-dnd)
|
||||
("^data:" . org-download-dnd-base64)
|
||||
,@dnd-protocol-alist))
|
||||
|
||||
(advice-add #'org-download-enable :override #'ignore)
|
||||
:config
|
||||
(setq-default org-download-image-dir +org-attach-dir
|
||||
org-download-heading-lvl nil
|
||||
org-download-timestamp "_%Y%m%d_%H%M%S")
|
||||
|
||||
(setq org-download-screenshot-method
|
||||
(cond (IS-MAC "screencapture -i %s")
|
||||
(IS-LINUX "maim --opengl -s %s")))
|
||||
(cond (IS-MAC "screencapture -i %s")
|
||||
(IS-LINUX
|
||||
(cond ((executable-find "maim")
|
||||
"maim -s %s")
|
||||
((executable-find "scrot")
|
||||
"scrot -s %s")))))
|
||||
|
||||
;; Handle non-image files a little differently. Images should be inserted
|
||||
;; as-is, as image previews. Other files, like pdfs or zips, should be linked
|
||||
;; to, with an icon indicating the type of file.
|
||||
(advice-add #'org-download-insert-link :override #'+org-attach*insert-link)
|
||||
|
||||
(defun +org-attach*download-subdir ()
|
||||
(when (file-in-directory-p buffer-file-name +org-dir)
|
||||
(file-relative-name buffer-file-name +org-dir)))
|
||||
|
||||
;; Write download paths relative to current file
|
||||
(defun +org-attach*download-fullname (path)
|
||||
(file-relative-name path (file-name-directory (buffer-file-name))))
|
||||
(file-relative-name path (file-name-directory buffer-file-name)))
|
||||
(advice-add #'org-download--dir-2 :override #'ignore)
|
||||
(advice-add #'org-download--fullname
|
||||
:filter-return #'+org-attach*download-fullname))
|
||||
|
||||
;;
|
||||
(defun +org-attach|init ()
|
||||
(setq org-attach-directory +org-attach-directory)
|
||||
(setq org-attach-directory +org-attach-dir)
|
||||
|
||||
(push +org-attach-dir projectile-globally-ignored-directories)
|
||||
|
||||
(push ".attach" projectile-globally-ignored-file-suffixes)
|
||||
(after! recentf
|
||||
(push (format "/%s.+$" (regexp-quote +org-attach-dir))
|
||||
recentf-exclude))
|
||||
(push (format "%s.+$" (regexp-quote +org-attach-dir))
|
||||
recentf-exclude)))
|
||||
|
||||
(require 'org-download)
|
||||
|
||||
;; Add another drag-and-drop handler that will handle anything but image files
|
||||
(push '("^\\(https?\\|ftp\\|file\\|nfs\\):\\(//\\)?" . +org-attach-download-dnd) dnd-protocol-alist))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue