読者です 読者をやめる 読者になる 読者になる

common lispでコンパイル時の余計な警告を抑制する

common lisp メモ
; test.lisp
(defun f (x) (g x))
(defun g (x) x)

* (load "test.lisp")
; file: /home/username/test.lisp
; in: DEFUN F
;     (G X)
; 
; caught STYLE-WARNING:
;   undefined function: G
; 
; compilation unit finished
;   Undefined function:
;     G
;   caught 1 STYLE-WARNING condition

with-compilation-unitを使う

http://clhs.lisp.se/Body/m_w_comp.htm

* (with-compilation-unit () (load "test.lisp"))
T

このマクロを持ち出してるところがpaipの演習くらいしかなかった

common lispのstring-*関数はシンボルも受け付ける

common lisp メモ
(string-downcase 'hoge)
; => "hoge"
(string-upcase 'hoge)
; => "HOGE"
(string-trim "*" '*var*)
; => "VAR"
(string= 'foo "FOO")
; => T

文字列のリストから目的の文字列を探してstring-upcaseをする

(string-upcase (find "hoge" '("hoge" "piyo" "fuga")))
; => "HOGE"

要素が見つからない場合

(string-upcase (find "hoge" '("foo" "bar" "baz")))
; => "NIL"

リストの中に目的の要素がないとtype-errorを出さずにnilをupcaseしてしまう罠があった

jnethackをインストールするシェルスクリプトを書いた

実行するとファイルをダウンロードして設定した場所に展開したあと日本語化パッチを当ててjapanese/Install.lnx通りにファイルを編集してからmakeしてインストールする

実行した後に/tmpにダウンロードしたtarballが残る

ダウンロードするURLは変数NETHACK_SOURCE_URLJNETHACK_URLで設定する

tarballを展開する場所は変数INSTALL_DIRに設定する
デフォルトは$HOME/opt

セーブデータを残してインストールする場合は変数MAKE_UPDATE_FLAGをtrueにする

roswellからcommon lisp処理系を入れていたときのstumpwmのインストールが失敗する場合の対処

common lisp stumpwm メモ

環境はubuntu 15.04 amd64sbcl 1.2.14

configureで処理系の場所を指定する

$ ./configure --with-sbcl="${HOME}/.roswell/impls/x86-64/linux/sbcl-bin/1.2.14/bin/sbcl"

生成されたMakefileを修正

LISP=ros
sbcl_BUILDOPTS=-l ./make-image.lisp
sbcl_INFOOPTS=-e "(progn (load \"load-stumpwm.lisp\") (load \"manual.lisp\"))" --eval "(progn (stumpwm::generate-manual) (sb-ext:quit))"

stumpwmでfloating windowを使う

common lisp メモ stumpwm

今のstumpwmのバージョンは0.9.8

いつからかstumpwmでfloating windowが使えるようになってた
floating windowはfloating groupの中で使える

gnew-floatコマンドでfloating groupを作る
フレームをマウスの左ボタンで移動、右ボタンで大きさの変更が出来る

色々と機能が足りない
このバージョンとgithubの最新のコードを見るにまだ作りかけらしい

このままだと不便だからキーボードから簡易的な操作を出来るようにした

(in-package :stumpwm)

(defun win-left ()
  0)

(defun win-top ()
  (let ((mode-line (head-mode-line (current-head))))
    (if mode-line
        (mode-line-height mode-line)
        0)))

(defun win-right ()
  (- (screen-width (current-screen))
     (window-width (current-window))))

(defun win-bottom ()
  (- (screen-height (current-screen))
     (window-height (current-window))))

(defcommand move-topleft () ()
            "ウィンドウを左上に移動"
            (float-window-move-resize (current-window)
                                      :x (win-left)
                                      :y (win-top)))

(defcommand move-topright () ()
            "ウィンドウを右上に移動"
            (float-window-move-resize (current-window)
                                      :x (win-right)
                                      :y (win-top)))

(defcommand move-bottomleft () ()
            "ウィンドウを左下に移動"
            (float-window-move-resize (current-window)
                                      :x (win-left)
                                      :y (win-bottom)))

(defcommand move-bottomright () ()
            "ウィンドウを右下に移動"
            (float-window-move-resize (current-window)
                                      :x (win-right)
                                      :y (win-bottom)))

(let ((toggle)
      x
      y
      width
      height)
  (defcommand maximum-window () ()
              "ウィンドウを最大化"
              (let ((window (current-window)))
                (cond (toggle
                       (float-window-move-resize
                        window
                        :x x
                        :y y
                        :width width
                        :height height))
                      (t
                       (setq x (window-x window))
                       (setq y (window-y window))
                       (setq width (window-width window))
                       (setq height (window-height window))
                       (when (< (screen-width (current-screen))
                                (+ x width))
                         (setf (window-width window)
                               (- (screen-width (current-screen)) x)))
                       (when (< (screen-height (current-screen))
                                (+ y height))
                         (setf (window-height window)
                               (- (screen-height (current-screen)) y)))
                       (let ((new-x (win-left))
                             (new-y (win-top)))
                         (float-window-move-resize
                          window
                          :x new-x
                          :y new-y
                          :width (- (screen-width (current-screen)) new-x)
                          :height (- (screen-height (current-screen))
                                     12
                                     new-y)))))
                (setq toggle (not toggle)))))


(define-key *top-map* (kbd "s-y") "move-topleft")
(define-key *top-map* (kbd "s-u") "move-topright")
(define-key *top-map* (kbd "s-b") "move-bottomleft")
(define-key *top-map* (kbd "s-n") "move-bottomright")
(define-key *top-map* (kbd "s-x") "maximum-window")

superキーとy,u,b,nでウィンドウを端に移動
superキーとxで画面を最大化、最大化しているときは元に戻すようにしている

コマンドラインからquicklispを使うスクリプト

common lisp メモ
#!/usr/local/bin/sbcl --script

(load "~/quicklisp/setup.lisp")

(defun usage ()
  (format t "usage: ql command package
command:
 search
 install
"))

(let ((argv sb-ext:*posix-argv*))
  (if (/= 3 (length argv))
      (usage)
      (destructuring-bind (cmd pkg) (cdr argv)
        (cond ((string= cmd "install")
               (ql::recursively-install pkg))
              ((string= cmd "search")
               (ql:system-apropos pkg))
              (t
               (usage))))))

パスの通った場所にqlとして保存した場合

hogeで探す
$ ql search hoge

hogeをインストール
$ ql install hoge

common lispの上で動くemacsライクなスクリーンエディタを書いた

common lisp

https://github.com/cxxxr/lem

MicroEMACSにcommon lispを書くのに必要なインデントやS式単位の編集、シンボルの補完、 式の評価、簡易的なデバッガがあるlisp-modeをつけたようなものになった

quicklispで呼び出せるようにquicklisp/local-projects/に置いて
(ql:quickload :lem)としてインストールする
sbclなら

(push #'(lambda (x)
          (if x
              (lem:lem x)
              (lem:lem))
          t)
      *ed-functions*)

とすれば(ed)で呼び出せるようになる

こんなことするより素直にemacsとslimeを使ったほうが遥かに良い