この記事は自分のブログのマルチポストです。

この記事はウェブクルー Advent Calendar 2017の4日目の記事です。
昨日は@wc_moriyamaさんの「わが社のSMS活用事例と5分でできる配信トライアル - Qiita」でした。

いま作っているEmacsプラグインで必要になった機能が、わりと実装の面倒くさいものだったのでメモ。
なおEmacs Lispは初心者なので、変なことやっているかもしれない(可能性大)。
Emacs 25.3以降で動くことは確認した。

やりたいこと

こうしたい。テキストは青空文庫から。

指定した矩形範囲の色を変えたい。
ポイントは以下の2点。

色を変える範囲をウィンドウ上の行番号・列番号で指定したい(複数行にわたっても)
指定範囲に文字(空白も含む)がなくても色を変えたい

なお等幅フォントを使っていない場合はきれいに矩形状に色が変わらないが、考慮しない。
(でも等幅でも変になることがあるようだ？)

基本方針: オーバーレイ

今回のように色を変えるには、Emacsではオーバーレイというのを使うようだ。これを駆使して実現してみる。
基本的な使い方は以下。

;; make-overlayでオーバーレイの範囲を指定(後で操作するため、 ovr という変数に入れておく)
(setq ovr (make-overlay 2 12))

;; オーバーレイで背景色を指定
(overlay-put ovr 'face '(t :background "red"))

;; オーバーレイで、指定範囲の後に文字列を追加
(overlay-put ovr 'after-string "あいうえお")

;; オーバーレイを削除
(delete-overlay ovr)

ここではオーバーレイの属性として face と after-string を使った。他にもいろいろある。

難しいこと

make-overlay は範囲をポイントで指定する。つまりそのバッファでの何文字目から何文字目という形で指定する。

今回やりたいのはウィンドウ上での行番号・列番号で範囲を指定すること。なので行番号・列番号をポイントに変換する処理が必要。

悩んだのは、文字のないところにどうやってオーバーレイをかけるかということ。文字のないところにポイントはないので、これはEmacsの機能として不可能なのでは…と思った。

実現しているelisp

調べたところ、文字のないところの色を変えているelispをいくつか見つけた。なので工夫すればできるよう。

文字のないところにオーバーレイをかける方法

文字のあるところには普通に face で背景色を指定する。
文字のないところには after-string で空白を追加すればいい。

以下では example-put-ovrs が現在行の列番号 bgn-column から end-column の色を変える。
example-put-ovrs-rectangle はこれを何度も使って、矩形状に色を変える。

コードと実行画像

(defvar example-ovrs-list nil)

(defun example-make-add-string (line-end-column bgn-column end-column face)
  "`line-end-column'の後に追加する文字列を返す。
色を変える範囲は`bgn-column'と`end-column'で指定。色は`face'で指定する。"
  (let* ((transparent-blanks
          (make-string
           (max
            0
            (- bgn-column line-end-column))
           ? ))
         (colored-blanks
          (propertize
           (make-string
            (max
             0
             (- end-column (max bgn-column line-end-column)))
            ? ) 'face face)))
    (concat transparent-blanks colored-blanks)))

(defun example-make-ovrs (line-end-column bgn-column end-column)
  "現在行にかける2つのオーバーレイをコンスセルの形で返す。
文字があるところにかけるオーバーレイと、文字がないところに加えるオーバーレイの2つ。"
  (let* ((before-p (< line-end-column bgn-column))
         (after-p (> line-end-column end-column))
         (line-end-point (save-excursion
                           (example-move-to-column line-end-column) (point)))
         (bgn-point (save-excursion
                      (example-move-to-column bgn-column) (point)))
         (end-point (save-excursion
                      (example-move-to-column end-column) (point)))
         (text-ovr (cond (before-p
                          (make-overlay line-end-point line-end-point))
                         (after-p
                          (make-overlay bgn-point end-point))
                         (t
                          (make-overlay bgn-point line-end-point))))
         (add-string-ovr (make-overlay line-end-point line-end-point)))
    `(,text-ovr . ,add-string-ovr)))

(defun example-move-to-column (column)
  "現在行の列番号`column'に移動する。"
  (vertical-motion `(,column . 0)))

(defun example-get-line-end-column ()
  "現在行(物理行)の末尾の列番号を返す。"
  (save-excursion
    (vertical-motion `(,(1- (window-body-width)) . 0))
    (% (current-column) (window-body-width))))

(defun example-put-ovrs (bgn-column end-column face)
  "現在行の、列番号で指定した範囲`bgn-column'から`end-column'の色を`face'で指定した色にする。"
  (let* ((line-end-column (example-get-line-end-column))
         (ovrs (example-make-ovrs line-end-column bgn-column end-column))
         (text-ovr (car ovrs))
         (add-string-ovr (cdr ovrs))
         (add-string (example-make-add-string
                      line-end-column bgn-column end-column face)))
    (overlay-put text-ovr 'face face)
    (overlay-put add-string-ovr 'after-string add-string)
    (push text-ovr example-ovrs-list)
    (push add-string-ovr example-ovrs-list)))

(defun example-put-ovrs-rectangle (left-top right-bottom face)
  "矩形状にオーバーレイをかける。
矩形は左上の点`left-top'と右下の点`right-bottom'で指定する。"
  (let* ((bgn-line (car left-top))
         (end-line (car right-bottom))
         (lines (number-sequence bgn-line end-line))
         (bgn-column (cdr left-top))
         (end-column (cdr right-bottom)))
    (save-excursion
      (dolist (line lines)
        (move-to-window-line line)
        (example-put-ovrs bgn-column end-column face)))))

(defun example-clear-ovrs ()
  "オーバーレイを全消去。"
  (dotimes (x (length example-ovrs-list))
    (delete-overlay (pop example-ovrs-list))))

;; 使用例
"
列番号の目盛:
0         1         2         3         4         5         6         7         8         9         0         1         2         3
012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901
"
(example-put-ovrs 10 30 '(t :background "red"))
(example-put-ovrs 100 120 '(t :background "blue"))
(example-put-ovrs 10 100 '(t :background "white"))
(example-clear-ovrs)


(example-put-ovrs-rectangle '(0 . 0) '(10 . 40) '(t :background "red"))
(example-put-ovrs-rectangle '(11 . 80) '(20 . 100) '(t :background "yellow"))
(example-put-ovrs-rectangle '(21 . 20) '(30 . 90) '(t :background "green"))
(example-clear-ovrs)

example-make-add-string

追加する空白文字列を作っている。
この関数は行末 line-end-column と bgn-column、end-column の関係で返却値を変える。

行末が bgn-column より前にあるとき
行末から bgn-column までの色なし空白 + bgn-column から end-column までの色付き空白
行末が bgn-column と end-column の間にあるとき
行末から end-column までの色付き空白
行末が end-column より後にあるとき
空文字

example-make-ovrs

オーバーレイを2つ、コンスセルにして返す。 (text-ovr . add-string-ovr) の形。
text-ovr は文字のあるところにかかり、色を変えるためのオーバーレイ。
add-string-ovr は文字のないところに文字を追加するためのオーバーレイ。
text-ovr は行末 line-end-column と bgn-column、end-column の関係で範囲が変わる。
add-string-ovr は常に行末。

text-ovr の範囲は以下のようになる。

行末が bgn-column より前にあるとき
行末が指定される。ここに文字はないので色は変わらない。
行末が bgn-column と end-column の間にあるとき
bgn-column から line-end-column までが指定される。
行末が end-column より後にあるとき
bgn-column から end-column が指定される。

これから

設定(？)によってうまくいかないことがある気がするので、できるだけいつでも使えるようにする
これだと同じ行に複数のオーバーレイを追加すると崩壊するので何か考える
本題のプラグインを早く…

明日は@asukameさんです。よろしくお願いします！