Index: application.lisp =================================================================== RCS file: /project/beirc/cvsroot/beirc/application.lisp,v retrieving revision 1.82 diff -u -r1.82 application.lisp --- application.lisp 9 May 2006 17:08:25 -0000 1.82 +++ application.lisp 29 May 2006 13:19:15 -0000 @@ -84,7 +84,9 @@ (:panes (io :interactor - :height 72) + :height 72 + :background *default-background-ink+ + :foreground *default-foreground-ink+) (pointer-doc :pointer-documentation) (status-bar @@ -108,6 +110,8 @@ ;; would allow more freedom to resize the tab-pane ;; (query). [2006/04/05:rpg] :min-height 100 + :background *default-background-ink+ + :foreground *default-foreground-ink+ :incremental-redisplay t))) (:geometry :width 800 :height 600) (:top-level (clim:default-frame-top-level :prompt 'beirc-prompt)) @@ -1134,4 +1138,4 @@ (defmethod frame-exit :after ((frame beirc)) "Shut off the sound server process, if necessary." - (stop-sound-server)) \ No newline at end of file + (stop-sound-server)) Index: message-display.lisp =================================================================== RCS file: /project/beirc/cvsroot/beirc/message-display.lisp,v retrieving revision 1.49 diff -u -r1.49 message-display.lisp --- message-display.lisp 9 May 2006 17:10:00 -0000 1.49 +++ message-display.lisp 29 May 2006 13:19:15 -0000 @@ -88,7 +88,7 @@ (output-timestamp-column (position) (when (eql position *timestamp-column-orientation*) (formatting-cell (stream* :align-x :left) - (with-drawing-options (stream* :ink +gray+) + (with-drawing-options (stream* :ink *timestamp-ink*) (if (and *meme-log-bot-nick* (irc:find-user (connection receiver) *meme-log-bot-nick*) (member (title receiver) @@ -111,7 +111,7 @@ (formatting-row (stream*) (output-timestamp-column :left) (formatting-cell (stream* :align-x :right :min-width '(3 :character)) - (with-drawing-options (stream* :ink +dark-red+) + (with-drawing-options (stream* :ink *preamble-ink*) (funcall preamble-writer))) (formatting-cell (stream* :align-x :left :min-width `(,*default-fill-column* :character)) @@ -200,8 +200,8 @@ (cond (*filter-colors* nil) ((equal (car foreground) 'normal) - (setf foreground-color +black+ - background-color +white+)) + (setf foreground-color *default-foreground-ink+ + background-color *default-background-ink+)) ((equal (car foreground) :ink) (setf foreground-color @@ -233,7 +233,7 @@ (with-bounding-rectangle* (left top right bottom) record (unless (equal left right) - (unless (equal ,background +white+) + (unless (equal ,background *default-background-ink+) (with-identity-transformation (medium) (draw-rectangle* *standard-output* left @@ -302,8 +302,8 @@ (with-drawing-options (*standard-output* :ink (if (string-equal "localhost" (irc:host message)) - +blue4+ - +black+)) + *privmsg-self-ink* + *privmsg-default-ink*)) (unless (message-from-ignored-nick-p message receiver) (with-text-face (*standard-output* @@ -334,7 +334,9 @@ (let ((source (cl-irc:source message))) (formatting-message (t message receiver) ((format t " ")) - ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) + ((with-drawing-options (*standard-output* + :ink *misc-message-ink* + :text-size :small) (present source 'unhighlighted-nickname) (format t " ") (format-message* "asked for your IRC client version" :start-length (+ 2 (length source)))))))) @@ -350,7 +352,7 @@ (declare (ignore _)) (formatting-message (t message receiver) ((format t "~A" (irc:source message))) - ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) + ((with-drawing-options (*standard-output* :ink *misc-message-ink* :text-size :small) (format-message* (format nil "~@[~A: ~]~{~A ~}~A" ,message-name (butlast arguments) body))))))))))) (define-server-message-printer ((irc:irc-rpl_motd-message . "MODT") @@ -382,7 +384,9 @@ (irc:destructuring-arguments (&whole args &last body) message (formatting-message (t message receiver) ((format t "!!! ~A" (irc:source message))) - ((with-drawing-options (*standard-output* :ink +red+ :text-size :small) + ((with-drawing-options (*standard-output* + :ink *unspecific-message-ink* + :text-size :small) (format t "~A ~A :~A" (irc:command message) (butlast args) body)))))) ;;; user-related messages @@ -391,7 +395,7 @@ (irc:destructuring-arguments (&optional body) message (formatting-message (t message receiver) ((format t " ")) - ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) + ((with-drawing-options (*standard-output* :ink *quit-message-ink* :text-size :small) (format t "Quit: ") (present (irc:source message) 'nickname) (unless (null body) @@ -411,7 +415,7 @@ (irc:destructuring-arguments (&last body) message (formatting-message (t message receiver) ((format t " ")) - ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) + ((with-drawing-options (*standard-output* :ink *nick-change-ink* :text-size :small) (format t "Nick change: ") (present (irc:source message) 'nickname) (write-string " ") @@ -422,7 +426,7 @@ (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) + ((with-drawing-options (*standard-output* :ink *whois-ink* :text-size :small) (irc:destructuring-arguments (me nickname user host &last ircname) message (declare (ignore me)) (present nickname 'nickname) @@ -435,7 +439,7 @@ (declare (ignore me)) (formatting-message (t message receiver) ((format t " ")) - ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) + ((with-drawing-options (*standard-output* :ink *whois-ink* :text-size :small) (present nickname 'nickname) (format-message* (format nil " is in ~A" body) :start-length (length nickname))))))) @@ -444,7 +448,7 @@ (declare (ignore me)) (formatting-message (t message receiver) ((format t " ")) - ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) + ((with-drawing-options (*standard-output* :ink *whois-ink* :text-size :small) (present nickname 'nickname) (format-message* (format nil " is on ~A: ~A" server server-callout) :start-length (length nickname))))))) @@ -454,7 +458,7 @@ (declare (ignore me)) (formatting-message (t message receiver) ((format t " ")) - ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) + ((with-drawing-options (*standard-output* :ink *away-message-ink* :text-size :small) (present nickname 'nickname) (format-message* (format nil " is away: ~A" away-msg) :start-length (length nickname))))))) @@ -464,7 +468,7 @@ (declare (ignore me)) (formatting-message (t message receiver) ((format t " ")) - ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) + ((with-drawing-options (*standard-output* :ink *whois-ink* :text-size :small) (present nickname 'nickname) (write-char #\Space) (format-message* body :start-length (length nickname))))))) @@ -484,7 +488,7 @@ (declare (ignore me rest)) (formatting-message (t message receiver) ((format t " ")) - ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) + ((with-drawing-options (*standard-output* :ink *whois-ink* :text-size :small) (present nickname 'nickname) (write-char #\Space) (format-message* (format nil "was idle ~A seconds, signed on: ~A" @@ -495,7 +499,7 @@ (defun offer-close (receiver) (with-output-as-presentation (t `(com-close (,receiver)) 'command) - (with-drawing-options (*standard-output* :ink +grey12+ :text-size :small) + (with-drawing-options (*standard-output* :ink *offer-ink* :text-size :small) (format-message* "Click here to close this tab.")))) (defun offer-reconnect (receiver) @@ -504,7 +508,7 @@ (nickname (irc:nickname (irc:user conn))) (realname (irc:realname (irc:user conn)))) (with-output-as-presentation (t `(com-connect ,server :nick ,nickname :realname ,realname) 'command) - (with-drawing-options (*standard-output* :ink +grey12+ :text-size :small) + (with-drawing-options (*standard-output* :ink *offer-ink* :text-size :small) (format-message* (format nil "Click here to reconnect to ~A as ~A" server nickname)))))) (defmethod print-message ((message irc:irc-err_nosuchnick-message) receiver) @@ -512,7 +516,7 @@ ((format t " ")) ((irc:destructuring-arguments (me target &rest rest) message (declare (ignore me rest)) - (with-drawing-options (*standard-output* :ink +red3+ :text-size :small) + (with-drawing-options (*standard-output* :ink *error-ink* :text-size :small) (format-message* (format nil "No such nick or channel \"~A\". " target))) (when (string= (title receiver) @@ -522,11 +526,11 @@ (defmethod print-message ((message irc:irc-err_blocking_notid-message) receiver) (formatting-message (t message receiver) ((format t " ")) - ((with-drawing-options (*standard-output* :ink +red3+ :text-size :small) + ((with-drawing-options (*standard-output* :ink *error-ink* :text-size :small) (irc:destructuring-arguments (me &last msg) message (declare (ignore me)) (format-message* msg) - (with-drawing-options (*standard-output* :ink +grey12+ :text-size :small) + (with-drawing-options (*standard-output* :ink *offer-ink* :text-size :small) (with-output-as-presentation (t `(com-identify) 'command) (format-message* "Click here to identify yourself.")))))))) @@ -534,13 +538,13 @@ (irc:destructuring-arguments (&last body) message (formatting-message (t message receiver) ((format t " ")) - ((with-drawing-options (*standard-output* :ink +red3+ :text-size :small) + ((with-drawing-options (*standard-output* :ink *error-ink* :text-size :small) (format-message* (format nil "Not permitted: ~A" body))))))) (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) + ((with-drawing-options (*standard-output* :ink *topic-ink* :text-size :small) (cond ((and (null sender) (null topic)) (format-message* (format nil "No topic for ~A" channel))) @@ -565,7 +569,7 @@ (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) + ((with-drawing-options (*standard-output* :ink *topic-ink* :text-size :small) (irc:destructuring-arguments (me channel who time) message (declare (ignore me)) (format-message* (format nil "~A topic set by ~A on ~A" channel who @@ -576,14 +580,14 @@ (declare (ignore me privacy)) (formatting-message (t message receiver) ((format t " ")) - ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) + ((with-drawing-options (*standard-output* :ink *whois-ink* :text-size :small) (format-message* (format nil "~A Names: ~A" channel nicks))))))) (defmethod print-message ((message irc:irc-part-message) receiver) (irc:destructuring-arguments (channel &optional part-msg) message (formatting-message (t message receiver) ((format t " ")) - ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) + ((with-drawing-options (*standard-output* :ink *part-ink* :text-size :small) (format t "Part: ") (present (irc:source message) 'nickname) (format t " left ~A" channel) @@ -593,7 +597,7 @@ (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) + ((with-drawing-options (*standard-output* :ink *join-ink* :text-size :small) (format t "Join: ") (present (irc:source message) 'nickname) (write-char #\Space) @@ -604,7 +608,7 @@ (declare (ignore channel)) (formatting-message (t message receiver) ((format t " ")) - ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) + ((with-drawing-options (*standard-output* :ink *kick-ink* :text-size :small) (present (irc:source message) 'nickname) (write-string " kicked ") (present victim 'nickname) @@ -645,7 +649,7 @@ (2 (formatting-message (t message receiver) ((format t " ")) ((irc:destructuring-arguments (channel 1c-mode) message - (with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) + (with-drawing-options (*standard-output* :ink *channel-mode-ink* :text-size :small) (format-message* (format nil "~A set mode ~A ~A" (irc:source message) channel 1c-mode))))))) (t @@ -657,7 +661,7 @@ :server-p (irc:user connection)))) (formatting-message (t message receiver) ((format t " ")) - ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) + ((with-drawing-options (*standard-output* :ink *channel-mode-ink* :text-size :small) (present (irc:source message) 'nickname) (write-string " changes channel mode: ") (loop for (change . rest) on mode-changes @@ -673,7 +677,7 @@ `(defmethod print-message ((message ,message-type) receiver) (formatting-message (t message receiver) ((format t " ")) - ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small) + ((with-drawing-options (*standard-output* :ink *misc-message-ink* :text-size :small) (write-string ,prefix) (present (nth 2 (irc:arguments message)) 'hostmask) (when (find #\! (nth 3 (irc:arguments message))) @@ -688,7 +692,7 @@ (defmethod print-message ((message irc-connection-closed-message) receiver) (formatting-message (t message receiver) ((format t " ")) - ((with-drawing-options (*standard-output* :ink +red3+) + ((with-drawing-options (*standard-output* :ink *error-ink*) (format-message* "Connection to server closed.") (offer-reconnect receiver))))) @@ -708,4 +712,4 @@ maximize (preamble-length message)))) (formatting-table (t) (loop for message in messages - do (print-message message receiver))))) \ No newline at end of file + do (print-message message receiver))))) Index: receivers.lisp =================================================================== RCS file: /project/beirc/cvsroot/beirc/receivers.lisp,v retrieving revision 1.28 diff -u -r1.28 receivers.lisp --- receivers.lisp 12 Apr 2006 18:42:30 -0000 1.28 +++ receivers.lisp 29 May 2006 13:19:15 -0000 @@ -102,7 +102,9 @@ (beirc-app-display frame pane receiver)) :display-time nil :min-width 400 :min-height 600 - :incremental-redisplay t))) + :incremental-redisplay t + :background *default-background-ink+ + :foreground *default-foreground-ink+))) (update-drawing-options receiver)))) (if (equal (current-process) (ui-process frame)) (funcall creator frame) Index: variables.lisp =================================================================== RCS file: /project/beirc/cvsroot/beirc/variables.lisp,v retrieving revision 1.17 diff -u -r1.17 variables.lisp --- variables.lisp 9 May 2006 17:08:03 -0000 1.17 +++ variables.lisp 29 May 2006 13:19:15 -0000 @@ -65,4 +65,27 @@ (defvar *filter-colors* nil "If set to non-NIL, filter color, bold, inverse and underline -codes from IRC messages.") \ No newline at end of file +codes from IRC messages.") + +(defvar *default-background-ink+ +white+) +(defvar *default-foreground-ink+ +black+) + +(defvar *preamble-ink* +dark-red+) +(defvar *timestamp-ink* +gray+) +(defvar *offer-ink* +grey12+) +(defvar *error-ink* +red3+) + +(defvar *privmsg-self-ink* +blue4+) +(defvar *privmsg-default-ink* +black+) +(defvar *misc-message-ink* +gray33+) +(defvar *unspecific-message-ink* +red+) + +(defvar *part-ink* +gray33+) +(defvar *quit-message-ink* +gray33+) +(defvar *join-ink* +gray33+) +(defvar *kick-ink* +gray33+) +(defvar *nick-change-ink* +gray33+) +(defvar *topic-ink* +gray33+) +(defvar *channel-mode-ink* +gray33+) +(defvar *whois-ink* +gray33+) +(defvar *away-message-ink* +gray33+)