Pasting the Org Clipboard

Table of Contents

A literate programming file of functions for formatting Emacs text and code into and out to the system clipboard.

Introduction

Sure, I try to keep my text editing world inside the internal consistency and mouse-less world of Emacs. But life is more complicated, especially on my Mac system given to me for work. The code shown before allows me to interact with other applications, including:

  • Copying code from Emacs to the clipboard that I can paste into apps like Slack
  • Copying Org notes to the clipboard so that when I paste them into web apps and Slack, they maintain their formatting
  • Copying formatted text from web pages and Slack and pasting them in Org files as org-formatted text.

Into the Clipboard

This essay from mbork has an interesting idea of being able to select code, and copy it to the clipboard with extra information about the location. The location is the filename (relative to the project), as well as the project name and line number, but since every buffer may not have all this information, we’ll make some best guesses: 

(defun current-location (start-line)
  "Show the current location and put it into the kill ring.
Use the filename relative to the current project root directory.
If called non-interactively, return the location as a string."
  (interactive "P")
  (let* ((project-name (project-name (project-current)))
         (file-name (when (and buffer-file-name (project-root (project-current)))
                      (file-relative-name buffer-file-name (project-root (project-current)))))
         (line-number (if (and (called-interactively-p) start-line)
                          (line-number-at-pos nil t)
                        start-line))

         (location (cond
                    ((and project-name file-name line-number)
                     (format "%s :: %s : %s" project-name file-name line-number))
                    ((and project-name file-name)
                     (format "%s :: %s" project-name file-name))
                    ((and file-name line-number)
                     (format "%s : %d" file-name line-number))
                    (file-name file-name)
                    (project-name
                     (format "project: %s" project-name))
                    (t ""))))
    (if (not (called-interactively-p))
        location
      (kill-new location)
      (message location))))

Use the current-location function, along with the region or function and copy it into the clipboard: 

(defun code-region-to-clipboard (start end)
  "Copy the active region along with a location header to kill ring.
Calls `current-location' to get the header."
  (interactive "r")
  (let ((location (current-location start)))
    (kill-new
     (format "From %s …\n%s" location (buffer-substring-no-properties start end)))
    (message "Copied code to clipboard, %s" location)))

And if there is no active region, let’s attempt to copy the function (whatever that may mean), that we get with the which-function-mode (see the Emacs wiki for details): 

(defun code-function-to-clipboard ()
  "Copy the current function along with a location header to kill ring.
Calls `current-location' to get the header, and uses the `which-function'
for the name of the function."
  (interactive)
  (let ((func-name (which-function))
        (func-start (save-excursion (beginning-of-defun) (point)))
        (func-end (save-excursion (end-of-defun) (point))))
    (kill-new
     (format "%s (%s)…\n%s"
             (current-location func-start) func-name (buffer-substring-no-properties func-start func-end)))
    (message "Copied `%s' to clipboard" func-name)))

Code is easy to paste, but what about org, as we could formatted it to HTML first, before putting it on the clipboard. For this, I’m going to use the illustrious pandoc project to convert my org file to either Markdown (for Slack) or rich-text (for highly formatted text for the MacOS clipboard). This function is MacOS specific, since it uses pbcopy. I will convert it to also use xclip. 

(defun org-to-clipboard (rich-text-p)
  "Copy the region or Org subtree to the clipboard as Rich Text."
  (interactive "cDo you want Rich Text conversion? [y/n] ")
  (save-excursion
    (unless (region-active-p) (org-mark-subtree))
    (let* ((contents
            (buffer-substring-no-properties (region-beginning) (region-end)))
           (tmp-file (make-temp-file "ha-clipboard-"))
           (text-cmd (format "pandoc --from org --to markdown --standalone %s | pbcopy" tmp-file))
           (rich-cmd (format "pandoc --from org --to rtf --standalone %s | pbcopy -Prefer rtf" tmp-file)))
      (with-temp-file tmp-file
        (insert contents))
      (cond
       ((or (eq rich-text-p ?y) (eq rich-text-p 13)) (shell-command rich-cmd))
       (t                                            (shell-command text-cmd))))))

And a do-what-I-mean function to call these guys based on context: 

(defun code-to-clipboard-dwim ()
  "Puts the region or function on the kill-ring along with location details.
The location details includes the project and file name along with line number."
  (interactive)
  (cond
   ((eq major-mode 'org-mode) (call-interactively 'org-to-clipboard))
   ((region-active-p)         (call-interactively 'code-region-to-clipboard))
   (t                         (code-function-to-clipboard))))

And we need a keybinding: 

(ha-leader
  "y" '("copy location" . current-location)
  "Y" '("copy code" . code-to-clipboard-dwim))

From The Clipboard

Copying regular text into buffers if well supported in Emacs, but this section describes functions to help convert content from the operating system's clipboard into org-mode-compatible text.

Each operating system as a different way of working with the clipboard, so let's create an operating-system abstraction: 

(defun ha-get-clipboard ()
  "Returns a list where the first entry is the content type,
either :html or :text, and the second is the clipboard contents."
  (if (ha-running-on-macos?)
      (ha-get-mac-clipboard)
    (ha-get-linux-clipboard)))

Let's define the clipboard for a Mac. The challenge here is that we need to binary unpack the data from a call to Applescript. 

(defun ha-get-mac-clipboard ()
  "Returns a list where the first entry is the content type,
either :html or :text, and the second is the clipboard contents."
  (cl-destructuring-bind (exit-code contents)
      (shell-command-with-exit-code "osascript" "-e" "the clipboard as \"HTML\"")
    (if (= 0 exit-code)
        (list :html (ha-convert-applescript-to-html contents))
      (list :text (shell-command-to-string "osascript -e 'the clipboard'")))))

(defun ha-convert-applescript-to-html (packed-contents)
  "Applescript's clipboard returns the contents in a packed array.
Convert and return this encoding into a UTF-8 string."
  (cl-flet ((hex-pack-bytes (tuple) (string-to-number (apply 'string tuple) 16)))
    (let* ((data (-> packed-contents
                     (substring 10 -2) ; strips off the =«data RTF= and =»\= bits
                     (string-to-list)))
           (byte-seq (->> data
                          (-partition 2)  ; group each two hex characters into tuple
                          (mapcar #'hex-pack-bytes))))
      (decode-coding-string
       (mapconcat #'byte-to-string byte-seq "") 'utf-8))))

And define the same interface for Linux. Keep in mind, we need the exit code from calling a process, so I am going to define/use a helper function. 

(defun ha-get-linux-clipboard ()
  "Return the clipbaard for a Unix-based system. See `ha-get-clipboard'."
  (cl-destructuring-bind (exit-code contents)
      (shell-command-with-exit-code "xclip" "-o" "-t" "text/html")
    (if (= 0 exit-code)
        (list :html contents)
      (list :text (shell-command-to-string "xclip -o")))))

(defun shell-command-with-exit-code (program &rest args)
  "Run PROGRAM with ARGS and return the exit code and output in a list."
  (with-temp-buffer
    (list (apply 'call-process program nil (current-buffer) nil args)
          (buffer-string))))

Converting to Org

Let's work top-down at this point with the interactive function that inserts the clipboard into the current buffer: 

(defun ha-org-yank-clipboard ()
  "Yanks (pastes) the contents of the Apple Mac clipboard in an
org-mode-compatible format."
  (interactive)
  (insert (ha-org-clipboard)))

This function does the heavy lifting. Note that I will need another function to tidy up the output from pandoc that will be more to my liking. 

(defun ha-org-clipboard ()
  "Return the contents of the clipboard in org-mode format."
  (seq-let (type contents) (ha-get-clipboard)
    (with-temp-buffer
      (insert contents)
      (if (eq :html type)
          (shell-command-on-region (point-min) (point-max)
                                   "pandoc -f html -t org --wrap=none --ascii" t t)
        (shell-command-on-region (point-min) (point-max)
                                 "pandoc -f markdown -t org --wrap=none --ascii" t t))
      (ha-html-paste-touchup)
      (buffer-substring-no-properties (point-min) (point-max)))))

(defun ha-html-paste-touchup ()
  "Attempts to fix the org produced by `pandoc''.
Much of this is also spurious characters from Slack.
Note that this isn't perfect, but a good beginning."
  (interactive)
  (dolist (combo `((" " " ")      ; Pandoc's fixed space needs to go
                   ;; Convert links to a user to an item element:
                   (,(rx "[[https://app.slack.com/team" (one-or-more (not "]")) "]["
                         (group (one-or-more (not "]"))) "]]")
                    "  - *\\1*: ")
                   ;; Make the link to the original more obvious:
                   (,(rx "[[" (group  "https://" (one-or-more any) ".slack.com/archives/"
                                      (one-or-more (not "]"))) "]["
                                      (group (one-or-more (not "]"))) "]]")
                    "  [[\\1][(Link to original message)]]")
                   (,(rx "[[https://slack-imgs.com" (one-or-more (not "]"))
                         "][" (one-or-more (not "]")) "]]")

                    "  - *\\1*: ")
                   (,(rx "[[data:" (one-or-more (not "]"))
                         (optional "][" (one-or-more (not "]"))) "]]") "")
                   (,(rx "[[https://slack-imgs.com" (one-or-more (not "]"))
                         (optional "][" (one-or-more (not "]"))) "]]") "")
                   (,(rx "\\" line-end) "")   ; Doing this twice covers both
                   (,(rx "\\" line-end) "")   ; single and double backslashes
                   (,(rx "(edited)") "")
                   (,(rx line-start "Last reply" (one-or-more any)) "")
                   (,(rx line-start "New" line-end) "")
                   (,(rx line-start "//" line-end) "") ; Odd choice of a separator
                   (,(rx line-start "<<" (one-or-more any) ">>" line-end) "")
                   ;; Shrink multiple blank lines into a single one:
                   (,(rx line-start
                         (zero-or-more space) (regex "\n")
                         (zero-or-more space) (regex "\n")) "")))
    (seq-let (search replace) combo
      (goto-char (point-min))
      (while (re-search-forward search nil t)
        (replace-match replace)))))

Bind these functions to the local mode key sequence: 

(with-eval-after-load 'ha-org
  (ha-leader :keymaps 'org-mode-map
     "o y" '("format yank" . ha-org-yank-clipboard)))