[beirc-cvs] CVS beirc
afuchs
afuchs at common-lisp.net
Mon Feb 6 21:21:02 UTC 2006
Update of /project/beirc/cvsroot/beirc
In directory common-lisp:/tmp/cvs-serv6629
Modified Files:
message-display.lisp
Log Message:
fix indentation of formatting-message
--- /project/beirc/cvsroot/beirc/message-display.lisp 2006/02/05 21:50:51 1.28
+++ /project/beirc/cvsroot/beirc/message-display.lisp 2006/02/06 21:21:02 1.29
@@ -74,6 +74,8 @@
(lambda ()
, at message-body-column-body)))
+;;; for optimal indentation, use (put 'formatting-message 'common-lisp-indent-function 1)
+
(defun strip-punctuation (word)
(if (= (length word) 0)
(values word "")
@@ -134,10 +136,10 @@
(*standard-output*
(if (message-from-focused-nick-p message receiver) :bold :roman))
(formatting-message (t message receiver)
- ((write-string start-string *standard-output*)
- (present (irc:source message) 'unhighlighted-nickname)
- (write-string end-string *standard-output*))
- ((format-message* (irc:trailing-argument message))))))))
+ ((write-string start-string *standard-output*)
+ (present (irc:source message) 'unhighlighted-nickname)
+ (write-string end-string *standard-output*))
+ ((format-message* (irc:trailing-argument message))))))))
(defmethod print-message ((message irc:IRC-PRIVMSG-MESSAGE) receiver)
(print-privmsg-like-message message receiver "<" ">"))
@@ -149,19 +151,19 @@
(let ((source (cl-irc:source message))
(matter (trailing-argument* message)))
(formatting-message (t message receiver)
- ((format t "*"))
- ((present source 'unhighlighted-nickname)
- (format t " ")
- (format-message* matter :start-length (+ 2 (length source)))))))
+ ((format t "*"))
+ ((present source 'unhighlighted-nickname)
+ (format t " ")
+ (format-message* matter :start-length (+ 2 (length source)))))))
(defmethod print-message ((message irc:ctcp-version-message) receiver)
(let ((source (cl-irc:source message)))
(formatting-message (t message receiver)
- ((format t " "))
- ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small)
- (present source 'unhighlighted-nickname)
- (format t " ")
- (format-message* "asked for your IRC client version" :start-length (+ 2 (length source))))))))
+ ((format t " "))
+ ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small)
+ (present source 'unhighlighted-nickname)
+ (format t " ")
+ (format-message* "asked for your IRC client version" :start-length (+ 2 (length source))))))))
;;; server messages
@@ -171,13 +173,13 @@
collect
`(defmethod print-message ((message ,message-type) receiver)
(formatting-message (t message receiver)
- ((format t "~A" (irc:source message)))
- ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small)
- (format-message*
- (format nil "~@[~A: ~]~{~A ~}~A"
- ,message-name
- (cdr (irc:arguments message))
- (irc:trailing-argument message)))))))))))
+ ((format t "~A" (irc:source message)))
+ ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small)
+ (format-message*
+ (format nil "~@[~A: ~]~{~A ~}~A"
+ ,message-name
+ (cdr (irc:arguments message))
+ (irc:trailing-argument message)))))))))))
(define-server-message-printer ((irc:irc-rpl_motd-message . "MODT")
(irc:irc-rpl_motdstart-message . "MOTD")
(irc:irc-rpl_isupport-message)
@@ -203,35 +205,35 @@
(defmethod print-message ((message irc:irc-rpl_isupport-message) receiver)
(formatting-message (t message receiver)
- ((format t "~A" (irc:source message)))
- ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small)
- (format t "MOTD: ~A" (irc:trailing-argument message))))))
+ ((format t "~A" (irc:source message)))
+ ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small)
+ (format t "MOTD: ~A" (irc:trailing-argument message))))))
(defmethod print-message ((message irc:irc-rpl_motd-message) receiver)
(formatting-message (t message receiver)
- ((format t "~A" (irc:source message)))
- ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small)
- (format t "MOTD: ~A" (irc:trailing-argument message))))))
+ ((format t "~A" (irc:source message)))
+ ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small)
+ (format t "MOTD: ~A" (irc:trailing-argument message))))))
(defmethod print-message (message receiver)
(formatting-message (t message receiver)
- ((format t "!!! ~A" (irc:source message)))
- ((with-drawing-options (*standard-output* :ink +red+ :text-size :small)
- (format t "~A ~A :~A" (irc:command message)
- (irc:arguments message)
- (irc:trailing-argument message))))))
+ ((format t "!!! ~A" (irc:source message)))
+ ((with-drawing-options (*standard-output* :ink +red+ :text-size :small)
+ (format t "~A ~A :~A" (irc:command message)
+ (irc:arguments message)
+ (irc:trailing-argument message))))))
;;; user-related messages
(defmethod print-message ((message irc:irc-quit-message) receiver)
(formatting-message (t message receiver)
- ((format t " "))
- ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small)
- (format t "Quit: ")
- (present (irc:source message) 'nickname)
- (format t ": ")
- (format-message* (irc:trailing-argument message)
- :start-length (+ 8 (length (irc:source message))))))))
+ ((format t " "))
+ ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small)
+ (format t "Quit: ")
+ (present (irc:source message) 'nickname)
+ (format t ": ")
+ (format-message* (irc:trailing-argument message)
+ :start-length (+ 8 (length (irc:source message))))))))
(defun present-as-hostmask (user host)
(write-char #\()
@@ -241,91 +243,91 @@
(defmethod print-message ((message irc:irc-nick-message) receiver)
(formatting-message (t message receiver)
- ((format t " "))
- ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small)
- (format t "Nick change: ")
- (present (irc:source message) 'nickname)
- (write-string " ")
- (present-as-hostmask (irc:user message) (irc:host message))
- (write-string " is now known as ")
- (present (irc:trailing-argument message) 'nickname)))))
+ ((format t " "))
+ ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small)
+ (format t "Nick change: ")
+ (present (irc:source message) 'nickname)
+ (write-string " ")
+ (present-as-hostmask (irc:user message) (irc:host message))
+ (write-string " is now known as ")
+ (present (irc:trailing-argument message) 'nickname)))))
(defmethod print-message ((message irc:irc-rpl_whoisuser-message) receiver)
(formatting-message (t message receiver)
- ((format t " "))
- ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small)
- (destructuring-bind (me nickname user host &rest args) (irc:arguments message)
- (declare (ignore me args))
- (present nickname 'nickname)
- (format t " is ")
- (present-as-hostmask user host)
- (format t " (~A)" (irc:trailing-argument message)))))))
+ ((format t " "))
+ ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small)
+ (destructuring-bind (me nickname user host &rest args) (irc:arguments message)
+ (declare (ignore me args))
+ (present nickname 'nickname)
+ (format t " is ")
+ (present-as-hostmask user host)
+ (format t " (~A)" (irc:trailing-argument message)))))))
(defmethod print-message ((message irc:irc-rpl_whoischannels-message) receiver)
(formatting-message (t message receiver)
- ((format t " "))
- ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small)
- (present (second (irc:arguments message)) 'nickname)
- (format-message* (format nil " is in ~A" (irc:trailing-argument message))
- :start-length (length (second (irc:arguments message))))))))
+ ((format t " "))
+ ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small)
+ (present (second (irc:arguments message)) 'nickname)
+ (format-message* (format nil " is in ~A" (irc:trailing-argument message))
+ :start-length (length (second (irc:arguments message))))))))
(defmethod print-message ((message irc:irc-rpl_whoisserver-message) receiver)
(formatting-message (t message receiver)
- ((format t " "))
- ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small)
- (present (second (irc:arguments message)) 'nickname)
- (format-message* (format nil " is on ~A: ~A"
- (third (irc:arguments message))
- (irc:trailing-argument message))
- :start-length (length (second (irc:arguments message))))))))
+ ((format t " "))
+ ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small)
+ (present (second (irc:arguments message)) 'nickname)
+ (format-message* (format nil " is on ~A: ~A"
+ (third (irc:arguments message))
+ (irc:trailing-argument message))
+ :start-length (length (second (irc:arguments message))))))))
(defmethod print-message ((message irc:irc-rpl_away-message) receiver)
(formatting-message (t message receiver)
- ((format t " "))
- ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small)
- (present (second (irc:arguments message)) 'nickname)
- (format-message* (format nil " is away: ~A" (irc:trailing-argument message))
- :start-length (length (second (irc:arguments message))))))))
+ ((format t " "))
+ ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small)
+ (present (second (irc:arguments message)) 'nickname)
+ (format-message* (format nil " is away: ~A" (irc:trailing-argument message))
+ :start-length (length (second (irc:arguments message))))))))
(defmethod print-message ((message irc:irc-rpl_whoisidentified-message) receiver)
(formatting-message (t message receiver)
- ((format t " "))
- ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small)
- (present (second (irc:arguments message)) 'nickname)
- (write-char #\Space)
- (format-message* (irc:trailing-argument message)
- :start-length (length (second (irc:arguments message))))))))
+ ((format t " "))
+ ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small)
+ (present (second (irc:arguments message)) 'nickname)
+ (write-char #\Space)
+ (format-message* (irc:trailing-argument message)
+ :start-length (length (second (irc:arguments message))))))))
;;; channel management messages
(defmethod print-message ((message irc:irc-err_nosuchnick-message) receiver)
(formatting-message (t message receiver)
- ((format t " "))
- ((with-drawing-options (*standard-output* :ink +red3+ :text-size :small)
- (let* ((target (second (irc:arguments message)))
- (close-p (string= (title receiver)
- (irc:normalize-nickname (current-connection *application-frame*)
- target))))
- (format-message* (format nil "No such nick or channel \"~A\". ~@[To close this tab, click ~]"
- target close-p))
- (when close-p
- (present `(com-close ,receiver) 'command)))))))
+ ((format t " "))
+ ((with-drawing-options (*standard-output* :ink +red3+ :text-size :small)
+ (let* ((target (second (irc:arguments message)))
+ (close-p (string= (title receiver)
+ (irc:normalize-nickname (current-connection *application-frame*)
+ target))))
+ (format-message* (format nil "No such nick or channel \"~A\". ~@[To close this tab, click ~]"
+ target close-p))
+ (when close-p
+ (present `(com-close ,receiver) 'command)))))))
(defmethod print-message ((message irc:irc-err_chanoprivsneeded-message) receiver)
(formatting-message (t message receiver)
- ((format t " "))
- ((with-drawing-options (*standard-output* :ink +red3+ :text-size :small)
- (format-message* (format nil "Not permitted: ~A" (irc:trailing-argument message)))))))
+ ((format t " "))
+ ((with-drawing-options (*standard-output* :ink +red3+ :text-size :small)
+ (format-message* (format nil "Not permitted: ~A" (irc:trailing-argument message)))))))
(defun print-topic (receiver message sender channel topic)
(formatting-message (t message receiver)
- ((format t " "))
- ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small)
- (if (null sender)
- (format-message* (format nil "Topic for ~A: ~A" channel topic))
- (progn
- (present sender 'nickname)
- (format-message* (format nil " set the topic for ~A to ~A" channel topic))))))))
+ ((format t " "))
+ ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small)
+ (if (null sender)
+ (format-message* (format nil "Topic for ~A: ~A" channel topic))
+ (progn
+ (present sender 'nickname)
+ (format-message* (format nil " set the topic for ~A to ~A" channel topic))))))))
(defmethod print-message ((message irc:irc-topic-message) receiver)
(print-topic receiver message (irc:source message)
@@ -337,49 +339,49 @@
(defmethod print-message ((message irc:irc-rpl_topicwhotime-message) receiver)
(formatting-message (t message receiver)
- ((format t " "))
- ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small)
- (destructuring-bind (me channel who time) (irc:arguments message)
- (declare (ignore me
- time ; TODO: no date display for now.
- ))
- (format-message* (format nil "~A topic set by ~A" channel who)))))))
+ ((format t " "))
+ ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small)
+ (destructuring-bind (me channel who time) (irc:arguments message)
+ (declare (ignore me
+ time ; TODO: no date display for now.
+ ))
+ (format-message* (format nil "~A topic set by ~A" channel who)))))))
(defmethod print-message ((message irc:irc-rpl_namreply-message) receiver)
(formatting-message (t message receiver)
- ((format t " "))
- ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small)
- (format-message* (format nil "~A Names: ~A" (third (irc:arguments message))
- (irc:trailing-argument message)))))))
+ ((format t " "))
+ ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small)
+ (format-message* (format nil "~A Names: ~A" (third (irc:arguments message))
+ (irc:trailing-argument message)))))))
(defmethod print-message ((message irc:irc-part-message) receiver)
(formatting-message (t message receiver)
- ((format t " "))
- ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small)
- (format t "Part: ")
- (present (irc:source message) 'nickname)
- (format-message* (format nil " left ~A: ~A" (first (irc:arguments message))
- (irc:trailing-argument message)))))))
+ ((format t " "))
+ ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small)
+ (format t "Part: ")
+ (present (irc:source message) 'nickname)
+ (format-message* (format nil " left ~A: ~A" (first (irc:arguments message))
+ (irc:trailing-argument message)))))))
(defmethod print-message ((message irc:irc-join-message) receiver)
(formatting-message (t message receiver)
- ((format t " "))
- ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small)
- (format t "Join: ")
- (present (irc:source message) 'nickname)
- (write-char #\Space)
- (present-as-hostmask (irc:user message) (irc:host message))))))
+ ((format t " "))
+ ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small)
+ (format t "Join: ")
+ (present (irc:source message) 'nickname)
+ (write-char #\Space)
+ (present-as-hostmask (irc:user message) (irc:host message))))))
(defmethod print-message ((message irc:irc-kick-message) receiver)
(formatting-message (t message receiver)
- ((format t " "))
- ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small)
- (present (irc:source message) 'nickname)
- (write-string " kicked ")
- (present (second (irc:arguments message)) 'nickname)
- (format-message* (format nil ": ~A" (irc:trailing-argument message))
- :start-length (+ 9 (length (second (irc:arguments message)))
- (length (irc:source message))))))))
+ ((format t " "))
+ ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small)
+ (present (irc:source message) 'nickname)
+ (write-string " kicked ")
+ (present (second (irc:arguments message)) 'nickname)
+ (format-message* (format nil ": ~A" (irc:trailing-argument message))
+ :start-length (+ 9 (length (second (irc:arguments message)))
+ (length (irc:source message))))))))
;;; XXX: uses unexported symbols from cl-irc, but I think their
;;; unexportedness is accidental.
@@ -412,11 +414,11 @@
(defmethod print-message ((message irc:irc-mode-message) receiver)
(case (length (irc:arguments message))
(1 (formatting-message (t message receiver)
- ((format t " "))
- ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small)
- (format-message* (format nil "~A set mode ~A ~A" (irc:source message)
- (irc:trailing-argument message)
- (first (irc:arguments message))))))))
+ ((format t " "))
+ ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small)
+ (format-message* (format nil "~A set mode ~A ~A" (irc:source message)
+ (irc:trailing-argument message)
+ (first (irc:arguments message))))))))
(t
(destructuring-bind (target &rest args) (irc:arguments message)
(let* ((connection (current-connection *application-frame*))
@@ -425,15 +427,15 @@
(mode-changes (irc:parse-mode-arguments connection target args
:server-p (irc:user connection))))
(formatting-message (t message receiver)
- ((format t " "))
- ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small)
- (present (irc:source message) 'nickname)
- (write-string " changes channel mode: ")
- (loop for (change . rest) on mode-changes
- do (destructuring-bind (op mode &optional arg) change
- (print-mode-change target op mode arg))
- if (not (null rest))
- do (write-string ", "))))))))))
+ ((format t " "))
+ ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small)
+ (present (irc:source message) 'nickname)
+ (write-string " changes channel mode: ")
+ (loop for (change . rest) on mode-changes
+ do (destructuring-bind (op mode &optional arg) change
+ (print-mode-change target op mode arg))
+ if (not (null rest))
[27 lines skipped]
More information about the Beirc-cvs
mailing list