hamacs/ha-org-clipboard.org

#+TITLE:  Pasting the Org Clipboard
#+AUTHOR: Howard X. Abrams
#+DATE:   2020-09-15
#+FILETAGS: :emacs:

A literate programming file of functions for formatting the clipboard.
# *Note:* After each change, /tangle it/ to the source destination with ~C-c C-v t~.

#+BEGIN_SRC emacs-lisp :exports none
;;; org-clipboard.el --- A literate programming file of functions for formatting the clipboard. -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2020 Howard X. Abrams
;;
;; Author: Howard X. Abrams <http://gitlab.com/howardabrams>
;; Maintainer: Howard X. Abrams
;; Created: September 15, 2020
;;
;; This file is not part of GNU Emacs.
;;
;; *NB:* Do not edit this file. Instead, edit the original literate file at:
;;            ~/other/hamacs/org-clipboard.org
;;       And tangle the file to recreate this one.
;;
;;; Code:
#+END_SRC
* 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:

#+BEGIN_SRC emacs-lisp
(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)))
#+END_SRC

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.

#+BEGIN_SRC emacs-lisp
(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))))
#+END_SRC

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

#+BEGIN_SRC emacs-lisp
(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))))
#+END_SRC

* Converting from Slack

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

#+BEGIN_SRC emacs-lisp
(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 "    ")))))))
#+END_SRC

* Converting to Org

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

#+BEGIN_SRC emacs-lisp
(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)))
#+END_SRC

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.

#+BEGIN_SRC emacs-lisp
(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)))))
#+END_SRC

* Keybinding to Paste into Org Files
We just need to bind it to the /local/ mode key sequence:
#+BEGIN_SRC emacs-lisp
  (with-eval-after-load 'ha-org
    (ha-org-leader "y" 'ha-org-yank-clipboard))
#+END_SRC

* Technical Artifacts                                :noexport:
Let's provide a name so we can =require= this file:

#+BEGIN_SRC emacs-lisp
(provide 'ha-org-clipboard)
;;; ha-org-clipboard.el ends here
#+END_SRC

#+DESCRIPTION: A literate programming version of functions for formatting the clipboard.

#+PROPERTY:    header-args:sh :tangle no
#+PROPERTY:    header-args:emacs-lisp :tangle yes
#+PROPERTY:    header-args    :results none :eval no-export :comments no mkdirp yes

#+OPTIONS:     num:nil toc:nil todo:nil tasks:nil tags:nil date:nil
#+OPTIONS:     skip:nil author:nil email:nil creator:nil timestamp:nil
#+INFOJS_OPT:  view:nil toc:nil ltoc:t mouse:underline buttons:0 path:http://orgmode.org/org-info.js