hamacs/ha-org-clipboard.org

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

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

#+begin_src emacs-lisp :exports none
  ;;; org-clipboard --- Functions for formatting the clipboard. -*- lexical-binding: t; -*-
  ;;
  ;; © 2020-2022 Howard X. Abrams
  ;;   Licensed under a Creative Commons Attribution 4.0 International License.
  ;;   See http://creativecommons.org/licenses/by/4.0/
  ;;
  ;; 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
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
[[http://mbork.pl/2022-06-20_Copying_the_current_location][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:
#+begin_src emacs-lisp
  (defun current-location (&optional start-line)
    "Show the current location and put it into the kill ring.
  Use the filename relative to the current projectile root directory.
  If called non-interactively, return the location as a string."
    (interactive)
    (let* ((project-name (projectile-project-name))
           (file-name (when (and buffer-file-name (projectile-project-root))
                        (file-relative-name buffer-file-name (projectile-project-root))))
           (line-number (or start-line (line-number-at-pos nil t)))

           (location (cond
                      ((and project-name file-name)
                       (format "%s :: %s : %s" project-name file-name line-number))
                      (file-name
                       (format "%s : %d" file-name line-number))
                      (project-name
                       (format "project: %s" project-name))
                      (t ""))))
      (if (not (called-interactively-p))
          location
        (kill-new location)
        (message location))))
#+end_src
Use the =current-location= function, along with the /region/ or /function/ and copy it into the clipboard:
#+begin_src emacs-lisp
  (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")
    (kill-new
     (format "From %s …\n%s" (current-location start) (buffer-substring-no-properties start end)))
    (message "Copied code to clipboard, %s" (current-location start)))
#+end_src
And if there is no active region, let’s attempt to copy the /function/ (whatever that may mean), that we get with the [[help:which-function-mode][which-function-mode]] (see [[https://www.emacswiki.org/emacs/WhichFuncMode][the Emacs wiki]] for details):
#+begin_src emacs-lisp
  (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)))
#+end_src

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 [[https://pandoc.org/][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 [[https://www.unix.com/man-page/osx/1/pbcopy/][pbcopy]]. I will convert it to also use [[https://linux.die.net/man/1/xclip][xclip]].
#+begin_src emacs-lisp
  (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))))))
#+end_src

And a do-what-I-mean function to call these guys based on context:
#+begin_src emacs-lisp
  (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))))
#+end_src
And we need a keybinding:
#+begin_src emacs-lisp
  (ha-leader
    "y" '("copy location" . current-location)
    "Y" '("copy code" . code-to-clipboard-dwim))
#+end_src
* 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:
#+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 (ha-running-on-macos?)
      (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."
    (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))))
#+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 (which I should move 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'."
  (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))))
#+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

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.
#+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 --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)))))
#+end_src

Bind these functions 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