bowbow99

(deftype plist (&optional key-type value-type)
  (let* ((tail (list value-type nil))
         (spec `(or null
                    (cons ,key-type
                          (cons ,@tail)))))
    (setf (cadr tail) spec)
    spec))

(si:canonicalize-type '(plist keyword number))
=> #1=(or null (cons keyword (cons number #1#)))

bowbow99

(defun fizzp (n) (zerop (mod n 3)))
(defun buzzp (n) (zerop (mod n 5)))

(deftype fizz () `(and integer (satisfies fizzp)))
(deftype buzz () `(and integer (satisfies buzzp)))
(deftype fizzbuzz () `(and fizz buzz))

(defun fizzbuzz-1 (n)
  (etypecase n

bowbow99

;;;;; relative pathname as buffer-name etc. in repository

(defvar *repository-type/landmark-alist*
  '(("GIT" . ".git")
    ("HG" . ".hg")))

(defun repository-type (dir-pathname)
  (dolist (x *repository-type/landmark-alist* nil)
    (when (file-exist-p (merge-pathnames (cdr x) dir-pathname))
      (return (car x)))))

bowbow99

;;;;; set *buffer-package*

(defparameter *lisp-mode-family* '(lisp-mode lisp-interaction-mode)
  "lisp-mode な感じのメジャーモードたち（あちこちで定義してる気がする...）")

(defun find-buffer-package-from-magic-comment ()
  "-*- ... package: PACKAGE -*- を拾ってくる"
  (cdr (assoc "package" (ed::find-file-scan-params) :test #'string-equal)))

(defun set-buffer-package (&optional (package (find-buffer-package-from-magic-comment)))

bowbow99

;;; -*- mode: lisp; package: keyword-mode -*-
;;;
;;; keyword-mode.l --- Major mode for editing keyword file for xyzzy.

;;; Code:

(defpackage :keyword-mode
  (:use :lisp :editor))

(in-package :keyword-mode)

bowbow99

;;; example output of DESCRIBE on Armed Bear Common Lisp (1.0.1)

;; (describe FOO)
FOO is an internal symbol in the COMMON-LISP-USER package.

;; (describe DESCRIBE)
DESCRIBE is an external symbol in the COMMON-LISP package.
Its function binding is #<DESCRIBE {E312}>.
The function's lambda list is:
  (OBJECT &OPTIONAL STREAM)

bowbow99

;(require "simple-test") ;無駄だった

(defun read-deftest-at-point ()
  "カーソル位置の deftest 式を読み込む。"
  (save-excursion
    (while (up-list -1 t))
    (let ((*readtable* *test-file-readtable*)
          (*package* (find-package :user)))
      (with-input-from-selected-buffer (read)))))

bowbow99

(defun switch-to-repl ()
  "repl を開く。
既に見えてたらそのウィンドウへ。既に開いてたらそのバッファへ。まだ開いて
なかったら開く。"
  (interactive)
  (let* ((repl-buffer (find-buffer "*repl*"))
         (repl-window (when repl-buffer (get-buffer-window repl-buffer))))
    (cond (repl-window (set-window repl-window))
          (repl-buffer (switch-to-buffer repl-buffer))

bowbow99

(defun 337-ding (&optional (rhythm '(nil nil t nil nil t nil nil nil nil nil nil)))
  (labels ((backding ()
             (ding)
             (when rhythm
               (start-timer (if (car rhythm) 0.6 0.3)
                            #'backding t)
               (setf rhythm (cdr rhythm)))))
    (start-timer 1 #'backding t)))
=> 337-ding

bowbow99

(defun interactive-test (x)
  (interactive (list '#1=(a . #1#)))
  (let ((*print-circle* t))
    (msgbox "~S" x)))
=> interactive-test

(interactive-test '#1=(a . #1#))
;; msgbox で
;;     #1=(a . #1#)
;; と表示される