Latest comments for language 'Emacs Lisp' on doukaku.org

emasaka's comment on 2^i * 3^j * 5^k なる整数

#7671のExcelの解が面白かったので、GNU Emacsに移植してみました。ネタ実装です。

できるだけプログラミング言語というよりエディターのマクロって感じの書きかたを目指しました。カラムの表現は面倒なのでS式にしちゃいましたが。

(defun hamming (num)
  (interactive (list (read-minibuffer "Number: " "100")))
  (let ((n 1) (c 0))
    (switch-to-buffer "*Hamming*")
    (erase-buffer)
    (insert "(nil 0 0 0)")
    (beginning-of-buffer)
    (while (< c num)
      (unless (eolp)
        (save-excursion
          (let ((s (read (current-buffer))))
            (setq c (1+ c))
            (backward-kill-sexp)
            (prin1 (cons n (cdr s)) (current-buffer))
            (mapc (lambda (i)
                    (hamming::goto-line-force (* n i))
                    (if (eolp)
                        (prin1 (cons nil
                                     (mapcar (lambda (j)
                                               (+ (nth (/ (1+ j) 2) s)
                                                  (if (= i j) 1 0) ))
                                             '(2 3 5) ))
                               (current-buffer) )))
                  '(2 3 5) ))))
      (setq n (1+ n))
      (forward-line) ))
  (setq outline-regexp "([0-9]")
  (outline-mode)
  (hide-body) )

(defun hamming::goto-line-force (n)
  (let ((r (goto-line n)))
    (unless (bolp) (insert ?\n))
    (while (< 0 r)
      (insert ?\n)
      (setq r (1- r) ))))

[ Emacs Lisp ] [ download code ] ]

匿名's comment on LL Golf Hole 2 - 文字列に含まれる単語の最初の文字を大文字にする

LL Golf Hole 2 - 文字列に含まれる単語の最初の文字を大文字にする (Nested Flatten)

コマンドラインから

1	emacs -Q --batch --eval '(print(upcase-initials"LL day and night"))'

[ Emacs Lisp ] [ download code ] ]

leque's comment on LL Golf Hole 2 - 文字列に含まれる単語の最初の文字を大文字にする

LL Golf Hole 2 - 文字列に含まれる単語の最初の文字を大文字にする (Nested Flatten)

バッファに文字列を書いた状態で。

1	(mark-whole-buffer)(upcase-initials-region)

[ Emacs Lisp ] [ download code ] ]

kozima's comment on コード圧縮

コード圧縮 (Nested Flatten)

昔ゴルフ用に書いたものを書き直しました。Emacs のバッファを書き換えます。対象言語は Common Lisp で、バッファのモードは lisp-mode と仮定しています。

出力例:: (defun mylib-compress-need-space-p()(cond((or(bobp)(eobp))nil)((string-match"["'(),`]"(string(following-char)))nil)((looking-back"#[0-9]+#")nil)((looking-back"#\\.")t)((string-match"["()]"(string(preceding-char)))nil)(t)))

(defun mylib-compress-region (&optional start end)
  (interactive "r")
  (save-restriction
    (when (and start end)
      (narrow-to-region start end)
      (goto-char (point-min)))
    (loop
      do (delete-region (point)
                        (progn (while (forward-comment 1)) (point)))
      until (or (eobp) (= (following-char) ?\)))
      if (mylib-compress-need-space-p)
      do (insert " ")
      if (looking-at "\\(#'?\\|['`]\\|,@?\\)?(")
      do
      (down-list 1)
      (mylib-compress-region)
      (up-list 1)
      else do (forward-sexp 1))))

(defun mylib-compress-need-space-p ()
  (cond ((or (bobp) (eobp))
         nil)
        ((string-match "[\"'(),`]" (string (following-char)))
         nil)
        ((looking-back "#[0-9]+#")
         nil)
        ((looking-back "#\\\\.")
         t)
        ((string-match "[\"()]" (string (preceding-char)))
         nil)
        (t)))

[ Emacs Lisp ] [ download code ] ]

匿名's comment on 設定ファイルから値を取得

設定ファイルから値を取得 (Nested Flatten)

設定ファイルのフォーマットは S式の連想リストです。
ファイルの内容を一時バッファに格納し、そのバッファを
read で読み込んでいます。

ファイル：ShowPrice.ini
((item-name . りんご)
 (item-cost . 200))

> (show-price)
=> "「りんご」は210円（税込み）"

(defun show-price ()
  (let ((call-with-input-file #'(lambda (filename proc)
                                  (with-temp-buffer
                                    (progn (insert-file-contents filename)
                                           (funcall proc (current-buffer))))))
        (call-with-name&cost #'(lambda (alist proc)
                                 (funcall proc
                                          (cdr (assq 'item-name alist))
                                          (cdr (assq 'item-cost alist)))))
        (call-with-add-tax #'(lambda (rate base proc)
                               (funcall proc (/ (* base (+ rate 100)) 100)))))
    (funcall call-with-input-file (expand-file-name "ShowPrice.ini")
             #'(lambda (in)
                 (funcall call-with-name&cost (read in)
                          #'(lambda (name cost)
                              (funcall call-with-add-tax 5 cost
                                       #'(lambda (cost)
                                           (format "「%s」は%d円（税込み）" name cost)))))))))

[ Emacs Lisp ] [ download code ] ]

匿名's comment on コメントの削除

コメントの削除 (Nested Flatten)

comment-kill がやるようです。

(defun decomment (buffer)
  "バッファ内のコメント文を削除します"
  (interactive "bdecomment ")
  (with-current-buffer buffer
    (save-excursion
      (goto-char (point-min))
      (comment-kill (point-max)))))

[ Emacs Lisp ] [ download code ] ]

kozima's comment on スタックの操作

スタックの操作 (Nested Flatten)

本当のスタックオーバーフローではありませんが、すぐ書ける Emacs Lisp の場合でも。

関数呼び出しのネスト数が max-lisp-eval-depth の値を超えるとエラーになります。初期値は 300 ぐらいが普通みたいです。

普通の変数なので setq で大きい数に設定すれば増やせますが、documentation に「大きくしすぎるとクラッシュするかも」とか書いてあります。

1 2	(defun f () (f)) (f) ;; => Debugger entered--Lisp error: (error "Lisp nesting exceeds `max-lisp-eval-depth'")

[ Emacs Lisp ] [ download code ] ]

みよ's comment on 自然数の分割

自然数の分割 (Nested Flatten)

comprehensionって便利ですね。 List Comprehension - defmacro によるリストの内包表記 http://lambda.s55.xrea.com/Emacs.html のlist-of を利用してemacs-lispで書いてみました。

(defun partitionNum (a b)
  (if (= b 1)
      (list (list a))
    (let ((x 0) (l '()))
      (while (<= x a)
    (progn
      (setq l
        (append 
         l
         (list-of (append (list (- a x)) y)
              (y in (partitionNum x (- b 1))))))
      (setq x (+ x 1))))
      l)))
(print (partitionNum 5 3))

[ Emacs Lisp ] [ download code ] ]

kacchi's comment on 文字列のセンタリング

文字列のセンタリング (Nested Flatten)

Emacs Lisp
実行結果:
(string-centering "abc" 0)
""
(string-centering "abc" 1)
"b"
(string-centering "abc" 2)
"ab"
(string-centering "abc" 3)
"abc"
(string-centering "abc" 4)
"abc "
(string-centering "abc" 5)
" abc "
(string-centering "abc" 6)
" abc  "
(string-centering "abc" 7)
"  abc  "

(defun string-centering (s c)
  (let ((p (lambda (k) (make-string k ? )))
        (d (- c (length s))))
    (let ((n (/ d 2))
          (m (% d 2)))
      (if (>= d 0)
          (concat (funcall p n) s (funcall p (+ n m)))
        (substring s (abs n) (- (length s) (abs (+ n m))))))))

[ Emacs Lisp ] [ download code ] ]

kozima's comment on 文字列リストをTRIE Optimizeされた正規表現に

文字列リストをTRIE Optimizeされた正規表現に (Nested Flatten)

Emacs Lisp だと regexp-opt が要求通り(+α)のことをやってくれるようです。
ただ、backslash だらけな elisp の正規表現が返ります。

実行結果は以下。
"program\\(?:ist\\(?:ic\\)?\\|m\\(?:a\\(?:r\\|ti\\(?:c\\(?:ally\\)?\\|st\\)\\)?\
\\|er\\)\\)?"

(regexp-opt '("program"
              "programist"
              "programistic"
              "programma"
              "programmar"
              "programmatic"
              "programmatically"
              "programmatist"
              "programmer"))

[ Emacs Lisp ] [ download code ] ]

kozima's comment on 水の移し替えパズル

水の移し替えパズル (Nested Flatten)

解くプロセスを Emacs で表示してみました。
もっときれいに書けるかも……

(eval-when-compile (require 'cl))

(defun water-puzzle (a b c)
  (let ((cups (list a b c)))
    (destructuring-bind ((i p) (j q) (k r))
        (sort `((0 ,a) (1 ,b) (2 ,c))
              (lambda (x y) (< (cadr x) (cadr y))))
      (cond ((zerop (mod (- p q) 3)) (show-strategy cups i j k))
            ((zerop (mod (- p r) 3)) (show-strategy cups i k j))
            ((zerop (mod (- q r) 3)) (show-strategy cups j k i))
            (t (message "Cannot solve!"))))))

(defun show-strategy (cups i j k)
  (let ((buf (get-buffer-create "*water puzzle*"))
        (mover (lambda (di dj dk)
                 (incf (nth i cups) di) (redraw-cup i di)
                 (incf (nth j cups) dj) (redraw-cup j dj)
                 (incf (nth k cups) dk) (redraw-cup k dk)))
        (counter 0))
    (switch-to-buffer buf)
    (show-init-state cups)
    (while (> (nth j cups) 0)
      (sit-for 1)
      (apply mover (if (zerop (nth i cups)) '(2 -1 -1) '(-1 -1 2)))
      (incf counter))
    (message "Solved in %d step%s."
             counter (if (= counter 1) "" "s"))))

(defun show-init-state (cups)
  (delete-region (point-min) (point-max))
  (redraw-cup 0 (car cups))   (insert ?\n)
  (redraw-cup 1 (cadr cups))  (insert ?\n)
  (redraw-cup 2 (caddr cups)) (insert ?\n))

(defun redraw-cup (i d)
  (goto-line (1+ i))
  (if (plusp d) (dotimes (x d) (insert ?|)) (delete-char (- d))))

;;; test
(water-puzzle 4 2 10)

[ Emacs Lisp ] [ download code ] ]

kozima's comment on 制限時間内のキー入力検査

制限時間内のキー入力検査 (Nested Flatten)

Emacs のミニバッファから。

(defun input-checker (n s)
  (interactive "nTime(second): \nsString: ")
  (let ((c (read-char (concat "input(" s ")=>"))))
    (push c unread-command-events))
  (with-timeout (n (message "TIME OUT"))
    (let ((input (read-string (concat "input(" s ")=>"))))
      (message (if (string= input s) "OK" "NG")))))

[ Emacs Lisp ] [ download code ] ]

kacchi's comment on 文字列の反転

文字列の反転 (Nested Flatten)

Emacs Lispにはそれ用の関数はないです。

1 2	(defun reverse-string (str) (concat (nreverse (append str nil))))

[ Emacs Lisp ] [ download code ] ]

kacchi's comment on 与えられた文字列でピラミッド

与えられた文字列でピラミッド (Nested Flatten)

あまり長くない文字列なら再帰でも行けます。
(Emacsは再帰の深さが変数max-lisp-eval-depthで制限されるので事実上使えない)

(pyramid "abracadabra")
          a
         r a
        b r a
       a b r a
      d a b r a
     a d a b r a
    c a d a b r a
   a c a d a b r a
  r a c a d a b r a
 b r a c a d a b r a
a b r a c a d a b r a

(defun pyramid (s &optional p)
  (unless (string= s "")
    (pyramid (substring s 1) (cons ? p))
    (insert (concat p) (mapconcat #'string s " ") "\n")))

[ Emacs Lisp ] [ download code ] ]

rubikitch's comment on 与えられた文字列でピラミッド

与えられた文字列でピラミッド (Nested Flatten)

(require 'cl)
(defun pyramid (str)
  (interactive "sPyramid string: ")
  (with-output-to-temp-buffer "*Pyramid*"
    (loop for i from (1- (length str)) downto 0 do
          (princ (make-string i ? ))
          (princ (mapconcat 'identity (split-string (substring str i) "") " "))
          (terpri))))

[ Emacs Lisp ] [ download code ] ]

mz's comment on 重複無し乱数

重複無し乱数 (Nested Flatten)

;;  random-permutation
(random t)
(bingo 10)

(defun iota (n &optional a step)
  (setq step (or step 1))
  (do ((n n (- n 1))
       (ret '() (cons a ret))
       (a (or a 0) (+ a step)))
      ((<= n 0) (nreverse ret))))
(defun bingo (a &optional b)
  (let* ((ret (vconcat (mapcar '1+ (iota a b))))
	 (num (length ret))
	 val rnd)
    (dotimes (x  num ret)
      (setq rnd (random num)
	    val (aref ret x))
      (aset ret x (aref ret rnd))
      (aset ret rnd val))))

[ Emacs Lisp ] [ download code ] ]

rubikitch's comment on 文字列からの情報抽出

文字列からの情報抽出 (Nested Flatten)

カレントバッファを入力としてM-x print-image-spec-on-bufferすると*image-spec*バッファに出力されます。

(require 'cl)
(defun print-image-spec-on-buffer ()
  (interactive)
  (save-excursion
    (goto-char (point-min))
    (with-output-to-temp-buffer "*image-spec*"
      (while (re-search-forward "\\([A-Za-z]+\\)\\(-hidden\\)?\\(-\\(small\\|big\\)\\)?\\.\\([A-Za-z]+\\)" nil t)
        (destructuring-bind (s0 e0  sname ename  shidden ehidden _ _ ssize esize  sext eext)
            (match-data)
         (princ (format "name:'%s', ext:'%s', size: %s hidden: %s\n"
                        (buffer-substring sname ename)
                        (buffer-substring sext eext)
                        (if ssize (buffer-substring ssize esize) "normal")
                        (if shidden "True" "False"))))))))

[ Emacs Lisp ] [ download code ] ]

rubikitch's comment on 隣り合う二項の差

隣り合う二項の差 (Nested Flatten)

elispのmapcarは劣化版。

1
2
3

(defun diffseq (list)
  (mapcar* #'- (cdr list) list))
(diffseq '(3 1 4 1 5 9 2 6 5))          ; => (-2 3 -3 4 4 -7 4 -1)

[ Emacs Lisp ] [ download code ] ]

kozima's comment on 複数行のコメントアウト

複数行のコメントアウト (Nested Flatten)

ソースコード中で使われることは意図してなさそうですが
#@n で n 文字読み飛ばすことができます。

1 2	#@18 this is a comment

[ Emacs Lisp ] [ download code ] ]

rubikitch's comment on 与えられた数字のケタ数

与えられた数字のケタ数 (Nested Flatten)

今度は数値計算でやってみた。そのままCommon Lispでも通る。

(require 'cl)
(defun keta (n)
  (cond ((zerop n) (values 1 1))
        ((< n 0) (keta (- n)))
        (t (loop
              with d = 1
              with len = 0
              while (>= (/ n d) 1) do
                (incf len)
                (setf d (* d 10))
              finally (return (values len (/ d 10)))))))

(keta 2469)                             ; => (4 1000)
(keta 600)                              ; => (3 100)
(keta 1)                                ; => (1 1)
(keta 0)                                ; => (1 1)
(keta -2469)                            ; => (4 1000)

[ Emacs Lisp ] [ download code ] ]