Yearly Archives: 2025

2025-11-05 Emacs, org-mode

Org Agendaに天気・日の出日の入・月の状態を表示する

org-modeのagendaについてはこれまでに色々な設定をしてきました。

特に日付に対する付加情報として、毎日の天気、日の出時刻、日の入り時刻、月相、月出、月没等も表示させるようにしてきました(diary-sexpで)。

ただ、これらの日付に対する付加的な情報を、情報ごとに1行ずつ表示していると肝心の予定が見づらくなってしまいます。なので私はこれらの情報は1日1行にまとめて表示するようにもしてきました。

今日はそれをさらに一歩進めて、付加的な情報は日付の右側に小さく表示させてみようと思います。

最終的な見た目は次のようになりました。

これならあまり邪魔にならないでしょう。

設定箇所が散乱していて大変でしたが、関連しそうな所を次のようにまとめてみました。足りないところがあったらすみません。

;;; my-org-agenda.el ---                            -*- lexical-binding: t; -*-
(require 'org-agenda)
(require 'calendar)
(require 'solar)
(require 'lunar)
(require 'japanese-holidays) ;; https://github.com/emacs-jp/japanese-holidays
(require 'jma-forecast) ;; https://github.com/misohena/el-jma
(require 'moonrise) ;; https://github.com/misohena/moonrise-el

;;;; 雑多な設定(関係ないのも含まれているかも)

;; moonrise-el用
(setq moonrise-day-events-format-org-agenda
      '(rise set
             (time :hour 12 :preceding t :display-time nil
                   :display-moon-phase t))
      moonrise-org-agenda-event-separator ""
      moonrise-org-agenda-use-cache t
      moonrise-point-event-format
      '((point-name :separator " ") (time :separator "")
        (moon-age :separator " ") (moon-phase :separator ""))
      moonrise-point-name-alist '((rise . "月出") (set . "月没") (meridian . "南中")))

;; el-jma用
(setq jma-weather-code-image-default-height 22
      jma-forecast-location-amedas "44132" ;; 東京(AMEDAS)
      jma-forecast-location-class10 "130010" ;; 東京地方
      jma-forecast-location-office "130000" ;; 東京都
      jma-forecast-location-week-amedas "44132" ;; 東京(AMEDAS)(週間予報)
      jma-forecast-location-week-area "130010") ;; 東京地方(週間予報)

;; solar.el用
(setq solar-n-hemi-seasons '("春分" "夏至" "秋分" "冬至"))

(setq calendar-latitude 35.0000 ;; 緯度
      calendar-longitude 139.0000) ;; 経度

;; org-modern用 (必要に応じて)
;; (add-hook 'org-agenda-finalize-hook #'org-modern-agenda)


;;; org-agenda用の設定

(setq
 org-agenda-custom-commands
 '(("a" "Default"
    ((agenda "" ((org-agenda-overriding-header "TODO"))))
    ((org-agenda-export-html-style
      "<link rel=\"stylesheet\" type=\"text/css\" href=\"agenda.css\">")
     (org-agenda-use-time-grid nil))
    ("~/my-org-agenda-html/agenda.html")))
 org-agenda-deadline-leaders '("DL" "DL%dd:" "DL-%dd:")
 org-agenda-files '("~/my-org-files/todo.org")
 org-agenda-include-diary t
 org-agenda-prefix-format
 '((agenda . " %i %?-12t%? s") (todo . " %i %-8:c")
   (tags . " %i %-8:c") (search . " %i %-8:c"))
 org-agenda-scheduled-leaders '("" "-%dd:")
 org-agenda-search-headline-for-time nil
 org-agenda-sort-notime-is-late nil
 org-agenda-span 31
 org-agenda-tags-column 0
 org-agenda-time-grid
 '((daily today require-timed) (800 1000 1200 1400 1600 1800 2000)
   " ·····" "────────────"))


;;;; 長い見出しの折り返し後をインデント

;; https://misohena.jp/blog/2022-10-30-org-agenda-wrap-prefix.html

(defvar my-org-agenda-format-item-prefix "") ;;formatterが返した値を取っておくための変数。
(defun my-org-agenda-format-item (orig-fun &rest args)
  ;; 元のorg-agenda-format-itemを呼び出す前に
  ;; org-prefix-format-compiledを一時的に書き替える。
  (let* ((org-prefix-format-compiled
          (list
           (car org-prefix-format-compiled)
           ;; formatterを書き替えてしまう。
           ;; 結果を my-org-agenda-format-item-prefix に書き込む関数に。
           (list 'setq
                 'my-org-agenda-format-item-prefix
                 (cadr org-prefix-format-compiled))))
         ;; 元のorg-agenda-format-itemを呼び出す。
         (rv (apply orig-fun args)))
    ;; 戻り値にwrap-prefixテキストプロパティを追加する。
    ;; インデントの深さはformatterが返した文字列(prefix)の長さとする。
    (put-text-property
     0 (length rv) 'wrap-prefix
     (make-string (length my-org-agenda-format-item-prefix) ? )
     rv)
    rv))

(advice-add #'org-agenda-format-item :around #'my-org-agenda-format-item)


;;;; ブロック区切りを一行に

;; ブロック区切りを制御するには `org-agenda-block-separator' を使用するが、
;; これはnilにすると空行が無くなってしまうし、文字や文字列を設定すると必ず
;; 2つの\nが挿入されてしまう。""を指定すると空行が2つ挿入されてしまう。
;; この処理は `org-agenda-prepare' で行っているので、そのafterアドバイスで
;; \nを一つだけ挿入する。

(setq org-agenda-block-separator nil) ;; 2行追加しない。

(defun my-org-agenda-prepare-after (&rest _args)
  (when (and (not (org-agenda-use-sticky-p))
             org-agenda-multi
             (> (point) 1) ;; (not (bobp))ではダメ。narrowingされているから。
             (not org-agenda-compact-blocks))
    ;; 1行のみ追加してそれ以降をナローイング
    (insert "\n")
    (narrow-to-region (point) (point-max))))

(advice-add #'org-agenda-prepare :after #'my-org-agenda-prepare-after)


;;;; 日付の形式

(defconst my-org-agenda-dow '(?日 ?月 ?火 ?水 ?木 ?金 ?土))

(defun my-org-agenda-format-date--date (date)
  (let* ((year (caddr date))
         (month (car date))
         (day (cadr date))
         (dow (elt my-org-agenda-dow (calendar-day-of-week date)))
         (today (calendar-gregorian-from-absolute (org-today)))
         (today-year (caddr today))
         (today-month (car today)))
    (concat
     (if (equal year today-year)
         (if (equal month today-month)
             (format "%d" day)
           (format "%2d/%02d" month day))
       (format "%d/%02d/%02d" year month day))
     ;; " "
     (propertize (format "%c" dow) 'my-org-agenda-dow t))))

(defun my-org-agenda-format-date (date)
  (concat
   ;; 日付の上に空白
   (propertize "" 'display '(space :width (1) :height 1.75 :ascent 100))
   ;; 日付
   (my-org-agenda-format-date--date date)))

(setq org-agenda-format-date #'my-org-agenda-format-date)


;;;; 日付の色

;; https://misohena.jp/blog/2021-08-29-colorize-saturday-and-japanese-holidays-in-org-agenda.html

(defface my-org-agenda-date-saturday
  '((t (:inherit org-agenda-date :foreground "#0bf" :weight bold)))
  "Face used in agenda for saturday."
  :group 'org-faces)

(defface my-org-agenda-dow-saturday
  '((t (:inherit my-org-agenda-date-saturday :height 0.8)))
  "Face used in agenda for saturday."
  :group 'org-faces)

(defface my-org-agenda-dow-weekend
  '((t (:inherit org-agenda-date-weekend :height 0.8)))
  "Face used in agenda for saturday."
  :group 'org-faces)

(defface my-org-agenda-dow
  '((t (:inherit org-agenda-date :height 0.8)))
  "Face used in agenda for saturday."
  :group 'org-faces)

(defun my-org-agenda-day-face (date)
  (let ((face (cond
               ;; 土曜日
               ((= (calendar-day-of-week date) 6)
                'my-org-agenda-date-saturday)
               ;; 日曜日か日本の祝日
               ((or (= (calendar-day-of-week date) 0)
                    (let ((calendar-holidays japanese-holidays))
                      (calendar-check-holidays date)))
                'org-agenda-date-weekend)
               ;; 普通の日
               (t 'org-agenda-date))))
    ;; 今日は色を反転
    ;;(if (org-agenda-today-p date) (list :inherit face :inverse-video t) face)
    face))

(setq org-agenda-day-face-function #'my-org-agenda-day-face)


;; 数字部分と曜日部分を分けて調整できるようにする

(defun my-org-agenda-fontify-dow ()
  ;; 曜日部分を独立したfaceにします。
  ;; `org-agenda-format-date'や`org-agenda-day-face-function'が呼び出され
  ;; るタイミングで行ってもダメなので、Agendaが完成した後にfaceを書き替えます。
  ;; See: `org-agenda-list'
  (let ((inhibit-read-only t)
        match)
    (save-excursion
      (goto-char (point-min))
      (while (setq match (text-property-search-forward 'my-org-agenda-dow t t))
        (put-text-property
         (prop-match-beginning match)
         (prop-match-end match)
         'face
         (pcase (get-text-property (1- (point)) 'face)
           ('org-agenda-date 'my-org-agenda-dow)
           ('org-agenda-date-weekend 'my-org-agenda-dow-weekend)
           ('my-org-agenda-date-saturday 'my-org-agenda-dow-saturday)))))))

(add-hook 'org-agenda-finalize-hook 'my-org-agenda-fontify-dow)


;;;; 日付付加情報

(defun my-org-agenda-sunrise-sunset ()
  ;; Return "<日の出><日の入>"
  (let ((times (solar-sunrise-sunset org-agenda-current-date)))
    (mapconcat
     #'identity
     (delq
      nil
      (list
       (when (car times) (apply #'solar-time-string (car times)))
       (when (and (car times) (cadr times)) "～")
       (when (cadr times) (apply #'solar-time-string (cadr times)))))
     "")))

(defun my-org-agenda-sun-and-moon ()
  (mapconcat #'identity
             (delq nil
                   (list
                    ;; "<日の出><日の入>"
                    (my-org-agenda-sunrise-sunset)
                    ;; "<12時月相><月出没>*"
                    (moonrise-org-agenda)
                    ;; "<四朔望>"
                    (cdr (diary-lunar-phases))))
             " "))

(defun my-org-agenda-weather ()
  (ignore-errors
    (jma-diary-weathers
     ;; 東京都 東京地方 東京
     "130000" "130010" "44132" "130010" "44132"
     ;; "<天気><降水確率><最低気温><最高気温>"
     "{{{weather-image:%s}}}{{{pop:%s%%}}}\
{{{temp-min: %s～}}}{{{temp-max:%s℃}}}")))

(defun my-org-agenda-nature-environment (date-arg)
  ;; 指定された日付(DATE-ARG)の自然環境情報文字列を返す。
  (with-no-warnings (defvar date))
  (let ((date date-arg)
        (org-agenda-current-date date-arg))
    (mapconcat
     #'identity
     (delq nil
           (list
            ;; 天気
            (my-org-agenda-weather)
            ;; 日の出・日の入
            (my-org-agenda-sunrise-sunset)
            ;; 12時月相・月出没
            (let ((moonrise-point-name-alist
                   '((rise . "↑")
                     (set . "↓")
                     (meridian . "中"))))
              (moonrise-org-agenda))
            ;; 四朔望
            (cdr (diary-lunar-phases))))
     " ")))

(defun my-org-agenda-day-info (date)
  ;; 日付DATEの付加情報文字列を返す。
  (propertize
   (concat
    " "
    (my-org-agenda-nature-environment date))
   'my-org-agenda-date-info t
   'face 'my-org-agenda-date-info))

(defface my-org-agenda-date-info
  '((t (:foreground "#999" :height 0.8)))
  "Face used in agenda for date info."
  :group 'org-faces)

(defun my-org-agenda-date-info-display-p ()
  ;; 特定の場所でのみ日付付加情報を表示するなら、ここで何らかの条件で判定せよ
  ;; (equal
  ;;  (get-text-property (point) 'org-series-cmd)
  ;;  '(agenda "" ((org-agenda-overriding-header "TODO"))))
  t)

(defcustom my-org-agenda-date-info-display-p
  #'my-org-agenda-date-info-display-p
  "日付付加情報を表示する条件。
  nil = 常に表示しない
  t = 常に表示する
  関数 = Agendaバッファの日付部分末尾で呼び出され、非nilを返したら表示"
  :type '(choice boolean function)
  :group 'org)

(defun my-org-agenda-update-date-info-face ()
  ;; 日付付加情報をAgendaバッファに挿入する。
  (when my-org-agenda-date-info-display-p
    (let ((inhibit-read-only t))
      (save-excursion
        (goto-char (point-min))
        (while (text-property-search-forward 'org-agenda-date-header)
          (when-let* ((day (get-text-property (1- (point)) 'day))
                      (date (calendar-gregorian-from-absolute day)))
            (when (or (eq my-org-agenda-date-info-display-p t)
                      (and (functionp my-org-agenda-date-info-display-p)
                           (funcall my-org-agenda-date-info-display-p)))
              (insert (my-org-agenda-day-info date)))))))))

(add-hook 'org-agenda-finalize-hook 'my-org-agenda-update-date-info-face)

org-agendaの出力を細かくカスタマイズするにはorg-agenda-finalize-hookを使うのが最も強力なようです。これはorg-agendaの出力が一通り終わった後に呼び出されるフックなので、細かいところも全て後から書き替える事が出来ます。ただし、バッファ全体をスキャンする必要が出てくるので多少効率は落ちます。

出力関数の一部の挙動をピンポイントで修正しようと思っても、それはほとんどの場合困難です。出力関数(org-agenda-list)は205行にもなる大きな関数ですし、処理が適切な粒度で関数化されていないので割り込む余地がありません。

というわけで上のコードでは、org-agenda-finalize-hookに my-org-agenda-update-date-info-face や my-org-agenda-fontify-dow といったフックを追加して付加情報の挿入や曜日部分のface分離を行っています。

その他細かいところを調整するのに苦労しました。

それでも最終的に調整できてしまうのがEmacsの良い所ではあります。

2025-07-27 Emacs

VerticoとCorfuをタッチスクリーンで操作できるようにする

私はEmacsの補完インタフェースにVerticoとCorfuを使用していますが、Android版のEmacsを使っていると補完候補の一覧をタップで選択できないことにフラストレーションを感じます。同様にスワイプによるスクロールも出来ません。

というわけで、何とかしてみました。

Vertico用のコード:

;;; my-vertico-touch.el ---                          -*- lexical-binding: t; -*-

;; 使い方:
;; (with-eval-after-load 'vertico
;;   (require 'my-vertico-touch)
;;   (my-vertico-touch-setup)

(require 'vertico)
(require 'vertico-mouse)

(defconst my-vertico-touch-tap-threshold 4)

(defun my-vertico-touchscreen-begin (begin-event)
  (interactive "e")
  (let* ((begin-posn (cdadr begin-event))
         (begin-xy (posn-x-y begin-posn))
         (begin-window (posn-window begin-posn))
         (moved nil))
    (with-selected-window begin-window
      (let ((begin-scroll-pos vertico--scroll))
        (while
            (let ((ev (read-event)))
              (pcase (car-safe ev)
                ('touchscreen-update
                 (let* ((update-xy (touch-screen-relative-xy (cdaadr ev)
                                                             begin-window))
                        (dx (- (car update-xy) (car begin-xy)))
                        (dy (- (cdr update-xy) (cdr begin-xy))))
                   (when (and (not moved)
                              (>= (+ (* dx dx) (* dy dy))
                                  (* my-vertico-touch-tap-threshold
                                     my-vertico-touch-tap-threshold)))
                     (setq moved t))
                   (when moved
                     (let* ((dline (/ dy (default-line-height)))
                            (new-scroll-pos (- begin-scroll-pos dline)))
                       (cond
                        ((< new-scroll-pos vertico--scroll)
                         (vertico--goto (+ new-scroll-pos vertico-scroll-margin)))
                        ((> new-scroll-pos vertico--scroll)
                         (vertico--goto (+ new-scroll-pos vertico-count
                                           (- vertico-scroll-margin))))))
                     (vertico--exhibit)))
                 t)
                ('touchscreen-end
                 (unless moved
                   (vertico--goto (vertico-mouse--index begin-event))
                   (vertico-exit))
                 nil))))))))

(defun my-vertico-touch-setup ()
  (interactive)
  (vertico-mouse-mode)
  (define-key vertico-mouse-map (kbd "<touchscreen-begin>")
              #'my-vertico-touchscreen-begin))

(defun my-vertico-touch-teardown ()
  (interactive)
  (define-key vertico-mouse-map (kbd "<touchscreen-begin>")
              #'my-vertico-touchscreen-begin
              t))

(provide 'my-vertico-touch)

Corfu用のコード:

;;; my-corfu-touch.el ---                            -*- lexical-binding: t; -*-

;; 使い方:
;; (with-eval-after-load "corfu"
;;   (require 'my-corfu-touch)
;;   (my-corfu-touch-setup))

(require 'corfu)

;;;; Frame Handling

(defun my-corfu-defocus-child-frame ()
  "corfu用の子フレームからフォーカスを外す。"
  (when (eq (selected-frame) corfu--frame)
    (when-let* ((parent (frame-parent)))
      (select-frame parent))))

(defun my-corfu-handle-switch-frame-p ()
  "フレームの変更処理中なら非nilを返す。
`this-command'と`last-input-event'によって判定される。

`this-command'が`handle-switch-frame'であり、かつ、`last-input-event'が
corfu用の子フレームに対する`switch-frame'イベントであれば、非nilを返し、
そうでなければnilを返す。"
  (and (eq this-command 'handle-switch-frame)
       (eq (car-safe last-input-event) 'switch-frame)
       (eq (cadr last-input-event) corfu--frame)))

;; 子フレームがクリック/タップされたとき、`switch-frame'イベントが発生
;; し`handle-switch-frame'コマンドが実行される。また、その前後でwindow
;; 変更を通知するフックも呼び出される(クリックかタップかによって微妙に
;; 順番は変わる?)。
;;
;; それらのタイミングのどこかでフォーカスの変更が行われるので、
;; `my-corfu-defocus-child-frame'を呼び出して元の親フレームがフォーカス
;; されている状態を維持する必要がある(`switch-frame'の効果を打ち消す)。
;;
;; また、`handle-switch-frame'コマンドによってcorfuが終了してしまうこ
;; とがあるので、それも防止する必要がある。基本的にcorfuの候補表示フレー
;; ム(`corfu--frame')に対する`handle-switch-frame'は無視した方が良い。

(defun my-corfu--post-command:around (old-fun &rest args)
  (my-corfu-defocus-child-frame)

  (unless (my-corfu-handle-switch-frame-p)
    (apply old-fun args)))

(defun my-corfu--prepare:around (old-fun &rest args) ;; pre-command-hook
  (unless (my-corfu-handle-switch-frame-p)
    (apply old-fun args)))

(defun my-corfu--window-change:around (old-fun &rest args)
  ;; 注意: タッチイベントの時はhandle-switch-frameよりも先にここに来る。
  ;;       クリックの時は先にhandle-switch-frameが発生するのでこれは不要。
  (my-corfu-defocus-child-frame)
  (apply old-fun args))

;;;; Candidate List

(defun my-corfu-select (index)
  (corfu--goto index)
  (corfu-insert))

(defun my-corfu-posn-line-number (posn)
  (with-current-buffer (window-buffer (posn-window posn))
    (line-number-at-pos (posn-point posn) t)))

(defun my-corfu-posn-index (posn)
  (+ corfu--scroll (my-corfu-posn-line-number posn) -1))

(defun my-corfu-select-clicked (event)
  (interactive "e")
  (my-corfu-select (my-corfu-posn-index (event-start event))))

(defun my-corfu-set-scroll-pos (new-scroll-pos)
  (cond
   ((< new-scroll-pos corfu--scroll)
    (corfu--goto (+ new-scroll-pos corfu-scroll-margin)))
   ((> new-scroll-pos corfu--scroll)
    (corfu--goto (+ new-scroll-pos corfu-count
                    (- corfu-scroll-margin))))))

;;;; Mouse / Touch Event Handlers

(defun my-corfu-on-mouse-1 (event)
  (interactive "e")
  (my-corfu-select-clicked event))

(defconst my-corfu-touch-tap-threshold 4)

(defun my-corfu-on-touchscreen-begin (begin-event)
  (interactive "e")
  (let* ((begin-posn (cdadr begin-event))
         (begin-window (posn-window begin-posn))
         (begin-xy (posn-x-y begin-posn))
         (moved nil))
    (with-selected-window begin-window
      (let ((begin-scroll-pos corfu--scroll)
            (echo-keystrokes 0))
        (while
            (let ((ev (read-event)))
              (pcase (car-safe ev)
                ('touchscreen-update
                 (let* ((update-xy (touch-screen-relative-xy (cdaadr ev) begin-window))
                        (dx (- (car update-xy) (car begin-xy)))
                        (dy (- (cdr update-xy) (cdr begin-xy))))
                   (when (and (not moved)
                              (>= (+ (* dx dx) (* dy dy))
                                  (* my-corfu-touch-tap-threshold
                                     my-corfu-touch-tap-threshold)))
                     (setq moved t))
                   (when moved
                     (let* ((dline (/ dy (default-line-height)))
                            (new-scroll-pos (- begin-scroll-pos dline)))
                       (my-corfu-set-scroll-pos new-scroll-pos))
                     (corfu--exhibit)))
                 t)
                ('touchscreen-end
                 (unless moved
                   (my-corfu-select (my-corfu-posn-index (cdadr begin-event))))
                 nil))))))))

;;;; Setup

(defun my-corfu-touch-setup ()
  (interactive)

  ;; pre-command-hook、post-command-hook、ウィンドウ切り替え時の処理を修正する。
  (advice-add 'corfu--post-command :around 'my-corfu--post-command:around)
  (advice-add 'corfu--prepare :around 'my-corfu--prepare:around)
  (advice-add 'corfu--window-change :around 'my-corfu--window-change:around)

  ;; マウスを無視するためのキーマップにマウスやタッチのイベントハンドラを
  ;; 登録してしまう。
  (push 'my-corfu-on-mouse-1 corfu-continue-commands)
  (push 'my-corfu-on-touchscreen-begin corfu-continue-commands)
  (define-key corfu--mouse-ignore-map
              [mouse-1] #'my-corfu-on-mouse-1)
  (define-key corfu--mouse-ignore-map
              [touchscreen-begin] #'my-corfu-on-touchscreen-begin)

  ;; 子フレームにフォーカスが当たるようにする。
  ;; そうしないとイベントが起きないので。
  (setf (alist-get 'no-accept-focus corfu--frame-parameters) nil))

(provide 'my-corfu-touch)

VerticoもCorfuも同じ作者によるものなので構造は似ています。

どちらもマウスやタッチイベントは完全に無視するように作られているので、まずはそれを解除する必要があります。

Verticoの方はvertico-mouse-modeというのが付属しているので、それを参考にしてタッチイベントへの対応を追加しました。

Corfuの方は子フレームを使っているので、改善の難易度が上がります。タッチした瞬間に子フレームにフォーカスが移動し、当然カレントバッファも変わってしまいます。そのため上のコードではフォーカスを親フレームに戻す処理を入れています。そういった遷移イベントによってCorfuが終了してしまうことも防止する必要がありました。一応マウスクリックにも対応させてみましたが、ホイールへの対応はうまく出来ませんでした。フォーカスが当たっていない別フレームでホイールを回しても、ホイールイベントは発生しないようです(MS-Windowsでの使用時)。

これらのコードはMS-Windowsのタッチパネル搭載ノートPCとAndroidの両方でテストして動作することを確認しました。

設定等によってはうまく動かないケースも多々あるかもしれません。

2025-07-27 Emacs, org-mode, Unicode

Unicodeの三角形の一覧を作成する

Unicodeの三角形ってどうなってるんだっけ？　と思ったので一覧を作成してみました。

Emacsでは C-x 8 RET triangle などと入力すれば(使っている補完インタフェースにもよりますが)色々出てくるわけですが、それだと4方向分が一緒くたになっているので分かりづらいのです。なので、方向を除いたベースとなる名前が一行にまとまるように表を作ってみました。

(let ((triangle-types
       ;; 次の条件を満たすUNICODE文字を列挙する。
       ;; - 名前にTRIANGLEが含まれてる
       ;; - 名前に{LEFT|UP|RIGHT|DOWN}-POINTINGが含まれている
       ;; 結果はalist ((三角形名 . ((方向名 . コード)...))...) の形にする。
       (cl-loop with triangle-types = nil
                for name being the hash-keys of (ucs-names)
                using (hash-values code) ;; ←これ書きづらいんだけど何とかならないの？
                when (and (string-match-p "TRIANGLE" name)
                          (string-match "\\`\\(.*\\)\\(LEFT\\|UP\\|RIGHT\\|DOWN\\)\\(-POINTING .*\\)\\'" name))
                do
                (let ((base-name (concat (match-string 1 name)
                                         "*" ;; 方向の部分は * に置き換える。
                                         (match-string 3 name)))
                      (dir (match-string 2 name)))
                  (setf (alist-get dir
                                   (alist-get base-name triangle-types
                                              nil nil #'equal)
                                   nil nil #'eql)
                        code))
                finally return triangle-types)))
  ;; 表の形に文字列化する。
  (let ((dir-names  '("LEFT" "UP" "RIGHT" "DOWN")))
    (concat
     "|NAME|" (mapconcat #'identity dir-names "|") "|\n"
     "|-\n"
     (cl-loop for (name . dirs) in (nreverse triangle-types)
              concat
              (concat "|" name "|"
                      (cl-loop for dir in dir-names
                               for code = (alist-get dir dirs nil nil #'equal)
                               concat (if code (format "%X %c" code code) "-")
                               concat "|")
                      "\n")))))

(例によってこの文書はorg-modeで書かれているので、コードブロックを評価すれば自動的に↓が文書中に挿入されるわけです ( :exports both :results raw replace value を指定) )

NAME	LEFT	UP	RIGHT	DOWN
BLACK *-POINTING DOUBLE TRIANGLE	23EA ⏪	23EB ⏫	23E9 ⏩	23EC ⏬
BLACK *-POINTING DOUBLE TRIANGLE WITH VERTICAL BAR	23EE ⏮	-	23ED ⏭	-
BLACK *-POINTING TRIANGLE WITH DOUBLE VERTICAL BAR	-	-	23EF ⏯	-
BLACK MEDIUM *-POINTING TRIANGLE	23F4 ⏴	23F6 ⏶	23F5 ⏵	23F7 ⏷
BLACK *-POINTING TRIANGLE	25C0 ◀	25B2 ▲	25B6 ▶	25BC ▼
WHITE *-POINTING TRIANGLE	25C1 ◁	25B3 △	25B7 ▷	25BD ▽
BLACK *-POINTING SMALL TRIANGLE	25C2 ◂	25B4 ▴	25B8 ▸	25BE ▾
WHITE *-POINTING SMALL TRIANGLE	25C3 ◃	25B5 ▵	25B9 ▹	25BF ▿
WHITE *-POINTING TRIANGLE WITH DOT	-	25EC ◬	-	-
*-POINTING TRIANGLE WITH LEFT HALF BLACK	-	25ED ◭	-	29E8 ⧨
*-POINTING TRIANGLE WITH RIGHT HALF BLACK	-	25EE ◮	-	29E9 ⧩
HEAVY WHITE *-POINTING TRIANGLE	-	-	-	26DB ⛛
BLACK MEDIUM *-POINTING TRIANGLE CENTRED	2BC7 ⯇	2BC5 ⯅	2BC8 ⯈	2BC6 ⯆
*-POINTING RED TRIANGLE	-	1F53A 🔺	-	1F53B 🔻
*-POINTING SMALL RED TRIANGLE	-	1F53C 🔼	-	1F53D 🔽
BLACK *-POINTING ISOSCELES RIGHT TRIANGLE	1F780 🞀	1F781 🞁	1F782 🞂	1F783 🞃

シンプルな一つの三角形で4方向揃っているものに限定すると次の7種類になります。

NAME	LEFT	UP	RIGHT	DOWN
BLACK MEDIUM *-POINTING TRIANGLE	23F4 ⏴	23F6 ⏶	23F5 ⏵	23F7 ⏷
BLACK *-POINTING TRIANGLE	25C0 ◀	25B2 ▲	25B6 ▶	25BC ▼
WHITE *-POINTING TRIANGLE	25C1 ◁	25B3 △	25B7 ▷	25BD ▽
BLACK *-POINTING SMALL TRIANGLE	25C2 ◂	25B4 ▴	25B8 ▸	25BE ▾
WHITE *-POINTING SMALL TRIANGLE	25C3 ◃	25B5 ▵	25B9 ▹	25BF ▿
BLACK MEDIUM *-POINTING TRIANGLE CENTRED	2BC7 ⯇	2BC5 ⯅	2BC8 ⯈	2BC6 ⯆
BLACK *-POINTING ISOSCELES RIGHT TRIANGLE	1F780 🞀	1F781 🞁	1F782 🞂	1F783 🞃

基本は「BLACK *-POINTING TRIANGLE▲」と「WHITE *-POINTING TRIANGLE△」ですね。これらはJIS X 0213にも入っています(JIS X 0208の段階では上下のみ)。私の使っている環境ではstring-width関数やchar-width関数は2を返します(設定によるかもしれません)。文書中に書くのは普通はこれですが、箇条書きの先頭(bullet)に使うには大きすぎて使いづらいです。

「BLACK MEDIUM *-POINTING TRIANGLE⏶」は少し特殊で、どうも(再生ボタン等の)メディアUIで使うことを意図しているみたい？

「BLACK *-POINTING SMALL TRIANGLE▴」と「WHITE *-POINTING SMALL TRIANGLE▵」は単純に小さいというだけ？

「BLACK MEDIUM *-POINTING TRIANGLE CENTRED⯅」は「BLACK MEDIUM *-POINTING TRIANGLE」と何が違うのか。単に中くらいのが欲しいならコレ？

「BLACK *-POINTING ISOSCELES RIGHT TRIANGLE🞁」は直角二等辺三角形です。最近はこれをorg-modeの見出しのマークとして使っています。開閉で見た目を変化させているので、閉じているときは🞂で開いているときは🞃にしています。

基本的なものだけでもこれだけあるわけですが、イマイチ使い分けがよく分かりません。子どもの頃漢字成り立ち辞典というのを持っていましたが、Unicode成り立ち辞典が欲しい。

他にも探せば三角形っぽいものは沢山あるみたいです。「BLACK * POINTING POINTER►」や「WHITE * POINTING POINTER▻」なんかは比較的上に挙げたものと同列に扱えそうです(2方向だけですが)。一方で三角形の形をした文字というのも多数あって、典型的なのはデルタΔですが、ここまでくるとどこまで「三角形」と呼ぶのかを考える必要があるでしょう。

それで、なんでこんなことをいきなり調べ始めたかというと、私のEmacsではこの辺りの記号が正しく表示できておらず、普段使っているフォントをFontForgeでいじって字形を調整している最中だからです。