[beirc-cvs] CVS beirc
afuchs
afuchs at common-lisp.net
Thu Feb 16 23:46:57 UTC 2006
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
More information about the Beirc-cvs
mailing list