(pushnew #P"~/Public/Projects/" ql:*local-project-directories*)
(ql:register-local-projects)
(ql:quickload :cl-irc)
(ql:quickload :linedit)
(require "PTY")
(defpackage #:lirc
(:use #:common-lisp #:irc #:linedit))
(in-package #:lirc)
(defparameter freenode (connect :nickname "ldb"
:server "irc.freenode.org"))
(join freenode "#linuxba")
(defun cmd-loop ()
(loop
(exec (read-char))))
(defvar *current-connection*)
(defvar *current-channel*)
(defparameter *command-table* (make-hash-table :test 'equal))
(defparameter *message-process* (ccl:make-process 'message-proc))
(defmacro defcommand (char function)
`(setf (gethash ,char *command-table*) ,function))
(defun prompt (p)
(let ((l (linedit:linedit :prompt (format nil ":~A > " p))))
(if (string= l "")
(throw 'abort nil)
l)))
(defcommand #\q
(lambda ()(quit *current-connection*)
(ccl:quit 0)))
#|
(defcommand #\e
(lambda ()
(ac (prompt "channel")))
|#
(defun msg ()
(privmsg *current-connection* *current-channel* (prompt "ldb")))
(defun exec (c)
(ccl:process-suspend *message-process*)
(catch 'abort
(let ((f (gethash c *command-table*)))
(funcall (or f 'msg))))
(ccl:process-resume *message-process*))
(ccl::disable-tty-local-modes 0 #$ICANON)
(format t "Hello
press q to quit.
")
(setf *current-connection* freenode)
(setf *current-channel* "#linuxba")
(ccl:process-preset *message-process* #'read-message-loop *current-connection*)
(ccl:process-enable *message-process*)
(cmd-loop)
1 个赞