EmacsでもPaste Imageしたい（クリップボードから画像を保存＆Markdown or Orgに貼り付けしたい）

Windows (WSL含む) とMacで以下の処理を行う。

クリップボードの画像をカレントディレクトリに YYYYMMDDThhmmss.png 形式で保存
その画像に対するorg-modeまたはmarkdwon形式のlinkを現在のファイルに挿入

実態は以下の記事2つをまとめて書き直しただけである。ただし（MacOSはTestしていない）。 MacOSは brew install pngpaste しておくこと。

Linuxでもなにかやりようはあるだろうが、今のところWSLがメイン環境なので、探してはいない。

(defvar paste-image-script-path "$HOME/wsl_bin/paste_image.ps1")

(defun save-clipboard-image-as-png--windows (filename)
  "Save clipboard image as a png file named FILENAME."
  (interactive)
  (message "Try to create File %s..." filename)
  (call-process "powershell.exe" nil nil nil
                "powershell.exe -ExecutionPolicy RemoteSigned"
                " -File \"" paste-image-script-path "\""
                " -FileName " filename))

;; Not tested
(defun save-clipboard-image-as-png--mac (filename)
  "Save clipboard image as a png file named FILENAME."
  (interactive)
  (message "Try to create File %s..." filename)
  (let ((cmd "pngpaste"))
    (if (executable-find cmd)
        (shell-command (concat "pngpaste " filename))
      (message "%s not found" cmd))))

(defun save-clipboard-image-as-png (filename)
  "Save clipboard image as a png file named FILENAME."
  (interactive)
  (cond
   ((or (> (length (getenv "WSL_DISTRO_NAME")) 0)
        (eq system-type 'windows-nt))
    (save-clipboard-image-as-png--windows filename))
   ((eq system-type 'darwin)
    (save-clipboard-image-as-png--mac filename))
   (t
    (message "system-type %s is not supported now" system-type))))

(defun insert-clipboard-image-as-markdown-or-org-style ()
  "Generate png file from a clipboard image and insert a link to current buffer."
  (interactive)
  (let ((fn (concat "./" (format-time-string "%Y%m%dT%H%M%S") ".png")))
    (save-clipboard-image-as-png fn)
    (if (file-exists-p fn)
        (if (eq major-mode 'org-mode)
            (insert (concat "[[file:" fn "]]"))
          (insert (concat "![](" fn ")"))))))

なお、 paste-image-script-path はpowershellに渡されるため、環境変数の扱いに注意が必要である。このサンプルに書いてある $HOME はWindowsの %HOME% を意味し、 WSLの $HOME を使いたい時は $Env:HOME としなければならない。

画像を保存するpowershell script pates_image.ps1 は変更なくそのままであるが、ここにも掲載しておく。

Param ($FileName)

Add-Type -AssemblyName System.Windows.Forms

If ([Windows.Forms.Clipboard]::ContainsImage() -eq $True) {
  $Image = [Windows.Forms.Clipboard]::GetImage()
  $FilePath = "."
  $ImagePath = Join-Path $FilePath $FileName
  $Image.Save($ImagePath, [System.Drawing.Imaging.ImageFormat]::Png)
}

Markdown形式のlinkをorg-mode形式のlinkに変換する

これをやりたい機会がそれなりにあったので書いた。

範囲選択していたらその範囲だけ、それ以外のときはbuffer全体で変換する。ただし、src-block内は変換しない。

(defun replace-markdown-links-to-org ()
  "Replace Markdown links with Org-mode links.
If region active, do in the active region, else do in the entire buffer.
Only if the current mode is org-mode and the link is not in src block,
this function repalce the link."
  (interactive)
  (save-excursion
    (save-restriction
      (when (region-active-p)
        (narrow-to-region (region-beginning) (region-end)))
      (goto-char (point-min))
      (while (re-search-forward "\\[\\([^]]+\\)\\](\\([^)]*\\))" nil t)
        (let ((text (match-string 1))
              (url (match-string 2)))
          (unless (when (eq major-mode 'org-mode) (org-in-src-block-p))
            (replace-match (format "[[%s][%s]]" url text))))))))

本気でMarkdwonをorg-mode形式に変えたいなら Pandoc がお手軽か？

使用可能なフォントを一覧する

組み込みでありそうだけど見つけられなかったので書いた。

(defun print-all-available-font-familes ()
  "使用可能なfont-familyをすべて表示する."
  (interactive)
  (let ((buf (get-buffer-create "*Font Familes*"))
        (cbuf (current-buffer)))
    (with-current-buffer buf
      (delete-region (point-min) (point-max))
      ;; (print (font-family-list) buf)
      (dolist (x (font-family-list))
        (progn  (print x buf)
                (delete-region (- (point-max) 1) (point-max)))))
    (pop-to-buffer buf)
    (delete-region (point-min) (+ (point-min) 1))
    ;; (goto-char (point-max))
    (switch-to-buffer-other-window cbuf)))

(defun print-all-available-fontsets ()
  "使用可能なfont-setをすべて表示する."
  (interactive)
  (let ((buf (get-buffer-create "*Fontsets"))
        (cbuf (current-buffer)))
    (with-current-buffer buf
      (delete-region (point-min) (point-max))
      ;; (print (font-family-list) buf)
      (dolist (x (x-list-fonts "*"))
        (progn  (print x buf)
                (delete-region (- (point-max) 1) (point-max)))))
    (pop-to-buffer buf)
    (delete-region (point-min) (+ (point-min) 1))
    ;; (goto-char (point-max))
    (switch-to-buffer-other-window cbuf)))