mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 10:30:25 -08:00
Code Issues Projects Releases Wiki Activity

Make rcirc logging more customizable

Browse source 
(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
This commit is contained in:
Miles Bader 2008-01-02 02:20:56 +00:00
parent b201b9880e
commit aacde24f5c
2 changed files with 44 additions and 19 deletions
Download patch file Download diff file Expand all files Collapse all files

10
lisp/ChangeLog
View file

@ -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)

53
lisp/net/rcirc.el
View file

@ -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)