From afuchs at common-lisp.net Mon Aug 20 18:33:25 2007 From: afuchs at common-lisp.net (afuchs) Date: Mon, 20 Aug 2007 14:33:25 -0400 (EDT) Subject: [beirc-cvs] CVS beirc Message-ID: <20070820183325.13D0A72093@common-lisp.net> Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv29545 Modified Files: application.lisp Log Message: Finally commit Troels Henriksen's read-frame-command patch. Drei is more strict w.r.t. inserting input while rescanning, so unbreak it. --- /project/beirc/cvsroot/beirc/application.lisp 2007/06/27 23:16:00 1.89 +++ /project/beirc/cvsroot/beirc/application.lisp 2007/08/20 18:33:24 1.90 @@ -1055,61 +1055,64 @@ (defmethod read-frame-command ((frame beirc) &key (stream *standard-input*)) (let ((bad-input nil)) (unwind-protect - (clim:with-input-editing (stream) - (when (and (current-receiver frame) (incomplete-input (current-receiver frame))) - (replace-input stream (incomplete-input (current-receiver frame)) :rescan t)) - (with-input-context ('command) (object) - (with-command-table-keystrokes (*accelerator-gestures* (frame-command-table frame)) - (catch 'keystroke-command - (let ((force-restore-input-state nil)) - (labels ((reset-saved-input () - (when (current-receiver frame) - (setf (incomplete-input (current-receiver frame)) "")))) - (handler-bind ((accelerator-gesture - (lambda (gesture) - (save-input-line stream frame) - (throw 'keystroke-command (lookup-keystroke-command-item - (accelerator-gesture-event gesture) - (frame-command-table frame))))) - (abort-gesture - (lambda (gesture) - (declare (ignore gesture)) - (reset-saved-input) - (setf force-restore-input-state nil))) - (invoked-command-by-clicking - (lambda (cond) - (declare (ignore cond)) - (save-input-line stream frame) - (setf force-restore-input-state t) - (invoke-restart 'acknowledged)))) - (let ((c (clim:read-gesture :stream stream :peek-p t))) - (multiple-value-prog1 - (cond ((eql c #\/) - (handler-case - (progn - (clim:read-gesture :stream stream) - (accept 'command :stream stream :prompt nil)) - (simple-completion-error (c) - #+mcclim - (let ((preliminary-line (save-input-line stream frame))) - (setf (incomplete-input (current-receiver frame)) - (subseq preliminary-line 0 - (search (climi::completion-error-input-so-far c) - preliminary-line)) - bad-input (subseq preliminary-line - (search (climi::completion-error-input-so-far c) - preliminary-line)) - force-restore-input-state t)) - (beep) - nil))) - (t - (list 'com-say (accept 'mumble :history 'mumble :prompt nil :stream stream)))) - (if force-restore-input-state - (setf force-restore-input-state nil) - (reset-saved-input))))))))) - (command - (save-input-line stream frame) - object))) + (clim:with-input-editing (stream) + (when (and (current-receiver frame) (incomplete-input (current-receiver frame)) + (not (stream-rescanning-p stream))) + (replace-input stream + (incomplete-input (current-receiver frame)) + :rescan t)) + (with-input-context ('command) (object) + (with-command-table-keystrokes (*accelerator-gestures* (frame-command-table frame)) + (catch 'keystroke-command + (let ((force-restore-input-state nil)) + (labels ((reset-saved-input () + (when (current-receiver frame) + (setf (incomplete-input (current-receiver frame)) "")))) + (handler-bind ((accelerator-gesture + (lambda (gesture) + (save-input-line stream frame) + (throw 'keystroke-command (lookup-keystroke-command-item + (accelerator-gesture-event gesture) + (frame-command-table frame))))) + (abort-gesture + (lambda (gesture) + (declare (ignore gesture)) + (reset-saved-input) + (setf force-restore-input-state nil))) + (invoked-command-by-clicking + (lambda (cond) + (declare (ignore cond)) + (save-input-line stream frame) + (setf force-restore-input-state t) + (invoke-restart 'acknowledged)))) + (let ((c (clim:read-gesture :stream stream :peek-p t))) + (multiple-value-prog1 + (cond ((eql c #\/) + (handler-case + (progn + (clim:read-gesture :stream stream) + (accept 'command :stream stream :prompt "" :prompt-mode :raw)) + (simple-completion-error (c) + #+mcclim + (let ((preliminary-line (save-input-line stream frame))) + (setf (incomplete-input (current-receiver frame)) + (subseq preliminary-line 0 + (search (climi::completion-error-input-so-far c) + preliminary-line)) + bad-input (subseq preliminary-line + (search (climi::completion-error-input-so-far c) + preliminary-line)) + force-restore-input-state t)) + (beep) + nil))) + (t + (list 'com-say (accept 'mumble :history 'mumble :prompt nil :stream stream)))) + (if force-restore-input-state + (setf force-restore-input-state nil) + (reset-saved-input))))))))) + (command + (save-input-line stream frame) + object))) (window-clear stream) (when bad-input (format stream "Bad input \"") From afuchs at common-lisp.net Mon Aug 20 18:39:10 2007 From: afuchs at common-lisp.net (afuchs) Date: Mon, 20 Aug 2007 14:39:10 -0400 (EDT) Subject: [beirc-cvs] CVS beirc Message-ID: <20070820183910.200867208F@common-lisp.net> Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv30307 Modified Files: application.lisp package.lisp receivers.lisp variables.lisp Log Message: Finally commit Thomas Persson's patch, too * Fixes the scrolling bug which surfaced after a semirecent mcclim update. * Changes the default port from irc::*default-irc-server-port* to simply 6667 to work around a recent change in cl-irc. * Added the customizable variable *auto-focused-alist* in order to be able to set a number of nicks which are focused by default for different channels. (the original patch included a command translator to close tabs on middle mouse button click, but I don't think this should be included.) --- /project/beirc/cvsroot/beirc/application.lisp 2007/08/20 18:33:24 1.90 +++ /project/beirc/cvsroot/beirc/application.lisp 2007/08/20 18:39:09 1.91 @@ -70,7 +70,7 @@ ((frame redisplay-frame-mixin) (pane application-pane) &key force-p) (declare (ignore force-p)) (change-space-requirements - pane :height (bounding-rectangle-height (stream-output-history pane)))) + pane :height (bounding-rectangle-height (car (output-record-children (stream-output-history pane)))))) (define-application-frame beirc (redisplay-frame-mixin standard-application-frame) @@ -393,9 +393,22 @@ (when *application-frame* (join-missing-channels *application-frame*) (redraw-all-receivers)))) +(defun auto-focus-nicks () + (dolist (channel *auto-focused-alist*) + (let ((receiver (find-receiver (car channel) + (current-connection *application-frame*) + *application-frame*))) + (when receiver + (setf (focused-nicks receiver) + (remove-duplicates (append (cdr channel) + (focused-nicks receiver)) + :test #'equal)) + (redraw-receiver receiver))))) + (define-beirc-command (com-reload :name t) () - (load-user-init-file)) + (load-user-init-file) + (auto-focus-nicks)) (define-beirc-command (com-identify :name t) (&key (password 'string :prompt "Password" @@ -938,7 +951,7 @@ (nick 'string :prompt "Nick name" :default *default-nick*) (realname 'string :prompt "Real name (phrase)" :default *default-realname*) (pass 'string :prompt "Password" :default nil) - (port 'number :prompt "Port" :default nil)) + (port 'number :prompt "Port" :default 6667)) (let ((success nil) (maybe-server-receiver (server-receiver-from-args *application-frame* server port nick))) (or (and maybe-server-receiver (connection-open-p maybe-server-receiver)) --- /project/beirc/cvsroot/beirc/package.lisp 2007/02/24 10:58:16 1.6 +++ /project/beirc/cvsroot/beirc/package.lisp 2007/08/20 18:39:09 1.7 @@ -4,5 +4,5 @@ #:*beirc-user-init-file* #:*hyperspec-base-url* #:*default-fill-column* #:*timestamp-column-orientation* #:*default-nick* #:*nickserv-password-alist* #:*default-web-browser - #:*auto-join-alist*) + #:*auto-join-alist* #:*auto-focused-alist*) (:import-from #:cl-irc #:&req)) --- /project/beirc/cvsroot/beirc/receivers.lisp 2007/02/24 10:58:16 1.29 +++ /project/beirc/cvsroot/beirc/receivers.lisp 2007/08/20 18:39:09 1.30 @@ -109,7 +109,10 @@ (if (equal (current-process) (ui-process frame)) (funcall creator frame) (queue-beirc-event frame (make-instance 'new-sheet-event :sheet frame :creator creator))) - (setf (gethash (list connection normalized-name) (receivers frame)) receiver) + (setf (gethash (list connection normalized-name) (receivers frame)) receiver + (focused-nicks receiver) (cdr (assoc normalized-name + *auto-focused-alist* + :test #'equal))) receiver)))) (defun reinit-receiver-for-new-connection (server-receiver connection &optional (frame *application-frame*)) --- /project/beirc/cvsroot/beirc/variables.lisp 2006/05/09 17:08:03 1.17 +++ /project/beirc/cvsroot/beirc/variables.lisp 2007/08/20 18:39:09 1.18 @@ -65,4 +65,9 @@ (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 *auto-focused-alist* nil + "An alist mapping channels to nicks which will be focused by +default. Each element should have the following format: +(\"#channel-name\" . (\"nick1\" \"nick2\"))")