bowbow99

;; - http://d.hatena.ne.jp/rubikitch/20110226/savekill

(defvar *kill-ring-file* "~/var/xyzzy-kill-ring.dat"
  "*kill-ring* の内容を保存するファイル名")

;; *kill-ring* をファイルに保存/ファイルから読み込み
(defun dump-kill-ring ()
  (with-open-file (out *kill-ring-file* :direction :output
                       :if-exists :overwrite
                       :if-does-not-exist :create)

bowbow99

;;; *scratch* で http://www.cs.northwestern.edu/academics/courses/325/readings/lisp-unit.html
;;; にある example をやってみたの図
(load "~/work/xyzzy.lisp-unit/site-lisp/lisp-unit.l")
t

(use-package :lisp-unit)
t

(setf (get 'define-test 'ed:lisp-indent-hook) 1)
1

bowbow99

;; (defun* NAME (ARGS...) (declare (type TYPE VAR*)) ...)
;; VAR の型チェックしてダメだったらブブブーブブブブーーブブー
;; ※音が鳴るだけでエラーで止めたりはしてくれない

(require "vuvuzela") ; vuvuzela が別ライブラリ sound に依存してるのでそれも必要

(defun parse-body (body)
  (let (doc intr decls)
    (labels ((parse-1 (body)
               (let ((form (car body)))

bowbow99

(defmacro flet* (defs &body body)
  (if defs
    `(flet (,(car defs))
       (flet* (,@(cdr defs)) ,@body))
    `(progn ,@body)))
=> flet*

(flet* ((foo (x) (1+ x))
        (foo (x) (foo (* x x))))
  (foo 3))

bowbow99

(defun string-index-of (whole part &key ignore-case)
  "Return position where PART starts in WHOLE."
  (let ((i 0)
        (part-len (length part))
        (start-with (if ignore-case #'string-equal #'string=)))
    (loop
      (cond ((funcall start-with whole part :end1 part-len)
             (return-from string-index-of i))
            ((<= (length whole) part-len)

bowbow99

(defun autoload-symbol-p (symbol)
  (and (symbolp symbol)
       (fboundp symbol)
       (autoload-function-p symbol)))

(defun autoload-module (symbol)
  (unless (autoload-symbol-p symbol)
    (error "autoload 指定されたシンボルじゃないです: ~S" symbol))
  (let* ((def (or (macro-function symbol)
                  (si:closure-body (symbol-function symbol))))

bowbow99

;;; require で読み込まれたのに provide してない奴を探す
;;; .xyzzy の先頭に書いといて起動すると、provide しなかった奴が記録されるので
;;; *scratch* で (print-required-but-not-provided) するとてきとーに表示
(defconstant +original-require+ #'require)

(defparameter *required-but-not-provided* nil)

(defun require (&rest args)
  (let ((modules-prev (copy-list *modules*))
        (module-name (car args)))

bowbow99

;; labels の lambda-list 内の init-form で同じ labels 式で定義したローカル
;; 関数を呼び出してると、コンパイルで挙動が変わる

(defun x () :global)
=> x

(defun test ()
  (labels ((x () :local)
           (test-1 (&optional (val (x))) val))
    (test-1)))

bowbow99

;;; 式の位置を記録しながら読み込む

(require "cmu_loop")

(defun read-forms-with-code-position (buffer &optional print-debug-info)
  (with-input-from-buffer (buffer (point-min))
    (let ((*readtable* (copy-readtable *readtable*))
          (positions (make-hash-table))
          (*read-depth* 0))
      (declare (special *read-depth*))

bowbow99

;; Clozure CL
CL-USER> (let ((x #\a)) `#(,x))
#(#\a)

;; xyzzy
(let ((x #\a)) `#(,x))
=> #((#:|| x))