Emacs の設定

はじめに

ここでは私の Emacs の設定についてまとめています．

基本方針

Debian パッケージがインストールされているならばそれを優先する

:Eating your own dog food - Wikipedia

Emacsに関連するDebianパッケージを幾つかメンテナンスしているので, 可能な限りDebianパッケージを使うことにしています．

leaf.elでEmacs のパッケージの導入と設定を行なう

設定にはleaf.elを利用します． VCS からインストールしたいパッケージは leaf.el の :vc キーワードで package-vc-install を使います.

設定は Org mode で書きたい

以前こんなブログ記事を書きました→ Emacsの設定ファイルをorgで書く

というわけで, 設定は Org Babel で書いています. 本ファイル(README.org) から, Makefile 内の以下のスクリプトで ~/init.el を生成し, byte-compile します.

init.el: README.org
	@mkdir -p ~/.cache/emacs
	@if [ ! -d ~/.cache/emacs/eln-cache ]; then \
		echo ";; mkdir ~/.cache/emacs/eln-cache"; mkdir ~/.cache/emacs/eln-cache ;\
	fi
	@if [ ! -L eln-cache ]; then \
		echo ";; ln -sf ~/.cache/emacs/eln-cache . "; ln -sf ~/.cache/emacs/eln-cache . ;\
	fi
	@mkdir -p elpa
	@mkdir -p share
	$(EMACS) --batch --eval \
	   "(progn \
		  (require 'ob-tangle) \
		  (org-babel-tangle-file \"$<\" \"$@\" \"emacs-lisp\"))"
	$(EMACS) -l init.el --batch --eval '(kill-emacs)'
%.elc: %.el
	$(EMACS) -l init.el -batch -f batch-byte-compile $<

設定ファイルのヘッダ

出力される init.el 用のヘッダは以下の通り. lexsical-binding を有効にしておきます．

;; -*- lexical-binding: t -*-
;; (eval-when-compile
;;   (require 'profiler)
;;   (profiler-start 'cpu)
;;   )

;; -*- lexical-binding: t -*-
;; (require 'profiler)    ;; 必要に応じて有効化
;; (profiler-start 'cpu)

ディレクトリ構成の修正

分割した設定ファイル群やパッケージでinstallしたパッケージ の置き場所は user-emacs-directory 以下にまとめられます. パッケージによって置き方はかなり野放図ですよねぇ. no-littering あたりで整理した方が良いかなぁ.

ディレクトリ構成は以下のようにしました:

~/.emacs.d/
 |-- Makefile    ←  byte-compile 用の rule
 |-- README.org  ←  本ファイル．`org-babel-tangle' で init.el を生成
 |-- eln-cache/  → ~/.cache/emacs/eln-cache への symlink: native compile 出力
 |-- elpa/       ←  package.el で導入したパッケージが置かれる場所
 `-- share/      ←  (基本的に)参照するだけの資源置き場所
~/.cache/emacs   ←  一次ファイルの置き場所

上記ディレクトリ構成を設定ファイルで使用するために ディレクトリ配置を宣言しておきます。

(eval-and-compile
  (when load-file-name
    (setq user-emacs-directory
          (expand-file-name (file-name-directory load-file-name))))
  (defconst my:d:share
    (expand-file-name "share/" user-emacs-directory))
  (defconst my:d:tmp
    (expand-file-name ".cache/emacs/" (getenv "HOME")))
  (defconst my:d:org
    (expand-file-name "~/Nextcloud/org")))

Byte-Compile 時の Common Lisp の読み込み

幾つかの関数で Common-Lisp 的挙動が期待されているので, cl-lib を読み込んでおきます．

(eval-when-compile
  (require 'cl-lib nil t))

また, Emacs 27 以降は cl が読み込まれていると `Package cl is deprecated’ が表示されるので, これを止めておきます.

(eval-and-compile
  (setq byte-compile-warnings t)
  ;; (setq byte-compile-warnings '(not cl-functions free-vars docstrings unresolved))
  )

Native Compile の挙動の調整

(eval-and-compile
  (if (and (fboundp 'native-comp-available-p)
           (native-comp-available-p))
      (setq native-comp-speed  2
            native-comp-async-report-warnings-errors nil ;; 'silent
            native-compile-target-directory (expand-file-name "eln-cache" user-emacs-directory)
            native-comp-jit-compilation-deny-list '(".*-\\(loaddefs\\|autoloads\\)\\.\\(el\\.gz\\|el\\)")
            ))
  (setq debug-on-error t))

起動の高速化

この辺は Emacs の起動時間を”“詰める”” を参考に.

early-init.el

Emacs >= 27 からの機能. 他にも設定しておいた方が良い事はあるかな?

(setq gc-cons-threshold most-positive-fixnum)
(setq package-enable-at-startup nil
      package-quickstart nil)
;;
(push '(vertical-scroll-bars . nil) default-frame-alist)
(push '(menu-bar-lines       . nil) default-frame-alist)
(push '(tool-bar-lines       . nil) default-frame-alist)
(push '(scroll-bar-mode      . nil) default-frame-alist)
(push '(blink-cursor-mode    . nil) default-frame-alist)
(push '(column-number-mode   . nil) default-frame-alist)
;;
(setq load-prefer-newer noninteractive)
;;
(setq frame-inhibit-implied-resize t)
;;
(setq site-run-file nil)
;; (setq file-name-handler-alist nil) ;; 🤔
(setq use-file-dialog nil)
;;
;; (setq native-comp-speed 2
;;       native-compile-target-directory (expand-file-name "eln-cache" user-emacs-directory))
(provide 'early-init)
;;; early-init.el ends here

GC の設定

起動時に garbage collection を発生させない様にする.

メモリ喰いな拡張を入れている場合には, 安易に gc-cons-threshold を上げるのは考えものである. 「gc が走る→大きな領域を掃除するのでその間 emacs が止まる」 という事を頻繁に経験することになるだろう.

とはいえ, デフォルト値のままだと 起動時に結構 garbage-collect が走って遅くなるので, 起動時と early-init では most-positive-fixnum にしておいて, 起動後に emacs-startup-hook で default に戻すようにしてみた.

ついでに idle-timer で入力が無い時に GC を走らせることに.

(setq gc-cons-threshold most-positive-fixnum)
;; Run GC every 60 seconds if emacs is idle.
(run-with-idle-timer 60.0 t #'garbage-collect)
(add-hook 'emacs-startup-hook
          (lambda ()
            ;; recover default value
            (setq gc-cons-threshold 800000)))

Magic File Name を一時的に無効化

これだけで 0.2秒縮まった. これは知見である.

(defconst my:saved-file-name-handler-alist file-name-handler-alist)
(setq file-name-handler-alist nil)
(add-hook 'emacs-startup-hook
          (lambda ()
            (setq file-name-handler-alist my:saved-file-name-handler-alist)))

Package 関連: package.el, leaf.el

leaf.elのおかげで, 無いと途方に暮れるパッケージ以外のインストールは無視できるようになります.

package.el

パッケージは基本的に package.el で導入するので, 先ずはその設定.

;; elpa/gnutls workaround
(eval-and-compile
;;  (when (version<=  emacs-version "26.2")  ;; => for syntax hightlight
;;    (customize-set-variable 'gnutls-algorithm-priority "NORMAL:-VERS-TLS1.3"))
  (setq package-archives '(("gnu"    . "https://elpa.gnu.org/packages/")
                           ("melpa"  . "https://melpa.org/packages/")
                           ("org"    . "https://orgmode.org/elpa/")
                           ("nongnu" . "https://elpa.nongnu.org/nongnu/")
                           )
        package-gnupghome-dir (expand-file-name ".gnupg" (getenv "HOME"))
        package-quickstart nil
        ;; package-quickstart-file (expand-file-name "package-quickstart.el" my:d:tmp)
        )
  ;; (add-hook 'kill-emacs-hook 'package-quickstart-refresh)
  (if (and (fboundp 'native-comp-available-p)
           (native-comp-available-p))
      (setq package-native-compile t))
  (package-initialize)
  (unless (package-installed-p 'leaf)
    (package-refresh-contents)
    (package-install 'leaf t)
    )
  )

leaf.el

個々のパッケージの設定にはleaf.elを利用します.

(leaf leaf-keywords
  :doc "Use leaf as a package manager"
  :url "https://github.com/conao3/leaf.el"
  :ensure t
  :init
  (leaf blackout :ensure t)
  (leaf hydra :ensure t)
  :config
  (leaf-keywords-init)
  )

独自関数

細かい独自関数, など．

ファイル名を minibuffer におさまる様に整形

zsh prompt風味．

;;;###autoload
(defun my:shorten-file-path (fpath max-length)
  "Show up to `max-length' characters of a directory name `fpath' like zsh"
  (let* ((path (reverse (split-string (abbreviate-file-name fpath) "/")))
         (output "")
         (top (mapconcat 'identity (reverse (last path 3)) "/"))
         (vmax (- max-length 4 (length top)))
         (path (butlast path 3))
         )
    (while (and path
                (and (< (length output) vmax) ;; > (for syntax)
                     (< (length (concat "/" (car path) output)) vmax))) ;; > (for syntax)
      (setq output (concat "/" (car path) output))
      (setq path (cdr path)))
    ;; 省略
    (when path
      (setq output (concat "/..." output)))
    (format "%s%s" top output)))

空になったファイルを尋ねずに自動削除

ゴミが残らないし, 地味に便利．

;;;###autoload
(defun my:delete-file-if-no-contents ()
  (when (and (buffer-file-name (current-buffer))
             (= (point-min) (point-max)))
    (delete-file
     (buffer-file-name (current-buffer)))))
(add-hook 'after-save-hook 'my:delete-file-if-no-contents)

scratch を殺さない. 消したら再生成

…元ネタがどこだったのか忘れてしまった…

;;;###autoload
(defun my:make-scratch (&optional arg)
  " *scratch* を作成して buffer-list に放り込む."
  (interactive)
  (progn
    (set-buffer (get-buffer-create "*scratch*"))
    (funcall initial-major-mode)
    (erase-buffer)
    (when (and initial-scratch-message (not inhibit-startup-message))
      (insert initial-scratch-message))
    (or arg
        (progn
          (setq arg 0)
          (switch-to-buffer "*scratch*")))
    (cond ((= arg 0) (message "*scratch* is cleared up."))
          ((= arg 1) (message "another *scratch* is created")))))

;;;###autoload
(defun my:buffer-name-list ()
  "buffer 一覧の取得"
  (mapcar (function buffer-name) (buffer-list)))
;;
(add-hook 'kill-buffer-query-functions
          (lambda ()
            (if (string= "*scratch*" (buffer-name))
                (progn (my:make-scratch 0) nil)
              t)))
(add-hook 'after-save-hook
          (lambda ()
            (unless (member "*scratch*" (my:buffer-name-list))
              (my:make-scratch 1))))

行末の無駄な空白/改行を削除する

@see 無駄な行末の空白を削除する(Emacs Advent Calendar jp:2010)

ただし, RD や Markdown だと空白行に意味があったりするので, 必要に応じて拡張子で判断して外している．

(defvar my:delete-trailing-whitespace-exclude-suffix
  (list "\\.rd$" "\\.md$" "\\.rbt$" "\\.rab$"))

;;;###autoload
(defun my:delete-trailing-whitespace ()
  (interactive)
  (eval-when-compile (require 'cl-lib nil t))
  (cond
   ((equal nil
           (cl-loop for pattern in my:delete-trailing-whitespace-exclude-suffix
                    thereis (string-match pattern buffer-file-name)))
    (delete-trailing-whitespace))))
(add-hook 'before-save-hook 'my:delete-trailing-whitespace)

ターミナルで C-M- を打つために

詳細は Using C-M-% to do a query-replace-regexp in Emacs running in Mac terminal を参照のこと. terminal では C-% (つまり Control-Shift-5 )が入力できない, という話.

代わりに C-x @ を C-M- に解釈させるように設定しておく.

;;;###autoload
; cargo cult adaptation of event-apply-control-modifier
(defun my:event-apply-control-meta-modifiers (ignore-prompt)
  (ignore ignore-prompt)
  (vector
   (event-apply-modifier (event-apply-modifier (read-event)
                                               'control 26 "C-")
                         'meta 27 "M-")))
(define-key function-key-map (kbd "C-x @") 'my:event-apply-control-meta-modifiers)

exec-path-from-shell: 環境変数の読み込み

shell(zsh)で設定した PATH などの環境変数をEmacsに引き継ぐために purcell/exec-path-from-shell を使います. 今の所

• DEBEMAIL
• DEBFULLNAME
• GPG_AGENT_INFO
• GPG_KEY_ID
• PASSWORD_STORE_DIR
• PATH
• SHELL
• SKKSERVER
• TEXMFHOME
• WSL_DISTRO_NAME
• http_proxy

を読み込んでいます(多いな…).

ターミナルでEmacsを起動する場合は不要なんだよなぁ.

(leaf exec-path-from-shell
  :ensure t
  :custom
  `((exec-path-from-shell-variables
     . '("DEBEMAIL"
         "DEBFULLNAME"
         "GPG_AGENT_INFO"
         "GPG_KEY_ID"
         "PASSWORD_STORE_DIR"
         "PATH"
         "SHELL"
         "SKKSERVER"
         "TEXMFHOME"
         "WSL_DISTRO_NAME"
         "http_proxy"))
    (exec-path-from-shell-arguments . nil))
  :config
  (exec-path-from-shell-initialize)
  (setq user-full-name    (concat (getenv "DEBFULLNAME"))
        user-mail-address (concat (getenv "DEBEMAIL")))
  (defconst my:d:password-store
    (if (getenv "PASSWORD_STORE_DIR")
        (expand-file-name (concat "Emacs/" (system-name))
                          (getenv "PASSWORD_STORE_DIR")) nil))
  )

言語の設定

最近のEmacsはlocaleから文字コードを自動判別するらしいので, 以前良く設定していた以下は不要らしいですね(ホントかな…?)。

(set-language-environment "Japanese")
(prefer-coding-system 'utf-8)
(set-file-name-coding-system 'utf-8)
(set-keyboard-coding-system 'utf-8)
(set-terminal-coding-system 'utf-8)
(set-default 'buffer-file-coding-system 'utf-8)

なお, m17n.org の消滅によって上記設定に関する情報の参照元が消えた。 適切な参照元はどこだろう…?

cp5022x.el

Emacs23 から内部が Unicode ベースになっています。

しかし文字コードの変換はGNU libcのiconvをベースにしているため, 機種依存文字を含む文字コードの変換をうまく行なえません。 そこで言語設定前に cp5022x.el をインストールすることにしています。

(leaf cp5022x
  :ensure t
  :require t
  :config
  (set-charset-priority 'ascii 'japanese-jisx0208 'latin-jisx0201
                        'katakana-jisx0201 'iso-8859-1 'unicode)
  (set-coding-system-priority 'utf-8 'euc-jp 'iso-2022-jp 'cp932)
  )

SOMEDAY East Asian Ambiguos 対応 [0/1]

East Asian Ambiguosを2文字幅にして, ついでに CJK 以外の East Asian Ambiguosと絵文字も2文字幅にするようにしています。 拙作の修正ロケールはこちら: https://github.com/uwabami/locale-eaw-emoji

(leaf locale-eaw-emoji
  :vc (:url "https://github.com/uwabami/locale-eaw-emoji")
  :hook
  `(;;(emacs-startup-hook . eaw-and-emoji-fullwidth)
    (emacs-startup-hook . eaw-half-emoji-fullwidth))
  )

• [ ] 最近, EAWは一文字幅強制の方が良いかなぁ, とか悩み中.

主にEmacs本体, および同梱されている拡張に関する設定

終了時に custom.el を消す

設定ファイルに極力移す.

(leaf cus-edit
  :preface
  (setq custom-file (expand-file-name "custom.el" my:d:tmp))
  :custom
  `((custom-file . ,(expand-file-name "custom.el" my:d:tmp)))
  :hook
  `((kill-emacs-hook . (lambda ()
                         (if (file-exists-p custom-file)
                             (delete-file custom-file)))))
  )

customize で設定していたアレコレ

custom.el にある設定は極力こちらに移すようにしている.

• 大抵の場合ターミナル内で -nw として起動するし, メニューは触ったことないので使わないので, フレーム, ツールバー等を非表示にする．
• .elc と .el の timestamp を比較し, 新しい方を読み込む (load-prefer-newer は Emacs >= 24.4 から).
• yes or no を y or n に

他にもイロイロと. 設定が増えてきたら分ける.

(leaf cus-start
  :custom
  `(
    ;; 表示
    (ring-bell-function     . 'ignore)   ; ベル無効化
    ;; 編集
    (tab-width              . 4)    ;; tab 幅 4
    (indent-tabs-mode       . nil)  ;; tab ではインデントしない
    (fill-column            . 78)   ;; RFC5322 風味
    (truncate-lines         . nil)  ;; 折り返し無し
    (truncate-partial-width-windows . nil)
    (paragraph-start        . '"^\\([ 　・○<\t\n\f]\\|(?[0-9a-zA-Z]+)\\)")
    (auto-fill-mode         . nil)
    (next-line-add-newlines . nil)  ;; バッファ終端で newline を入れない
    (read-file-name-completion-ignore-case . t)  ; 大文字小文字区別無し
    (save-abbrevs           . 'silent)
    ;; backup
    (auto-save-list-file-prefix . ,(expand-file-name ".saves-" my:d:tmp))
    (auto-save-default       . t)
    (auto-save-timeout       . 15)
    (auto-save-interval      . 60)
    (make-backup-files       . t)
    (backup-by-copying       . t)  ;; symlink は使わない
    (backup-directory-alist  . '(("." . ,my:d:tmp)))
    (auto-save-file-name-transforms . '((".*" ,my:d:tmp t)))
    (version-control         . nil)
    (kept-new-versions       . 2)
    (kept-old-versions       . 2)
    (delete-old-versions     . t)
    (delete-auto-save-files  . t)
    ;; undo/redo - 数字に根拠無し
    (undo-limit              . 200000)
    (undo-strong-limit       . 260000)
    (history-length          . t)  ;; 無制限(の筈)
    ;; (save-silently           . t)
    (use-short-answers       . t)
    ;;
    (safe-local-variable-values
     . '((org-link-file-path-type . absolute)))
    ;;
    (native-comp-jit-compilation-deny-list
     . '(".*-\\(loaddefs\\|autoloads\\)\\.\\(el\\.gz\\|el\\)"))
    )
  :config
  (when (boundp 'load-prefer-newer)
    (setq load-prefer-newer t))
  ;; yes or no を y or n に
  (when (< emacs-major-version 28) ;; >
    (fset 'yes-or-no-p 'y-or-n-p))
  )

startup: 起動は静かに

(leaf startup
  :custom
  ((inhibit-startup-screen            . t)
   (inhibit-startup-message           . t)
   (inhibit-startup-echo-area-message . t)
   (initial-scratch-message           . nil)
   )
  )

hl-mode: 現在行のハイライト

(leaf hl-line
  :hook
  (emacs-startup-hook . global-hl-line-mode)
  )

選択リージョンに色付け

(leaf simple
  :hook
  (emacs-startup-hook . transient-mark-mode)
  )

show-paren-mode: 対応する括弧を強調表示

(leaf paren
  :custom
  ((show-paren-style  . 'mixed))
  :hook
  (emacs-startup-hook . show-paren-mode)
  )

linum-mode : 行番号表示

必要に応じて有効にするので, 基本使わない. 通常はモードラインに行番号や桁番号を表示しないようする. ついでに linum-mode を有効にした場合の桁表示を 5 桁に.

(leaf line-number-mode
  :custom
  ((linum-format     . "%5d ")
   (line-number-mode . nil))
  )

autorevert: ファイルが変更されたら再読み込み

(leaf autorevert
  :custom
  ((auto-revert-interval . 0.1))
  :hook
  (find-file-hook . global-auto-revert-mode)
  )

savehist: 変更履歴を保存

(leaf savehist
  :custom
  `((savehist-file
     . ,(expand-file-name "history" my:d:tmp)))
  :hook
  ((emacs-startup-hook . savehist-mode))
  )

ファイル, デイレクトリ整理

~/.emacs.d/ 以下にファイルが転がるのがなんか嫌なので, 気がつく度に設定している.

(leaf *change-default-file-location
  :custom
  `(;; url
    (url-configuration-directory
     . ,(expand-file-name "url" my:d:tmp))
    ;; nsm
    (nsm-settings-file
     . ,(expand-file-name "nsm.data" my:d:tmp))
    ;; bookmark
    (bookmark-default-file
     . ,(expand-file-name "bookmarks" my:d:tmp))
    ;; eshell
    (eshell-directory-name
     . ,(expand-file-name "eshell" my:d:tmp))
    )
  )

他にもイロイロありそう． bookmark はちゃんと使いこなしたい所ではあるが．

eldoc: emacs-lisp document

minibuffer では eldoc にお黙り頂く。

(leaf eldoc
  :hook (emacs-lisp-mode-hook . turn-on-eldoc-mode)
  ;; :blackout t
  :custom
  `((eldoc-echo-area-prefer-doc-buffer . nil)
    (eldoc-print-after-edit            . t)
    (eldoc-echo-area-use-multiline-p   . nil))
  :preface
  (defun my:shutup-eldoc-message (f &optional string)
    (unless (active-minibuffer-window)
      (funcall f string)))
  :advice
  (:around eldoc-message
           my:shutup-eldoc-message)
  )

midnight: 一定期間使用しなかった buffer を自動削除

(leaf midnight
  :custom
  ((clean-buffer-list-delay-general . 1))
  :hook
  (emacs-startup-hook . midnight-mode))

uniquify: モードラインのファイル名にディレクトリも表示する

(leaf uniquify
  :custom
  ((uniquify-buffer-name-style . 'post-forward-angle-brackets)
   (uniquify-min-dir-content   . 1))
  )

whitespace: 空白の強調表示

背景も変えようかなぁ…

(leaf whitespace
  ;; :blackout ((global-whitespace-mode . "")
  ;;            (whitespace-mode        . ""))
  :hook (emacs-startup-hook . global-whitespace-mode)
  :custom
  ((whitespace-line-column      . 72)
   (whitespace-style
    . '(face        ; faceを使う. *-mark に必要
        trailing    ; 行末の空白を対象.
        tabs        ; tab
        spaces      ; space
        empty       ; 前後の空行
        space-mark  ; 可視化の際の置き換えを有効化
        tab-mark    ; 可視化の際の置き換えを有効化
        ))
   (whitespace-display-mappings . '((space-mark ?\u3000 [?\□])
                                    (tab-mark ?\t [?\u00BB ?\t] [?\\ ?\t])))
   (whitespace-space-regexp     . "\\(\u3000+\\)")
   (whitespace-trailing-regexp  . "\\([ \u00A0]+\\)$")
   (whitespace-global-modes     . '(not eww-mode
                                        term-mode
                                        eshell-mode
                                        org-agenda-mode
                                        calendar-mode))
   )
  )

saveplace: 前回の修正位置を記憶する.

記憶の保存先を ~/.emacs.d/tmp/emacs-places に変更.

(leaf save-place
  :custom
  `((save-place . t)
    (save-place-file . ,(expand-file-name "emacs-places"  my:d:tmp))
    ;; add tramp-file-name-regexp
    (save-place-ignore-files-regexp
     . "\\(\\(?:COMMIT_EDITMSG\\|hg-editor-[[:alnum:]]+\\.txt\\|svn-commit\\.tmp\\|bzr_log\\.[[:alnum:]]+\\)$\\)\\|\\(\\`/[^/:]+:[^/:]*:\\)")
    )
  :hook (emacs-startup-hook . save-place-mode)
  )

time-stamp: 保存時に timestamp を自動更新

デフォルトではいろいろと衝突したので 更新文字列を変更し, ＄Lastupdate: 2 (＄は半角) があったら timestamp を更新する様にした．

(leaf time-stamp
  :hook (before-save-hook . time-stamp)
  :custom
  ((time-stamp-active     . t)
   (time-stamp-line-limit . 10)
   (time-stamp-start      . "$Lastupdate: 2")
   (time-stamp-end        . "\\$")
   (time-stamp-format     . "%Y-%02m-%02d %02H:%02M:%02S")
   )
  )

モード独自の設定(例えば Org とか)に関しては別途．

tramp: ssh 越しにファイルを編集

(leaf tramp
  :preface
  (defvar tramp-persistency-file-name (expand-file-name "tramp" my:d:tmp))
  :custom
  `((tramp-persistency-file-name . ,(expand-file-name "tramp" my:d:tmp))
    (tramp-completion-reread-directory-timeout . nil)
    (remote-file-name-inhibit-cache . nil)
    (vc-ignore-dir-regexp
     . ,(format "\\(%s\\)\\|\\(%s\\)"
                locate-dominating-stop-dir-regexp
                tramp-file-name-regexp))
    )
  :hook
  (kill-emacs-hook . (lambda ()
                       (if (file-exists-p tramp-persistency-file-name)
                           (delete-file tramp-persistency-file-name))))
  )

browse-url

ブラウザ呼び出しは xdg-open/open に丸投げ.

(leaf browse-url
  ;; :require t
  :bind* ("C-c C-j" . browse-url-at-point)
  :defer-config
  (cond ((executable-find "xdg-open")
         (setq browse-url-browser-function 'browse-url-xdg-open
               browse-url-secondary-browser-function 'browse-url-xdg-open))
        ((eq system-type 'darwin)
         (setq browse-url-browser-function 'browse-url-default-macosx-browser
               browse-url-secondary-browser-function 'browse-url-default-macosx-browser))
        (t
         ;; (setq browse-url-browser-function 'w3m-browse-url)
         (setq browse-url-browser-function 'eww-browse-url)
         ))
  )

server: Emacs server

(leaf server
  :commands (server-running-p)
  :init
  (defun my:new-client-frame ()
    "Create new GUI emacsclient"
    (interactive)
    (make-frame-on-display (getenv "DISPLAY")))
  :hook
  (emacs-startup-hook . (lambda ()
                          (unless (server-running-p)
                            (server-start))))
  )

buffer の印刷

(leaf ps-mule
  :if (executable-find "lpr")
  :custom
  ((ps-multibyte-buffer       . 'non-latin-printer)
   (ps-printer-name           . "PDF")
   (ps-paper-size             . 'a4)
   ;; (ps-n-up-printing          .  2)
   (ps-print-header           .  t)
   (ps-print-footer           .  nil)
   (ps-font-family            . 'Courier)
   (ps-font-size              . '(9 . 10))
   (ps-header-font-family     . 'Helvetica)
   (ps-header-font-size       . '(10 . 12))
   (ps-header-title-font-size . '(12 . 14))
   (ps-line-number            . nil)
   ;; (ps-line-number-font   . "Times-Italic")
   ;; (ps-line-number-font-size . 6)
   ;; (ps-line-number-start   . 1)
   ;; (ps-line-number-step    . 1)
   )
  :hook
  (defalias 'ps-mule-header-string-charset 'ignore)
  :config
  ;; (setq ps-mule-font-info-database-default
  ;;       '((iso-8859-1
  ;;          (normal nil nil))
  ;;         (katakana-jisx0201
  ;;          (normal builtin "Ryumin-Light-Katakana")
  ;;          (bold builtin "GothicBBB-Medium-Katakana"))
  ;;         (latin-jisx0201
  ;;          (normal builtin "Ryumin-Light-Hankaku")
  ;;          (bold builtin "GothicBBB-Medium-Hankaku"))
  ;;         (japanese-jisx0208
  ;;          (normal builtin "Ryumin-Light-Ext-H")
  ;;          (bold builtin "GothicBBB-Medium-Ext-H"))
  ;;         (japanese-jisx0213-2
  ;;          (normal builtin "Ryumin-Light-Ext-H")
  ;;          (bold builtin "GothicBBB-Medium-Ext-H"))
  ;;         (japanese-jisx0213.2004-1
  ;;          (normal builtin "Ryumin-Light-2004-H")
  ;;          (bold builtin "GothicBBB-Medium-H"))
  ;;         (unicode-bmp
  ;;          (normal builtin "Ryumin-Light-Ext-H")
  ;;          (bold builtin "GothicBBB-Medium-Ext-H"))
  ;;         )
  ;;       )
  )

tab-bar-mode: Emacsの「tab」

Emacs27から同梱された tab-bar-mode に elscreen から乗り換えた. 手癖で “C-o” を prefix で使いたいので, その設定をしていたり.

(leaf tab-bar-mode
  :init
  (defvar my:ctrl-o-map (make-sparse-keymap)
    "My original keymap binded to C-o.")
  (defalias 'my:ctrl-o-prefix my:ctrl-o-map)
  (define-key global-map (kbd "C-o") 'my:ctrl-o-prefix)
  (define-key my:ctrl-o-map (kbd "c")   'tab-new)
  (define-key my:ctrl-o-map (kbd "C-c") 'tab-new)
  (define-key my:ctrl-o-map (kbd "k")   'tab-close)
  (define-key my:ctrl-o-map (kbd "C-k") 'tab-close)
  (define-key my:ctrl-o-map (kbd "n")   'tab-next)
  (define-key my:ctrl-o-map (kbd "C-n") 'tab-next)
  (define-key my:ctrl-o-map (kbd "p")   'tab-previous)
  (define-key my:ctrl-o-map (kbd "C-p") 'tab-previous)
;;;###autoload
(defun my:tab-bar-tab-name-truncated ()
  "Custom: Generate tab name from the buffer of the selected window."
  (let ((tab-name (buffer-name (window-buffer (minibuffer-selected-window))))
        (ellipsis (cond
                   (tab-bar-tab-name-ellipsis)
                   ((char-displayable-p ?…) "…")
                   ("..."))))
    (if (< (length tab-name) tab-bar-tab-name-truncated-max) ;; >
        (format "%-12s" tab-name)
      (propertize (truncate-string-to-width
                   tab-name tab-bar-tab-name-truncated-max nil nil
                   ellipsis)
                  'help-echo tab-name))))
  :custom
  ((tab-bar-close-button-show      . nil)
   (tab-bar-close-last-tab-choice  . nil)
   (tab-bar-close-tab-select       . 'left)
   (tab-bar-history-mode           . nil)
   (tab-bar-new-tab-choice         . "*scratch*")
   (tab-bar-new-button-show        . nil)
   (tab-bar-tab-name-function      . 'my:tab-bar-tab-name-truncated)
   (tab-bar-tab-name-truncated-max . 12)
   (tab-bar-separator              . "|")
   )
  :hook
  (emacs-startup-hook . tab-bar-mode)
;;   :config
;;   (tab-bar-mode +1)
  )

• ターミナルの zsh と Emacs を風のように駆け抜ける！

認証関連: plstore, password-store など

• leaf-plstore で plstore が使えるようになったので, その設定をしておく.
• auth-password-store で auth-source として password-store を使う.

といった事をしている.

(leaf *authentication
  :if (and (getenv "GPG_KEY_ID")
           my:d:password-store)
  :init
  (setq leaf-default-plstore
     (plstore-open
         (expand-file-name "plstore.plist" my:d:password-store)))
  (add-to-list 'vc-directory-exclusion-list
               (expand-file-name my:d:password-store))
  (leaf auth-source
    :init
    (setq auth-source-gpg-encrypt-to '(getenv "GPG_KEY_ID")))
  (leaf password-store :ensure t)
  (leaf auth-source-pass :ensure t)
  (leaf plstore
    :custom
    `((plstore-secret-keys . 'silent)
      (plstore-encrypt-to  . ,(getenv "GPG_KEY_ID")))
    )
  )

日本語入力: ddskk

Daredevil SKK (DDSKK) をメインで使用中．無いと途方に暮れる． ちなみにGTKが有効になっていると gtk-immodule なんかと衝突するので ~/.Xresources で im を無効にしておくと良い． 例えば以下の様に:

! disable XIM
Emacs*useXIM: false

以前は別ファイルで行なっていた設定を customize にまとめた.

(leaf skk
  :commands skk-make-indicator-alist
  :bind (("C-x j"   . skk-mode)
         ("C-x C-j" . skk-mode)
         ;; ("C-x C-j" . skk-auto-fill-mode)
         ;; ("C-j"     . skk-mode)
         ("C-\\"    . skk-mode)
         )
  :preface
  (unless (file-directory-p (expand-file-name "skk" my:d:tmp))
    (progn
      (make-empty-file (expand-file-name "skk/keep" my:d:tmp) t)
      (make-empty-file (expand-file-name "skk-jisyo/keep" my:d:tmp) t)))
  ;; override - -;
  (defvar skk-get-jisyo-directory (expand-file-name "skk-jisyo" my:d:tmp))
  (defvar skk-extra-jisyo-file-list nil)
  :init
  (setq default-input-method "japanese-skk")
  :hook
  (;; minibuffer では skk を無効化
   (skk-mode-hook . (lambda ()
                      (and (skk-in-minibuffer-p)
                           (skk-mode-exit))))
   )
  :custom
  `(;;
    (skk-user-directory . ,(expand-file-name "skk" my:d:tmp))
    ;; 設定ファイルは Customize にまとめる. → 別ファイルでの設定はしない
    (skk-init-file . "")
    (skk-byte-compile-init-file . nil)
    ;; sticky shift  を ; に割り当て
    (skk-sticky-key  . ";")
    ;; 変換候補の表示数
    (skk-henkan-number-to-display-candidates . 10)
    ;; メニューを日本語にしない. どうせ menu は使わないし.
    (skk-show-japanese-menu . nil)
    ;; 半角ｶﾀｶﾅを入力可能に
    (skk-use-jisx0201-input-method . t)
    ;; インジケータのカスタマイズ
    (skk-latin-mode-string          . "[_A]")
    (skk-hiragana-mode-string       . "[あ]")
    (skk-katakana-mode-string       . "[ア]")
    (skk-jisx0208-latin-mode-string . "[Ａ]")
    (skk-jisx0201-mode-string       . "[_ｱ]")
    (skk-abbrev-mode-string         . "[aA]")
    ;; カーソルに色は付けない
    (skk-indicator-use-cursor-color . nil)
    (skk-use-color-cursor           . nil)
    ;; Enter で改行しない
    (skk-egg-like-newline . t)
    ;; 対応する括弧の自動入力
    (skk-auto-insert-paren . t)
    ;; 句読点変換ルールの追加
    (skk-kuten-touten-alist . '((jp    . ("。" . "、"))
                                (jp-en . ("。" . ", "))
                                (en-jp . ("．" . "，"))
                                (en    . (". " . ", "))
                                (EN    . ("．" . "，"))
                                ))
    ;; 句読点変換ルール: default は ,.
    (skk-kutouten-type . 'en)
    ;; 送り仮名が厳密に正しい候補を優先
    (skk-henkan-strict-okuri-precedence . t)
    ;; 変換ルールの追加: 全角スペース入力ルールと日付入力無効化.
    (skk-rom-kana-rule-list . '(("z " nil "　")
                                ("@" nil "@")))
    ;; 辞書サーバ
    (skk-server-host . ,(or (getenv "SKKSERVER") nil))
    (skk-aux-large-jisyo
     . ,(or (if (file-readable-p "/usr/share/skk/SKK-JISYO.L") "/usr/share/skk/SKK-JISYO.L") nil))
    ;; 冗長...?
    (skk-large-jisyo
     . ,(cond ((getenv "SKKSERVER") nil)
              ((if (file-readable-p "/usr/share/skk/SKK-JISYO.L") "/usr/share/skk/SKK-JISYO.L"))
              (t (expand-file-name "skk-jisyo/SKK-JISYO.L" my:d:tmp))))
    ;; インクリメンタルサーチは migemo に任せる. hook も参照
    (skk-isearch-mode-enable . nil)
    (skk-isearch-start-mode  . 'latin)  ;; 不要?
    ;; ja-dic は利用しない
    (skk-inhibit-ja-dic-search . t)
    ;; 辞書登録の際に送り仮名を削除
    (skk-check-okurigana-on-touroku . 'auto)
    ;; 漢字登録のミスをチェック
    (skk-check-okurigana-on-touroku . t)
    ;; 個人辞書の文字コード
    (skk-jisyo-code . 'utf-8-unix)
    )
  :config
  ;; 環境毎に辞書の設定が煩雑になっていて, どうしたモンかなぁ...
  (unless (or (or (getenv "SKKSERVER")
                  (file-readable-p "/usr/share/skk/SKK-JISYO.L"))
              (file-exists-p (expand-file-name "SKK-JISYO.L" skk-get-jisyo-directory)))
    (skk-get skk-get-jisyo-directory))
  ;; この
  (if (file-exists-p "/usr/share/skk/SKK-JISYO.JIS3_4")
      (add-to-list 'skk-extra-jisyo-file-list
                   (cons (expand-file-name "/usr/share/skk/SKK-JISYO.JIS3_4") 'euc-jisx0213) t))
  (cond
   ((file-exists-p "/usr/local/share/skkdic/SKK-JISYO.emoji.utf8")
    (dolist (file
             '("SKK-JISYO.chibutsu.utf8"
               "SKK-JISYO.tanudic4.utf8"
               "SKK-JISYO.matsucon.utf8"
               "SKK-JISYO.emoji.utf8"))
      (add-to-list 'skk-extra-jisyo-file-list
                   (cons (expand-file-name file "/usr/local/share/skkdic/") 'utf-8) t )))
   (t
    (setq skk-extra-jisyo-file-list nil)))
  )

recentf: 最近使ったファイル履歴の保管

結局履歴を貯める設定をしている事になっている. ディレクトリの履歴も取れるので recentf-ext を入れておく

(leaf recentf
  :defun
  (recentf-save-list recentf-cleanup)
  :preface
  (defun my:recentf-track-visited-file (_prev _curr)
    (and buffer-file-name
         (recentf-add-file buffer-file-name)))
  :init
  (leaf recentf-ext :ensure t)
  :custom
  `((recentf-save-file       . ,(expand-file-name "recentf" my:d:tmp))
    (recentf-max-saved-items . 500)
    (recentf-auto-cleanup    . 'mode)
    (recentf-exclude         . '(".recentf"
                                 "^/tmp\\.*"
                                 "^/private\\.*"
                                 "^/var/folders\\.*"
                                 "/TAGS$"
                                 "\\.*草稿\\.*"
                                 "^#\\.*"
                                 "^/[^/:]+:"
                                 "bookmarks"
                                 "org-recent-headings.dat"
                                 "^/mnt/c/\\.*"
                                 "\\.*COMMIT_EDITMSG$"
                                 ))
    )
  )
;; テスト中
(leaf switch-buffer-functions
  :ensure t
  :after recent
  :preface
  (defun my:recentf-track-visited-file (_prev _curr)
    (and buffer-file-name
         (recentf-add-file buffer-file-name)))
  ;; :init
  ;; (add-hook 'switch-buffer-functions
  ;;           #'my:recentf-track-visited-file)
  :hook
  (switch-buffer-functions
   . my:recentf-track-visited-file)
  )

カレンダー設定

表示の更新と japanese-holidays による日本の休日の追加

カレンダー本体の設定

(leaf calendar
  :defvar calendar-holidays japanese-holidays
  :custom
  `(;; 月と曜日の表示調整
    (calendar-month-name-array   . ["01" "02" "03" "04" "05" "06"
                                    "07" "08" "09" "10" "11" "12" ])
    (calendar-day-name-array     . ["日" "月" "火" "水" "木" "金" "土"])
    (calendar-day-header-array   . ["日" "月" "火" "水" "木" "金" "土"])
    ;; 日曜開始
    (calendar-week-start-day     . 0)
    ;; 祝日をカレンダーに表示
    (calendar-mark-holidays-flag . t)
    )
  :config
  (with-eval-after-load 'japanese-holidays
    (setq calendar-holidays (append japanese-holidays holiday-local-holidays)))
  )
  

日本の休日の追加: japanese-holidays

(leaf japanese-holidays
  :ensure t
  :after calendar
  :require t
  :custom
  `((japanese-holiday-weekend         . '(0 6))
    (japanese-holiday-weekend-marker
     . '(holiday  ;; 日
         nil      ;; 月
         nil      ;; 火
         nil      ;; 水
         nil      ;; 木
         nil      ;; 金
         japanese-holiday-saturday))
    )
  :config
  ;; autoload
  (defun my:japanese-holiday-show (&rest _args)
    (let* ((date (calendar-cursor-to-date t))
           ;; (calendar-date-display-form '((format "%s年 %s月 %s日（%s）" year month day dayname)))
           (date-string (calendar-date-string date))
           (holiday-list (calendar-check-holidays date)))
      (when holiday-list
        (message "%s: %s" date-string (mapconcat #'identity holiday-list "; ")))))
  :hook
  ((calendar-move-hook            . my:japanese-holiday-show)
   (calendar-today-visible-hook   . japanese-holiday-mark-weekend)
   (calendar-today-invisible-hook . japanese-holiday-mark-weekend)
   (calendar-today-visible-hook   . calendar-mark-today))
  )

キーバインドの設定

既に手癖になってしまっているアレコレ． 特に [home] と [end] は無いと途方に暮れます．

(leaf-keys (("C-h"     . backward-delete-char)
            ("C-c M-a" . align-regexp)
            ("C-c ;"   . comment-region)
            ("C-c M-;" . uncomment-region)
            ("C-/"     . undo)
            ("C-c M-r" . replace-regexp)
            ("C-c r"   . replace-string)
            ("<home>"  . beginning-of-buffer)
            ("<end>"   . end-of-buffer)
            ("C-c M-l" . toggle-truncate-lines)))

migemo: インクリメンタル検索

無いと途方に暮れる．

(leaf migemo
  :if (executable-find "cmigemo")
  :ensure t
  :custom
  `((migemo-user-dictionary  . nil)
    (migemo-regex-dictionary . nil)
    (migemo-options          . '("-q" "--emacs"))
    (migemo-command          . "cmigemo")
    (migemo-coding-system    . 'utf-8-unix)
    (migemo-dictionary
     .  ,(or (if (file-exists-p "/usr/local/share/migemo/utf-8/migemo-dict")
                 "/usr/local/share/migemo/utf-8/migemo-dict")
             "/usr/share/cmigemo/utf-8/migemo-dict"))
    )
  :hook
  (emacs-startup-hook . migemo-init)
  )

eww: 内蔵ブラウザ

リンクを簡単に辿る(Hit-a-Hint) のために ace-link も入れておく

(leaf eww
  :preface
  (unless (file-directory-p (expand-file-name "eww" my:d:tmp))
    (make-directory (expand-file-name "eww" my:d:tmp)))
  :init
  (leaf ace-link :ensure t)
  (leaf shr
    :custom
    ((shr-use-colors    . nil)
     (shr-use-fonts     . nil)
     (shr-image-animate . nil)
     (shr-width         . 72))
    )
  :bind (("<f2>" . eww)
         (:eww-mode-map
          ("r"   . eww-reload)
          ("o"   . eww)
          ("&"   . eww-browse-with-external-browser)
          ("b"   . eww-back-url)
          ("]"   . eww-next-url)
          ("["   . eww-previous-url)
          ("g"   . eww-top-url)
          ("h"   . backward-char)
          ("j"   . next-line)
          ("C-n" . next-line)
          ("k"   . previous-line)
          ("C-p" . previous-line)
          ("l"   . forward-char)
          ("/"   . isearch-forward)
          ("?"   . isearch-backward)
          ("n"   . isearch-next)
          ("N"   . isearch-previous)
          ("f"   . ace-link-eww))
         )
  :custom
  `((eww-bookmarks-directory . ,(expand-file-name "eww" my:d:tmp))
    (eww-search-prefix
     . "https://www.google.com/search?&gws_rd=cr&complete=0&pws=0&tbs=li:1&q=")
    )
  ;; :advice (:around eww-colorize-region
  ;;                  my:shr-colorize-region--disable)
  :config
  (ace-link-setup-default)
  )
  

ibuffer: buffer の操作

buffer を眺めるのは ibuffer が好み

(leaf ibuffer
  :defun (ibuffer-current-buffer)
  :defvar (ibuffer-formats)
  :preface
  (defun my:ibuffer-find-file ()
    "Like `find-file', but default to the directory of the buffer at point."
    (interactive)
    (let ((default-directory
            (let ((buf (ibuffer-current-buffer)))
              (if (buffer-live-p buf)
                  (with-current-buffer buf
                    default-directory)
                default-directory))))
      (find-file default-directory)))
  ;;
  :bind (("C-x C-b" . ibuffer-other-window)
         ("C-x b"   . ibuffer-other-window)
         ("C-x M-b" . ibuffer)
         (:ibuffer-mode-map
          ("C-x C-f" . my:ibuffer-find-file))
         )
  )

Copy & Paste:

Linux では xclip を利用

clipboard と PRIMARY の同期には gpaste を使っている．

(leaf xclip
  :if (and (executable-find "xclip")
           (eq system-type 'gnu/linux))
  :ensure t
  :hook (emacs-startup-hook
         . (lambda () (xclip-mode +1)))
  )

macOS では pbcopy/pbpaste を利用.

pbcopy/pbpase の呼び出し方が変わった? 動かない時がある様な。

(leaf *macOSclipborad
  :disabled t
  :if (eq system-type 'darwin)
  :preface
  (defun my:copy-from-osx ()
    "Get string via pbpaste"
    (shell-command-to-string "pbpaste"))
  (defun my:paste-to-osx (text &optional push)
    "put `TEXT' via pbcopy with `PUSH' mode"
    (let ((process-connection-type nil))
      (let ((proc (start-process "pbcopy" "*Messages*" "pbcopy")))
        (process-send-string proc text)
        (process-send-eof proc))))
  :config
  (setq interprogram-cut-function   'my:paste-to-osx
        interprogram-paste-function 'my:copy-from-osx)
  )

補完: vertico, marginalia, consult, corfu

最近話題になりだしたので, ちょっと使い始めてみた.

helm, ivy の無効化

依存する拡張がまだまだ多いので, 一度インストールして邪魔しないようにしておくことに.

(leaf helm :defer-config (helm-mode -1))
(leaf ivy :defer-config (ivy-mode -1))

無視する拡張子の追加設定

とりあえず, 無視するファイルの拡張子を指定しておく.

(leaf *completion
  :init
  ;; 補完で無視する拡張子の追加．そのうち増える．
  (cl-loop for ext in
           '(;; TeX
             ".dvi"
             ".fdb_latexmk"
             ".fls"
             ".ilg"
             ".jqz"
             ".nav"
             ".out"
             ".snm"
             ".synctex\\.gz"
             ".vrb"
             ;; fortran >= 90
             ".mod"
             ;; zsh
             ".zwc"
             ;; libtool
             ".in"
             ".libs/"
             ;; fxxkin Apple
             ".DS_Store"
             "._DS_Store"
             ;; "org-id-locations"
             )
           do (add-to-list 'completion-ignored-extensions ext))
  )

vertico: 本体

find-fileでHelmみたいにC-lでディレクトリを遡る - emacs より, C-l で一つ上の階層へ上がれる様にしたり.

(leaf vertico
  :ensure t
  :preface
  (defun my:disable-selection ()
    (when (eq minibuffer-completion-table #'org-tags-completion-function)
      (setq-local vertico-map minibuffer-local-completion-map
                  completion-cycle-threshold nil
                  completion-styles '(basic))))
  ;;
  ;; @see https://misohena.jp/blog/2022-08-15-transition-ivy-to-vertico.html
  ;; 候補更新時に最初の候補を選択しない -> (vertico-preselect . 'prompt)

  ;; ただし require-matchがt(やそれに類するもの)で入力が空ではなくマッチする候
  ;; 補がある場合は、その候補の先頭を選択する。
  (defun my:vertico--recompute (orig-fun pt content &rest args)
    (let ((result (apply orig-fun pt content args)))
      (if (and (not (equal content ""))
               ;; 入力が空の時は(require-matchであっても)defaultまたはnilを返
               ;; すことになっている。
               (> (alist-get 'vertico--total result) 0) ;; < for syntax
               ;; completing-readの説明によれば
               ;; nil,confirm,confirm-after-completion以外はtのように
               ;; 振る舞うべき。
               (not (memq minibuffer--require-match
                          '(nil confirm confirm-after-completion))))
          (setf (alist-get 'vertico--index result) 0))
      result))
  ;;
  ;;
  (defun my:filename-upto-parent ()
    "Move to parent directory like \"cd ..\" in find-file."
    (interactive)
    (let ((sep (eval-when-compile (regexp-opt '("/" "\\")))))
      (save-excursion
        (left-char 1)
        (when (looking-at-p sep)
          (delete-char 1)))
      (save-match-data
        (when (search-backward-regexp sep nil t)
          (right-char 1)
          (filter-buffer-substring (point)
                                   (save-excursion (end-of-line) (point))
                                   #'delete)))))
  :advice
  ((:before vertico--setup
            my:disable-selection)
   (:around vertico--recompute-candidates
            my:vertico--recompute)
   )
  :bind
  (:vertico-map (("C-l" . my:filename-upto-parent)))
  :custom-face
  `((vertico-current
     . '((t (:inherit hl-line :background unspecified)))))
  :custom
  `((vertico-count . 8)
    (vertico-cycle . t)
    (vertico-preselect . 'prompt)
    (vertico-multiline . '(("↓" 0 1 (face vertico-multiline))
                           ("…" 0 1 (face vertico-multiline))))
    )
  :config
  :hook (emacs-startup-hook . vertico-mode)
  )

marginalia: リッチな注釈(Enable richer annotations)

行揃えが微妙. あと, ファイル名を省略表示できないのかな? ⇒ Better truncation method for file names #70

(leaf marginalia
  :ensure t
  :init
  ;; 補完でも icon 表示
  ;;(leaf all-the-icons-completion
  ;;  :ensure t
  ;;  :hook
  ;;  (emacs-startup-hook . all-the-icons-completion-mode)
  ;;  )
  :bind (("M-A" . marginalia-cycle)
         (:minibuffer-local-map
          ("M-A" . marginalia-cycle)
          ))
  :custom
  `((marginalia-annotators
     . '(marginalia-annotators-light marginalia-annotators-heavy nil))
    (marginalia-align . 'right)
    (marginalia-align-offset .  -2) ;; icon 分引いておく
    )
  :hook
  ((emacs-startup-hook . marginalia-mode)
   ;;(marginalia-mode-hook . all-the-icons-completion-marginalia-setup)
   )
  )

consult: 便利コマンド集

とりあえず recetnf が使えないと途方に暮れるので consult-recent-file のカスタマイズのみ.

(leaf consult
  :ensure t
  :bind (("C-x C-r" . my:consult-recent-file))
  ;; :defvar recentf-list
  :custom
  `(;; 増やさないと preview 時に theme がロードされない模様.
    ;; とりあえず default の 10 倍にしている. 1 MB かな?
    (consult-preview-raw-size . 1024000)
    (consult-async-refresh-delay . 0.2)
    (consult-preview-key  . nil)
    (consult-narrow-key   . "<")
    )
  :config
  (defun my:consult-recent-file ()
    "Find recent using `completing-read' with shorten filename"
    (interactive)
    (eval-when-compile (require 'recentf))
    (recentf-mode +1)
    (let ((files (mapcar (lambda (f)
                           (cons (my:shorten-file-path f (- (window-width) 2)) f))
                         recentf-list)))
      (let ((selected
             (consult--read (mapcar #'car files)
                            :prompt "Find recent file: "
                            :sort nil
                            :require-match t
                            :category 'file
                            :state (consult--file-preview)
                            :history 'file-name-history)))
        (find-file (assoc-default selected files)))))
  )

orderless: 補完候補の選択

イロイロと凝れそうだけど, とりあえずはデフォルトのままで.

(leaf orderless
  :ensure t
  :custom
  `((completion-styles . '(orderless))
    (orderless-matching-styles
     . '(orderless-prefixes
         orderless-flex
         orderless-regexp
         orderless-initialism
         orderless-literal))
    )
  )

corfu: on the fly completions

company より使い勝手が良い, 気がする.

(leaf corfu
  :disabled t
  :ensure t
  :init
  (leaf corfu-terminal
    :ensure t
    :custom (corfu-terminal-disable-on-gui . nil)
    )
  :bind
  (:corfu-map
   ("TAB"       . corfu-next)
   ("<tab>"     . corfu-next)
   ("S-TAB"     . corfu-previous)
   ("<backtab>" . corfu-previous)
   ("C-j"       . corfu-next)
   ("C-n"       . corfu-next)
   ("C-p"       . corfu-previous)
   ("C-k"       . corfu-previous))
  :custom
  `((completion-cycle-threshold . 4)
    (tab-always-indent          . 'complete)
    (corfu-cycle                . t)       ;; Enable cycling for `corfu-next/previous'
    (corfu-auto                 . t)       ;; Enable auto completion
    (corfu-preselect-first      . nil)     ;; Disable candidate preselection
    ;; (corfu-separator          . ?\s)  ;; Orderless field separator
    ;; (corfu-quit-at-boundary   . nil)  ;; Never quit at completion boundary
    ;; (corfu-quit-no-match      . nil)  ;; Never quit, even if there is no match
    ;; (corfu-preview-current    . nil)  ;; Disable current candidate preview
    ;; (corfu-on-exact-match     . nil)  ;; Configure handling of exact matches
    ;; (corfu-echo-documentation . nil)  ;; Disable documentation in the echo area
    ;; (corfu-scroll-margin      . 5)    ;; Use scroll margin
    )
  :hook (emacs-startup-hook
         . (lambda ()
             (corfu-terminal-mode +1)
             (global-corfu-mode)))
  )

cape: 補完 backend

;; (leaf cape :ensure t)
  ;; ;; 補完候補を出すときの文脈を特定

  ;; (defvar my-capf-context nil)

  ;; (defun my-capf--corfu--auto-complete (old-fun &rest args)
  ;;   ;; my-capf-context = 'in-corfu--auto-complete にして補完候補を出す。
  ;;   (let ((my-capf-context 'in-corfu--auto-complete))
  ;;     (apply old-fun args)))
  ;; (advice-add 'corfu--auto-complete :around #'my-capf--corfu--auto-complete)

  ;; ;; 追加の補完関数

  ;; (defun my-capf-additional ()
  ;;   (pcase my-capf-context
  ;;     ('in-corfu--auto-complete
  ;;      ;; 自動補完の場合は確度の高い候補しか出さない。
  ;;      nil)
  ;;     (_
  ;;      ;; 手動補完の場合は積極的にいろんな候補を出す。
  ;;      (my-capf-manual))))
  ;; (add-hook 'completion-at-point-functions #'my-capf-additional 100)

  ;; ;; 手動補完時の補完関数

  ;; (defvar my-capf-manual nil)
  ;; (defun my-capf-manual ()
  ;;   ;; capeパッケージの読み込みを遅延させる。
  ;;   (unless my-capf-manual
  ;;     (setq my-capf-manual
  ;;           ;; いろんな補完候補を合成する。
  ;;           (cape-super-capf
  ;;            #'cape-file #'cape-dabbrev #'cape-abbrev #'cape-line)))
  ;;     (funcall my-capf-manual))

MUA の設定: wanderulst

MUA として Wanderlust を使っている

• Wanderlust – Yet Another Message Interface On Emacsen –

Emacs 本体側の設定(wanderlust)

Emacs 本体での設定は以下の通り. Wanderlust 自体の設定は別ファイルで行なわれる． ここでは wl-init-file を指定することで, 設定ファイルを明示している．

(leaf wl
  :if (file-exists-p "/etc/emacs/site-start.d/65wl-beta.el")
  :defvar (wl-address-file
          wl-folders-file
          elmo-passwd-alist-file-name)
  :commands (wl
             wl-other-frame
             wl-draft
             wl-user-agent
             wl-user-agent-compose
             wl-draft-send
             wl-draft-kill)
  :preface
  (defun my:wl-mode-line-buffer-identification (&optional id)
    (ignore id)
    (force-mode-line-update t))
  (defconst my:d:wl-cache-directory
    (expand-file-name "wanderlust" "~/.cache"))
  (unless (file-directory-p
           (expand-file-name "local/Trash" my:d:wl-cache-directory))
    (make-directory
     (expand-file-name "local/Trash" my:d:wl-cache-directory) t))
  :advice (:override wl-mode-line-buffer-identification
                     my:wl-mode-line-buffer-identification)
  :custom
  `((elmo-msgdb-directory     . my:d:wl-cache-directory)
    (read-mail-command        . #'wl)
    (wl-init-file
     . ,(expand-file-name "init-wl" user-emacs-directory))
    (wl-demo                  . nil)
    )
  :init
  (define-mail-user-agent
    'wl-user-agent
    'wl-user-agent-compose
    'wl-draft-send
    'wl-draft-kill
    'mail-send-hook)
  :pl-setq (wl-address-file
            wl-folders-file
            elmo-passwd-alist-file-name)
  )

割と /etc/emacs/site-start.d/65wl-beta.el と重複している気がするが.

Wanderlust 本体の設定

実際の設定は以下の通り

byte-compile の準備

(eval-when-compile
  (require 'leaf-keywords)
  (require 'cp5022x)
  (require 'wl)
  (require 'mime-def)
  (leaf-keywords-init)
  )
  

依存/追加ライブラリのインストールと読み込み

rail

SEMI や FLIM などの UA の表示に rail を使っている. ちなみに rail を有効にすると, 以下の様に User-Agent が表示される

(leaf rail
  :init
  (unless (locate-library "rail")
    (package-vc-install :url "https://github.com/uwabami/rail"))
  (setq rail-emulate-genjis t)
  :require t
  )

cp5022x を使う

ISO-2022-JP を CP50220 として扱う. Wanderlustと文字コード も参照のこと.

(add-to-list 'mime-charset-coding-system-alist
             '(iso-2022-jp . cp50220))
;; fxxkin outlook
(add-to-list 'mime-charset-coding-system-alist
             '(gb2312 . gbk))
;;
(setq wl-mime-charset 'iso-2022-jp)
;; (setq wl-mime-charset 'utf-8-unix)

SEMI の追加設定

HTML メールを表示するために emacs-w3m を使う. mime-setup がロードされる前に記述する必要あり.

(leaf mime-setup
  :preface
  ;; (leaf w3m-load)
  ;; (leaf mime-w3m :require t)
  (setq mime-view-text/html-previewer 'shr)
  )

どのアプリケーションで開くか → xdg-open に丸投げ．

;; (defvar my:mime-preview-play-current-entity-appname "xdg-open"
;;   "meadow なら fiber, mac なら open, linux なら xdg-open")
;; (cond
;;  ((string-match "apple-darwin" system-configuration)
;;   (setq my:mime-preview-play-current-entity-appname "open")
;;   )
;;  ((string-match "linux" system-configuration)
;;   (setq my:mime-preview-play-current-entity-appname "xdg-open")
;;   ))
;;
;; (unless (functionp #'mime-preview-play-current-entity-orig)
;;   (fset #'mime-preview-play-current-entity-orig
;;         (symbol-function #'mime-preview-play-current-entity)))
;; (defun mime-preview-play-current-entity (&optional ignore-examples mode)
;;   (interactive "P")
;;   (if (and mode (not (equal mode "play")))
;;       (mime-preview-play-current-entity-orig ignore-examples mode)
;;     (let* ((entity (get-text-property (point) 'mime-view-entity))
;;            (name (mime-entity-safe-filename entity))
;;            (filename (expand-file-name (if (and name (not (string= name "")))
;;                                            name
;;                                          (make-temp-name "EMI"))
;;                                        (make-temp-file "EMI" 'directory))))
;;       (mime-write-entity-content entity filename)
;;       (message "External method is starting...")
;;       (let* ((process-name
;;               (concat my:mime-preview-play-current-entity-appname " " filename))
;;              (process
;;               (start-process process-name
;;                              mime-echo-buffer-name
;;                              my:mime-preview-play-current-entity-appname
;;                              filename)))
;;         (set-alist 'mime-mailcap-method-filename-alist process filename)
;;         (set-process-sentinel process 'mime-mailcap-method-sentinel)))))
(setq mime-play-delete-file-immediately nil)
(setq mime-view-mailcap-files '("~/.mailcap"))

~/.mailcap 自体は以下

applications/*; xdg-open %s;
image/*; xdg-open %s;
video/*; xdg-open %s;

MIME の例の保存先の変更

(setq mime-situation-examples-file
      (concat my:d:tmp "mime-example"))

text/plain を html より優先.

(setq mime-view-type-subtype-score-alist
      '(((text . plain) . 1)
        ((text . html)  . 0)
        ))

音を鳴らすアレやコレの無効化

(setq mime-play-find-every-situations nil
      process-connection-type nil)

個人情報の設定

具体的な設定内容は以下のファイルに置いている

(load (concat my:d:password-store "/wl-info.gpg"))

設定している内容は以下の通り

自身のメールアドレスと購読メーリングリストの設定

;; From: の設定
(setq wl-from (concat user-full-name " <" user-mail-address ">"))
;; (system-name) が FQDN を返さない場合、
;; `wl-local-domain' にホスト名を除いたドメイン名を設定
(setq wl-local-domain "example.com")
;; 自分のメールアドレスのリスト
(setq wl-user-mail-address-list
      (list (wl-address-header-extract-address wl-from)
            ;; "e-mail2@example.com"
            ;; "e-mail3@example.net" ...
            ))
;; 自分の参加しているメーリングリストのリスト
(setq wl-subscribed-mailing-list
      '("wl@lists.airs.net"
        "apel-ja@m17n.org"
        "emacs-mime-ja@m17n.org"
        ;; "ml@example.com" ...
        ))

送受信用サーバの設定

受信(IMAP)

(setq elmo-imap4-default-server "your imap server")
(setq elmo-imap4-default-port '993)
(setq elmo-imap4-default-stream-type 'ssl)

送信(SMTP)

(setq wl-smtp-posting-server "your smtp server")
(setq wl-smtp-posting-user "your account")
(setq wl-smtp-posting-port 587)
(setq wl-smtp-connection-type 'starttls)
(setq wl-smtp-authenticate-type "login")

From に応じて送信サーバをきりかえる.

本来はメール作成時/返信時の template の切り替えなのだれど, 送信時の SMTP の設定を from に合わせてきりかえるようにする. default に二重に指定しているのは, 一度別のアカウントに切り替えた後に再びトグルして戻って来た際に元に戻す(上書き)するため.

(setq wl-template-alist
      '(("default"
         ("From" . wl-from)
         (wl-smtp-posting-server . "your smtp server")
         (wl-smtp-posting-user . "your account")
         (wl-smtp-posting-port . 587)
         (wl-smtp-connection-type . 'starttls)
         (wl-smtp-authenticate-type . "login")
         )
        ("example1"
         ("From" . "Your Name <account@example1.com>")
         (wl-smtp-posting-server . "smtp.example1.com")
         (wl-smtp-posting-user . "your account")
         (wl-smtp-posting-port . 587)
         (wl-smtp-connection-type . 'starttls)
         (wl-smtp-authenticate-type . "login")
         )
        ("example2"
         ("From" . "Your Name <account@example2.com>")
         (wl-smtp-posting-server . "smtp.example2.com")
         (wl-smtp-posting-user . "your account")
         (wl-smtp-posting-port . 587)
         (wl-smtp-connection-type . 'starttls)
         (wl-smtp-authenticate-type . "plain")
         )
        ("ssh:smtp"
         ;; need ssh tunnel
         ;; ssh -f -N -L 20025:localhost:25 smtp.server.com
         ("From" . "Your Name <account@example3.com>")
         (wl-smtp-posting-server . "localhost")
         (wl-smtp-posting-user . "your ssh account")
         (wl-smtp-posting-port . 20025)
         (wl-smtp-connection-type . 'nil)
         (wl-smtp-authenticate-type . 'nil)
         )
        ))

ssh tunnel を自動的にやる事はできないモンだろうか (送信時に open して, 送信後に close する, みたいなの).

ついでに template の切り替えに関して幾つか設定.

;; template 切り替え時に 内容を表示
(setq wl-template-visible-select t)

draft-mode で C-c C-n をするとテンプレートを切り替え

(define-key wl-draft-mode-map "\C-c\C-n" 'wl-template-select)

from に応じて wl-from, wl-envelope-from, 送信 smtp サーバを変更する送信時に変更

(add-hook 'wl-draft-send-hook
          (lambda ()
            (set (make-local-variable 'wl-from)
                 (std11-fetch-field "From"))))

送信時に自動的に wl-draft-config-alist を適用…しない?

(remove-hook 'wl-draft-send-hook 'wl-draft-config-exec)

基本設定

imap 関連

デフォルトの認証設定 フォルダ名は UTF-7 でエンコードされているので, 表示する際にこれをデコードする

(setq elmo-imap4-use-modified-utf7 t)

非同期チェック

(setq wl-folder-check-async t)

フォルダの位置の default からの変更

~/.cache/wanderlust/ に集約している local の Mail folder(MH) の位置

(setq elmo-localdir-folder-path "~/.cache/wanderlust/local")

local フォルダの設定: .lost+found は elmo-maildir-folder-path からの相対パスになっていることに注意

(setq elmo-lost+found-folder ".lost+found")
(setq wl-queue-folder "+queue")

folders の位置の変更

;; (setq wl-folders-file "~/.mu(concat my:d:password-store "/wl-folders.gpg"))

Drafts, Trash の置き場所

(setq wl-draft-folder "+drafts")
(setq wl-trash-folder "+drash")
(setq elmo-lost+found-folder "+lost+found")
(setq wl-temporary-file-directory "~/Downloads/")

アドレス帳

(setq wl-use-petname t)
;; (setq wl-address-file  "~/.mua/Address")

LDAP サーバからアドレスを引くことも可能. 以前は GCALDaemon を使って local に ldap サーバを上げていたのだけれども, Google Contacts の API が変わったらしく GCALDaemon で LDAP サーバは使えなくなったのでコメントアウト.

(setq wl-use-ldap t)
(setq wl-ldap-server "localhost")
(setq wl-ldap-port "389")
(setq wl-ldap-base "dc=math,dc=kyoto-u,dc=ac,dc=jp")

パスワードの保存先

;; (setq elmo-passwd-alist-file-name (concat my:d:password-store "/wl-passwd.gpg"))

フォルダ編集時に backup を作成しない.

(setq wl-fldmgr-make-backup nil)

FCC, BCC の設定

(setq wl-fcc nil)
;; (setq wl-fcc "%Sent")

fcc を既読にする場合は以下．=wl-fcc= が nil の場合には意味は無い

(setq wl-fcc-force-as-read t)

bcc は常に自身に.

(setq wl-bcc (concat user-mail-address))

起動時に %INBOX のみをチェック

(setq wl-auto-check-folder-name "%INBOX")

フォルダ選択時の初期設定

imap の namespace を毎度入力するのが面倒なので, これを追加しておく.

(setq wl-default-spec "%")

confirm 関連の設定

スキャン時の問い合わせの無効化. ちなみに confirm を nil にしても 問い合わせが無いだけで threshold は効くので, 明示的に nil に.

(setq elmo-folder-update-confirm nil)
(setq elmo-folder-update-threshold nil)
(setq elmo-message-fetch-confirm nil)
(setq elmo-message-fetch-threshold nil)
(setq wl-prefetch-confirm nil)
(setq wl-prefetch-threshold nil)

終了時に確認しない

(setq wl-interactive-exit nil)

送信時は確認する

(setq wl-interactive-send t)

dispose, delete の設定

Gmail用に%INBOXでは削除を wl-trash-folder への移動ではなく, 「delete」に．

(add-to-list 'wl-dispose-folder-alist
             '("^%INBOX" . delete))

迷惑メール関連も

(add-to-list 'wl-dispose-folder-alist
             '(".*Junk$" . delete))

折り返しの設定

message は折り返す.

(setq wl-message-truncate-lines nil)

draft も折り返す

(setq wl-draft-truncate-lines nil)

mode-line の設定

長いと嫌なのでイロイロ削る

(setq wl-summary-mode-line-format "") ; "%f {%t}(%n/%u/%a)"
(setq wl-message-mode-line-format "") ; "<< %f:%F>> [%m]"

SOMEDAY misc.

大きいメッセージを送信時に分割しない

(setq mime-edit-split-message nil)

スレッドは常に閉じる

(setq wl-thread-insert-opened nil)

3 pain 表示 -> 使わない

(setq wl-stay-folder-window nil)

未読を優先的に読む

(setq wl-summary-move-order 'unread)

改ページ無視

(setq wl-break-pages nil)

icon を使わない → GUI でもメニュー表示してないし, 体感的には遅くなる

(setq wl-highlight-folder-with-icon nil)

印刷 → ps-print-buffer に任せる←まだ保留. エラー吐きよる….

(setq wl-print-buffer-function 'ps-print-buffer)

キーバインド関連

C-c C-j を browse-url に明け渡す

(define-key wl-draft-mode-map "\C-c\C-j" 'browse-url-at-point)

M-u で unread にする

(define-key wl-summary-mode-map "\M-u" 'wl-summary-mark-as-unread)

i で sync <- Mew 風

(define-key wl-summary-mode-map "i" 'wl-summary-sync-update)

C-o は elscreen で使う

(define-key wl-summary-mode-map "\C-o" nil )

M-o で auto-refile (Mew 風)

(define-key wl-summary-mode-map "\M-o" 'wl-summary-auto-refile)

flag とフォルダを行き来する関数の追加

”=” でフラグ付きフォルダと 実際にメッセージのあるフォルダを行き来する. Gmail の「スター付き」フォルダでも有効

(require 'elmo nil 'noerror)
(defun my:wl-summary-jump-to-referer-message ()
  (interactive)
  (when (wl-summary-message-number)
    (if (eq (elmo-folder-type-internal wl-summary-buffer-elmo-folder) 'flag)
        (progn
          (let* ((referer (elmo-flag-folder-referrer
                           wl-summary-buffer-elmo-folder
                           (wl-summary-message-number)))
                 (folder (if (> (length referer) 1)
                             (completing-read
                              (format "Jump to (%s): " (car (car referer)))
                              referer
                              nil t nil nil (car (car referer)))
                           (car (car referer)))))
            (wl-summary-goto-folder-subr folder 'no-sync nil nil t)
            (wl-summary-jump-to-msg (cdr (assoc folder referer)))))
      (when (eq (elmo-folder-type wl-summary-last-visited-folder) 'internal)
        (wl-summary-goto-last-visited-folder)))))
(define-key wl-summary-mode-map "=" 'my:wl-summary-jump-to-referer-message)

summary-mode の表示のカスタマイズ

自分が差出人である mail は To:某 と表示

(setq wl-summary-showto-folder-regexp ".*")
(setq wl-summary-from-function 'wl-summary-default-from)

サマリ行の表示関連

サマリ行のフォーマット指定

(setq wl-summary-line-format
      "%T%P%1@%1>%Y/%M/%D %21(%t%[%19(%c %f%)%]%) %#%~%s"
      wl-summary-width (- (window-width) 1))

サマリ表示は切り詰めない

(setq wl-subject-length-limit t)

スレッドの幅の指定

(setq wl-thread-indent-level 2)
(setq wl-thread-have-younger-brother-str "+" ;; "├" ;; "+"
      wl-thread-youngest-child-str "+" ;; "└" ;; "+"
      wl-thread-vertical-str "|";; "│" ;; "|"
      wl-thread-horizontal-str "-";; "─" ;; "-"
      wl-thread-space-str " ")

以下の二つの設定を有効にするには elmo-msgdb-extra-fields を設定する必要がある. この変数は振り分け判定にも使用するのでそこで設定している

Gmail 風に, 自分宛のメールに “>” をつけて表示する

元ネタ http://d.hatena.ne.jp/khiker/20080206/wanderlust

;; 一覧表示での置き換え規則に追加
(defun my:wl-summary-line-for-me ()
  (if (catch 'found
        (let ((to (elmo-message-entity-field wl-message-entity 'to))
              (cc (elmo-message-entity-field wl-message-entity 'cc)))
          (when (or (stringp to) cc)
            (setq to
                  (append (if (stringp to) (list to) to)
                          (when cc
                            (if (stringp cc) (list cc) cc)))))
          (dolist (i to)
            (when (wl-address-user-mail-address-p (eword-decode-string i))
              (throw 'found t)))))
      ">"
    ""))
;; > を summary-line-format に追加
(setq wl-summary-line-format-spec-alist
      (append wl-summary-line-format-spec-alist
              '((?> (my:wl-summary-line-for-me)))))

添付ファイルがあったら, サマリ行に @ を付ける

(setq wl-summary-line-format-spec-alist
      (append wl-summary-line-format-spec-alist
              '((?@ (wl-summary-line-attached)))))

クォートされた文字列もデコードする

昔はあれこれ設定してたけど, 今は良いのかな? とりあえず, デコードする長さを default の 1000 から二桁増やしておく.

(setq mime-field-decoding-max-size 100000)
;; (setq mime-header-lexical-analyzer
;;       '(
;;         eword-analyze-quoted-string
;;         eword-analyze-domain-literal
;;         eword-analyze-comment
;;         eword-analyze-spaces
;;         eword-analyze-special
;;         eword-analyze-encoded-word
;;         eword-analyze-atom))
(with-eval-after-load 'eword-decode
  (mime-set-field-decoder
   'From nil 'eword-decode-and-unfold-unstructured-field-body)
  (mime-set-field-decoder
   'CC nil 'eword-decode-and-unfold-unstructured-field-body)
  (mime-set-field-decoder
   'To nil 'eword-decode-and-unfold-unstructured-field-body))

Subject が変わってもスレッドを切らない

(setq wl-summary-divide-thread-when-subject-changed nil)

Subject での Tab や複数スペースを無視

;; (defadvice std11-unfold-string (after simply activate)
;;   (setq ad-return-value
;;         (replace-regexp-in-string ad-return-value "[ \t]+" " ")))

重複メッセージを非表示に

フォルダ内の Message-ID が同じメールを非表示にする

(setq wl-folder-process-duplicates-alist
      '(
        (".*" . hide)
        ))

sort 順: 返信が来た順

元ネタは Re: wanderlust で GMail 風、新着レス順にソート.

(defun wl-summary-overview-entity-compare-by-reply-date (a b)
  "Compare message A and B by latest date of replies including thread."
  (cl-letf (((symbol-function 'string-max2)
             (lambda (x y) (cond ((string< x y) y) ;;>
                                 ('t x))))
            ((symbol-function 'elmo-entity-to-number)
             (lambda (x) (elt (cddr x) 0)))

            ((symbol-function 'thread-number-get-date)
             (lambda (x) (timezone-make-date-sortable
                          (elmo-msgdb-overview-entity-get-date
                           (elmo-message-entity
                            wl-summary-buffer-elmo-folder
                            x)))))
            ((symbol-function 'thread-get-family)
             (lambda (x)
               (cons x (wl-thread-entity-get-descendant
                        (wl-thread-get-entity x)))))
            ((symbol-function 'max-reply-date)
             (lambda (x) (cond ((eq 'nil x)
                                'nil)
                               ((eq 'nil (cdr x))
                                (thread-number-get-date (car x)))
                               ('t
                                (string-max2 (thread-number-get-date (car x))
                                             (max-reply-date (cdr x)))))))
            )
    (string<  ;;>
     (max-reply-date (thread-get-family (elmo-entity-to-number a)))
     (max-reply-date (thread-get-family (elmo-entity-to-number b))))))
;; (defun wl-summary-overview-entity-compare-by-reply-date (a b)
;;   "Compare message A and B by latest date of replies including thread."
;;   (flet ((string-max2 (x y) (cond ((string< x y) y) ;;>
;;                                   ('t x)))
;;          (elmo-entity-to-number (x)
;;                                 (elt (cddr x) 0))
;;          (thread-number-get-date (x)
;;                                  (timezone-make-date-sortable
;;                                   (elmo-msgdb-overview-entity-get-date
;;                                    (elmo-message-entity
;;                                     wl-summary-buffer-elmo-folder
;;                                     x))))
;;          (thread-get-family (x)
;;                             (cons x (wl-thread-entity-get-descendant
;;                                      (wl-thread-get-entity x))))
;;          (max-reply-date  (x)
;;                           (cond ((eq 'nil x)
;;                                  'nil)
;;                                 ((eq 'nil (cdr x))
;;                                  (thread-number-get-date (car x)))
;;                                 ('t
;;                                  (string-max2 (thread-number-get-date (car x))
;;                                               (max-reply-date (cdr x))))))
;;          )
;;         (string<  ;;>
;;          (max-reply-date (thread-get-family (elmo-entity-to-number a)))
;;          (max-reply-date (thread-get-family (elmo-entity-to-number b))))))
(add-to-list 'wl-summary-sort-specs 'reply-date)
(setq wl-summary-default-sort-spec 'reply-date)

振り分け設定

$ 以外を振り分け対象に

(setq wl-summary-auto-refile-skip-marks '("$"))

振り分け判定に使用するヘッダ

添付の有無の表示にも使うので Content-Type も登録. あと Delivered-To はメールの検索の時に結構重宝している.

(setq elmo-msgdb-extra-fields
      '(
        "List-Post"
        "List-Id"
        "List-ID"                  ;; たまに List-ID で来るメールあるよね?
        "Resent-CC"
        "Mailing-List"
        "X-Mailing-List"
        "X-ML-Address"
        "X-ML-Name"
        "X-ML-To"
        "X-Loop"
        "Delivered-To"
        "Content-Type"              ;; 添付の有無の表示の為に追加
        "X-Google-Appengine-App-Id" ;; GAEの送信するメールの振り分け用
        "To"
        "Cc"
        "From"
        "Subject"
        "Reply-To"
        "Auto-Submitted"            ;; Git commit/Cron notify
        ))

メッセージ表示

いったん全て非表示に

(setq wl-message-ignored-field-list '("^.*:"))

見たいヘッダだけ表示

(setq wl-message-visible-field-list
      '("^Subject:"
        "^From:"
        "^To:"
        "^Cc:"
        "^Date:"
        "^Message-ID:"
        ))

表示順の変更

Mew 風…

(setq wl-message-sort-field-list
      '("^Subject:"
        "^From:"
        "^To:"
        "^Cc:"
        "^Date:"
        "^Message-ID:"
        ))

From, To を省略表示しない

To や From にアドレスが沢山指定されていると省略されるので, これを無効化

(setq wl-message-use-header-narrowing nil)

Wanderlust: Face の設定

デフォルトより細かく指定するために幾つかの face 定義を追加.

(setq wl-highlight-message-header-alist
      '(("Subject[ \t]*:"
         . wl-highlight-message-subject-header-contents)
        ("From[ \t]*:"
         . wl-highlight-message-from-header-contents)
        ("Date[ \t]*:"
         . wl-highlight-message-date-header-contents)
        ("\\(.*To\\|Cc\\|Newsgroups\\)[ \t]*:"
         . wl-highlight-message-important-header-contents)
        ("\\(User-Agent\\|X-Mailer\\|X-Newsreader\\)[ \t]*:"
         . wl-highlight-message-unimportant-header-contents)
        ))
;; face の色付け
(defun my:wl-set-face (face spec)
  (make-face face)
  (cond ((fboundp 'face-spec-set)
         (face-spec-set face spec))
        (t
         (wl-declare-face face spec))))
;;
(my:wl-set-face
 'wl-highlight-message-subject-header-contents
 '((t (:foreground "#FF5252" :bold t :italic nil :weight bold ))))
(my:wl-set-face
 'wl-highlight-message-from-header-contents
 '((t (:foreground "#FFD740" :bold t :italic nil :weight bold ))))
(my:wl-set-face
 'wl-highlight-message-date-header-contents
 '((t (:foreground "#5CF19E" :bold t :italic nil :weight bold ))))

以下, 元々定義されているfaceの設定

;; (my:wl-set-face 'wl-highlight-folder-closed-face
;;                 '((t (:foreground "#4cff4c" :bold nil :italic nil :weight normal ))))
;; (my:wl-set-face 'wl-highlight-folder-few-face
;;                 '((t (:foreground "#FF4C4C" :bold t :italic nil :weight bold ))))
;; (my:wl-set-face 'wl-highlight-folder-zero-face
;;                 '((t (:foreground "#f6f3e8" :bold nil :italic nil :weight normal ))))
;; (my:wl-set-face 'wl-highlight-message-cited-text-1
;;                 '((t (:foreground "#7fff7f" :bold nil :italic nil :weight normal ))))
;; (my:wl-set-face 'wl-highlight-message-cited-text-2
;;                 '((t (:foreground "#ffff7f" :bold nil :italic nil :weight normal ))))
;; (my:wl-set-face 'wl-highlight-message-cited-text-3
;;                 '((t (:foreground "#7f7fff" :bold nil :italic nil :weight normal ))))
;; (my:wl-set-face 'wl-highlight-message-cited-text-4
;;                 '((t (:foreground "#7fffff" :bold nil :italic nil :weight normal ))))
;; (my:wl-set-face 'wl-highlight-message-cited-text-5
;;                 '((t (:foreground "#ff7fff" :bold nil :italic nil :weight normal ))))
;; (my:wl-set-face 'wl-highlight-message-cited-text-6
;;                 '((t (:foreground "#ff7f7f" :bold nil :italic nil :weight normal ))))
;; (my:wl-set-face 'wl-highlight-message-cited-text-7
;;                 '((t (:foreground "#4cff4c" :bold nil :italic nil :weight normal ))))
;; (my:wl-set-face 'wl-highlight-message-cited-text-8
;;                 '((t (:foreground "#ffff4c" :bold nil :italic nil :weight normal ))))
;; (my:wl-set-face 'wl-highlight-message-cited-text-9
;;                 '((t (:foreground "#4c4cff" :bold nil :italic nil :weight normal ))))
;; (my:wl-set-face 'wl-highlight-message-cited-text-10
;;                 '((t (:foreground "#4cffff" :bold nil :italic nil :weight normal ))))
;; (my:wl-set-face 'wl-highlight-message-cited-text-11
;;                 '((t (:foreground "#ff4cff" :bold nil :italic nil :weight normal ))))
;; (my:wl-set-face 'wl-highlight-message-cited-text-12
;;                 '((t (:foreground "#ff4c4c" :bold nil :italic nil :weight normal ))))
;; (my:wl-set-face 'wl-highlight-message-date-header-contents
;;                 '((t (:foreground "#4CFF4C" :bold t :italic nil :weight bold ))))
;; (my:wl-set-face 'wl-highlight-message-header-contents
;;                 '((t (:foreground "#aaaaaa" :bold nil :italic nil :weight normal ))))
;; (my:wl-set-face 'wl-highlight-message-headers
;;                 '((t (:foreground "#4CFFFF" :bold t :italic nil :weight bold ))))
;; (my:wl-set-face 'wl-highlight-message-important-header-contents2
;;                 '((t (:foreground "#4CFF4C" :bold nil :italic nil :weight normal ))))
;; (my:wl-set-face 'wl-highlight-message-signature
;;                 '((t (:foreground "#aaaaaa" :bold nil :italic nil :weight normal ))))
;; (my:wl-set-face 'wl-highlight-message-important-header-contents
;;                 '((t (:foreground "#FF4CFF" :bold t :italic nil :weight bold ))))
;; (my:wl-set-face 'wl-highlight-message-subject-header-contents
;;                 '((t (:foreground "#FF4C4C" :bold t :italic nil :weight bold ))))
;; (my:wl-set-face 'wl-highlight-message-unimportant-header-contents
;;                 '((t (:foreground "#aaaaaa" :bold nil :italic nil :weight normal ))))
;; (my:wl-set-face 'wl-highlight-summary-answered-face
;;                 '((t (:foreground "#4CFF4C" :bold nil :italic nil :weight normal ))))
;; (my:wl-set-face 'wl-highlight-summary-refiled-face
;;                 '((t (:foreground "#7F7FFF" :bold nil :italic nil :weight normal ))))
;; (my:wl-set-face 'wl-highlight-summary-thread-top-face
;;                 '((t (:foreground "#F6F3E8" :bold nil :italic nil :weight normal ))))
;; (my:wl-set-face 'wl-highlight-summary-important-flag-face
;;                 '((t (:foreground "#ffff4c" :bold nil :italic nil :weight normal ))))
;; (my:wl-set-face 'wl-highlight-folder-killed-face
;;                 '((t (:foreground "#4c4c4c" :5Dbold nil :italic nil ))))
;; (my:wl-set-face 'wl-highlight-folder-many-face
;;                 '((t (:foreground "#ff7fbf" :bold nil :italic nil ))))
;; (my:wl-set-face 'wl-highlight-folder-opened-face
;;                 '((t (:foreground "#4cffff" :bold nil :italic nil ))))
;; (my:wl-set-face 'wl-highlight-folder-path-face
;;                 '((t (:underline t :bold nil :italic nil ))))
;; (my:wl-set-face 'wl-highlight-folder-unknown-face
;;                 '((t (:foreground "#4cffff" :bold nil :italic nil ))))
;; (my:wl-set-face 'wl-highlight-folder-unread-face
;;                 '((t (:foreground "#4c4cff" :bold nil :italic nil ))))
;; (my:wl-set-face 'wl-highlight-header-separator-face
;;                 '((t (:inherit highlight :bold t ))))
;; (my:wl-set-face 'wl-highlight-message-citation-header
;;                 '((t (:foreground "#7fff7f" :bold nil :italic nil ))))
;; (my:wl-set-face 'wl-highlight-summary-copied-face
;;                 '((t (:foreground "#4CFFFF" :bold nil :italic nil ))))
;; (my:wl-set-face 'wl-highlight-summary-deleted-face
;;                 '((t (:foreground "#4c4c4c" :bold nil :italic nil ))))
;; (my:wl-set-face 'wl-highlight-summary-displaying-face
;;                 '((t (:underline t :bold nil :italic nil ))))
;; (my:wl-set-face 'wl-highlight-summary-disposed-face
;;                 '((t (:foreground "#aaaaaa" :bold nil :italic nil ))))
;; (my:wl-set-face 'wl-highlight-summary-flagged-face
;;                 '((t (:foreground "#ffff7f" :bold nil :italic nil ))))
;; (my:wl-set-face 'wl-highlight-summary-forwarded-face
;;                 '((t (:foreground "#7f7fff" :bold nil :italic nil ))))
;; (my:wl-set-face 'wl-highlight-summary-high-read-face
;;                 '((t (:foreground "#7fff7f" :bold nil :italic nil ))))
;; (my:wl-set-face 'wl-highlight-summary-high-unread-face
;;                 '((t (:foreground "#ffb347" :bold nil :italic nil ))))
;; (my:wl-set-face 'wl-highlight-summary-important-face
;;                 '((t (:foreground "#ffff4c" :bold nil :italic nil ))))
;; (my:wl-set-face 'wl-highlight-summary-killed-face
;;                 '((t (:foreground "#4c4c4c" :bold nil :italic nil ))))
;; (my:wl-set-face 'wl-highlight-summary-l:read-face
;;                 '((t (:foreground "#4CFF4C" :bold nil :italic nil ))))
;; (my:wl-set-face 'wl-highlight-summary-l:unread-face
;;                 '((t (:foreground "#7fbfff" :bold nil :italic nil ))))
;; (my:wl-set-face 'wl-highlight-summary-new-face
;;                 '((t (:foreground "#ff4c4c" :bold nil :italic nil ))))
;; (my:wl-set-face 'wl-highlight-summary-normal-face
;;                 '((t (:foreground "#f6f3e8" :bold nil :italic nil ))))
;; (my:wl-set-face 'wl-highlight-summary-prefetch-face
;;                 '((t (:foreground "#4c4cee" :bold nil :italic nil ))))
;; (my:wl-set-face 'wl-highlight-summary-resend-face
;;                 '((t (:foreground "#ffb347" :bold nil :italic nil ))))
;; (my:wl-set-face 'wl-highlight-summary-target-face
;;                 '((t (:foreground "#4CFFFF" :bold nil :italic nil ))))
;; (my:wl-set-face 'wl-highlight-summary-temp-face
;;                 '((t (:foreground "##ee4cee" :bold nil :italic nil ))))
;; (my:wl-set-face 'wl-highlight-summary-unread-face
;;                 '((t (:foreground "#ff4c4c" :bold nil :italic nil ))))
;; (my:wl-set-face 'wl-highlight-thread-indent-face
;;                 '((t (:underline t :bold nil :italic nil ))))

作成/返信設定

自分宛のメールに返信する場合は To:, Cc: から自分のアドレスを削除

(setq wl-draft-always-delete-myself t)

“a” (without-argument)では Reply-To: や From: などで 指定された唯一人または唯一つの投稿先に返信. また, X-ML-Name: と Reply-To: がついているなら Reply-To: 宛に返信

(setq wl-draft-reply-without-argument-list
      '((("X-ML-Name" "Reply-To") . (("Reply-To") nil nil))
        ("X-ML-Name" . (("To" "Cc") nil nil))
        ("Followup-To" . (nil nil ("Followup-To")))
        ("Newsgroups" . (nil nil ("Newsgroups")))
        ("Reply-To" . (("Reply-To") nil nil))
        ("Mail-Reply-To" . (("Mail-Reply-To") nil nil))
        ("From" . (("From") nil nil))))

C-u a (with-argument)であれば関係する全ての人・投稿先に返信

(setq wl-draft-reply-with-argument-list
      '(("Followup-To" . (("From") nil ("Followup-To")))
        ("Newsgroups" . (("From") nil ("Newsgroups")))
        ("Mail-Followup-To" . (("Mail-Followup-To") nil ("Newsgroups")))
        ("From" . (("From") ("To" "Cc") ("Newsgroups")))))

サマリ表示には petname を使うが, 引用には使わない

(setq wl-default-draft-cite-decorate-author nil)

ドラフトの自動保存の無効化

偶に暴発している様な…? elscreen のせいかしら.

;; (setq wl-auto-save-drafts-interval 300)
(setq wl-auto-save-drafts-interval nil)

メール本文の文字コード

丸囲み数字なんかが入ってしまうと 勝手にエンコーディングが変わってしまって鬱陶しい. どうしたモンだろうかね.

(add-hook 'wl-draft-mode-hook
          (lambda ()
            (add-to-list 'mime-charset-type-list '(utf-8 8 nil))))

draft mode で orgtbl を有効に

(add-hook 'wl-draft-mode-hook
          (lambda ()
            (progn
              (require 'org-table)
              #'turn-on-orgtbl)))

c-sig

署名の選択に c-sig を使用している. 設定は以下の通り. Mew 風に C-c <tab> で signature を挿入するようにしている

(leaf c-sig
  :commands insert-signature-eref
  :config
  (eval-when-compile (require 'wl))
  (setq sig-insert-end t
        sig-save-to-sig-name-alist nil
        message-signature-file nil)
  )
(define-key wl-draft-mode-map "\C-c\t" 'insert-signature-eref)
(add-hook 'wl-draft-mode-hook
          (lambda ()
            (define-key (current-local-map) "\C-c\C-w"
              'insert-signature-eref)))

GPG 署名

以前は mailcrypt を使っていたけれど, epa があるので主にキーバインドの設定のみ. draft-mode の文字コードをあらかじめ指定しておかないと, 送信時に文字コードが変換されるので不正な署名となってしまう.

もっとうまい方法/正攻法がありそうな気がするけれど, 使えてるから, まあ良いかな, とか.

(setq mime-pgp-verify-when-preview nil)
(defun my:epa-wl-decrypt-message ()
  (interactive)
  (save-window-excursion
    (wl-summary-jump-to-current-message)
    (wl-message-decrypt-pgp-nonmime)))
(defun my:epa-wl-verify-message ()
  (interactive)
  (save-selected-window
    (wl-summary-jump-to-current-message)
    (wl-message-verify-pgp-nonmime)))
(leaf-keys ((:wl-summary-mode-map
             ("C-c : d" . my:epa-wl-decrypt-message)
             ("C-c : v" . my:epa-wl-verify-message))
            (:wl-draft-mode-map
             ("C-c : s" . epa-mail-sign)
             ("C-c : e" . epa-mail-encrypt)))
           )

検索

notmuchを使う.

(leaf elmo-search
  :config
  (elmo-search-register-engine 'notmuch-custom 'local-file
                               :prog "notmuch-query-custom"
                               :args '(elmo-search-split-pattern-list)
                               :charset 'utf-8)
  (setq elmo-search-default-engine 'notmuch-custom))
(leaf wl-qs
  :config
  (setq wl-quicksearch-folder "[]"
        )
  )
(leaf-keys ((:wl-summary-mode-map
             ("v" . wl-quicksearch-goto-search-folder-wrapper))
            (:wl-folder-mode-map
             ("v" . wl-quicksearch-goto-search-folder-wrapper)))
           )

実際の呼び出しはスレッドを全部取得したいので以下を呼び出している

#!/bin/sh
if [ ! x"$*" = x"" ] ; then
    res=$(notmuch search --output=threads "$*")
fi
if [ ! x"$res" = x"" ] ; then
    echo $res | xargs notmuch search --sort=oldest-first --output=files
fi

検索時にメールが多すぎると怒られるので. 数字は適当.

(setq elmo-multi-divide-number 2000000
      elmo-multi-number 2000000)

Linux Desktop で mailto: リンクを扱うために

ついでに mailto のリンクを emacsclient で扱うために, 以下の関数を定義しておく

(defun my:mailto-compose-mail (mailto-url)
  "Custom: handling mailto: link"
  (if (and (stringp mailto-url)
           (string-match "\\`mailto:" mailto-url))
      (progn
        (eval-and-compile (require 'rfc6068))
        (let* ((headers (mapcar (lambda (h) (cons (intern (car h)) (cdr h)))
                                (rfc6068-parse-mailto-url mailto-url)))
               (good-headers (cl-remove-if (lambda (h) (member (car h) '(Body))) headers))
               (body (cdr (assoc 'Body headers))))
          (wl-draft good-headers nil nil body)))))

Desktop の設定では

#!/bin/sh
# emacs-mailto-handler

mailto=$1
mailto="mailto:${mailto#mailto:}"
mailto=$(printf '%s\n' "$mailto" | sed -e 's/[\"]/\\&/g')
elisp_expr="(my:mailto-compose-mail \"$mailto\")"

emacsclient -a "" -n --eval "$elisp_expr" \
            '(set-window-dedicated-p (selected-window) t)'

をメーラとして指定すれば良い． GNOME は .desktop ファイルが無いと「お気に入り」登録ができないので 以下のファイルを適当な名前で ~/.local/share/applications/ 以下に放り込んでおくと良いだろう

[Desktop Entry]
Name=Emacs Mail Handler
GenericName=Mail User Agent
X-GNOME-FullName=Emacs Mail Handler
Comment=Use emacsclient as MUA, handling mailto link
Keywords=email
Exec=/home/uwabami/bin/emacs-mailto-handler %U
Icon=emacs25
Terminal=false
Type=Application
Categories=GNOME;GTK;Office;Email;
StartupNotify=false
MimeType=application/mbox;message/rfc822;x-scheme-handler/mailto;

mbsync

(leaf mbsync
  :if (executable-find "mbsync")
  :ensure t
  )

翻訳

DeepL 翻訳

ブラウザ呼び出し

(leaf *deepl-translate
  :commands my:deepl-translate
  :bind (("C-x T" . my:deepl-translate))
  :preface
  (require 'url-util)
  (defun my:deepl-translate (&optional string)
    (interactive)
    (setq string
          (cond ((stringp string) string)
                ((use-region-p)
                 (buffer-substring (region-beginning) (region-end)))
                (t
                 (save-excursion
                   (let (s)
                     (forward-char 1)
                     (backward-sentence)
                     (setq s (point))
                     (forward-sentence)
                     (buffer-substring s (point)))))))
    (run-at-time 0.1 nil 'deactivate-mark)
    (browse-url
     (concat
      "https://www.deepl.com/translator#en/ja/"
      (url-hexify-string string)
      )))
  )

Google 翻訳

(leaf google-translate
  :ensure t
  :defvar google-translate-backend-method
  :init
  (defvar google-translate-translation-directions-alist '(("en" . "ja") ("ja" . "en")))
  (leaf popup :ensure t)
  (defun my:google-translate--search-tkk ()
    "Search TKK. @see https://github.com/atykhonov/google-translate/issues/52"
    (list 430675 2721866130))
  :bind
  ("C-x t" . google-translate-smooth-translate)
  :advice (:override google-translate--search-tkk
                     my:google-translate--search-tkk)
  :config
  (setq google-translate-translation-directions-alist '(("en" . "ja") ("ja" . "en"))
        google-translate-backend-method 'curl)
  )

校正, 辞書等

ispell,=flyspell=: spell checker, on-the-fly spell checker

ispell はコマンドとして aspell を利用する.

(leaf flyspell
  :if (executable-find "aspell")
  ;; :blackout (flyspell-mode . "F")
  :custom
  `((ispell-program-name   . "aspell")
    (ispell-check-comments . nil)
    (ispell-skip-html      . t)
    (ispell-silently-savep . t)
    )
  :bind (:flyspell-mode-map
         ("C-." . nil)
         ("C-," . nil))
  :defer-config
  (add-to-list 'ispell-skip-region-alist '("[^\000-\377]+"))
  )

lookup: 電子辞書の検索

EPWING化した辞書群を検索するために lookup-el ver. 1.4 系列を利用

(leaf lookup
  :if (and (file-exists-p "/etc/emacs/site-start.d/50lookup-el.el")
           (file-exists-p "/usr/local/share/dict/lookup-enabled"))
  :commands (lookup lookup-region lookup-pattern)
  :bind (("C-c w" . lookup-pattern)
         ("C-c W" . lookup-word))
  :custom
  (lookup-search-agents
   . '((ndeb "/usr/local/share/dict/eijiro" :alias "英辞郎")
       (ndeb "/usr/local/share/dict/waeijiro" :alias "和英辞郎")
       (ndeb "/usr/local/share/dict/rikagaku5" :alias "理化学辞典 第5版")
       (ndeb "/usr/local/share/dict/koujien4" :alias "広辞苑 第4版")
       (ndeb "/usr/local/share/dict/wadai5" :alias "研究社 和英大辞典 第5版")
       ;; (ndeb "/usr/local/share/dict/eidai6" :alias "研究社 英和大辞典 第6版")
       ;; (ndeb "/usr/local/share/dict/colloc" :alias "研究社 英和活用大辞典 ")
       ))
  )

text-adjust: 全角文字の撲滅

(leaf text-adjust :vc (:url "https://github.com/uwabami/text-adjust.el"))

flycheck: on-the-fly linter

(leaf flycheck
  :ensure t
  :disabled t
  ;; :hook (prog-mode-hook . flycheck-mode)
  :custom ((flycheck-display-errors-delay . 0.3))
  :config
  (leaf flycheck-popup-tip
    :ensure t
    :hook (flycheck-mode-hook . flycheck-popup-tip-mode))
  ;; (leaf flycheck-inline
  ;;   :ensure t
  ;;   :hook (flycheck-mode-hook . flycheck-inline-mode))
  ;;
  (flycheck-define-checker textlint
    "A linter for text."
    :command ("textlint-wrapper.sh" source)
    :error-patterns
    ((warning line-start (file-name) ":" line ":" column ": "
              (id (one-or-more (not (any " "))))
              (message (one-or-more not-newline)
                       (zero-or-more "\n" (any " ") (one-or-more not-newline)))
              line-end))
    :modes (text-mode markdown-mode gfm-mode org-mode wl-draft-mode draft-mode))
  :hook
  ((text-mode-hook     . flycheck-mode)
   (markdown-mode-hook . flycheck-mode)
   (gfm-mode-hook      . flycheck-mode)
   (org-mode-hook      . flycheck-mode)
   (wl-draft-mode-hook . flycheck-mode)
   (draft-mode-hook    . flycheck-mode))
  )

閉じタグの入力補助: smartparens

(leaf smartparens
  :disabled t
  :ensure t
  ;; :blackout t
  :defun (sp-pair)
  :hook (emacs-startup-hook . smartparens-global-mode)
  :config
  (require 'smartparens-config)
  (sp-pair "=" "=" :actions '(wrap))
  (sp-pair "+" "+" :actions '(wrap))
  (sp-pair "<" ">" :actions '(wrap))
  (sp-pair "$" "$" :actions '(wrap))
  )

カラーコードに色付け: rainbow-mode

#RRGGBB のカラーコードに勝手に色が付く．CSS の編集中なんかで地味に便利．

(leaf rainbow-mode
  :ensure t
  ;; :blackout `((rainbow-mode . ,(format " %s" "\x1F308")))
  )

Org-mode

org-mode が無いと生きていけない体になりました

基本設定: org

目新しい設定はしていない, と思う．

;;; timestamp 更新文字列の変更:
;;  org-mode では ＃+date: をひっかける用に(＃は小文字)．
;;;###autoload
(defun my:org-timestamp-hook ()
  "Change `time-stamp-start' in org-mode"
  (set (make-local-variable 'time-stamp-start) "#\\+date: ")
  (set (make-local-variable 'time-stamp-end)   "\$")
  )
;; org-plus-contrib も使うかなぁ….
(leaf org
  :ensure t
  ;; :blackout `((org-mode . ,(all-the-icons-icon-for-mode 'org-mode)))
  :bind (("C-x n s" . org-narrow-to-subtree)
         ("C-x n w" . widen)
         ("C-c a"   . org-agenda)
         ("C-x m"   . org-capture)
         ("C-x M"   . org-journal-new-entry)
         )
  ;; 昔のメモ(howm)も org-mode で開く
  :mode "\\.org\\'" "\\.howm\\'"
  ;; GTD: TODO→...→DONE としたエントリを =Arhive.org= に移動
  ;; - 一旦保留
  ;; (defun my:org-archive-done-tasks ()
  ;;   (interactive)
  ;;   (org-map-entries 'org-archive-subtree "/DONE" 'file))
  :hook
  `((org-mode-hook . my:org-timestamp-hook)
    ;; (org-todo-statistics-hook       . my:org-archive-done-tasks)
    ;; (org-todo-after-statistics-hook . my:org-archive-done-tasks)
    )
  :custom
  `(;; Nextcloud に保存する
    (org-directory              . ,(expand-file-name my:d:org))
    ;; return でリンクを辿る
    (org-return-follows-link    . t)
    ;; 見出しを畳んで表示
    (org-startup-folded         . t)
    ;; 折り返し無し
    (org-startup-truncated      . t)
    ;; インデントする
    (org-adapt-indentation      . t)
    ;; link handler → xdg-open 任せ
    (org-file-apps-defaults     . '((remote . emacs)
                                    (system . "xdg-open %s")
                                    (t      . "xdg-open %s")))
    (org-file-apps-defaults-gnu . '((remote . emacs)
                                    (system . "xdg-open %s")
                                    (t      . "xdg-open %s")))
    (org-file-apps              . '((auto-mode . emacs)
                                    ("\\.mm\\'" . default)
                                    ("\\.x?html?\\'" . "xdg-open %s")
                                    ("\\.pdf\\'" . "xdg-open %s")))
    ;; GTD: 状態の追加
    (org-todo-keywords          . '((sequence "TODO(t)" "WAIT(w)" "SOMEDAY(s)" "|" "DONE(d)" "CANCEL(c)")
                                    (type "ARTICLE(a)" "|" "DONE(d)")
                                    (type "MEMO(m)" "|" "DONE(d)")))
    (org-todo-keyword-faces     . '(("TODO"    . org-todo)
                                    ("WAIT"    . org-todo)
                                    ("ARTICLE" . (:foreground "#7fbfff" :weight bold))
                                    ("MEMO"    . (:foreground "#7fbfff" :weight bold))
                                    ("SOMEDAY" . (:foreground "#7fff7f" :weight bold))))
    ;; GTD: タグの追加
    (org-tag-alist              . '(("OFFICE"     . ?o)
                                    ("HOME"       . ?h)
                                    ("MAIL"       . ?m)
                                    ("WORK"       . ?w)
                                    ("Debian"     . ?d)
                                    ("Computer"   . ?c)
                                    ("Book"       . ?b)
                                    ("Emacs"      . ?e)
                                    ("TeX"        . ?t)
                                    ("Ruby"       . ?r)
                                    ("IGNORE"     . ?i)
                                    ("PLANNED"    . ?p)
                                    ))
    ;; Archive.org の位置指定
    (org-archive-location       . ,(expand-file-name "Archive.org::" my:d:org))
    ;; modules → とりあえずクリアしておく
    (org-modules  . '())
    ;; element-cache は使わない...うまく使えると良いんだけれど.
    (org-element-use-cache . nil)
    )
  :defer-config
  ;; +打ち消し+ の font-lock の変更 →これはテーマに任せるべき?
  ;; (setq org-emphasis-alist
  ;;       (cons '("+" '(:strike-through t :foreground "#999999"))
  ;;             (cl-delete "+" org-emphasis-alist :key 'car :test 'equal)))
  (require 'org-tempo nil 'noerror)
  )

Org-Id

(leaf org-id
  :commands
  (my:org-id-add-custom-id
   my:org-id-get-custom-id
   my:org-custom-id-get
   my:org-id-add-to-headlines-in-file
   my:org-id-delete-all-id-in-file
   )
  :init
  (leaf org-macs :commands org-with-point-at)
  :custom
  `((org-id-locations-file
     . ,(expand-file-name "org-id-locations" my:d:tmp))
    (org-id-link-to-org-use-id . 'create-if-interactive-and-no-custom-id)
    )
  :config
  (defun my:org-id-add-custom-id ()
    "Add \"CUSTOM_ID\" to the current tree if not assigned yet."
    (interactive)
    (my:org-custom-id-get nil t))
  ;;
  (defun my:org-id-get-custom-id ()
    "Return a part of UUID with an \"org\" prefix.
e.g. \"org3ca6ef0c\"."
    (let* ((id (org-id-new "")))
      (when (org-uuidgen-p id)
        (downcase (concat "org"  (substring (org-id-new "") 0 8))))))
  ;;
  (defun my:org-custom-id-get (&optional pom create)
    "Get the CUSTOM_ID property of the entry at point-or-marker POM.
See https://writequit.org/articles/emacs-org-mode-generate-ids.html"
    (interactive)
    (eval-when-compile (require 'org-macs))
    (org-with-point-at pom
      (let ((id (org-entry-get nil "CUSTOM_ID")))
        (cond
         ((and id (stringp id) (string-match "\\S-" id))
          id)
         (create
          (setq id (my:org-id-get-custom-id))
          (unless id
            (error "Invalid ID"))
          (org-entry-put pom "CUSTOM_ID" id)
          (message "--- CUSTOM_ID assigned: %s" id)
          (org-id-add-location id (buffer-file-name (buffer-base-buffer)))
          id)))))
  ;;
  (defun my:org-id-delete-all-id-in-file ()
    (interactive)
    (goto-char 1)
    (while (not (eq (point) (point-max)))
      (org-next-visible-heading 1)
      (let ((id (org-entry-get (point) "ID")))
        (when id
          (message "ID: %s" id)
          (org-delete-property "ID"))))
    (message "--- done."))
  ;;
  (defun my:org-id-add-to-headlines-in-file ()
    "Add CUSTOM_ID properties to all headlines in the current file.
See https://writequit.org/articles/emacs-org-mode-generate-ids.html"
    (interactive)
    (save-excursion
      (widen)
      (goto-char (point-min))
      (when (re-search-forward "^#\\+options:.*auto-id:t" (point-max) t)
        (org-map-entries
         (lambda () (my:org-custom-id-get (point) 'create))))))
  ;;
  :hook (before-save-hook
         . (lambda ()
             (when (and (eq major-mode 'org-mode)
                        (eq buffer-read-only nil))
               (my:org-id-add-to-headlines-in-file))))
  )

Babel

(leaf org-babel
  ;; :blackout `((org-src-mode . ,(format " %s" (all-the-icons-octicon "code"))))
  :custom
  `(;; font-lock
   (org-src-fontify-natively         . t)
   ;; TAB の挙動
   (org-src-tab-acts-natively        . t)
   ;; インデント
   (org-edit-src-content-indentation . 0)
   ;; インデントを残す
   (org-src-preserve-indentation     . t)
   ;; load languages
   (org-babel-load-languages
    . '((emacs-lisp . t)
        (ditaa . ,(file-exists-p "/usr/local/lib/jditaa.jar"))
        (latex . ,(file-exists-p "/usr/bin/uplatex"))
        )
    )
   )
  )
(leaf ob-ditaa
  :if (file-exists-p "/usr/local/lib/jditaa.jar")
  :custom
  ((org-ditaa-jar-path . "/usr/local/lib/jditaa.jar"))
  )
(leaf ob-latex
  :if (file-exists-p "/usr/bin/uplatex")
  )

Org-agenda: スケジュール, TODO 表示

GTD 用の設定．後述の org-gcal と orgmine で取得したデータも表示している． ついでに

• 土曜日をの face を追加.
• 祝日, 休日を日曜と同じfaceにする.

なんて事もやっている．元ネタは Org-mode and holidays.

(leaf org-agenda
  :if (file-directory-p my:d:org)
  :preface
  ;; face は theme にまわすべき, かな？
  (defface my:org-agenda-date-saturday
    '((t (:foreground "#7FBFFF" :bold t )))
    "Agenda 表示中の土曜日用のface"
    :group 'org-agenda )
  ;; こっからは org-gcal で同期したカレンダーの色
  (defface my:org-agenda-calendar-Univ
    '((t (:foreground "#7FFF7F")))
    "Agenda 表示中, Univ.org の表示 face"
    :group 'org-agenda )
  (defface my:org-agenda-calendar-Schedule
    '((t (:foreground "#7FFFFF")))
    "Agenda 表示中, Schedule.org の表示 face"
    :group 'org-agenda )
  (defface my:org-agenda-calendar-GFD
    '((t (:foreground "#FFFF7F")))
    "Agenda 表示中, GFD.org の表示 face"
    :group 'org-agenda )
  (defface my:org-agenda-calendar-DebianJP
    '((t (:foreground "#BF7FFF")))
    "Agenda 表示中, DebianJP.org の表示 face"
    :group 'org-agenda )
  ;; (defface my:org-agenda-calendar-twitter
  ;;   '((t (:foreground "#CCCCCC")))
  ;;   "Agenda 表示中, Twitter log の表示 face"
  ;;   :group 'org-agenda )
  ;;
  ;; font-lock の適用. loop減らせないかなぁ….
  (defun my:org-agenda-finalize-font-lock ()
    "Custom: apply custom font-lock"
    (save-excursion
      (goto-char (point-min))
      (while (re-search-forward "Univ:" nil t)
        (add-text-properties (match-beginning 0) (line-end-position)
                             '(face my:org-agenda-calendar-Univ)))
      (goto-char (point-min))
      (while (re-search-forward "Schedule:" nil t)
        (add-text-properties (match-beginning 0) (line-end-position)
                             '(face my:org-agenda-calendar-Schedule)))
      (goto-char (point-min))
      (while (re-search-forward "DebianJP:" nil t)
        (add-text-properties (match-beginning 0) (line-end-position)
                             '(face my:org-agenda-calendar-DebianJP)))
      (goto-char (point-min))
      (while (re-search-forward "GFD:" nil t)
        (add-text-properties (match-beginning 0) (line-end-position)
                             '(face my:org-agenda-calendar-GFD)))
      (goto-char (point-min))
      (while (re-search-forward "twitter:" nil t)
        (add-text-properties (match-beginning 0) (line-end-position)
                             '(face my:org-agenda-calendar-twitter)))
      (goto-char (point-min))
      (while (re-search-forward "祝日:\\|Holidays:\\|誕生日:" nil t)
        (add-text-properties (match-beginning 0) (line-end-position)
                             '(face org-agenda-date-weekend)))
      ))
  :custom
  `((org-agenda-day-face-function
     . (lambda (date)
         (let ((face
                (cond
                 ;; 日曜日か日本の祝日
                 ((or (= (calendar-day-of-week date) 0)
                      (let ((calendar-holidays japanese-holidays))
                        (calendar-check-holidays date)))
                  'org-agenda-date-weekend)
                 ;; 土曜日
                 ((= (calendar-day-of-week date) 6)
                  'my:org-agenda-date-saturday)
                 ;; 普通の日
                 (t 'org-agenda-date))))
           ;; 今日は色を反転
           (if (org-agenda-today-p date) (list :inherit face :underline t) face))))
    (org-agenda-span . 'week)
    (org-agenda-start-on-weekday . nil)
    (org-agenda-format-date . "%Y/%m/%d (%a)")
    (org-agenda-weekend-days . '(0))
    (org-agenda-inhibit-startup . t)
    (org-agenda-ignore-drawer-properties . '(effort appt))
    (org-agenda-repeating-timestampo-show-all . t)
    (org-agenda-sorting-strategy . '((agenda habit-down time-up timestamp-down priority-down category-keep)
                                     (todo timestamp-down priority-down category-keep)
                                     (tags priority-down category-keep)
                                     (search category-keep)))
    (org-agenda-custom-commands . '(("n" "agenda and all TODO list"
                                     (
                                      (agenda ""
                                              ((org-agenda-ndays 1)
                                               (org-agenda-entry-types '(:timestamp :sexp))))
                                      (todo "TODO"
                                            ((org-agenda-prefix-format " %i %-22:c"))
                                            )
                                      (todo "新規|着手|進行中|確認"
                                            ((org-agenda-prefix-format " %i %-22:c"))
                                            )
                                      (todo "WAIT"
                                            ((org-agenda-prefix-format " %i %-22:c"))
                                            )
                                      (todo "SOMEDAY"
                                            ((org-agenda-prefix-format " %i %-22:c"))
                                            )
                                      ))
                                    ("N" "All memo entry"
                                     (;;
                                      (todo "MEMO")
                                      ))
                                    )
                                )
    )
    :hook ((org-agenda-finalize-hook
            . my:org-agenda-finalize-font-lock))
    :defer-config
    ;; (defvar my:org-agenda-files nil)
    (dolist (file
             '(;; Archive.org   ← 🤔
               ;; Calendar
               "Holidays.org"
               "Schedule.org"
               "GFD.org"
               "Univ.org"
               "DebianJP.org"
               ;; INBOX
               ;; "INBOX.org"
               ;; misc
               "twitter.org"
               ;; Project
               "redmine_GFD.org"
               "redmine_SSKLAB.org"
               ;; "redmine_FluidSoc.org"
               ))
      (add-to-list 'org-agenda-files (expand-file-name file my:d:org)))
    ;;
    (if (file-directory-p
         (expand-file-name "journal/" my:d:org))
        (dolist (file
                 (directory-files-recursively
                  (expand-file-name "journal/" my:d:org) "org$"))
          (add-to-list 'org-agenda-files file)))
    )

Org-journal: 日記

機能が豊富なのだが, イマイチ使いこなせていない.

(leaf org-journal
  :if (file-directory-p my:d:org)
  :commands org-journal-new-entry
  :ensure t
  :hook
  ((org-journal-mode-hook
    . (lambda()
        (setq-local truncate-lines t))))
  :custom
  `((org-journal-file-type                 . 'yearly)
    (org-journal-dir                       . ,(expand-file-name "journal" my:d:org))
    (org-journal-file-format               . "%Y.org")
    (org-journal-cache-file
     . ,(expand-file-name "org-journal.cache" my:d:tmp))
    (org-journal-date-format               . "%x (%a)")
    (org-journal-time-format               . "<%Y-%m-%d %R> ")
    (org-journal-time-prefix               . "** MEMO ")
    (org-journal-enable-agenda-integration . t)
    (org-journal-find-file                 . 'find-file)
    (org-journal-carryover-delete-empty-journal . 'ask)
    (org-journal-start-on-weekday          . 0) ;; sunday
    )
  :config
  (eval-and-compile 'browse-url)
  ;; (with-eval-after-load 'org-journal
  ;;   (global-set-key (kbd "C-c C-j") 'browse-url-at-point))
  )

Org-capture: メモ取り

キーバインドは以前 changelog memo をやっていた時の癖で C-x m をメモにしている.

(leaf org-capture
  :if (file-directory-p my:d:org)
  :commands org-capture
  :pl-setq
  ;; 名前がイケてないっ!
  (my:org:calendar1 my:org:calendar2 my:org:calendar3 my:org:calendar4)
  :config
  (defun my:org-journal-add-date-entry-capture ()
    (org-journal-new-entry t)
    (goto-char (point-max))
    )
  (setq org-default-notes-file (expand-file-name "Memo.org" my:d:org))
  (setq org-capture-templates
        `(
          ("t" "TODO" plain
           (function my:org-journal-add-date-entry-capture)
           "** TODO %(format-time-string org-journal-time-format)%^{title} %^g\n  %?\n  %a"
           :prepend nil
           ;; :unnarrowed nil
           :kill-buffer t
           )
          ("m" "メモを追加" plain
           (function my:org-journal-add-date-entry-capture)
           "** MEMO %(format-time-string org-journal-time-format)%?"
           :prepend nil
           ;; :unnarrowed nil
           :kill-buffer t
           )
          ("a" "少し長めの記事を追加する" plain
           (function my:org-journal-add-date-entry-capture)
           "** ARTICLE %(format-time-string org-journal-time-format)%? "
           :prepend nil
           ;; :unnarrowed nil
           :kill-buffer t
           )
          ("s" "個人予定表スケジュールを追加" plain
           (file ,(expand-file-name "Schedule.org" my:d:org))
           "* %^{prompt}\n  :PROPERTIES:\n  :calendar-id: %(format \"%s\" my:org:calendar1)\n  :org-gcal-managed: org\n  :END:\n  :org-gcal:\n%?\n%i\n  :END:"
           :prepend nil
           ;; :unnarrowed nil
           :kill-buffer t
           )
          ("u" "仕事予定表スケジュールを追加" plain
           (file ,(expand-file-name "Univ.org" my:d:org))
           "* %^{prompt}\n  :PROPERTIES:\n  :calendar-id: %(format \"%s\" my:org:calendar2)\n  :org-gcal-managed: org\n  :END:\n  :org-gcal:\n%?\n%i\n  :END:"
           :prepend nil
           ;; :unnarrowed nil
           :kill-buffer t
           )
          ("g" "GFD 関連 スケジュールを追加" plain
           (file ,(expand-file-name "GFD.org" my:d:org))
           "* %^{prompt}\n  :PROPERTIES:\n  :calendar-id: %(format \"%s\" my:org:calendar3)\n  :org-gcal-managed: org\n  :END:\n  :org-gcal:\n%?\n%i\n  :END:"
           :prepend nil
           ;; :unnarrowed nil
           :kill-buffer t
           )
          ("h" "有給休暇・特別休暇を追加" plain
           (file ,(expand-file-name "Holidays.org" my:d:org))
           "* %^{prompt}\n  :PROPERTIES:\n  :calendar-id: %(format \"%s\" my:org:calendar4)\n  :org-gcal-managed: org\n  :END:\n  :org-gcal:\n%?\n%i\n  :END:"
           :prepend nil
           ;; :unnarrowed nil
           :kill-buffer t
           )
          )
        )
  )

OrgとGoogle カレンダーの連携: org-gcal

request token 等の置き場所の変更 実際の情報等は password-store を使って設定しておく. ついでに agenda 表示の際の色付けを設定．

(leaf org-gcal
  :if (and my:d:password-store
           (and (file-directory-p my:d:org)
                (executable-find "curl")))
  :ensure t
  ;; :el-get (org-gcal
  ;;          :type github
  ;;          :pkgname "kidd/org-gcal.el")
  :commands (org-gcal-fetch
             org-gcal-sync
             org-gcal-post-at-point
             org-gcal-reload-client-id-secret)
  ;; :advice ((:before org-gcal-sync
  ;;                   org-gcal-reload-client-id-secret)
  ;;          (:before org-gcal-fetch
  ;;                   org-gcal-reload-client-id-secret)
  ;;          (:before org-gcal-post-at-point
  ;;                   org-gcal-reload-client-id-secret))
  :preface
  (setq org-gcal-dir (expand-file-name "org-gcal" my:d:tmp))
  (unless (file-directory-p org-gcal-dir)
    (make-directory org-gcal-dir))
  ;; (setq oauth2-auto-plstore (expand-file-name "oauth2-auto.plist" my:d:tmp))
  ;; (setq oauth2-auto-plstore (expand-file-name "oauth2-auto.plist" my:d:password-store))
  :init
  (leaf oauth2-auto
    :custom
    `(oauth2-auto-plstore . ,(expand-file-name "/run/user/1000/psd/uwabami-emacs-cache/oauth2-auto.plist"))
    )
  (leaf aio :ensure t)
  (leaf alert :ensure t)
  (leaf dash :ensure t)
  ;; (leaf oauth2-auto
  ;;   ;; :el-get rhaps0dy/emacs-oauth2-auto
  ;;   :el-get telotortium/emacs-oauth2-auto
  ;;   :custom
  ;;   `(oauth2-auto-plstore . ,(expand-file-name "oauth2-auto.plist" my:d:tmp))
  ;;   )
  ;;
  (leaf org-generic-id
    :custom
    `((org-generic-id-locations-file
       . ,(expand-file-name "org-generic-id-locations"  my:d:tmp))
      )
    )
  (leaf request-deferred :ensure t)
  (leaf request
    :ensure t
    :preface
    (setq request-storage-directory (expand-file-name "request" my:d:tmp))
    (unless (file-directory-p request-storage-directory)
      (make-directory request-storage-directory))
    :custom
    `((request-storage-directory . ,(expand-file-name "request" my:d:tmp))
      ;; (request-backend . 'url-retrieve)
      )
    )
  (leaf persist
    :ensure t
    :config
    (setq persist--directory-location (expand-file-name "persist" my:d:tmp)))
  :custom
  `((org-gcal-dir
     . ,(expand-file-name "org-gcal" my:d:tmp))
    (org-gcal-token-file
     . ,(expand-file-name "org-gcal/org-gcal-token" my:d:tmp))
    (org-gcal-down-days    . 180)  ;; 未来 180 日
    (org-gcal-up-days      .  30)  ;; 過去 30 日
    (org-gcal-auto-archive . t)
    (org-gcal-notify-p     . nil)
    (org-gcal-remove-api-cancelled-evetnts . t)
    (org-gcal-remove-events-with-cancelled-todo . t)
    (org-gcal-remove-api-cancelled-events  . t)
    (alert-log-messages    . t)
    (alert-default-style   .'libnotify))
  :pl-setq
  (org-gcal-client-id
   org-gcal-client-secret
   org-gcal-file-alist)
  )

OrgとRedmine の連携: orgmine

素晴しい!! kametoku/orgmine: Emacs minor mode for org-mode with redmine integration

(leaf *orgmine
  :if  (and my:d:password-store
            (file-directory-p my:d:org))
  :hook
  `(org-mode-hook
    . (lambda ()
        (if (assoc "om_server" org-keyword-properties)
            (orgmine-mode))))
  :init
  (setq enable-local-variables :safe)
  (leaf elmine :ensure t)
  ;; (add-hook 'org-mode-hook
  ;;           (lambda ()
  ;;             (if (assoc "om_server" org-file-properties) (orgmine-mode))))
  (leaf orgmine
    :vc (:url "https://github.com/kametoku/orgmine" )
    :commands (orgmine-mode)
    :init
    ;; (defun my:orgmine-default-todo-keyword ()
    ;;   "Custom: use `org-file-properties' for backward compatibility."
    ;;   (or (cdr (assoc-string "om_default_todo" org-file-properties))
    ;;       orgmine-default-todo-keyword
    ;;       (nth 0 org-todo-keywords-1)
    ;;       1))

    ;; (defun my:orgmine-setup ()
    ;;   "Custom: use `org-file-properties' for backward compatibility."
    ;;   (let* ((server (cdr (assoc-string "om_server" org-file-properties t)))
    ;;          (config (cdr (assoc-string server orgmine-servers t))))
    ;;     (if config
    ;;         (set (make-local-variable 'orgmine-server) server))
    ;;     (mapc (lambda (elem)
    ;;             (let* ((key (car elem))
    ;;                 (symbol (intern (format "orgmine-%s" key)))
    ;;                 (value (cdr elem)))
    ;;               (if (memq key orgmine-valid-variables)
    ;;                (progn
    ;;                  (set (make-local-variable symbol) value)
    ;;                  (if (eq key 'custom-fields)
    ;;                      (orgmine-setup-custom-fields value)))
    ;;              (message "orgmine-setup: %s: skipped - invalid name" key))))
    ;;           config))
    ;;   (orgmine-setup-tags)
    ;;   (run-hooks 'orgmine-setup-hook))
    ;; :advice
    ;; '((:override orgmine-default-todo-keyword my:orgmine-default-todo-keyword)
    ;;   (:override orgmine-setup my:orgmine-setup))
    :pl-setq orgmine-servers
    :config
    (setq orgmine-note-block-begin "#+begin_src gfm"   ;; 要調整
          orgmine-note-block-end   "#+end_src\n")
    )
  )

Org-Wiki

(leaf org-wiki
  :vc (:url "https://github.com/uwabami/org-wiki")
  :if (file-directory-p "~/Public/cc-env")
  :custom
  `((org-wiki-location-alist     . '("~/Public/cc-env"))
    (org-wiki-location           . "~/Public/cc-env")
    (org-wiki-publish-relative   . t)
    (org-wiki-publish-root       . "{{site.url}}/cc-env")
    (org-wiki-completing-backend . 'completing-read)
    (org-wiki-template
     . ,(concat "#+TITLE: %n\n"
                "#+date: 20\n"
                "#+LAYOUT: default\n"
                "#+PREMALINK: /cc-env/%n.html\n"
                "#+options: auto-id:nil\n"
                "#+REF: cc-env/%n\n"
                "Related [[wiki:index][Index]] [[~/Public/cc-env/index.org::#orge0707863][Debian]]\n"
                "* %n\n"
                )))
  )

Org-Export

全般設定

latex, beamer,jekyll(後述) のみを有効に.

(leaf ox
  :preface
  ;; 空行の削除
  (defun my:remove-org-newlines-at-cjk-text (&optional _mode)
    "先頭が '*', '#', '|' でなく、改行の前後が日本の文字の場合は改行を除去"
    (interactive)
    (goto-char (point-min))
    (while (re-search-forward "^\\([^|#*\n].+\\)\\(.\\)\n *\\(.\\)" nil t)
      (if (and (> (string-to-char (match-string 2)) #x2000)
               (> (string-to-char (match-string 3)) #x2000))
          (replace-match "\\1\\2\\3"))
      (goto-char (line-beginning-position))))
  :hook
  ;; ((org-export-before-processing-hook . my:remove-org-newlines-at-cjk-text))
  :custom
  ((org-export-backends             . '(;; remove somve built-in
                                        ;; html
                                        jekyll
                                        latex
                                        beamer))
   (org-export-with-toc             . nil)
   (org-export-with-section-numbers . nil))
  )

Jekyll, HTML

Web サイトは Jekyll で作成しています. 以前は org file を直接 jekyll で処理していましたが, 最近は org を html に export して, それを処理する様にしています.

exporter は uwabami/ox-jekyll にあります.

(leaf ox-html
  :after ox
  :init
  (leaf ox-jekyll
    :if (file-directory-p "~/Public/cc-env")
    :vc (:url "https://github.com/uwabami/ox-jekyll")
    )
  (leaf s :ensure t)
  :custom
  ((org-html-table-align-individual-fields . nil)
   (org-html-table-default-attributes      . nil)
   (org-html-html5-fancy                   . t)
   (org-html-doctype                       . "html5")
   ;; (org-html-container-element             . "div")
   (org-html-inline-image-rules
    . '(("file"  . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|webp\\|svg\\)\\'")
        ("http"  . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|webp\\|svg\\)\\'")
        ("https" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|webp\\|svg\\)\\'")))
   )
  :config
  ;;
  (defun my:org-wiki-jekyll-finalized1 (contents backend info)
    "Replace some URL"
    (ignore info)
    (when (org-export-derived-backend-p backend 'jekyll)
      (require 's)
      (s-replace
       (format "<a href=\"file://%sREADME.html"
               (expand-file-name user-emacs-directory))
       "<a href=\"{{baseurl}}/cc-env/Emacs.html"
       contents)))
  ;;
  (defun my:org-wiki-jekyll-finalized2 (contents backend info)
    "Replace some URL"
    (ignore info)
    (when (org-export-derived-backend-p backend 'jekyll)
      (require 's)
      (s-replace
       (format "<a href=\"file://%s"
               (expand-file-name "Public/" (getenv "HOME")))
       "<a href=\"{{site.url}}/"
       contents)))
  ;;
  (defun my:org-wiki-jekyll-finalized3 (contents backend info)
    "Replace some URL"
    (ignore info)
    (when (org-export-derived-backend-p backend 'jekyll)
      (replace-regexp-in-string
       " id=\"outline-container-org.+\" class=\"outline-.+\""
       "" contents)))
  ;;
  (defun my:org-wiki-jekyll-finalized4 (contents backend info)
    "Replace some URL"
    (ignore info)
    (when (org-export-derived-backend-p backend 'jekyll)
      (replace-regexp-in-string
       "<a id=\"org.+?\"></a>"
       "" contents)))
  ;;
  (defun my:org-wiki-jekyll-finalized5 (contents backend info)
    "Replace some URL"
    (ignore info)
    (when (org-export-derived-backend-p backend 'jekyll)
      (replace-regexp-in-string
       "<pre class=\"example\" id=\".+?\">"
       "<pre class=\"example\">" contents)))
  ;;
  (defun my:org-wiki-jekyll-finalized6 (contents backend info)
    "Replace some URL"
    (ignore info)
    (when (org-export-derived-backend-p backend 'jekyll)
      (replace-regexp-in-string
       "<figure id=\".+?\">"
       "<figure>" contents)))

  ;;
  (add-to-list 'org-export-filter-body-functions
               'my:org-wiki-jekyll-finalized1)
  (add-to-list 'org-export-filter-body-functions
               'my:org-wiki-jekyll-finalized2)
  (add-to-list 'org-export-filter-body-functions
               'my:org-wiki-jekyll-finalized3)
  (add-to-list 'org-export-filter-body-functions
               'my:org-wiki-jekyll-finalized4)
  (add-to-list 'org-export-filter-body-functions
               'my:org-wiki-jekyll-finalized5)
  (add-to-list 'org-export-filter-body-functions
               'my:org-wiki-jekyll-finalized6)
  )

LaTeX, Beamer

LaTeX 関連

(leaf ox-latex
  :after ox
  :init
  (leaf oc-natbib :after ox :require t)
  :custom
  `((org-latex-default-class . "my:uplatex")
    (org-latex-pdf-process   . '("latexmk -r ~/.latexmkrc -pdfdvi -recorder -output-directory='%o' %f"))
    (org-latex-compiler . "latexmk")
    (org-latex-listings . 'minted)
    (org-format-latex-header . "\\documentclass[dvipdfmx]{standalone}
\\usepackage[usenames]{color}
\\usepackage{pgfplots}
\\usepgfplotslibrary{fillbetween,patchplots}
\\pgfplotsset{compat=newest}
\\usepackage{tikz}
\\usetikzlibrary{intersections,calc,arrows,arrows.meta,decorations.markings,fadings,decorations.pathreplacing,patterns}
\\definecolor{cud_blue}{HTML}{005aff}
\\definecolor{cud_green}{HTML}{03af7a}
\\definecolor{cud_orange}{HTML}{f6aa00}
\\definecolor{cud_red}{HTML}{ff4b00}
\\definecolor{cud_yellow}{HTML}{fff100}
\\definecolor{cud_cyan}{HTML}{4dc4ff}
\\definecolor{cud_pink}{HTML}{ff8082}
\\definecolor{cud_purple}{HTML}{990099}
\\definecolor{cud_brown}{HTML}{804000}
\\definecolor{cud_lightgrey}{HTML}{c8c8cb}
\\definecolor{cud_grey}{HTML}{84919e}
\\definecolor{blackblue}{HTML}{2C3E50}
\\def\\pgfsysdriver{pgfsys-dvipdfmx.def}
\[PACKAGES]
\[DEFAULT-PACKAGES]")
    (org-latex-minted-options
     . '(("frame" "lines")
         ("framesep=2mm")
         ("linenos=true")
         ("baselinestretch=1.2")
         ("breaklines")
         ))
    ;; (org-latex-default-table-environment . "tabularx")
    (org-latex-default-packages-alist
     . '(("utf8" "inputenc" t nil)
         ;; ("prefernoncjk" "pxcjkcat" t nil)
         ("T1" "fontenc" t nil)
         ("" "graphicx" t nil)
         ("normalem" "ulem" t nil) ;; udline に変更すべきかな?
         ("" "amsmath" t nil)
         ("" "amssymb" t nil)
         ("" "physics" t nil)
         ;; ("" "siunitx" t nil)
         ("" "hyperref" t nil)
         ("" "multirow" t nil)
         ("" "ltablex" t nil)
         ("" "wrapfig" t nil)
         ("" "silence" t nil)
         ("" "arydshln" t nil)
         ))
    (org-latex-hyperref-template
     .
     "\\hypersetup{
pdfauthor={%a},
pdftitle={%t},
pdfkeywords={%k},
pdfsubject={%s},
pdfcreator={%c},
pdflang={%l}}
")
    (org-latex-classes
     . '(("my:uplatex"
          "\\RequirePackage{plautopatch}\n\\documentclass[a4paper,uplatex,dvipdfmx]{jsarticle}\n\\plautopatchdisable{eso-pic}\n\\ifdefined\\endofdump\\else\\let\\endofdump\\relax\\fi
            [DEFAULT-PACKAGES] [NO-PACKAGES] [EXTRA]"
          ("\\section\{%s\}" . "\\section*\{%s\}")
          ("\\subsection\{%s\}" . "\\subsection*\{%s\}")
          ("\\subsubsection\{%s\}" . "\\subsubsection*\{%s\}"))
         ("my:beamer"
          "\\RequirePackage{plautopatch}\n\\documentclass[dvipdfmx,c,presentation]{beamer}\n\\plautopatchdisable{eso-pic}\n\\ifdefined\\endofdump\\else\\let\\endofdump\\relax\\fi
            [DEFAULT-PACKAGES] [NO-PACKAGES] [EXTRA]"
          ("\\section\{%s\}" . "\\section*\{%s\}")
          ("\\subsection\{%s\}" . "\\subsection*\{%s\}")
          ("\\subsubsection\{%s\}" . "\\subsubsection*\{%s\}"))
         ("my:beamer169"
          "\\RequirePackage{plautopatch}\n\\documentclass[dvipdfmx,c,presentation,aspectratio=169]{beamer}\n\\plautopatchdisable{eso-pic}\n\\ifdefined\\endofdump\\else\\let\\endofdump\\relax\\fi
            [DEFAULT-PACKAGES] [NO-PACKAGES] [EXTRA]"
          ("\\section\{%s\}" . "\\section*\{%s\}")
          ("\\subsection\{%s\}" . "\\subsection*\{%s\}")
          ("\\subsubsection\{%s\}" . "\\subsubsection*\{%s\}"))
         )
     )
    )
  )

Beamer 関連: SHORT 系を追加している

(leaf ox-beamer
  :after ox-latex
  :init
  (add-to-list 'org-export-options-alist
               '(:shortdate      "SHORT_DATE"      nil nil))
  (add-to-list 'org-export-options-alist
               '(:shorttitle     "SHORT_TITLE"     nil nil))
  (add-to-list 'org-export-options-alist
               '(:shortauthor    "SHORT_AUTHOR"    nil nil))
  (add-to-list 'org-export-options-alist
               '(:institute      "INSTITUTE"       nil nil))
  (add-to-list 'org-export-options-alist
               '(:shortinstitute "SHORT_INSTITUTE" nil nil))
  (add-to-list 'org-export-options-alist
               '(:outlinetitle   "OUTLINE_TITLE" nil nil))
  ;; customize
  (defun my:org-beamer-template (contents info)
    "Custom: support shortdate, shorttile, shortauthor, institute for beamer export"
    (let ((title (org-export-data (plist-get info :title) info))
          (subtitle (org-export-data (plist-get info :subtitle) info)))
      (concat
       ;; Time-stamp.
       (and (plist-get info :time-stamp-file)
            (format-time-string "%% Created %Y-%m-%d %a %H:%M\n"))
       ;; LaTeX compiler
       (org-latex--insert-compiler info)
       ;; Document class and packages.
       (org-latex-make-preamble info)
       ;; Insert themes.
       (let ((format-theme
              (lambda (prop command)
                (let ((theme (plist-get info prop)))
                  (when theme
                    (concat command
                            (if (not (string-match "\\[.*\\]" theme))
                                (format "{%s}\n" theme)
                              (format "%s{%s}\n"
                                      (match-string 0 theme)
                                      (org-trim
                                       (replace-match "" nil nil theme))))))))))
         (mapconcat (lambda (args) (apply format-theme args))
                    '((:beamer-theme "\\usetheme")
                      (:beamer-color-theme "\\usecolortheme")
                      (:beamer-font-theme "\\usefonttheme")
                      (:beamer-inner-theme "\\useinnertheme")
                      (:beamer-outer-theme "\\useoutertheme"))
                    ""))
       ;; Possibly limit depth for headline numbering.
       (let ((sec-num (plist-get info :section-numbers)))
         (when (integerp sec-num)
           (format "\\setcounter{secnumdepth}{%d}\n" sec-num)))
       ;; custom: Author support `shortauthor'
       (let ((author (and (plist-get info :with-author)
                          (let ((auth (plist-get info :author)))
                            (and auth (org-export-data auth info)))))
             (shortauthor (plist-get info :shortauthor))
             (email (and (plist-get info :with-email)
                         (org-export-data (plist-get info :email) info))))
         (cond ((and author shortauthor) (format "\\author[%s]{%s}\n" shortauthor author))
               ((and author shortauthor email (not (string= "" email)))
                (format "\\author[%s]{%s\\thanks{%s}}\n" shortauthor author email))
               ((and author email (not (string= "" email)))
                (format "\\author{%s\\thanks{%s}}\n" author email))
               ((or author email) (format "\\author{%s}\n" (or author email)))))
       ;; custom: Date support `shortdate'
       (let ((date (and (plist-get info :with-date) (org-export-get-date info)))
             (shortdate (plist-get info :shortdate)))
         (cond ((and date shortdate)
                (format "\\date[%s]{%s}\n" shortdate (org-export-data date info)))
               (t (format "\\date{%s}\n" (org-export-data date info)))))
       ;; custom: Title support `shorttitle'
       (let ((shorttitle (plist-get info :shorttitle)))
         (cond ((and title shorttitle) (format "\\title[%s]{%s}\n" shorttitle title))
               (t (format "\\title{%s}\n" title))))
       ;; custom: support `institute', `shortinstitute'
       (let ((institute (plist-get info :institute))
             (shortinstitute (plist-get info :shortinstitute)))
         (cond ((and institute shortinstitute)
                (format "\\institute[%s]{%s}\n" shortinstitute institute))
               ((or institute shortinstitute)
                (format "\\institute{%s}\n" (or shortinstitute institute)))))
       (when (org-string-nw-p subtitle)
         (concat (format (plist-get info :beamer-subtitle-format) subtitle) "\n"))
       ;; Beamer-header
       (let ((beamer-header (plist-get info :beamer-header)))
         (when beamer-header
           (format "%s\n" (plist-get info :beamer-header))))
       ;; 9. Hyperref options.
       (let ((template (plist-get info :latex-hyperref-template)))
         (and (stringp template)
              (format-spec template (org-latex--format-spec info))))
       ;; Document start.
       "\\begin{document}\n\n"
       ;; Title command.
       (org-element-normalize-string
        (cond ((not (plist-get info :with-title)) nil)
              ((string= "" title) nil)
              ((not (stringp org-latex-title-command)) nil)
              ((string-match "\\(?:[^%]\\|^\\)%s"
                             org-latex-title-command)
               (format org-latex-title-command title))
              (t org-latex-title-command)))
       ;; Table of contents.
       (let ((depth (plist-get info :with-toc)))
         (when depth
           (concat
            (format "\\begin{frame}%s{%s}\n"
                    (org-beamer--normalize-argument
                     (plist-get info :beamer-outline-frame-options) 'option)
                    (cond ((plist-get info :outlinetitle)
                           (plist-get info :outlinetitle))
                          (t
                           (plist-get info :beamer-outline-frame-title)))
                    )
            (when (wholenump depth)
              (format "\\setcounter{tocdepth}{%d}\n" depth))
            "\\tableofcontents\n"
            "\\end{frame}\n\n")))
       ;; Document's body.
       contents
       ;; Creator.
       (if (plist-get info :with-creator)
           (concat (plist-get info :creator) "\n")
         "")
       ;; Document end.
       "\\end{document}")))
  ;;
  :advice ((:override org-beamer-template
                      my:org-beamer-template))
  :custom
  `((org-beamer-frame-level . 2)
    (org-beamer-frame-default-options . "fragile")
    )
  )

Publish

(leaf ox-publish
  :if (file-directory-p "~/Public/cc-env")
  :after (ox-jekyll org-wiki)
  :commands my:org-wiki-publish
  :custom
  `((org-publish-timestamp-directory
     . ,(expand-file-name "org-timestamps/" my:d:tmp)))
  :config
  (defun my:org-wiki-publish ()
    (interactive)
    (org-publish (org-wiki-make-org-publish-plist
                  'org-jekyll-publish-to-html)
                 t))
  )

SOMEDAY 日記: tDiary [0/1]

(leaf tdiary-mode
  :if (and my:d:password-store
           (file-directory-p (concat (getenv "HOME") "/Nextcloud/tdiary")))
  :commands (tdiary-mode tdiary-replace tdiary-append)
  :vc (:url "https://github.com/uwabami/tdiary-mode")
  :defvar tdiary-passwd-file
  :pl-setq
  (tdiary-csrf-key tdiary-passwd-file)
  :config
  (setq tdiary-text-directory (concat (getenv "HOME") "/Nextcloud/tdiary/")
        tdiary-diary-list '(("log" "https://uwabami.junkhub.org/log/"))
        tdiary-style-mode 'org-mode
        tdiary-text-suffix ".org"
        tdiary-http-timeout 100
        )
  (tdiary-passwd-file-load)
  )

• [ ] org2blog で tDiary を更新できないか妄想している

VCSなど, ソースコード管理関係

まあ, ほとんど Git 関連な訳ですが．

project.el

Emacs 27.1 から built-in となった. eglot でも使われているので, 設定しておく.

(leaf project
  :ensure t
  :custom
  `((project-list-file . ,(expand-file-name "projects" my:d:tmp))
    (project-switch-use-entire-map . t)
    )
  )

• [ ] ghq の list を追加できないかな? できれば --full-path じゃない表示にしたい(my:shorten-file-path を噛ませたい).

consult-ghq: ghq を consult で.

project.el で ghq を使うようになったら不要かもしれないけど, とりあえず.

(leaf consult-ghq
  :vc (:url "https://github.com/uwabami/consult-ghq")
  :bind (("C-x f" . consult-ghq-open))
  :custom
  `((consult-ghq-short-list . t))
  )

magit:

magit は Emacs の Git Frontend. 結局の所 CUI でコマンド叩く事も多いけれど, これはこれで重宝している．

(leaf magit
  :bind (("C-x g" . magit-status))
  :ensure t
  :init
  (leaf transient
    :custom
    `((transient-history-file
       . ,(expand-file-name "transient-history.el" my:d:tmp))
      (transient-levels-file
       . ,(expand-file-name "transient-levels.el" my:d:tmp))
      (transient-values-file
       . ,(expand-file-name "transient-values.el" my:d:tmp))
      (transient-force-fixed-pitch . t))
    )
  :custom
  `((magit-completing-read-function . 'magit-builtin-completing-read)
    (magit-refs-show-commit-count   . 'all)
    (magit-log-buffer-file-locked   . t)
    (magit-revision-show-gravatars  . nil)
    )
  )

TeX: AUCTeX

やっている事は

• japanese-latex-mode において, 幾つかのコマンドが追加/上書きされているものの, あまり使うことの無いコマンドが表示されるのが嫌なのでそれらを削除．
• コンパイルにはLatexmkを使う

と言った所. …ただ, Beamerのクラスなんかだと勝手にdefault コマンドが LaTeX に変更されたりするので挙動がイマイチ良くわからん. async で latexmk -pvc を走らせておいた方が気持が良い, 気がしている….

(leaf auctex
  :disabled t
  :if (and (executable-find "uplatex")
           (executable-find "latexmk"))
  :load-path "/usr/share/emacs/site-lisp/auctex"
  :init
  (unless (file-directory-p (expand-file-name "auctex/auto" my:d:tmp))
    (progn
      (make-directory (expand-file-name "auctex/auto" my:d:tmp) t)
      (make-directory (expand-file-name "auctex/style" my:d:tmp) t)))
  (leaf reftex
    :custom ((reftex-plug-into-AUCTeX               . t)
             (reftex-cite-prompt-optional-args      . t)
             (reftex-toc-split-windows-horizontally . t)
             )
    )
  (leaf auctex-latexmk
    :vc (:url "https://github.com/tom-tan/auctex-latexmk")
    :custom
    `((auctex-latexmk-inherit-TeX-PDF-mode . t))
    :config
    (setq TeX-command-output-list '(("LaTeXMk" ("pdf")))
          TeX-command-default "LaTexMk"
          japanese-LaTeX-command-default "LaTeX")
    )
  (load "auctex" t t)
  (load "preview-latex" t t)
  :hook
  `((LaTeX-mode-hook
     . ,(lambda ()
          (turn-on-reftex)
          (auctex-latexmk-setup)
          (setq-default TeX-command-default "LaTexMk"
                        japanese-LaTeX-command-default "LaTeX")
          (TeX-PDF-mode)
          (TeX-source-correlate-mode)
          (LaTeX-math-mode)
          (outline-minor-mode)))
    )
  :custom
  `((TeX-auto-local
     . ,(expand-file-name "auctex/auto" my:d:tmp))
    (TeX-style-local
     . ,(expand-file-name "auctex/style" my:d:tmp))
    (TeX-default-mode                  . 'japanese-latex-mode) ;; 🤔
    (japanese-TeX-engine-default       . 'uptex)
    (japanese-LaTeX-default-style      . "jlreq") ;; jsarticle? bxjsarticle?
    (TeX-engine                        . 'uptex)
    (TeX-PDF-from-DVI                  . "Dvipdfmx")
    (TeX-view-program-selection        . '((output-dvi "xdvi")
                                           (output-pdf "Okular")
                                           ;; (output-pdf "Evince")
                                           (output-html "xdg-open")))
    (LaTeX-figure-label                . "fig:")
    (LaTeX-table-label                 . "tab:")
    (LaTeX-section-label               . "sec:")
    (TeX-command-default               . "LaTexMk")
    (TeX-ispell-extend-skip-list       . t)
    (TeX-parse-self                    . t)
    (TeX-auto-save                     . t)
    (TeX-auto-untabify                 . t)
    (TeX-source-correlate-mode         . t)
    (TeX-source-correlate-start-server . t)
    (TeX-source-correlate-method       . 'synctex)
    (font-latex-fontify-script         . nil)
    (font-latex-script-display         . nil)
    (font-latex-fontify-sectioning     . 1.0)
    )
  )

その他のモード設定

ほぼ読み込むだけの mode の設定. 設定が増えたら別途まとめる。

(leaf lua-mode :ensure t)
(leaf ssh-config-mode :ensure t)
(leaf fish-mode :ensure t :mode "\\.fish\\'")
(leaf rd-mode
  :mode "\\.rd\\'"
  :hook
  (rd-mode-hook . rd-show-other-block-all))
(leaf scss-mode
  :ensure t
  :init
  (leaf css-mode :custom (css-indent-offset . 2))
  :mode "\\.sass\\'" "\\.scss\\'")
(leaf generic-x)
(leaf systemd :ensure t)
;; (leaf *misc-mode
;;   :init
;;   (leaf systemd :ensure t)
;;   (leaf debian-el
;;     :custom
;;     `((debian-bug-download-directory . "~/Downloads"))
;;     )
(leaf yaml-mode :ensure t :mode "\\.yml\\'" "\\.yaml\\'")
;;   (leaf textile-mode :ensure t)
;;   (leaf dpkg-dev-el)
;;   (leaf sh-mode
;;     :custom ((system-uses-terminfo . nil))
;;     )
;;   (leaf apt-sources-list
;;     :custom
;;     ((apt-sources-list-suites
;;       . '("stable" "stable-backports"
;;           "testing" "testing-backports"
;;           "unstable" "experimental"
;;           "jessie" "jessie-backports"
;;           "stretch" "stretch-backports"
;;           "buster" "buster-backports"
;;           "bullseye" "bullseye-backports"
;;           "sid")))
;;     )
;;   (leaf info-colors
;;     :ensure t
;;     :hook
;;     (Info-selection #'info-colors-fontify-node))
;;   )

テーマ, フォント, モードライン, などなど

SOMEDAY フォント [0/1]

試行錯誤中. とはいえ, GUIで使う事は滅多に無いのでなかなか弄る機会が無い.

;;;###autoload
(defun my:load-window-config ()
  "load window-system specific settings"
  (interactive)
  (progn
    (set-frame-parameter nil 'alpha 90)
    (set-face-attribute 'default nil
                        :family "FSMRMP"
                        :height 95)
    (set-face-attribute 'fixed-pitch nil
                        :family "FSMRMP"
                        :height 95)
    (set-face-attribute 'variable-pitch nil
                        :family "FSMRMP"
                        :height 95)
    ;; Japanese
    (set-fontset-font nil
                      'japanese-jisx0213.2004-1
                      (font-spec :family "FSMRMP" :height 95))
    (set-fontset-font nil
                      'japanese-jisx0213-2
                      (font-spec :family "FSMRMP" :height 95))
    (set-fontset-font nil
                      'katakana-jisx0201
                      (font-spec :family "FSMRMP" :height 95))
    ;; Latin with pronounciation annotations
    (set-fontset-font nil
                      '(#x0080 . #x024F)
                      (font-spec :family "FSMRMP" :height 95))
    ;; Math symbols
    (set-fontset-font nil
                      '(#x950 . #x22FF)
                      (font-spec :family "FSMRMP" :height 95))
    ;; Greek
    (set-fontset-font nil
                      '(#x0370 . #x03FF)
                      (font-spec :family "FSMRMP" :height 95))
    ;; Some Icons
    (set-fontset-font nil
                      '(#xE0A0 . #xEEE0)
                      (font-spec :family "FSMRMP" :height 95))
    ))
;;;###autoload
(defun my:load-side-window-config ()
  "load window-system specific settings"
  (interactive)
  (progn
    (set-face-attribute 'default nil
                        :family "FSMRMP"
                        :height 135)
    (set-face-attribute 'fixed-pitch nil
                        :family "FSMRMP"
                        :height 135)
    (set-face-attribute 'variable-pitch nil
                        :family "FSMRMP"
                        :height 135)
    ;; Japanese
    (set-fontset-font nil
                      'japanese-jisx0213.2004-1
                      (font-spec :family "FSMRMP" :height 135))
    (set-fontset-font nil
                      'japanese-jisx0213-2
                      (font-spec :family "FSMRMP" :height 135))
    (set-fontset-font nil
                      'katakana-jisx0201
                      (font-spec :family "FSMRMP" :height 135))
    ;; Latin with pronounciation annotations
    (set-fontset-font nil
                      '(#x0080 . #x024F)
                      (font-spec :family "FSMRMP" :height 135))
    ;; Math symbols
    (set-fontset-font nil
                      '(#x2200 . #x22FF)
                      (font-spec :family "FSMRMP" :height 135))
    ;; Greek
    (set-fontset-font nil
                      '(#x0370 . #x03FF)
                      (font-spec :family "FSMRMP" :height 135))
    ;; Some Icons
    (set-fontset-font nil
                      '(#xE0A0 . #xEEE0)
                      (font-spec :family "FSMRMP" :height 135))
    ))
(leaf *gui
  :if window-system
  :config
  ;; (set-frame-parameter nil 'alpha 90)
  (setq use-default-font-for-symbols nil)
  (scroll-bar-mode -1)
;;  (my:load-window-config)
  )

• [ ] FSMRMP のギリシャ文字が全角にならない. 要調整

  幅の確認:
  絵文字は全角, 他は半角で 2:1 になっているかの確認用.
  GUI だと駄目だなぁ….

|abcdefghijkl|
|ABCDEFGHIJKL|
|'";:-+=/\~`?|
|∞≤≥∏∑∫|
|×±≒≡⊆⊇|
|αβγδεζ|
|ηθικλμ|
|ΑΒΓΔΕΖ|
|ΗΘΙΚΛΜ|
|日本語の美観|
|あいうえおか|
|アイウエオカ|
|ｱｲｳｴｵｶｷｸｹｺｻｼ|

| hoge                 | hogeghoe | age              |
|----------------------+----------+------------------|
| 今日もいい天気ですね | お、     | 等幅になった👍 🍺|
|----------------------+----------+------------------|

theme: modus-theme

デフォルトの font-lock を(好みに合わせて)入れ替えたり.

(leaf modus-themes
  :ensure t
  :bind ("<f5>" . modus-themes-toggle)
  :commands modus-themes-load-theme
  :preface
  (defun my:override-face-attribute()
    "CUSTOM: Override face attribute"
    (modus-themes-with-colors
      (custom-set-faces
       `(font-lock-comment-delimiter-face ((,c :inherit font-lock-comment-face :bold t)))
       `(wl-highlight-folder-closed-face                  ((,c :foreground ,green-cooler )))
       `(wl-highlight-folder-few-face                     ((,c :foreground ,red-cooler )))
       `(wl-highlight-folder-killed-face                  ((,c :foreground ,fg-alt )))
       `(wl-highlight-folder-many-face                    ((,c :foreground ,magenta )))
       `(wl-highlight-folder-opened-face                  ((,c :foreground ,cyan-cooler )))
       `(wl-highlight-folder-unknown-face                 ((,c :foreground ,cyan-warmer )))
       `(wl-highlight-folder-unread-face                  ((,c :foreground ,blue-warmer )))
       `(wl-highlight-folder-zero-face                    ((,c :foreground ,fg-main )))
       `(wl-highlight-message-citation-header             ((,c :foreground ,green-warmer )))
       `(wl-highlight-message-cited-text-1                ((,c :foreground ,green-intense )))
       `(wl-highlight-message-cited-text-2                ((,c :foreground ,yellow-intense )))
       `(wl-highlight-message-cited-text-3                ((,c :foreground ,blue-intense )))
       `(wl-highlight-message-cited-text-4                ((,c :foreground ,cyan-intense )))
       `(wl-highlight-message-cited-text-5                ((,c :foreground ,magenta-cooler )))
       `(wl-highlight-message-cited-text-6                ((,c :foreground ,red-intense )))
       `(wl-highlight-message-cited-text-7                ((,c :foreground ,green-intense )))
       `(wl-highlight-message-cited-text-8                ((,c :foreground ,yellow-intense )))
       `(wl-highlight-message-cited-text-9                ((,c :foreground ,blue-intense )))
       `(wl-highlight-message-cited-text-10               ((,c :foreground ,cyan-intense )))
       `(wl-highlight-message-header-contents             ((,c :foreground ,magenta-cooler )))
       `(wl-highlight-message-headers                     ((,c :foreground ,cyan-intense )))
       `(wl-highlight-message-important-header-contents   ((,c :foreground ,magenta-intense )))
       `(wl-highlight-message-important-header-contents2  ((,c :foreground ,magenta-intense )))
       `(wl-highlight-message-signature                   ((,c :foreground ,fg-dim )))
       `(wl-highlight-message-unimportant-header-contents ((,c :foreground ,fg-dim )))
       `(wl-highlight-summary-answered-face               ((,c :foreground ,green-intense )))
       `(wl-highlight-summary-deleted-face                ((,c :foreground ,blue-intense )))
       `(wl-highlight-summary-disposed-face               ((,c :foreground ,fg-dim )))
       `(wl-highlight-summary-flagged-face                ((,c :foreground ,yellow-intense )))
       `(wl-highlight-summary-high-unread-face            ((,c :foreground ,red-intense )))
       `(wl-highlight-summary-low-unread-face             ((,c :foreground ,red-intense )))
       `(wl-highlight-summary-normal-face                 ((,c :foreground ,fg-main )))
       `(wl-highlight-summary-refiled-face                ((,c :foreground ,blue-warmer )))
       `(wl-highlight-summary-spam-face                   ((,c :foreground ,magenta-intense )))
       `(wl-highlight-summary-thread-top-face             ((,c :foreground ,fg-main )))
       `(wl-highlight-summary-unread-face                 ((,c :foreground ,fg-main )))
       `(wl-highlight-summary-new-face                    ((,c :foreground ,red-intense )))
       `(wl-highlight-summary-displaying-face             ((,c :underline t :bold t)))
       `(wl-highlight-folder-path-face                    ((,c :underline t :bold t)))
       ;;
       `(whitespace-trailing                              ((,c :foreground ,magenta-intense )))
       `(whitespace-tab                                   ((,c :foreground ,blue-intense :underline t)))
       `(whitespace-space                                 ((,c :foreground ,green-intense :bold t)))
       `(whitespace-empty                                 ((,c :background ,red-intense )))
       )))
  :hook
  `((modus-themes-after-load-theme-hook . my:override-face-attribute))
  :custom
  `(
    (modus-themes-custom-auto-reload      . t)
    (modus-themes-disable-other-themes    . t)
    (modus-themes-bold-constructs         . nil)
    (modus-themes-italic-constructs       . nil)
    (modus-themes-mixed-fonts             . nil)
    (modus-themes-prompts
     . '(bold bold))
    (modus-themes-completions
     . '((matches   . (bold))
         (selection . (bold underline))))
    (modus-themes-org-blocks              . nil)
    (modus-themes-headings                . '((t . (bold))))
    (modus-themes-variable-pitch-ui       . nil)
    (modus-vivendi-palette-overrides
     . '(;;
         ;;; Basic color override
         (green-cooler "#bfff7f")
         (green-intense "#4ceea5")
         (yellow "#efef00")
         (yellow-warmer "#ffb347")
         (yellow-intense "#ffff7f")
         ;;
         (bg-yellow-intense "#556b2f")
         ;;
         (bg-main 'unspecified)
         (comment fg-dim)
         (bg-hl-line bg-yellow-intense)
         ;;
         ;;; Code remapping
         ;;
         (builtin blue-warmer)
         (constant yellow-warmer)
         (docstring green-intense)
         (docmarkup green-intense)
         (fnname magenta-cooler)
         (keyword red-faint)
         (preprocessor red-cooler)
         (string cyan-cooler)
         (type yellow-intense)
         (variable blue)
         ;;
         (rx-construct blue-faint)
         (rx-backslash green-cooler)
         ;;
         (fg-link cyan-warmer)
         ;;
         (err red-intense)
         (warning magenta-intense)
         (info cyan-intense)
         ;;
         ;; Org Agenda view
         ;; (date-common fg-alt)
         ;; (date-deadline red-faint)
         ;; (date-event fg-alt)
         ;;
         (date-common fg-alt)
         (date-weekday fg-main)
         ;; headline
         (fg-heading-0 cyan-intense)
         (fg-heading-1 magenta-cooler)
         (fg-heading-2 blue-cooler)
         (fg-heading-3 yellow-warmer)
         (fg-heading-4 green-faint)
         (fg-heading-5 yellow-intense)
         (fg-heading-6 red-cooler)
         (fg-heading-7 magenta-warmer)
         (fg-heading-8 fg-main)
         ))
    )
  :init
  (modus-themes-load-theme 'modus-vivendi)
  )

modeline: powerline

(leaf powerline
  :ensure t
  :defvar
  (skk-indicator-alist
   skk-hiragana-mode-string
   skk-katakana-mode-string
   skk-latin-mode-string
   skk-jisx0208-latin-mode-string
   skk-jisx0201-mode-string
   skk-abbrev-mode-string
   )
  :init
  ;; (defun my:major-mode-icon (mode)
  ;;   "Update file icon in mode-line, just display major-mode icon. not filename."
  ;;   (let* ((icon (all-the-icons-icon-for-mode mode)))
  ;;     (if (symbolp icon)
  ;;         (all-the-icons-faicon "file-code-o"
  ;;                               :face 'all-the-icons-dsilver
  ;;                               :height 1.0)
  ;;       icon)))
  ;;
  (defun my:skk-init-modeline-input-mode ()
    "Custom skkが読み込まれていなくても skk-modeline-input-mode に値を設定"
    (cond
     ((not (boundp 'skk-modeline-input-mode))
      (setq skk-modeline-input-mode "--SKK"))
     (t skk-modeline-input-mode)))
  ;;
  (defun my:skk-modeline-input-mode ()
    "Custom: powerline 用に skk の indicator を準備"
    (cond
     ((string-match "--SKK" skk-modeline-input-mode) "[--]")
     ((string-match skk-hiragana-mode-string skk-modeline-input-mode) "[あ]")
     ((string-match skk-katakana-mode-string skk-modeline-input-mode) "[ア]")
     ((string-match skk-latin-mode-string skk-modeline-input-mode)    "[_A]")
     ((string-match skk-jisx0208-latin-mode-string skk-modeline-input-mode) "[Ａ]")
     ((string-match skk-jisx0201-mode-string skk-modeline-input-mode) "[_ｱ]")
     ((string-match skk-abbrev-mode-string skk-modeline-input-mode)   "[aA]")
     (t "[--]")
     )
    )
  ;;
  (defun my:skk-setup-modeline ()
    "skk-setup-modeline による modeline の更新を無効化"
    (setq skk-indicator-alist (skk-make-indicator-alist))
    (force-mode-line-update t))
  ;;
  :advice (:override skk-setup-modeline my:skk-setup-modeline)
  :custom
  `((powerline-buffer-size-suffix    . nil)
    (powerline-display-hud           . nil)
    (powerline-display-buffer-size   . nil)
    (powerline-text-scale-factor     .  1)
    (powerline-default-separator     . 'utf-8)
    (powerline-utf-8-separator-left  . #xe0b0)
    (powerline-utf-8-separator-right . #xe0b2)
    )
  :hook (emacs-startup-hook . my:powerline-theme)
  :config
;;;###autoload
  (defun my:powerline-theme ()
    "Setup the default mode-line."
    (interactive)
    (my:skk-init-modeline-input-mode)
    (setq-default
     mode-line-format
     '("%e"
       (:eval
        (let* ((active (powerline-selected-window-active))
               (mode-line-buffer-id (if active 'mode-line-buffer-id 'mode-line-buffer-id-inactive))
               (mode-line (if active 'mode-line 'mode-line-inactive))
               (face0 (if active 'powerline-active0 'powerline-inactive0))
               (face1 (if active 'powerline-active1 'powerline-inactive1))
               (face2 (if active 'powerline-active2 'powerline-inactive2))
               (separator-left (intern (format "powerline-%s-%s"
                                               (powerline-current-separator)
                                               (car powerline-default-separator-dir))))
               (separator-right (intern (format "powerline-%s-%s"
                                                (powerline-current-separator)
                                                (cdr powerline-default-separator-dir))))
               (lhs (list (powerline-raw (format "%s" (my:skk-modeline-input-mode)) mode-line 'l)
                          (powerline-raw "%*" mode-line 'l)
                          (powerline-raw mode-line-mule-info mode-line 'l)
                          ;; (powerline-raw (my:major-mode-icon major-mode) mode-line 'l)
                          (powerline-buffer-id mode-line-buffer-id 'l)
                          (powerline-raw " ")
                          ;; (funcall separator-left face0 face1)
                          ))
               (rhs (list (powerline-raw global-mode-string face1 'r)
                          ;; (funcall separator-right face2 face1)
                          (powerline-vc face1 'r)
                          (powerline-raw mode-line-misc-info 'r)
                          (powerline-raw " ")
                          (powerline-raw "%6p" mode-line 'r)
                          )))
          (concat (powerline-render lhs)
                  (powerline-fill face2 (powerline-width rhs))
                  (powerline-render rhs))))))
    )
  ;; (my:powerline-theme)
  )

Debug&Test

(defun my:debug-on-quit-if-scratch (&rest _args)
  (setq debug-on-quit (string= (buffer-name) "*scratch*")))
(add-hook 'window-selection-change-functions 'my:debug-on-quit-if-scratch)
(leaf which-key
  :ensure t
  :custom
  `((which-key-show-early-on-C-h    . t)
    (which-key-idle-delay           . 10000)
    (which-key-idle-secondary-delay . 0.05)
    (which-key-popup-type           . 'minibuffer)
    )
  :hook (emacs-startup-hook . which-key-mode)
  )
;; (leaf tree-sitter :ensure t)
;; (leaf tree-sitter-langs :ensure t)
(leaf rg
  :if (executable-find "rg")
  :ensure t
  )
;;
;; (leaf mozc-temp
;;   :init
;;   (leaf mozc
;;     :config
;;     (setq default-input-method "japanese-mozc"))
;;   :bind* ("C-j" . mozc-temp-convert)
;;   :require t
;;   )
;; (global-set-key (kbd "C-j") #'mozc-temp-convert)
;;(leaf emacs
;;  :preface
;;  (defun my-advice/window-width (fn &rest args)
;;    (- (apply fn args) 1))
;;  :advice (:around window-width my-advice/window-width))
;;
;; (leaf elfeed
;;   :if (file-directory-p my:d:password-store)
;;   :ensure t
;;   :custom
;;   `((elfeed-set-timeout  . 36000)
;;     (elfeed-db-directory . "~/.cache/elfeed"))
;;   :config
;;   (leaf elfeed-goodies
;;     :ensure t
;;     :config
;;     (elfeed-goodies/setup))
;;   ;;
;;   (leaf elfeed-protocol
;;     :ensure t
;;     :config
;;     (setq elfeed-feeds
;;           '(("owncloud+https://uwabami@uwabami.junkhub.org/nextcloud"
;;              :password (password-store-get "Web/uwabami.junkhub.org/nextcloud")
;;              )
;;             ))
;;     (elfeed-protocol-enable)
;;     )
;;   )
;;
(leaf vterm
  :ensure t
  :custom
  `((vterm-always-compile-module . t))
  :hook
  (vterm-mode-hook
   . (lambda () (setq-local global-hl-line-mode nil)))
  )
(leaf nginx-mode :ensure t)
(leaf apache-mode :ensure t)
(leaf keg :ensure t)
(leaf keg-mode :ensure t)
(leaf esup
  :ensure t
  :custom
  ((esup-insignificant-time . 0.01)
   (esup-depth              . 0)) ;; 🤔
  )

起動時間の出力

起動時間を計測する 改訂版 - すぎゃーんメモ

(leaf *show-startup-time
  :hook
  (emacs-startup-hook
   . (lambda ()
       (message "init time: %.3f sec"
                (float-time (time-subtract after-init-time before-init-time)))))
  )

最後に

profiler report

必要に応じて

(setq debug-on-error nil)
;; (profiler-report)
;; (profiler-stop)

provide の設定

(provide 'init)
;; Local Variables:
;; byte-compile-warnings: (not cl-functions free-vars docstrings unresolved)
;; End:

;; Local Variables:
;; byte-compile-warnings: (not cl-functions free-vars docstrings unresolved)
;; End:

LICENSE

幾つかの関数の元ネタとして Emacs 本体のコードを参照したので, GPL-3 or later です．

Copyright (C) 2011--2017 Youhei SASAKI <uwabami@gfd-dennou.org>
.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
.
This package is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.
.
You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.