Emacs Lisp でプリントデバッグをする (2)

こちらの記事より新しい記事があります：

https://qiita.com/javacommons/items/8fb62f9052df31582168

----

最新版の xprint.el は以下のGitHubリポジトリからダウンロードできます。

> [https://github.com/emacs-pkg/xprint/releases/latest](https://github.com/emacs-pkg/xprint/releases/latest)

# インストール方法 (xprint.el)

とりあえず使ってみたい(または最新の変更に追随したい)方は、.emacs または init.el に以下を追加しておくと自動的にロードされます。.emacs 内で xprint 等を呼びたい場合は、呼び出す前の時点で以下のコードを記述しておいてください。

```elisp:~/.emacs or ~/.emacs.d/init.el
(unless (featurep 'get-feature)
  (defun get-feature (feature-name &optional url file-name)
    (if (featurep feature-name) t
      (unless url (setq url (format "https://github.com/emacs-pkg/%s/raw/main/%s.el"
                                    feature-name feature-name)))
      (unless file-name (setq file-name (format "%s.el" feature-name)))
      (let ((make-backup-files nil)
            (file-path (expand-file-name file-name user-emacs-directory)))
        (ignore-errors
          (url-copy-file url file-path 'ok-if-already-exists))
        (ignore-errors
          (load file-path nil 'nomessage))
        (featurep feature-name))))
  (get-feature 'get-feature))

(get-feature 'xprint)
```

straight.el でロードしたい場合は以下を .emacs または init.el に入れてください(但し git のインストールが必要です)：

```elisp:~/.emacs or ~/.emacs.d/init.el
(defvar bootstrap-version)
(let ((bootstrap-file
       (expand-file-name "straight/repos/straight.el/bootstrap.el" user-emacs-directory))
      (bootstrap-version 6))
  (unless (file-exists-p bootstrap-file)
    (with-current-buffer
        (url-retrieve-synchronously
         "https://raw.githubusercontent.com/radian-software/straight.el/develop/install.el"
         'silent 'inhibit-cookies)
      (goto-char (point-max))
      (eval-print-last-sexp)))
  (load bootstrap-file nil 'nomessage))

(straight-use-package '(xprint :type git :host github :repo "emacs-pkg/xprint"))
(require 'xprint)
```

----

この前以下の記事を書きましたが

> 『[Emacs Lisp でプリントデバッグをする - Qiita](https://qiita.com/javacommons/items/6d780f2d1168c089a894)』

この記事(『[変数をリストにまとめる - Qiita](https://qiita.com/tadsan/items/8a0e4135788550ade006)』)をヒントに、xdump という変数や関数呼び出しの値を名前(または式)とともに表示するマクロを追加してみました。

xprint関数およびxdumpマクロは、Emacsのバッファに対する操作等を行うEmacs Lispコード(マクロ)の任意の位置から呼び出せて、マクロの処理を一切邪魔することがありませんので、インタラクティブな操作を行うプログラムの開発・デバッグに向いています。

以下に xprint と xdump の出力の違いをデモした際のスクリーンショットを示します：

![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/140610/0869ca77-c8b9-effe-204a-520880eba7bb.png)

# ソース添付

```elisp:xprint.el
;;;; xprint.el v1.2.1                ;;;;
;;;; Last Modified: 2023/01/02 00:00 ;;;;

(require 'cl-lib)
(require 'cl-extra)

(defun xprint (&rest args)
  (let ((raw nil))
    (when (eq (car args) :raw)
      (setq raw t)
      (setq args (cdr args))
      )
    (prog1 args
      (let ((msg ""))
        (dotimes (i (length args))
          (if (zerop i) nil
            (setq msg (concat msg " "))
            )
          (setq msg (concat msg (format (if raw "%s" "%S") (nth i args))))
          )
        (if noninteractive (message "%s" msg)
          (let ((cb (current-buffer))
                (cw (selected-window)))
            (if (equal (buffer-name) "*xprint*") nil
              (switch-to-buffer-other-window "*xprint*")
              )
            ;;(emacs-lisp-mode)
            (lisp-interaction-mode)
            (goto-char (point-max))
            (insert msg)
            (insert "\n")
            (let ((wins (window-list)))
              (dolist (win wins)
                (select-window win)
                (when (equal (buffer-name) "*xprint*")
                  (goto-char (point-max))
                  (cond
                   ((pos-visible-in-window-p (point)) nil)
                   ((< (point) (window-start)) (recenter 0))
                   (t (recenter -1)))
                  )
                )
              )
            (select-window cw)
            (switch-to-buffer cb)
            )
          )
        )
      )
    )
  )

(defmacro xdump (&rest list)
  (let ((exp '(xprint)))
    (dolist (x list)
      (if (and (not (consp x)) (not (and (symbolp x) (not (keywordp x))))) (push x exp)
        (push (list 'quote x) exp)
        (push := exp)
        (push x exp)
        )
      )
    (reverse exp)
    )
  )

(defun xclear ()
  (interactive)
  (let ((cb (current-buffer))
        (cw (selected-window)))
    (let ((wins (window-list)))
      (dolist (win wins)
        (select-window win)
        (when (equal (buffer-name) "*xprint*")
          (ignore-errors (delete-window win))
          )
        )
      )
    (ignore-errors (kill-buffer "*xprint*"))
    (ignore-errors (select-window cw))
    nil)
  )

(defun xsleep (millisec)
  (when millisec
    (sit-for 0)
    (sleep-for 0 millisec)
    )
  )

(defmacro xmessage (&rest list)
  (let ((sleep nil))
    (if (and (not (integerp (nth 0 list))) (not (symbolp (nth 0 list)))) nil
      (setq sleep (pop list))
      )
    (if (not sleep)
        `(message ,@list)
      `(progn (message ,@list) (xsleep ,sleep))
      )
    )
  )

(defmacro xformat (&rest list)
  `(xprint :raw (format ,@list))
  )

(defun xpp (x)
  (xprint :raw (xpp-to-string x))
  )

(defun xpp-to-string (form)
  (with-temp-buffer
    (cl-prettyprint form)
    (let ((str (buffer-string)))
      (replace-regexp-in-string "\\`[ \t\n\r]*\\|[ \t\n\r]*\\'" "" str)
      )
    )
  )

(defun xpand-macro-scan (form callback data)
  (cond
   ((symbolp form) (funcall callback form data))
   ((consp form)
    (cons
     (xpand-macro-scan (car form) callback data)
     (xpand-macro-scan (cdr form) callback data)))
   (t form)
   )
  )

(defun xpand-macro (form)
  (let ((result (macroexpand-all form))
        (hash (make-hash-table :test #'equal)))
    (xprint :raw "")
    (xprint :raw ";;; Expanding Macro:")
    (xprint
     :raw
     (xpp-to-string form)
     )
    (xprint :raw "    |")
    (xprint :raw "    |")
    (xprint :raw "    v")
    (xpand-macro-scan
     result
     #'(lambda (sym data)
         (let ((lst (gethash (symbol-name sym) data)))
           (when (not (member sym lst))
             (push sym lst)
             (puthash (symbol-name sym) lst data)
             )
           )
         )
     hash
     )
    (setq result
          (xpand-macro-scan
           result
           #'(lambda (sym data)
               (let ((lst (gethash (symbol-name sym) data)))
                 (if (= 1 (length lst)) sym
                   (intern (format "%s_%d" sym (length (member sym lst))))
                   )
                 )
               )
           hash
           )
          )
    (xprint
     :raw
     (xpp-to-string result)
     )
    result
    )
  )

(defmacro xpand (form)
  `(xpand-macro (quote ,form))
  )

(provide 'xprint)
```
----

何かお気づきの点がございましたら、コメント等で教えていただけると助かります。