Emacsの拡張を作るのに便利かもしれない関数集

Emacs Advent Calender 2014 の 9日目の記事です。

ネタを思いつけなかったので、今までに溜め込んだ汎用性のありそうなプチelispの紹介をさせていただきます。
まとまりのない支離滅裂なコード羅列ですが、ひとつでもEmacs拡張を作る際の参考になればいいなと思います。

最小限、Emacs内臓の cl-lib ライブラリを呼び出して使用します。

(require 'cl-lib)

※忘れていしまいましたがどこからか参考にしたものもあるかもしれません。

Emacsの操作に関するもの

行頭/行の文字の始まる位置に移動

C-aを上書きし、連続して使うと行の一番最初、文字の始まっている位置とを行き来できます。おすすめ。

(defun my-goto-line-beginning-or-indent (&optional $position)
  (interactive)
  (or $position (setq $position (point)))
  (let (($starting-position (progn (back-to-indentation) (point))))
    (if (eq $starting-position $position)
      (move-beginning-of-line 1))))

(global-set-key (kbd "C-a") 'my-goto-line-beginning-or-indent)

カーソル位置のフェイス情報を表示

(defun my-get-face (&optional $point)
  (interactive)
  (or $point (setq $point (point)))
  (let (($face (or (get-char-property $point 'read-face-name)
                   (get-char-property $point 'face))))
    (if $face
        (message (format "%s" $face))
      (message "no face"))))

カーソル位置のEmacs Lisp関数がプリミティブかどうかを確認

ループ内などでプリミティブな関数を使うことで高速化が図れます。しかし、どれがプリミティブかは分かりづらいですね。

(defun my-primitive-at-p ()
  "Check a function at the point is primitive or not"
  (interactive)
  (message
   (format "%s" (if (thing-at-point 'symbol)
                    (subrp (symbol-function
                            (intern (thing-at-point 'symbol))))
                  "nil"))))

カーソル位置のオーバーレイ情報を表示

(defun my-get-overlay-property-cons-list-at (&optional $position)
  (interactive)
  "Get overlay property cons list at the argument $position pointed,
or the cursor on."
  (or $position (setq $position (point)))
  (let ($list $ov)
    (setq $ov (overlay-properties
               (car (overlays-in $position (1+ $position)))))
    (mapc (lambda ($elt)
            (let (($key (car $elt))
                  ($value (cdr $elt)))
              (setq $list (cons (cons $key $value) $list))))
          (let ($ret)
            (while $ov
              (setq $ret (cons (cons (car $ov) (cadr $ov)) $ret))
              (setq $ov (cddr $ov)))
            $ret))
    (message "%s" $list)))

文字列の中で対象の文字列が最後に現れた位置を返す。大文字小文字の区別も可

(defun my-string-last-match ($key $text &optional $case)
  "Return position $key last match in $text.
If $case is non-nil $key distinguishes upper/lower case"
  (let (($i 0)
        (case-fold-search (not $case)))
    (while (string-match $key $text $i)
      (setq $i (1+ $i)))
    $i))

(my-string-last-match "fa" "fafabAfe" t) ; => 3
(my-string-last-match "a" "fafabAfe" t) ; => 4
(my-string-last-match "a" "fafabAfe" nil) ; => 6

バッファ内で正規表現にマッチするものをすべて削除する

(defun my-delete-all-matches-in-buffer ($regexp)
  (save-excursion
    (goto-char (point-min))
    (while (re-search-forward $regexp nil t)
      (delete-region (match-beginning 0) (match-end 0)))))

リストの先頭からn個をリストとして取り出す

(defun my-nthcar ($i $l)
  "Return n($i) of values from the head of a list($l)"
  (cl-loop for $k from 1 to $i
           collect (nth (- $k 1) $l) into res
           finally return (delq nil res)))

(my-nthcar 3 '(5 6 7 8 9)) ; => (5 6 7)

※ コメント欄でご指摘を頂きました。

バッファ内のすべてのテキストプロパティを削除する

(defun my-clear-all-text-properties ()
  (interactive)
  (let ((inhibit-read-only t))
    (set-text-properties (point-min) (point-max) nil)))

除外リストにあるものを対象リストから除外する

(defun my-remove-at-indices ($exclude-list $target-list)
  (let (($return $target-list))
    (mapc (lambda ($x)
            (setq $return (delete $x $return)))
          $exclude-list)
    $return))

(my-remove-at-indices '(1 2 3 "a" "e") '(0 7 2 "c" "e" 1 3 "b" "a")) ;=> (0 7 "c" "b")

※ コメント欄でご指摘を頂きました。

現在バッファのファイルのフルパスを取得

(defun my-get-current-path ()
  (interactive)
  (or (buffer-file-name) (expand-file-name default-directory)))

バッファのテキストエンコーディングを表示

(defun my-show-text-encoding ()
  (interactive)
  (message (format "%s" buffer-file-coding-system)))

指定したフォントの有無を確認

(defun my-font-existsp ($font-name)
    (if (null (x-list-fonts $font-name))
        nil t))

(my-font-existsp "FontAwesome")         ; => nil
(my-font-existsp "Ricty Diminished")    ; => t

Webに関するもの

HTML:選択範囲のそれぞれの行を任意のタグで囲む

ミニバッファに入力したタグ名で1行ごとに囲みます。リスト(li)を作るときによく使っています。

(defun my-wrap-lines-with-html-tag ($tag)
  (interactive "sTag: ")
  (if (and mark-active transient-mark-mode)
      (shell-command-on-region
       (region-beginning) (region-end)
       (concat "perl -0 -p -w -e \'"
               "s/^([^\\S\\r\\n]*)(\\S.*?)[^\\S\\r\\n]*$/$1<"
               $tag ">$2<\\/" $tag ">/gm\'")
       nil t)))

HTML:タグとタグの間、またはタグ内を一気に選択

(defun my-region-angle-brackets ()
  (interactive)
  (let ($pt)
    (skip-chars-backward "^<>")
    (setq $pt (point))
    (skip-chars-forward "^<>")
    (set-mark $pt)))

クオートに囲まれたカーソル地点の文字を選択

(defun my-region-quotes ()
  (interactive)
  (let ($pt)
    (skip-chars-backward "^\"\'")
    (setq $pt (point))
    (skip-chars-forward "^\"\'")
    (set-mark $pt)))

文字をパーセントエンコード

(defun my-encode-char ($char)
  (interactive "cChar: ")
  (if (eq (type-of $char) 'string)
      (setq $char (string-to-char $char)))
  (let (($res (concat "%" (upcase (format "%x" $char)))))
   (when (called-interactively-p 'any)
     (message " %c -> %s " $char $res))
    $res))

(my-encode-char "a")                     ; => "%61"
(my-encode-char "\\")                    ; => "%5C"
(my-encode-char "\"")                    ; => "%22"

1つのパーセントエンコードされた文字をデコード

(defun my-decode-one-percent-string ($percent-string)
  (interactive)
  (when (string-match "^%" $percent-string)
    (let* (($h (substring $percent-string 1))
           ($c (string-to-number $h 16)))
      (format "%c" $c))))

(my-decode-one-percent-string "%2F")       ; => "/"
(my-decode-one-percent-string "%3A")       ; => ":"

色に関連するもの

背景色を取得

(defun my-get-background-color ()
  (interactive)
  (princ (face-attribute 'default :background)))

(my-get-background-color)               ; => "#3F3F3F"

ランダムに色を生成

(defun my-random-color ()
  (interactive)
  (format "#%02x%02x%02x"
          (cl-random 255)
          (cl-random 255)
          (cl-random 255)))

(my-random-color)                       ; => "#288000"
(my-random-color)                       ; => "#7c2ebe"
(my-random-color)                       ; => "#ca4f5f"

16進数値の色をRGB値に変換

(defun my-convert-hex-color-to-rgb ($hex)
  (interactive "sHEX: ")
  (let ($result)
    (when (string-match
           "^\\s-*\\#\\([0-9a-fA-F]\\)\\([0-9a-fA-F]\\)\\([0-9a-fA-F]\\)\\s-*$"
           $hex)
      (let (($m1 (match-string 1 $hex))
            ($m2 (match-string 2 $hex))
            ($m3 (match-string 3 $hex)))
        (setq $result (list (read (format "#x%s%s" $m1 $m1))
                            (read (format "#x%s%s" $m2 $m2))
                            (read (format "#x%s%s" $m3 $m3))))))
    (when (string-match
           "^\\s-*\\#\\([0-9a-fA-F]\\{2\\}\\)\\([0-9a-fA-F]\\{2\\}\\)\\([0-9a-fA-F]\\{2\\}\\)\\s-*$"
           $hex)
      (setq $result (list (read (format "#x%s" (match-string 1 $hex)))
                          (read (format "#x%s" (match-string 2 $hex)))
                          (read (format "#x%s" (match-string 3 $hex))))))
    $result))

(my-convert-hex-color-to-rgb "#ff9900") ; => (255 153 0)
(my-convert-hex-color-to-rgb "#fa9") ; => (255 170 153)

色の名称を16進数値に変換

(defun my-convert-color-name-to-hex ($color-name)
  (let (($rgb) ($hex "#"))
    (mapc (lambda (x)
            (setq $rgb (cons (round (* x 255)) $rgb)))
          (color-name-to-rgb $color-name))
    (setq $rgb (nreverse $rgb))
    (mapc (lambda (x)
              (setq $hex (concat $hex (format "%02x" x))))
            $rgb)
    $hex))

(my-convert-color-name-to-hex "blue")   ; => "#0000ff"
(my-convert-color-name-to-hex "red3")   ; => "#cd0000"

カーソルの色を取得

(defun my-get-cursor-color ()
  (car (cl-loop for ($k . $v) in (frame-parameters)
                if (eq $k 'cursor-color)
                collect $v)))

(my-get-cursor-color)                   ; => "#FFFFEF"

置換に関するもの

後述の置換に使用

(defun my-replace-strings-in-region-by-list ($list)
  "Replace strings in a region according to $list"
  (if mark-active
      (let* (($beg (region-beginning))
             ($end (region-end))
             ($word (buffer-substring-no-properties $beg $end)))
        (mapc (lambda ($r)
                (setq $word (replace-regexp-in-string (car $r) (cdr $r) $word)))
              $list)
        (delete-region $beg $end)
        (insert $word))
    (error "Need to make region")))

選択範囲を1行にする

(defun my-join-multi-lines-to-one ()
  (interactive)
  (my-replace-strings-in-region-by-list
   '(("\\(\n\\s-*\\)+" . ""))))

選択範囲のコードをブログ用にエスケープする

(defun my-escape-region-for-blog-post ()
  "Escape code in region for blog posts"
  (interactive)
  (my-replace-strings-in-region-by-list
   '(("\&" . "&")
     ("\<" . "&lt;")
     ("\>" . "&gt;")
     ;; ("\"" . "&quot;")
     ;; ("\'" . "&#039;")
     ("\t" . "	"))))

選択範囲の全角数字を半角数字に置換

(defun my-convert-to-single-byte-number ()
  "Convert multi-byte numbers in region into single-byte number"
  (interactive)
  (my-replace-strings-in-region-by-list
   '(("１" . "1")
     ("２" . "2")
     ("３" . "3")
     ("４" . "4")
     ("５" . "5")
     ("６" . "6")
     ("７" . "7")
     ("８" . "8")
     ("９" . "9")
     ("０" . "0"))))

選択範囲の半角数字を全角数字に置換

(defun my-convert-to-multi-byte-number ()
  "Convert multi-byte numbers in region into single-byte number"
  (interactive)
  (my-replace-strings-in-region-by-list
   '(("1" ."１")
     ("2" ."２")
     ("3" ."３")
     ("4" ."４")
     ("5" ."５")
     ("6" ."６")
     ("7" ."７")
     ("8" ."８")
     ("9" ."９")
     ("0" ."０"))))

選択範囲の全角記号を半角記号に置換

(defun my-convert-yakumono-to-half-width ()
  "Replace multi byte punctuation marks to half width chars"
  (interactive)
  (my-replace-strings-in-region-by-list
   '(("、" . "､")
     ("。" . "｡")
     ("「" . "｢")
     ("」" . "｣")
     ("［" . "[")
     ("］" . "]")
     ("｛" . "{")
     ("｝" . "}")
     ("（" . "(")
     ("）" . ")")
     ("・" . "･"))))

その他

Mac: 現在のフォルダ以下の DS_Store を一掃

(defun my-delete-DS_Store-under-current-directory-recursively ()
  (interactive)
  (shell-command "find . -name '*.DS_Store' -type f -delete")
  (if (eq major-mode 'dired-mode)
      (revert-buffer)))

おわり

明日、10日目のEmacs Advent Calendarの担当はongaeshiさんです。それではまた～

GitHubにEmacs拡張をいくつか置いています。興味がありましたら試してみてください。
GitHub ShingoFukuyama https://github.com/ShingoFukuyama