hamacs/ha-org-clipboard.org

Pasting the Org Clipboard

A literate programming file of functions for formatting the clipboard.

Introduction

I would like to paste the formatted contents of the clipboard into an Org file as org-formatted text.

The Clipboard

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 (eq system-type 'darwin)
      (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."
  (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 (that really should go into the piper project).

(defun ha/get-linux-clipboard ()
  "Return the clipbaard for a Unix-based system. See `ha/get-clipboard'."
  (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 from Slack

We can assume that most non-HTML text could be Slack-like:

(defun ha/slack-to-markdown-buffer ()
  "Odd function that converts Slack’s version of Markdown (where
code is delimited with triple backticks) into a more formal
four-space indent markdown style."
  (goto-char (point-min))
  ;; Begin by converting all Carriage Returns to line feeds:
  (while (re-search-forward "
" nil t)
    (replace-match "
"))

  (goto-char (point-min))
  (while (re-search-forward "```" nil t)
    (replace-match "

    ")
    (let ((starting-bounds (point)))
      (if (re-search-forward "```[ \t]*" nil t)
          (let ((ending-bounds (point)))
            (replace-match "

")
            (goto-char starting-bounds)
            (while (< (point) ending-bounds)
              (next-line)
              (beginning-of-line)
              (insert "    ")))))))

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)))

The heavy lifting, however is done by this function. 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" t t)
        (ha/slack-to-markdown-buffer)
        (shell-command-on-region (point-min) (point-max) "pandoc -f markdown -t org" 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'' that seems to plague us."
  (interactive)
  (dolist (combo '((" (edited) " " ")   ; Slack appends this phrase that is never needed
                   (" " " ")             ; Pandoc's fixed space needs to go
                   ("\\\\\\\\$" "")     ; Pandoc's fixed space needs to go
                   ("\\[\\[https://slack-imgs\\.com/.*\\.png\\]\\]" "") ;; Emoticons associated with a user
                   ("\\[\\[https://.*\\.slack\\.com/archives.*\\]\\[\\(.*\n.*\\)\\]\\]" "")
                   ("\\[\\[https://app\.slack\.com/team.*\\]\\[\\(.*\\)\n\\(.*\\)\\]\\]" "  - *\\1 \\2:* ")
                   ("\\[\\[https://app\.slack\.com/team.*\\]\\[\\(.*\n.*\\)\\]\\]" "  - *\\1:* ")
                   ("^- \\(.*\\)\\n  " "- \\1 ")
                   ("^ *<<[0-9\.]+>>\n\n" ""))) ;; Slack includes these time things?
    (seq-let (search replace) combo
      (goto-char (point-min))
      (while (re-search-forward search nil t)
        (replace-match replace)))))

Keybinding to Paste into Org Files

We

(general-evil-define-key 'normal org-mode-map
  :prefix "SPC m"
    "y" 'ha/org-yank-clipboard)