Make rcirc logging more customizable

(rcirc-log-filename-function): New variable.
(rcirc-log): Use `rcirc-log-filename-function' to generate the
log-file name.  Don't log anything if it returns nil.
(rcirc-log-write): Use `expand-file-name' when merging the
log-file name from the alist with rcirc-log-directory; this does
the right thing if the name in the alist already an absolute
filename.  Make the log-file directory if necessary.

Revision: emacs@sv.gnu.org/emacs--devo--0--patch-976

2 files changed, 44 insertions, 19 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index fc4e3046931..470812daa18 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,13 @@
+2008-01-02  Miles Bader  <Miles Bader <miles@gnu.org>>
+
+        * net/rcirc.el (rcirc-log-filename-function): New variable.
+        (rcirc-log): Use `rcirc-log-filename-function' to generate the
+        log-file name.  Don't log anything if it returns nil.
+        (rcirc-log-write): Use `expand-file-name' when merging the
+        log-file name from the alist with rcirc-log-directory; this does
+        the right thing if the name in the alist already an absolute
+        filename.  Make the log-file directory if necessary.
+
 2007-12-29  Richard Stallman  <rms@gnu.org>
 
         * font-lock.el (font-lock-prepend-text-property)
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index a1a0e0ca8e9..06e5c1ad678 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -1480,32 +1480,47 @@ record activity."
         (run-hook-with-args 'rcirc-print-hooks
                             process sender response target text)))))
 
+(defcustom rcirc-log-filename-function 'rcirc-generate-new-buffer-name
+  "A function to generate the filename used by rcirc's logging facility.
+
+It is called with two arguments, PROCESS and TARGET (see
+`rcirc-generate-new-buffer-name' for their meaning), and should
+return the filename, or nil if no logging is desired for this
+session.
+
+If the returned filename is absolute (`file-name-absolute-p'
+returns true), then it is used as-is, otherwise the resulting
+file is put into `rcirc-log-directory'."
+  :group 'rcirc
+  :type 'function)
+
 (defun rcirc-log (process sender response target text)
   "Record line in `rcirc-log', to be later written to disk."
-  (let* ((filename (rcirc-generate-new-buffer-name process target))
-         (cell (assoc-string filename rcirc-log-alist))
-         (line (concat (format-time-string rcirc-time-format)
-                       (substring-no-properties
-                        (rcirc-format-response-string process sender
-                                                      response target text))
-                       "\n")))
-    (if cell
-        (setcdr cell (concat (cdr cell) line))
-      (setq rcirc-log-alist
-            (cons (cons filename line) rcirc-log-alist)))))
+  (let ((filename (funcall rcirc-log-filename-function process target)))
+    (unless (null filename)
+      (let ((cell (assoc-string filename rcirc-log-alist))
+            (line (concat (format-time-string rcirc-time-format)
+                          (substring-no-properties
+                           (rcirc-format-response-string process sender
+                                                         response target text))
+                          "\n")))
+        (if cell
+            (setcdr cell (concat (cdr cell) line))
+          (setq rcirc-log-alist
+                (cons (cons filename line) rcirc-log-alist)))))))
 
 (defun rcirc-log-write ()
   "Flush `rcirc-log-alist' data to disk.
 
-Log data is written to `rcirc-log-directory'."
-  (make-directory rcirc-log-directory t)
+Log data is written to `rcirc-log-directory', except for
+log-files with absolute names (see `rcirc-log-filename-function')."
   (dolist (cell rcirc-log-alist)
-    (with-temp-buffer
-      (insert (cdr cell))
-      (let ((coding-system-for-write 'utf-8))
-        (write-region (point-min) (point-max)
-                      (concat rcirc-log-directory "/" (car cell))
-                      t 'quiet))))
+    (let ((filename (expand-file-name (car cell) rcirc-log-directory))
+          (coding-system-for-write 'utf-8))
+      (make-directory (file-name-directory filename) t)
+      (with-temp-buffer
+        (insert (cdr cell))
+        (write-region (point-min) (point-max) filename t 'quiet))))
   (setq rcirc-log-alist nil))
 
 (defun rcirc-join-channels (process channels)