youz · January 20, 2012 08:39 · Jan 22, 2012 · Jan 20, 2012 · Jan 20, 2012 · Jan 20, 2012
diff --git a/xl-repl.l b/xl-repl.l
@@ -28,11 +28,11 @@
 
 
 (in-package :editor)
-(export '(start-repl))
+(export '(start-repl lisp-repl-mode))
 
 (in-package :lisp)
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  (export '(** *** // /// ++ +++))) ; ぶつかる人いそう
+  (export '(** *** // /// ++ +++)))
 
 (defpackage :repl
   (:use :lisp :editor))
@@ -126,6 +126,7 @@
       (unless (<= from p (1- to))
 	(delete-char-or-selection n)))))
 
+
 (defun get-input ()
   (multiple-value-bind (from to) (previous-prompt-point)
     (save-excursion
@@ -153,7 +154,7 @@
 	(with-output-to-buffer ((selected-buffer) (point-max))
 	  (setq forms (nreverse forms))
 	  (iflet com (and (keywordp (car forms)) (getf *commands* (car forms)))
-	       (apply com (cdr forms))
+		 (apply com (cdr forms))
 	    (dolist (expr (nreverse forms))
 	      (setq - expr)
 	      (let ((results (save-excursion
@@ -187,7 +188,34 @@
   (delete-region (point-min) (point-max))
   (show-prompt))
 
+(defmacro define-repl-command (name args &body body)
+  (let ((kw (intern (string name) :keyword)))
+    `(setf (getf *commands* ,kw)
+	   (lambda ,args ,@body))))
+(setf (get 'define-repl-command 'ed:lisp-indent-hook) 2)
+
+
+;;; repl command
+(define-repl-command require (name)
+  (let ((*load-path* (cons (default-directory) *load-path*)))
+    (eval-and-print (format nil "(require \"~A\")" name))))
+
+(define-repl-command load (name)
+  (let ((*load-path* (cons (default-directory) *load-path*)))
+    (eval-and-print (format nil "(load-library \"~A\")" name))))
 
+(define-repl-command dir (&optional wild)
+  (let* ((dir (default-directory))
+	 (files (directory dir :wild (or wild "*"))))
+    (format t "[~A]~%~{~A~%~}~%" dir files)))
+
+(define-repl-command cd (dir)
+  (let ((path (merge-pathnames dir (default-directory))))
+    (set-default-directory dir)
+    (format t "[~A]~%~%" path)))
+
+
+;;; major mode
 (defun ed::lisp-repl-mode ()
   (interactive)
   (lisp-mode)
@@ -204,6 +232,8 @@
   (setq *buffer-package* *startup-package*)
   (run-hooks '*startup-hook*))
 
+
+;;; launcher
 (defun ed::start-repl ()
   (interactive)
   (let ((buf (get-buffer-create *buffer-name*)))

diff --git a/xl-repl.l b/xl-repl.l
@@ -28,7 +28,7 @@
 
 
 (in-package :editor)
-(export '(lisp-repl-mode start-repl))
+(export '(start-repl))
 
 (in-package :lisp)
 (eval-when (:compile-toplevel :load-toplevel :execute)

diff --git a/xl-repl.l b/xl-repl.l
@@ -1,14 +1,39 @@
-
 ;;; -*- mode:lisp; package:repl -*-
 
+;; Copyright (c) 2012  Yousuke Ushiki
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining a copy
+;; of this software and associated documentation files (the "Software"), to deal
+;; in the Software without restriction, including without limitation the rights
+;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+;; copies of the Software, and to permit persons to whom the Software is
+;; furnished to do so, subject to the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+;; THE SOFTWARE.
+
+;; :usage
+;; (require "xl-repl")
+;; M-x start-repl
+
+(provide "xl-repl")
+
+
 (in-package :editor)
 (export '(lisp-repl-mode start-repl))
 
 (in-package :lisp)
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (export '(** *** // /// ++ +++))) ; ぶつかる人いそう
 
-
 (defpackage :repl
   (:use :lisp :editor))
 

diff --git a/xl-repl.l b/xl-repl.l
@@ -1,8 +1,14 @@
+
 ;;; -*- mode:lisp; package:repl -*-
 
 (in-package :editor)
 (export '(lisp-repl-mode start-repl))
 
+(in-package :lisp)
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (export '(** *** // /// ++ +++))) ; ぶつかる人いそう
+
+
 (defpackage :repl
   (:use :lisp :editor))
 
@@ -14,23 +20,21 @@
 	  *error-style*
 	  *startup-hook*))
 
-(defvar *buffer-name* "*xlrepl*")
-(defvar *prompt* "xl-%p>")
+(defvar *buffer-name* "*xl-repl*")
+(defvar *prompt* "%p>")
 (defvar *prompt-style* '(:foreground 12 :bold t))
 (defvar *error-style* '(:foreground 1))
 (defvar *startup-hook* nil)
 (defvar *startup-package* "user")
 (defvar *commands* nil)
 
-(defparameter *keymap* nil)
-(unless #0=*keymap*
-  (setq #0# (make-sparse-keymap))
-  (define-key #0# #\RET 'newline-or-eval-input)
-  (define-key #0# '(#\C-c #\C-l) 'clear-buffer)
-  (define-key #0# #\C-h 'repl-backward-delete-char)
-  (define-key #0# #\Delete 'repl-delete-char-or-selection)
-  (define-key #0# #\C-d 'repl-delete-char-or-selection)
-  (define-key #0# #\C-l 'clear-repl))
+(defparameter *keymap* (copy-keymap ed::*lisp-mode-map*))
+(define-key *keymap* #\RET 'newline-or-eval-input)
+(define-key *keymap* '(#\C-c #\C-l) 'clear-buffer)
+(define-key *keymap* #\C-h 'repl-backward-delete-char)
+(define-key *keymap* #\Delete 'repl-delete-char-or-selection)
+(define-key *keymap* #\C-d 'repl-delete-char-or-selection)
+(define-key *keymap* #\C-l 'clear-repl)
 
 (defvar-local *input-history* nil)
 
@@ -126,9 +130,13 @@
 	  (iflet com (and (keywordp (car forms)) (getf *commands* (car forms)))
 	       (apply com (cdr forms))
 	    (dolist (expr (nreverse forms))
+	      (setq - expr)
 	      (let ((results (save-excursion
 			       (multiple-value-list (eval expr)))))
-		(setq *buffer-package* (package-name *package*))
+		(setq *** ** ** * * (car results)
+		      +++ ++ ++ + + expr
+		      /// // // / / (if (cdr results) results *)
+		      *buffer-package* (package-name *package*))
 		(format t "~{~S~^ ;~%~}~%~%" results))))))
     (error (c)
       (let ((start (point-max)))
@@ -166,6 +174,8 @@
     (make-local-variable 'auto-save)
     (setq need-not-save t
 	  auto-save nil))
+  (mapc #'make-local-variable
+	'(* ** *** / // /// + ++ +++ -))
   (setq *buffer-package* *startup-package*)
   (run-hooks '*startup-hook*))
 
@@ -177,4 +187,4 @@
       (return-from ed::start-repl))
     (ed::lisp-repl-mode)
     (insert ";;; xyzzy lisp REPL\n")
-    (show-prompt)))
+    (show-prompt)))
diff --git a/.xyzzy b/.xyzzy
@@ -1,6 +1,15 @@
+(require "ac-mode-lisp")
 (require "ldoc2")
+(require "paren")
+
 (require "xl-repl")
+(push 'lisp-repl-mode ed::*ldoc-activated-mode-list*)
+(push 'lisp-repl-mode ed::*ac-mode-lisp-mode*)
 
-(add-hook 'repl:*startup-hook*
-	  '(lambda ()
-	    (pushnew 'lisp-repl-mode *ldoc-activated-mode-list*)))
+;; *startup-hook*の前に*lisp-mode-hook*も実行するので
+;; 被ってる物は不要
+(add-hook repl:*startup-hook*
+	  #'(lambda ()
+	      (ac-mode-on)
+	      (turn-on-ldoc)
+	      (toggle-paren t)))
diff --git a/xl-repl.l b/xl-repl.l
@@ -171,10 +171,10 @@
 
 (defun ed::start-repl ()
   (interactive)
-  (let ((buf (get-buffer-create "*xlrepl*")))
+  (let ((buf (get-buffer-create *buffer-name*)))
     (set-buffer buf)
     (when (eq buffer-mode 'ed::lisp-repl-mode)
       (return-from ed::start-repl))
     (ed::lisp-repl-mode)
     (insert ";;; xyzzy lisp REPL\n")
-    (show-prompt)))
+    (show-prompt)))
diff --git a/.xyzzy b/.xyzzy
@@ -3,4 +3,4 @@
 
 (add-hook 'repl:*startup-hook*
 	  '(lambda ()
-	    (pushnew 'ed:lisp-repl-mode *ldoc-activated-mode-list*)))
+	    (pushnew 'lisp-repl-mode *ldoc-activated-mode-list*)))
diff --git a/.xyzzy b/.xyzzy
@@ -0,0 +1,6 @@
+(require "ldoc2")
+(require "xl-repl")
+
+(add-hook 'repl:*startup-hook*
+	  '(lambda ()
+	    (pushnew 'ed:lisp-repl-mode *ldoc-activated-mode-list*)))
diff --git a/xl-repl.l b/xl-repl.l
@@ -19,6 +19,7 @@
 (defvar *prompt-style* '(:foreground 12 :bold t))
 (defvar *error-style* '(:foreground 1))
 (defvar *startup-hook* nil)
+(defvar *startup-package* "user")
 (defvar *commands* nil)
 
 (defparameter *keymap* nil)
@@ -31,8 +32,6 @@
   (define-key #0# #\C-d 'repl-delete-char-or-selection)
   (define-key #0# #\C-l 'clear-repl))
 
-
-(defvar-local *current-package* (find-package "user"))
 (defvar-local *input-history* nil)
 
 (defmacro iflet (var test then else)
@@ -57,7 +56,7 @@
 	     (let ((post (read-char is nil nil)))
 	       (if (null post) c
 		 (case (char-downcase post)
-		   (#\p *current-package*)
+		   (#\p *buffer-package*)
 		   (#\d (default-directory))
 		   (#\u (user-name))
 		   (#\m (machine-name))
@@ -115,7 +114,8 @@
 
 (defun eval-and-print (input)
   (handler-case
-      (let ((*package* (find-package *current-package*))
+      (let ((*package* (or (find-package *buffer-package*)
+			   (find-package "user")))
 	    (forms nil))
 	(with-input-from-string (is input)
 	  (do ((s #0=(read is nil #1='#:eos) #0#))
@@ -128,13 +128,14 @@
 	    (dolist (expr (nreverse forms))
 	      (let ((results (save-excursion
 			       (multiple-value-list (eval expr)))))
-		(setq *current-package* (package-name *package*))
+		(setq *buffer-package* (package-name *package*))
 		(format t "~{~S~^ ;~%~}~%~%" results))))))
     (error (c)
       (let ((start (point-max)))
 	(with-output-to-buffer ((selected-buffer) start)
 	  (format t "~A~%~%" (si:*condition-string c)))
-	(apply #'set-text-attribute start (- (point-max) 2) 'error *error-style*)))))
+	(apply #'set-text-attribute start (- (point-max) 2) 'error
+	       *error-style*)))))
 
 (defun newline-or-eval-input ()
   (interactive)
@@ -165,6 +166,7 @@
     (make-local-variable 'auto-save)
     (setq need-not-save t
 	  auto-save nil))
+  (setq *buffer-package* *startup-package*)
   (run-hooks '*startup-hook*))
 
 (defun ed::start-repl ()
@@ -176,4 +178,3 @@
     (ed::lisp-repl-mode)
     (insert ";;; xyzzy lisp REPL\n")
     (show-prompt)))
-
diff --git a/xl-repl.l b/xl-repl.l
@@ -0,0 +1,179 @@
+;;; -*- mode:lisp; package:repl -*-
+
+(in-package :editor)
+(export '(lisp-repl-mode start-repl))
+
+(defpackage :repl
+  (:use :lisp :editor))
+
+(in-package :repl)
+(export '(*buffer-name*
+	  *keymap*
+	  *prompt*
+	  *prompt-style*
+	  *error-style*
+	  *startup-hook*))
+
+(defvar *buffer-name* "*xlrepl*")
+(defvar *prompt* "xl-%p>")
+(defvar *prompt-style* '(:foreground 12 :bold t))
+(defvar *error-style* '(:foreground 1))
+(defvar *startup-hook* nil)
+(defvar *commands* nil)
+
+(defparameter *keymap* nil)
+(unless #0=*keymap*
+  (setq #0# (make-sparse-keymap))
+  (define-key #0# #\RET 'newline-or-eval-input)
+  (define-key #0# '(#\C-c #\C-l) 'clear-buffer)
+  (define-key #0# #\C-h 'repl-backward-delete-char)
+  (define-key #0# #\Delete 'repl-delete-char-or-selection)
+  (define-key #0# #\C-d 'repl-delete-char-or-selection)
+  (define-key #0# #\C-l 'clear-repl))
+
+
+(defvar-local *current-package* (find-package "user"))
+(defvar-local *input-history* nil)
+
+(defmacro iflet (var test then else)
+  `(let ((,var ,test)) (if ,var ,then ,else)))
+
+(defmacro whenlet (var test &body body)
+  `(let ((,var ,test)) (when ,var ,@body)))
+
+(defmacro whilet (var test &body body)
+  `(do ((,var ,test ,test)) ((not ,var) nil) ,@body))
+
+(defmacro nth-value (n form)
+  `(nth ,n (multiple-value-list ,form)))
+
+
+(defun format-prompt ()
+  (with-output-to-string (os)
+    (with-input-from-string (is *prompt*)
+      (whilet c (read-char is nil nil)
+	(princ
+         (if (char= c #\%)
+	     (let ((post (read-char is nil nil)))
+	       (if (null post) c
+		 (case (char-downcase post)
+		   (#\p *current-package*)
+		   (#\d (default-directory))
+		   (#\u (user-name))
+		   (#\m (machine-name))
+		   (#\o (os-platform))
+		   (#\v (software-version))
+		   (#\n (software-type))
+		   (t post))))
+	   c) os)))))
+
+(defun show-prompt (&optional default)
+  (goto-char (point-max))
+  (unless (bolp) (insert "\n") (forward-char))
+  (let ((p (point)))
+    (insert (format-prompt) #\SPC)
+    (apply #'set-text-attribute p (point-max) 'prompt *prompt-style*)
+    #0=(goto-char (point-max))
+    (when default (insert default))
+    #0#))
+
+(defmacro previous-prompt-point ()
+  `(find-text-attribute 'prompt :end (point) :from-end t))
+
+(defmacro next-prompt-point ()
+  `(find-text-attribute 'prompt :start (point)))
+
+(defun repl-backward-delete-char (&optional (n 1))
+  (interactive "p")
+  (let ((p (point)))
+    (multiple-value-bind (from to) (previous-prompt-point)
+      (if (<= from p (1- to))
+	  (goto-char to)
+	(backward-delete-char-untabify-or-selection (min n (- p to)))))))
+
+(defun repl-delete-char-or-selection (&optional (n 1))
+  (interactive "p")
+  (let ((p (point)))
+    (multiple-value-bind (from to) (previous-prompt-point)
+      (unless (<= from p (1- to))
+	(delete-char-or-selection n)))))
+
+(defun get-input ()
+  (multiple-value-bind (from to) (previous-prompt-point)
+    (save-excursion
+      (goto-eol)
+      (buffer-substring to (point)))))
+
+(defun input-complete-p ()
+  (save-excursion
+    (let ((from (nth-value 1 (previous-prompt-point))))
+      (goto-eol)
+      (while (and (>= (point) from)
+		  (ignore-errors (backward-sexp)))
+	(skip-chars-backward " \t\n"))
+      (<= (point) from))))
+
+(defun eval-and-print (input)
+  (handler-case
+      (let ((*package* (find-package *current-package*))
+	    (forms nil))
+	(with-input-from-string (is input)
+	  (do ((s #0=(read is nil #1='#:eos) #0#))
+	      ((eq s #1#))
+	    (push s forms)))
+	(with-output-to-buffer ((selected-buffer) (point-max))
+	  (setq forms (nreverse forms))
+	  (iflet com (and (keywordp (car forms)) (getf *commands* (car forms)))
+	       (apply com (cdr forms))
+	    (dolist (expr (nreverse forms))
+	      (let ((results (save-excursion
+			       (multiple-value-list (eval expr)))))
+		(setq *current-package* (package-name *package*))
+		(format t "~{~S~^ ;~%~}~%~%" results))))))
+    (error (c)
+      (let ((start (point-max)))
+	(with-output-to-buffer ((selected-buffer) start)
+	  (format t "~A~%~%" (si:*condition-string c)))
+	(apply #'set-text-attribute start (- (point-max) 2) 'error *error-style*)))))
+
+(defun newline-or-eval-input ()
+  (interactive)
+  (if (input-complete-p)
+      (let ((input (get-input)))
+	(if (next-prompt-point)
+	    (show-prompt input)
+	  (goto-eol))
+	(newline)
+	(eval-and-print input)
+	(show-prompt))
+    (lisp-newline-and-indent)))
+
+(defun clear-repl ()
+  (interactive)
+  (delete-region (point-min) (point-max))
+  (show-prompt))
+
+
+(defun ed::lisp-repl-mode ()
+  (interactive)
+  (lisp-mode)
+  (setq buffer-mode 'ed::lisp-repl-mode
+	mode-name "REPL")
+  (use-keymap *keymap*)
+  (unless (file-visited-p)
+    (make-local-variable 'need-not-save)
+    (make-local-variable 'auto-save)
+    (setq need-not-save t
+	  auto-save nil))
+  (run-hooks '*startup-hook*))
+
+(defun ed::start-repl ()
+  (interactive)
+  (let ((buf (get-buffer-create "*xlrepl*")))
+    (set-buffer buf)
+    (when (eq buffer-mode 'ed::lisp-repl-mode)
+      (return-from ed::start-repl))
+    (ed::lisp-repl-mode)
+    (insert ";;; xyzzy lisp REPL\n")
+    (show-prompt)))
+