本日の酒：鎌倉ビール 花

本日の酒

• 鎌倉ビール 花(神奈川/鎌倉ビール醸造株式会社)

本日の酒:世界ビール紀行 ベルジャンエール

本日の酒

• 世界ビール紀行 ベルギー ベルジャンエールタイプ(アサヒビール/福島工場)
• 琥珀ヱビス(サッポロビール)

今日も酒がおいしいです。

昨日の続き(syntax-table)

word-at-pointやsymbol-at-pointはメジャーモードごと、というかsyntax-tableごとに動きをかえてしまうので、適当なsyntax-tableを定義してつねにそいつを利用するようにしてみました。

https://gist.github.com/740118

Emacsで単語の省略形を定義する

最近どうにかして同じようなコードを何度も何度も何度も書くような真似をしなくて良い方法はないだろうかと考えています。

基本的にEmacsユーザーなので、Elispでそれっぽい機能を書けばいいんじゃないかと考えて思いついたネタの一つが、劣化yasnippetといいますか、単にある文章(単語)の省略形を登録しておいて、それを展開してもとの文章(単語)になるようにする、というものでした。

まぁ、補完があるのでたいして役に立たないかもしれません。

(require 'cl)
;;; メジャーモードで分けたほうがよいだろうか
(defvar shorthand:*shorthand-expand-ht*
  (make-hash-table :test 'equal))
(defvar shorthand:*shorthand-fold-ht*
  (make-hash-table :test 'equal))

(defun shorthand:add (short long)
  (interactive "Sshort:\nslong:")
  (setf (gethash long shorthand:*shorthand-fold-ht*) short
	(gethash short shorthand:*shorthand-expand-ht*) long))


(fset 'sh:add #'shorthand:add)


;; syntax-tableによっては. や / で区切られてしまう
(defun shorthand:word-at-point ()
  (let ((s (sexp-at-point)))
    (typecase s
      (string (format "\"%s\"" s))
      (list nil)
      (symbol (symbol-name s))
      (t nil))))

(defun shorthand:symbol-at-point ()
  (symbol-at-point))

(defun shorthand:add-at-point-short (long)
  (interactive "slong:")
  (let ((short (shorthand:symbol-at-point)))
    (when short
      (shorthand:add short long))))
(fset 'sh:add-at-point-short #'shorthand:add-at-point-short)

(defun shorthand:add-at-point-long (short)
  (interactive "Sshort:")
  (let ((long (shorthand:word-at-point)))
    (when long
      (shorthand:add short long))))
(fset 'sh:add-at-point-long #'shorthand:add-at-point-long)

(defun shorthand:get (short)
  (gethash short shorthand:*shorthand-expand-ht*))
(fset 'sh:get #'shorthand:get)

(defun shorthand:get-short (long)
  (gethash long shorthand:*shorthand-fold-ht*))

(defun shorthand:expand (short)
  (interactive (list (shorthand:symbol-at-point)))
  (let ((long (shorthand:get short)))
    (when long
      (cond
       ((functionp long) (funcall long short))
       ((not (interactive-p)) long)
       (t (shorthand:replace long))))))
(fset 'sh:expand #'shorthand:expand)

(defun shorthand:fold (long)
  (interactive (list (shorthand:word-at-point)))
  (let ((short (shorthand:get-short long)))
    (when short
      (if (not (interactive-p))
	  short
	(let ((short (format "%S" short)))
	  (shorthand:replace short))))))
(fset 'sh:fold #'shorthand:fold)

(defun shorthand:replace (new)
  (backward-sexp)
  (kill-sexp)
  (pop kill-ring-yank-pointer)
  (let ((pos (point))
	(len (length new)))
    (insert new)
    (goto-char (+ pos len))))

(defvar shorthand:*expand-fold-toggle-flag* nil)

(defun shorthand:expand-and-fold ()
  (interactive)
  (if (and (eq this-command last-command)
	   shorthand:*expand-fold-toggle-flag*)
      (progn
	(setf shorthand:*expand-fold-toggle-flag* nil)
	(command-execute 'shorthand:fold))
    (progn
      (setf shorthand:*expand-fold-toggle-flag* t)
      (command-execute 'shorthand:expand)))
  (when (interactive-p)
    (setf this-command 'shorthand:expand-and-fold)))

;; key bindings
(global-set-key (kbd "C-o") 'shorthand:expand-and-fold)
(global-set-key (kbd "M-RET") 'shorthand:add-at-point-long)
(global-set-key (kbd "M-SPC") 'shorthand:add-at-point-short)

;; example
;; (sh:add 'sysout "System.out.println")
;; sysout [M-x sh:expand]
;; =>
;; System.out.println
;; System.out.println [M-x sh:fold]
;; =>
;; sysout


(sh:add 'file
	(lambda (short)
	  (let ((name (read-file-name "Filename:")))
	    (when name
	      (shorthand:replace name)))))

単語の展開だけではつまらないので関数の呼び出しも行えるようにしました。

syntax-tableによって、単語やS式(シンボル)の範囲が異なるあたりがめんどくさそうです。

とりあえず、interactiveについての勉強にはなりました。

最近飲んでいる(いた)日本酒リスト

• 賀儀屋 無濾過純米吟醸 (愛媛/成龍酒造株式会社)
• 古緑川(平成9年度産) (新潟/緑川酒造株式会社)
• 櫻室町 吟醸純米酒 (岡山/室町酒造株式会社)
• 幻の瀧 山田錦大吟醸袋しぼり(製造No.0428) (富山/皇国晴酒造株式会社)
• 伝兵衛 純米 (石川/合名会社中島酒造店)
• 霧筑波 特別純米酒 (茨城/合名会社浦里酒造店)

「皇国晴」は「みくにはれ」と読むらしい。

cl-gtk2

cl-gtk2を使ってウィンドウに絵を書いてみます。

;;(asdf:load-system :cl-gtk2-glib)
;;(asdf:load-system :cl-gtk2-gdk)
;;(asdf:load-system :cl-gtk2-cairo)
(defun run-test-1 ()
  (let ((out *standard-output*))
    (gtk:within-main-loop
      (let ((window (make-instance 'gtk:gtk-window
				   :type :toplevel
				   :window-position :center
				   :title "run-test-1"
				   :default-width 300
				   :default-height 100))
	    (area (make-instance 'gtk:drawing-area
				 :default-width 100 :default-height 100))
	    (button (make-instance 'gtk:button :label "はろー, World"))
	    (v-box (make-instance 'gtk:v-box)))
	(gobject:g-signal-connect button "clicked"
				  (lambda (b)
				    (format out "Hello,World Clicked: ~A~%" b)
				    (multiple-value-bind (width height)
					(gdk:drawable-get-size (gtk:widget-window area))
				      (cl-gtk2-cairo:with-gdk-context
					  (ctx (gtk:widget-window area))
					(cairo:with-context (ctx)
					  (cairo:set-source-rgb (random 1.0)
								(random 1.0)
								(random 1.0))
					  (cairo:move-to (random width) (random height))
					  (cairo:line-to (random width) (random height))
					  (cairo:stroke)
					  nil)))))
	(gtk:container-add window v-box)
	(gtk:box-pack-start v-box button :expand nil)
	(gtk:box-pack-start v-box area)
	(gtk:widget-show window :all t)))))

画面上部のボタンを押すと、ウィンドウに線を描きます。

ウィジェットを並べるにはv-boxやh-boxその他が使えるようです。

たくさんの閉じ括弧を不快に思う人のためのリーダマクロ

本日(2010/11/27)はShibuya.lisp TT6に参加してきました。

Lisperばかりが70以上も集まるという、とても楽しいイベントでした。運営、発表者、会場、その他参加者の皆様、どうもありがとうございました。

内容についてはきっとどなたかがナイスな感じでまとめてくださるはずなので、帰宅して書いてみたネタを晒そうと思います。

今日のTTで Programming 2.0 という話題がでました。自分の中で要約すると、「おいコンパイラ、そのくらいのタイポでエラーをだすな。俺がやりたいことくらいわかるだろ？」という感じになりましたが、そのあたりに関連して、「Lispのネストした閉じ括弧をたくさん書くのが面倒、わかりにくい」というようなつぶやきが聞こえてきたので、なんとかしてみようと頑張ってみました。

(defparameter *unclose-parenthesis* 0)
(defparameter *super-kokka-sym* (gensym))
(defparameter *kokka-sym* (gensym))

(defun super-kakko-reader (stream ch)
  (let ((*unclose-parenthesis* 0))
    (loop :for s = (read stream t nil t)
       :until (eq s *super-kokka-sym*)
       :collect s)))

(defun super-kokka-reader (stream ch)
  (when (> *unclose-parenthesis* 0) (unread-char ch stream))
  *super-kokka-sym*)

(defun kakko-reader (stream ch)
  (let ((*unclose-parenthesis* (1+ *unclose-parenthesis*)))
    (loop :for s = (read stream t nil t)
       :until (or (eq s *kokka-sym*)
		  (eq s *super-kokka-sym*))
       :collect s)))

(defun kokka-reader (stream ch)
  *kokka-sym*)

(set-macro-character #\{ #'super-kakko-reader)
(set-macro-character #\} #'super-kokka-reader)
(set-macro-character #\) #'kokka-reader)
(set-macro-character #\( #'kakko-reader)

「{」 で始まった式は、どれだけネストしていようと 「}」 が現れた時点で終端だと判断されます。

;; example

'{dotimes (i 3)
  (dotimes (j 3)
    (format t "~A x ~A = ~A~%" i j (* i j}

;; => (DOTIMES (I 3) (DOTIMES (J 3) (FORMAT T "~A x ~A = ~A~%" I J (* I J))))

最大の問題は、エディタのインデント支援の恩恵を受けられなくなるというところ。致命的ですね。