From e40d991cee3e918da5aa3ebe4f6aefb1af6da93e Mon Sep 17 00:00:00 2001 From: Henrik Lissner Date: Thu, 7 Sep 2017 17:25:38 +0200 Subject: [PATCH] Refactor org/org-attach --- modules/org/org-attach/autoload/evil.el | 37 ++---- modules/org/org-attach/autoload/org-attach.el | 119 +++++++++++++----- modules/org/org-attach/config.el | 63 +++++++--- 3 files changed, 140 insertions(+), 79 deletions(-) diff --git a/modules/org/org-attach/autoload/evil.el b/modules/org/org-attach/autoload/evil.el index 67ffe1b9a..7570f465b 100644 --- a/modules/org/org-attach/autoload/evil.el +++ b/modules/org/org-attach/autoload/evil.el @@ -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 "") - (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 "") + (+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"))))) diff --git a/modules/org/org-attach/autoload/org-attach.el b/modules/org/org-attach/autoload/org-attach.el index 19189cd13..c5972c8c8 100644 --- a/modules/org/org-attach/autoload/org-attach.el +++ b/modules/org/org-attach/autoload/org-attach.el @@ -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))))))) + diff --git a/modules/org/org-attach/config.el b/modules/org/org-attach/config.el index 61d489bb9..6f5dda9c5 100644 --- a/modules/org/org-attach/config.el +++ b/modules/org/org-attach/config.el @@ -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))