iii/cli/iii-cli.lisp

;;;; cli.lisp

(in-package #:iii/cli)

(defmacro with-temporary-hook ((connection class hook) &body body)
  (let ((conn (gensym))
        (cl (gensym))
        (h (gensym)))
    `(let ((,conn ,connection)
           (,cl ,class)
           (,h ,hook))
       (unwind-protect
         (progn
           (irc:add-hook ,conn ,cl ,h)
           ,@body)
         (irc:remove-hook ,conn ,cl ,h)))))

(defmacro with-temporary-hooks ((connection (&rest hooks)) &body body)
  (setf hooks (remove-if-not #'second hooks))
  (let ((conn (gensym)))
    (if (null hooks)
        `(progn ,@body)
        `(let ((,conn ,connection))
           (with-temporary-hook (,conn ,(caar hooks) ,(cadar hooks))
             (with-temporary-hooks (,conn (,@(rest hooks))) ,@body)))))) 

(defun write-privmsg (message &optional (stream *standard-output*))
  (multiple-value-bind (s m h) (decode-universal-time (irc:received-time message))
    (declare (ignore s))
    (format stream "~2,'0D:~2,'0D <~A> ~A" h m (irc:source message) (second (irc:arguments message)))))

(defun privmsg-watcher (channel &optional (stream *standard-output*))
  (lambda (message)
    (when (string= (first (irc:arguments message)) channel)
      (write-privmsg message stream))))

(defun hhmm (time &optional stream)
  (multiple-value-bind (s m h) (decode-universal-time time)
    (declare (ignore s))
    (format stream "~2,'0D:~2,'0D" h m)))

(defun format-part (message &optional stream)
  (format stream "~A -!- ~A abiit~@[ (~A)~]" (hhmm (irc:received-time message) stream) (irc:source message) (second (irc:arguments message))))

(defun format-quit (message &optional stream)
  (format stream "~A -!- ~A omnino discessit~@[ (~A)~]" (hhmm (irc:received-time message) stream) (irc:source message) (first (irc:arguments message))))

(defun format-join (message &optional stream)
  (format stream "~A -!- ~A advenit" (hhmm (irc:received-time message) stream) (irc:source message)))

(defun ircread-main (argv)
  (let ((channel (first argv))
        (box (safe-queue:make-mailbox)))
    (format t "Praesunt:~%~{    ~A~%~}" (sort (loop for user being the hash-values of (irc:users (gethash channel (irc:channels iii:*connection*)))
                                                collect (irc:nickname user))
                                          #'string-lessp))
    (finish-output)
    (with-temporary-hooks (iii:*connection* (('irc:irc-privmsg-message (lambda (message)
                                                                     (when (string= (first (irc:arguments message)) channel)
                                                                       (safe-queue:mailbox-send-message box (write-privmsg message nil)))))
                                         ('irc:irc-part-message (lambda (message)
                                                                  (when (string= (first (irc:arguments message)) channel)
                                                                    (safe-queue:mailbox-send-message box (format-part message)))))
                                         ('irc:irc-quit-message (lambda (message)
                                                                    (when (gethash (irc:normalize-nickname iii:*connection* (irc:source message)) (irc:users (gethash channel (irc:channels iii:*connection*))))
                                                                      (safe-queue:mailbox-send-message box (format-quit message)))))
                                         ('irc:irc-join-message (lambda (message)
                                                                  (when (string= (first (irc:arguments message)) channel)
                                                                    (safe-queue:mailbox-send-message box (format-join message)))))))
      (loop
        (let ((line (safe-queue:mailbox-receive-message box :timeout 5)))
          (when line
            (write-line line)
            (finish-output))
          ;; an atrocious hack instead of (non-existent) pinging
          ;; there was without ignore-errors
          (unless (ignore-errors (lserver-impl::ping))
            (return)))))))


(defun ircmsg-main (argv)
  (let ((channel (first argv))
        (text (read-line)))
    (irc:privmsg iii:*connection* channel text)))