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 () ,@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]