Update of /project/beirc/cvsroot/beirc In directory common-lisp:/tmp/cvs-serv18918

Modified Files: application.lisp message-display.lisp receivers.lisp variables.lisp Log Message: query auto-closing; improve urls highlighting; resize new queries correctly.

* Query auto-closing code: if *auto-close-inactive-query-windows-p* is set to T (nil is the default), beirc will automatically close windows that were inactive for more than *max-query-inactive-time* seconds (and all messages in the window were seen).

* Highlight https:// urls; that should speak for itself (:

* change the presentation of rewritten clhs URLs. instead of file://, we show clhs://; the link target is still the right one, of course.

* add a change-space-requirements call that resizes new query panes to fit the size of the tab pane container.

--- /project/beirc/cvsroot/beirc/application.lisp 2006/02/05 21:50:51 1.37 +++ /project/beirc/cvsroot/beirc/application.lisp 2006/02/16 23:46:57 1.38 @@ -220,6 +220,8 @@ (defmethod handle-event ((frame beirc) (event bar-event)) (let ((pane (get-frame-pane frame 'status-bar))) (redisplay-frame-pane frame pane) + (when *auto-close-inactive-query-windows-p* + (com-close-inactive-queries)) (medium-force-output (sheet-medium pane))))

;;; @@ -256,7 +258,8 @@ (when (interesting-message-p message) (incf (unseen-messages receiver))) (when (message-directed-to-me-p frame message) - (incf (messages-directed-to-me receiver)))) + (incf (messages-directed-to-me receiver))) + (incf (all-unseen-messages receiver))) (update-drawing-options receiver) (clim-internals::event-queue-prepend (climi::frame-event-queue frame) @@ -344,6 +347,22 @@ (irc:part connection channel))) (remove-receiver receiver *application-frame*))

+(define-beirc-command (com-close-inactive-queries :name t) () + (let ((receivers-to-close nil)) + (maphash (lambda (name receiver) + (declare (ignore name)) + (when (and (not (eql receiver (server-receiver *application-frame*))) + (not (eql receiver (current-receiver *application-frame*))) + (= 0 + (unseen-messages receiver) (all-unseen-messages receiver) + (messages-directed-to-me receiver)) + (null (irc:find-channel (current-connection *application-frame*) (title receiver))) + (> (- (get-universal-time) (last-visited receiver)) *max-query-inactive-time*)) + (push receiver receivers-to-close))) + (receivers *application-frame*)) + (loop for receiver in receivers-to-close + do (remove-receiver receiver *application-frame*)))) + (define-beirc-command (com-part :name t) () (irc:part (current-connection *application-frame*) (title (current-receiver *application-frame*)))) --- /project/beirc/cvsroot/beirc/message-display.lisp 2006/02/10 20:48:23 1.30 +++ /project/beirc/cvsroot/beirc/message-display.lisp 2006/02/16 23:46:57 1.31 @@ -6,13 +6,14 @@ :inherit-from 'string)

(defun present-url (url) - (let ((start (search "http://www.lispworks.com/reference/HyperSpec/" url))) + (let* ((clhs-base "http://www.lispworks.com/reference/HyperSpec/") + (start (search clhs-base url))) (cond (start - (write-string (subseq url 0 start)) - (present (concatenate 'string - *hyperspec-base-url* - (subseq url (+ 45 start))) - 'url)) + (let* ((clhs-page (subseq url (+ start (length clhs-base)))) + (new-url (concatenate 'string *hyperspec-base-url* clhs-page))) + (write-string (subseq url 0 start)) + (with-output-as-presentation (t new-url 'url) + (format t "clhs://~A" clhs-page)))) ((> (length url) *default-fill-column*) (let ((new-url (concatenate 'string @@ -107,7 +108,7 @@ (multiple-value-bind (word% stripped-punctuation) (strip-punctuation %word) (write-string stripped-preceding-punctuation) (cond - ((search "http://" word%) + ((or (search "http://" word%) (search "https://" word%)) (present-url word%)) ((or (nick-equals-my-nick-p word%) --- /project/beirc/cvsroot/beirc/receivers.lisp 2006/02/05 21:50:51 1.14 +++ /project/beirc/cvsroot/beirc/receivers.lisp 2006/02/16 23:46:57 1.15 @@ -3,11 +3,13 @@ (defclass receiver () ((messages :accessor messages :initform nil) (unseen-messages :accessor unseen-messages :initform 0) + (all-unseen-messages :accessor all-unseen-messages :initform 0) (messages-directed-to-me :accessor messages-directed-to-me :initform 0) (channel :reader channel :initform nil :initarg :channel) (query :reader query :initform nil :initarg :query) ;; <- XXX: remove this. (focused-nicks :accessor focused-nicks :initform nil) (title :reader title :initarg :title) + (last-visited :accessor last-visited :initform 0) (pane :reader pane) (tab-pane :accessor tab-pane)))

@@ -52,7 +54,8 @@ (progn (setf (slot-value receiver 'tab-pane) (make-tab-pane-from-list (title receiver) (pane receiver) 'receiver-pane)) - (add-pane (tab-pane receiver) (find-pane-named frame 'query)))) + (add-pane (tab-pane receiver) (find-pane-named frame 'query)) + ;; resize the pane to fit the tab container change-space-requirements pane))) (setf (gethash (tab-pane receiver) (tab-panes-to-receivers frame)) receiver))

(defun find-receiver (name frame) @@ -74,7 +77,7 @@ (lambda (frame pane) (beirc-app-display frame pane receiver)) :display-time nil - :width 600 :height 800 + :min-width 600 :min-height 800 :incremental-redisplay t))) (setf (gethash normalized-name (receivers frame)) receiver) receiver))))) @@ -255,10 +258,14 @@ (find-in-tab-panes-list pane my-tab-layout-pane)))) (unless (null receiver) (setf (unseen-messages receiver) 0) + (setf (all-unseen-messages receiver) 0) (setf (messages-directed-to-me receiver) 0) + (setf (last-visited receiver) (get-universal-time)) (update-drawing-options receiver))))))

(defun raise-receiver (receiver) (setf (unseen-messages receiver) 0) + (setf (all-unseen-messages receiver) 0) (setf (messages-directed-to-me receiver) 0) + (setf (last-visited receiver) (get-universal-time)) (switch-to-pane (pane receiver) 'tab-layout-pane)) --- /project/beirc/cvsroot/beirc/variables.lisp 2005/10/02 23:47:51 1.8 +++ /project/beirc/cvsroot/beirc/variables.lisp 2006/02/16 23:46:57 1.9 @@ -19,4 +19,17 @@

(defvar *beirc-user-init-file* (merge-pathnames (make-pathname :name ".beirc.lisp") - (user-homedir-pathname))) \ No newline at end of file + (user-homedir-pathname))) + +(defvar *auto-close-inactive-query-windows-p* nil + "Indicates whether beirc automatically closes query windows +that were inactive for longer than *max-query-inactive-time* +seconds. If set to NIL, beirc doesn't automaticaly close query +windows. Closing inactive query windows is still available via +/Close Inactive Queries.") + +(defvar *max-query-inactive-time* 600 + "Longest time an inactive query window will be kept around by +the command /Close Inactive Queries and the automatic query +window closing mechanism (see +*auto-close-inactive-query-windows-p*).") \ No newline at end of file