From: Visuwesh <visuweshm@gmail.com>
To: emacs-orgmode@gnu.org
Subject: [BUG] [PATCH] Add yank-media and DND handler [9.6.7 (9.6.7-g6eb773 @ /home/viz/lib/emacs/straight/build/org/)]
Date: Fri, 22 Sep 2023 20:22:03 +0530 [thread overview]
Message-ID: <87jzsintv0.fsf@gmail.com> (raw)
[-- Attachment #1: Type: text/plain, Size: 858 bytes --]
Attached patch adds yank-media and DND handler to attach files in the
clipboard and dropped onto an Emacs frame respectively.
The yank-media handler for images is well tested, I use it frequently
however, rest of the stuff aren't really tested since I don't use a GUI
file manager. I tested enough to make sure the logic is right so I
don't know if they are ergonomic enough. As noted in the comments,
files copied/cut to clipboard doesn't seem to have a solid spec and most
of the code was written with pcmanfm as the file manager, testing with
other file managers are highly welcome.
Better names for the newly added defcustoms are highly welcome since I
don't find them to be clear enough from their name.
The patch compiles cleanly without warnings but I haven't tested _this_
patch yet, I have these functions in my init.el and have tested those.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Add-support-for-yank-media-and-DND.patch --]
[-- Type: text/x-diff, Size: 9705 bytes --]
From b6f1315cbdc331f2f54e1801b03272915d344cfd Mon Sep 17 00:00:00 2001
From: Visuwesh <visuweshm@gmail.com>
Date: Fri, 22 Sep 2023 20:11:41 +0530
Subject: [PATCH] Add support for yank-media and DND
* lisp/org.el (org-mode): Call the setup function for yank-media and
DND.
(org-setup-yank-dnd-handlers): Register yank-media-handler and DND
handler.
(org-media-image-save-type, org-dnd-default-attach-method): New
defcustoms.
(org--image-yank-media-handler, org--copied-files-yank-media-handler)
(org--dnd-local-file-handler): Add yank-media and DND handlers.
* etc/ORG-NEWS: Advertise the new features.
---
etc/ORG-NEWS | 16 ++++++
lisp/org.el | 153 +++++++++++++++++++++++++++++++++++++++++++++++++--
2 files changed, 164 insertions(+), 5 deletions(-)
diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index 252c5a9..f193c54 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -596,6 +596,22 @@ return a matplotlib Figure object to plot. For output results, the
current figure (as returned by =pyplot.gcf()=) is cleared before
evaluation, and then plotted afterwards.
+*** Images and files in clipboard can be attached
+
+Org can now attach images in clipboard and files copied/cut to the
+clipboard from file managers using the ~yank-media~ command which also
+inserts a link to the attached file.
+
+Images can be saved to a separate directory instead of being attached,
+customize ~org-media-image-save-type~.
+
+*** Files and images can be attached by dropping onto Emacs
+
+Attachment method other than ~org-attach-method~ for dropped files can
+be specified using ~org-dnd-default-attach-method~.
+
+Images dropped also respect the value of ~org-media-image-save-type~.
+
** New functions and changes in function arguments
*** =TYPES= argument in ~org-element-lineage~ can now be a symbol
diff --git a/lisp/org.el b/lisp/org.el
index d0b2355..5c66f04 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -4999,7 +4999,10 @@ The following commands are available:
(org--set-faces-extend '(org-block-begin-line org-block-end-line)
org-fontify-whole-block-delimiter-line)
(org--set-faces-extend org-level-faces org-fontify-whole-heading-line)
- (setq-local org-mode-loading nil))
+ (setq-local org-mode-loading nil)
+
+ ;; `yank-media' handler and DND support.
+ (org-setup-yank-dnd-handlers))
;; Update `customize-package-emacs-version-alist'
(add-to-list 'customize-package-emacs-version-alist
@@ -15125,20 +15128,20 @@ INCREMENT-STEP divisor."
(setq hour (mod hour 24))
(setq pos-match-group 1
new (format "-%02d:%02d" hour minute)))
-
+
((org-pos-in-match-range pos 6) ;; POS on "dmwy" repeater char.
(setq pos-match-group 6
new (car (rassoc (+ nincrements (cdr (assoc (match-string 6 ts-string) idx))) idx))))
-
+
((org-pos-in-match-range pos 5) ;; POS on X in "Xd" repeater.
(setq pos-match-group 5
;; Never drop below X=1.
new (format "%d" (max 1 (+ nincrements (string-to-number (match-string 5 ts-string)))))))
-
+
((org-pos-in-match-range pos 9) ;; POS on "dmwy" repeater in warning interval.
(setq pos-match-group 9
new (car (rassoc (+ nincrements (cdr (assoc (match-string 9 ts-string) idx))) idx))))
-
+
((org-pos-in-match-range pos 8) ;; POS on X in "Xd" in warning interval.
(setq pos-match-group 8
;; Never drop below X=0.
@@ -20254,6 +20257,146 @@ it has a `diary' type."
(org-format-timestamp timestamp fmt t))
(org-format-timestamp timestamp fmt (eq boundary 'end)))))))
+;;; Yank media handler and DND
+(defun org-setup-yank-dnd-handlers ()
+ "Setup the `yank-media' and DND handlers for buffer."
+ (setq-local dnd-protocol-alist
+ (cons '("^file:///" . org--dnd-local-file-handler)
+ dnd-protocol-alist))
+ (yank-media-handler "image/.*" #'org--image-yank-media-handler)
+ ;; Looks like different DEs go for different handler names,
+ ;; https://larsee.com/blog/2019/05/clipboard-files/.
+ (yank-media-handler "x/special-\\(?:gnome\|KDE\|mate\\)-files"
+ #'org--copied-files-yank-media-handler))
+
+(defcustom org-media-image-save-type 'attach
+ "Method to save images yanked from clipboard and dropped to Emacs.
+It can be the symbol `attach' to add it as an attachment, or a
+directory name to copy/cut the image to that directory."
+ :group 'org
+ :package-version '(Org . "9.7")
+ :type '(choice (const :tag "Add it as attachment" attach)
+ (directory :tag "Save it in directory"))
+ :safe (lambda (x) (or (stringp x) (eq x 'attach))))
+
+(declare-function org-attach-attach "org-attach" (file &optional visit-dir method))
+
+(defun org--image-yank-media-handler (mimetype data)
+ "Save image DATA of mime-type MIMETYPE and insert link at point.
+It is saved as per `org-media-image-save-type'. The name for the
+image is prompted and the extension is automatically added to the
+end."
+ (let* ((ext (symbol-name (mailcap-mime-type-to-extension mimetype)))
+ (iname (read-string "Insert filename for image: "))
+ (filename (file-name-with-extension iname ext))
+ (absname (expand-file-name
+ filename
+ (if (eq org-media-image-save-type 'attach)
+ temporary-file-directory
+ org-media-image-save-type)))
+ link)
+ (when (and (not (eq org-media-image-save-type 'attach))
+ (not (file-directory-p org-media-image-save-type)))
+ (make-directory org-media-image-save-type t))
+ (with-temp-file absname
+ (insert data))
+ (if (null (eq org-media-image-save-type 'attach))
+ (setq link (org-link-make-string
+ (concat "file:" (file-relative-name absname))
+ filename))
+ (require 'org-attach)
+ (org-attach-attach absname nil 'mv)
+ (setq link (org-link-make-string
+ (concat "attachment:" filename)
+ filename)))
+ (insert link)))
+
+;; I cannot find a spec for this but
+;; https://indigo.re/posts/2021-12-21-clipboard-data.html and pcmanfm
+;; suggests that this is the format.
+(defun org--copied-files-yank-media-handler (_mimetype data)
+ "Attach copied or cut files from file manager.
+If the files were cut from the file manager, then the `mv' attach
+method is used; `cp' otherwise.
+
+DATA is a string where the first line is the operation to
+perform: copy or cut. Rest of the lines are file: links to the
+concerned files."
+ (require 'org-attach)
+ (let* ((data (split-string data "[\0\n\r]" t "^file://"))
+ (files (cdr data))
+ (method (if (equal (car data) "cut")
+ 'mv
+ 'cp)))
+ (dolist (f files)
+ (setq f (url-unhex-string f))
+ (if (file-readable-p f)
+ (org-attach-attach f nil method)
+ (message "File `%s' is not readable, skipping" f)))))
+
+(defcustom org-dnd-default-attach-method nil
+ "Default attach method to use when DND action is unspecified.
+This attach method is used when the DND action is `private'.
+This is also used when `org-media-image-save-type' is nil.
+When nil, use `org-attach-method'."
+ :group 'org
+ :package-version '(Org . "9.7")
+ :type '(choice (const :tag "Default attach method" nil)
+ (const :tag "Copy" cp)
+ (const :tag "Move" mv)
+ (const :tag "Hard link" ln)
+ (const :tag "Symbol link" lns)))
+
+(declare-function mailcap-file-name-to-mime-type "mailcap" (file-name))
+(defvar org-attach-method)
+
+(defun org--dnd-local-file-handler (url action)
+ "Attach filename given by URL using method pertaining to ACTION.
+If ACTION is `move', use `mv' attach method.
+If `copy', use `cp' attach method.
+If `ask', ask the user.
+If `private', use the method denoted in `vz/org-dnd-default-attach-action'.
+The action `private' is always returned."
+ (require 'mailcap)
+ (let* ((filename (dnd-get-local-file-name url))
+ (mimetype (mailcap-file-name-to-mime-type filename))
+ (separatep (and (string-prefix-p "image/" mimetype)
+ (not (eq 'attach org-media-image-save-type))))
+ (method (pcase action
+ ('copy 'cp)
+ ('move 'mv)
+ ('ask (caddr (read-multiple-choice
+ "Attach using method"
+ '((?c "cp" cp)
+ (?m "mv" mv)
+ (?l "ln hard link" ln)
+ (?s "symbolic link" lns)))))
+ ('private (or org-dnd-default-attach-method
+ org-attach-method)))))
+ (if separatep
+ (funcall
+ (pcase method
+ ('cp #'copy-file)
+ ('mv #'rename-file)
+ ('ln #'add-name-to-file)
+ ('lns #'make-symbolic-link))
+ filename
+ (expand-file-name (file-name-nondirectory filename)
+ org-media-image-save-type))
+ (org-attach-attach filename nil method))
+ (insert
+ (org-link-make-string
+ (concat (if separatep
+ "file:"
+ "attachment:")
+ (if separatep
+ (expand-file-name (file-name-nondirectory filename)
+ org-media-image-save-type)
+ (file-name-nondirectory filename)))
+ (file-name-nondirectory filename))
+ "\n")
+ 'private))
+
;;; Other stuff
(defvar reftex-docstruct-symbol)
--
2.40.1
next reply other threads:[~2023-09-22 14:53 UTC|newest]
Thread overview: 49+ messages / expand[flat|nested] mbox.gz Atom feed top
[not found] <87bkdccihf.fsf.ref@yahoo.com>
2023-09-22 14:52 ` Visuwesh [this message]
2023-09-22 16:51 ` [BUG] [PATCH] Add yank-media and DND handler [9.6.7 (9.6.7-g6eb773 @ /home/viz/lib/emacs/straight/build/org/)] Max Nikulin
2023-09-22 17:29 ` Visuwesh
2023-09-24 8:06 ` Max Nikulin
2023-09-23 10:28 ` Ihor Radchenko
2023-09-23 16:55 ` Visuwesh
2023-09-25 13:14 ` Visuwesh
2023-09-26 16:25 ` Max Nikulin
2023-09-27 8:33 ` Visuwesh
2023-10-07 11:56 ` Ihor Radchenko
2023-10-07 12:07 ` Ihor Radchenko
2023-10-07 12:27 ` Visuwesh
2023-10-07 12:36 ` Ihor Radchenko
2023-10-07 14:03 ` Visuwesh
2023-10-08 9:30 ` Ihor Radchenko
2023-10-08 11:21 ` Visuwesh
2023-10-09 11:12 ` Ihor Radchenko
2023-10-09 12:17 ` Visuwesh
2023-10-19 7:34 ` Visuwesh
2023-10-19 9:44 ` Ihor Radchenko
2023-10-20 1:52 ` Po Lu
2023-10-20 7:29 ` Ihor Radchenko
2023-10-20 7:46 ` Po Lu
2023-10-20 7:57 ` Ihor Radchenko
2023-10-20 8:29 ` Po Lu
2023-10-20 10:17 ` Visuwesh
2023-10-22 6:19 ` Visuwesh
2023-10-23 8:58 ` Ihor Radchenko
2023-10-23 10:12 ` Visuwesh
2023-10-26 11:39 ` Po Lu
2023-11-05 12:02 ` Ihor Radchenko
2023-11-05 17:45 ` Visuwesh
2023-12-05 13:18 ` Visuwesh
2023-12-10 13:53 ` Ihor Radchenko
2023-12-10 14:47 ` Bastien Guerry
2023-12-10 15:07 ` Ihor Radchenko
2023-09-24 14:58 ` Max Nikulin
2023-09-25 14:15 ` Visuwesh
2023-09-26 10:24 ` Ihor Radchenko
2023-09-27 8:29 ` Visuwesh
2023-09-28 12:01 ` Max Nikulin
2023-09-24 14:49 ` Max Nikulin
2023-10-06 7:34 ` Po Lu
2023-09-29 8:20 Liu Hui
2023-10-01 14:28 ` Visuwesh
2023-10-02 0:28 ` Liu Hui
-- strict thread matches above, loose matches on Subject: below --
2023-10-11 14:24 Liu Hui
2023-10-11 15:36 ` Visuwesh
2023-10-12 5:12 ` Liu Hui
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.orgmode.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87jzsintv0.fsf@gmail.com \
--to=visuweshm@gmail.com \
--cc=emacs-orgmode@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).