From 753abfb8acd7656931059b1af2650178ae3a16b1 Mon Sep 17 00:00:00 2001 From: bg66 Date: Tue, 17 Jun 2003 01:08:34 +0000 Subject: [PATCH] * riece-display.el (riece-channel-buffer-create): Add new hook. * riece-log.el: New add-on for saving irc logs. * COMPILE (riece-modules): Add `riece-log'. * Makefile.am (EXTRA_DIST): Add `riece-log.el'. * riece-commands.el (riece-command-join): Use `let*' instead of `let'. (riece-command-part): Ditto. --- lisp/COMPILE | 1 + lisp/ChangeLog | 10 ++++ lisp/Makefile.am | 2 +- lisp/riece-commands.el | 22 ++++---- lisp/riece-display.el | 3 +- lisp/riece-log.el | 132 ++++++++++++++++++++++++++++++++++++++++++++++++ 6 files changed, 157 insertions(+), 13 deletions(-) create mode 100644 lisp/riece-log.el diff --git a/lisp/COMPILE b/lisp/COMPILE index fde0e89..8408a5e 100644 --- a/lisp/COMPILE +++ b/lisp/COMPILE @@ -41,6 +41,7 @@ ;; add-ons riece-ctcp riece-highlight + riece-log riece-rdcc riece-url riece-unread)))) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 2639d1f..4e6c194 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,13 @@ +2003-06-17 OHASHI Akira + + * riece-display.el (riece-channel-buffer-create): Add new hook. + * riece-log.el: New add-on for saving irc logs. + * COMPILE (riece-modules): Add `riece-log'. + * Makefile.am (EXTRA_DIST): Add `riece-log.el'. + + * riece-commands.el (riece-command-join): Use `let*' instead of `let'. + (riece-command-part): Ditto. + 2003-06-06 OHASHI Akira * riece-ndcc.el (riece-ndcc-server-sentinel): Close a parenthesis. diff --git a/lisp/Makefile.am b/lisp/Makefile.am index efa84d4..4c4885d 100644 --- a/lisp/Makefile.am +++ b/lisp/Makefile.am @@ -7,7 +7,7 @@ EXTRA_DIST = COMPILE ChangeLog ChangeLog.Liece \ riece-options.el riece-server.el riece-user.el riece-version.el \ riece-xemacs.el riece.el \ riece-ctcp.el riece-url.el riece-unread.el \ - riece-ndcc.el riece-rdcc.el + riece-ndcc.el riece-rdcc.el riece-log.el CLEANFILES = auto-autoloads.el custom-load.el *.elc FLAGS ?= -batch -q -no-site-file diff --git a/lisp/riece-commands.el b/lisp/riece-commands.el index 2b32033..3442c5d 100644 --- a/lisp/riece-commands.el +++ b/lisp/riece-commands.el @@ -391,11 +391,11 @@ (defun riece-command-join (target &optional key) (interactive - (let ((completion-ignore-case t) - (target - (completing-read "Channel/User: " - (mapcar #'list riece-current-channels))) - key) + (let* ((completion-ignore-case t) + (target + (completing-read "Channel/User: " + (mapcar #'list riece-current-channels))) + key) (if (and current-prefix-arg (riece-channel-p target)) (setq key @@ -427,12 +427,12 @@ (defun riece-command-part (target &optional message) (interactive - (let ((completion-ignore-case t) - (target - (completing-read "Channel/User: " - (mapcar #'list riece-current-channels) - nil t (cons riece-current-channel 0))) - message) + (let* ((completion-ignore-case t) + (target + (completing-read "Channel/User: " + (mapcar #'list riece-current-channels) + nil t (cons riece-current-channel 0))) + message) (if (and current-prefix-arg (riece-channel-p target)) (setq message (read-string "Message: "))) diff --git a/lisp/riece-display.el b/lisp/riece-display.el index be46a46..37fd476 100644 --- a/lisp/riece-display.el +++ b/lisp/riece-display.el @@ -218,7 +218,8 @@ (concat "Created on " (funcall riece-format-time-function (current-time)) - "\n")))) + "\n")) + (run-hook-with-args 'riece-channel-buffer-create-functions identity))) (current-buffer))) (eval-when-compile diff --git a/lisp/riece-log.el b/lisp/riece-log.el new file mode 100644 index 0000000..fe4a25c --- /dev/null +++ b/lisp/riece-log.el @@ -0,0 +1,132 @@ +;;; riece-log.el --- saving irc logs add-on +;; Copyright (C) 2003 OHASHI Akira + +;; Author: OHASHI Akira +;; Keywords: IRC, riece + +;; This file is part of Riece. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; This add-on saves irc logs for every channel. + +;; To use, add the following line to your ~/.riece/init.el: +;; (add-to-list 'riece-addons 'riece-log t) + +;;; Code: + +(eval-when-compile (require 'riece-message)) + +(defgroup riece-log nil + "Save irc log" + :group 'riece) + +(defcustom riece-log-directory + (expand-file-name "log" riece-directory) + "*Where to look for log files." + :type 'directory + :group 'riece-log) + +(defcustom riece-log-directory-map nil + "The map of channel name and directory name." + :type '(repeat (cons (string :tag "Channel name") + (string :tag "Directory name"))) + :group 'riece-log) + +(defcustom riece-log-flashback 10 + "*If non-nil, irc messages flash back from log files. +If integer, flash back only this line numbers. t means all lines." + :type '(choice (integer :tag "line numbers") + (boolean :tag "flash back or not")) + :group 'riece-log) + +(defun riece-log-display-message-function (message) + (let ((open-bracket + (funcall riece-message-make-open-bracket-function message)) + (close-bracket + (funcall riece-message-make-close-bracket-function message)) + (name + (funcall riece-message-make-name-function message)) + (file (riece-log-get-file (riece-message-target message)))) + (unless (file-directory-p (file-name-directory file)) + (make-directory (file-name-directory file) t)) + (with-temp-buffer + (insert (concat (format-time-string "%H:%M") " " + open-bracket name close-bracket + " " (riece-message-text message) "\n")) + (write-region (point-min) (point-max) file t 0)))) + +(defun riece-log-get-file (identity) + (expand-file-name + (concat (format-time-string "%Y%m%d") ".log") + (riece-log-get-directory identity))) + +(defun riece-log-get-directory (identity) + (let ((channel (riece-identity-prefix identity)) + (server (riece-identity-server identity))) + (let ((map (assoc channel riece-log-directory-map))) + (if map + (expand-file-name (cdr map) riece-log-directory) + (if (string-match (concat riece-channel-regexp + "\\([^:]+\\)\\(:\\*\\.\\(.*\\)\\)?") channel) + (let ((name (match-string 1 channel)) + (suffix (match-string 3 channel))) + (let ((name (if suffix (concat name "-" suffix) name))) + (if server + (expand-file-name + name + (expand-file-name server riece-log-directory)) + (expand-file-name name riece-log-directory)))) + riece-log-directory))))) + +(defun riece-log-flashback (identity) + (when riece-log-flashback + (let ((file (riece-log-get-file identity))) + (when (file-exists-p file) + (let (string) + (with-temp-buffer + (insert-file-contents file) + (if (not (integerp riece-log-flashback)) + (goto-char (point-min)) + (goto-char (point-max)) + (forward-line (- riece-log-flashback))) + (setq string (buffer-substring (point) (point-max)))) + (let (buffer-read-only) + (goto-char (point-max)) + (insert string) + (goto-char (point-max)) + (set-window-point (get-buffer-window (current-buffer)) + (point)))))))) + +(defun riece-log-open-directory (&optional channel) + (interactive) + (if channel + (find-file (riece-log-get-directory channel)) + (find-file riece-log-directory))) + +(defun riece-log-insinuate () + ;; FIXME: Use `riece-after-insert-functions' for trapping change, + ;; notice, wallops and so on. But must add argument. + (add-hook 'riece-after-display-message-functions + 'riece-log-display-message-function) + (add-hook 'riece-channel-buffer-create-functions + 'riece-log-flashback)) + +(provide 'riece-log) + +;;; riece-log.el ends here -- 1.7.10.4