* test/test-riece-log.el (test-riece-log-encode-file-name): New
[riece] / lisp / riece-log.el
index 5b79710..f9c9fe3 100644 (file)
@@ -30,8 +30,8 @@
 
 ;;; Code:
 
-(eval-when-compile (require 'riece-message)
-                  (require 'riece-button))
+(require 'riece-message)
+(require 'riece-button)
 
 (defgroup riece-log nil
   "Save irc log"
@@ -61,25 +61,46 @@ If integer, flash back only this line numbers. t means all lines."
   :type 'symbol
   :group 'riece-log)
 
+(defcustom riece-log-file-name-coding-system
+  (if (boundp 'file-name-coding-system)
+      file-name-coding-system)
+  "*Coding system used for filenames of log files."
+  :type 'symbol
+  :group 'riece-log)
+
 (defcustom riece-log-open-directory-function 'find-file
   "*Function for opening a directory."
   :type 'function
   :group 'riece-log)
 
+(defvar riece-log-enabled nil)
+
+(defconst riece-log-description
+  "Saving IRC logs")
+
 (defun riece-log-display-message-function (message)
-  (let ((file (riece-log-get-file (riece-message-target message)))
-       (coding-system-for-write riece-log-coding-system))
-    (unless (file-directory-p (file-name-directory file))
-      (make-directory (file-name-directory file) t))
-    (write-region (concat (format-time-string "%H:%M") " "
-                         (riece-format-message message))
-                 nil file t 0)))
+  (if riece-log-enabled
+      (let ((file (riece-log-get-file (riece-message-target message)))
+           (coding-system-for-write riece-log-coding-system))
+       (unless (file-directory-p (file-name-directory file))
+         (make-directory (file-name-directory file) t))
+       (write-region (concat (format-time-string "%H:%M") " "
+                             (riece-format-message message))
+                     nil 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-files (identity)
+  (let ((files (directory-files (riece-log-get-directory identity) t
+                               (concat "^"
+                                       (riece-make-interval-regexp "[0-9]" 8)
+                                       "\\.log$")
+                               t)))
+    (nreverse (sort files #'string-lessp))))
+
 (defun riece-log-get-directory (identity)
   (let ((channel (riece-identity-canonicalize-prefix
                  (riece-identity-prefix identity)))
@@ -98,34 +119,93 @@ If integer, flash back only this line numbers. t means all lines."
        (expand-file-name name (expand-file-name server riece-log-directory))
       (expand-file-name name riece-log-directory))))
 
+(defun riece-log-encode-file-name (file-name)
+  (if riece-log-file-name-coding-system
+      (setq file-name
+           (encode-coding-string file-name
+                                 riece-log-file-name-coding-system)))
+  (let ((index 0))
+    (while (string-match "[^-0-9A-Za-z=_\x80-\xFF]" file-name index)
+      (setq file-name (replace-match
+                      (format "=%02X"
+                              (aref file-name (match-beginning 0)))
+                      nil t file-name)
+           index (+ 3 index)))
+    file-name))
+
+(defun riece-log-decode-file-name (file-name)
+  (let ((index 0))
+    (while (string-match "=\\([0-7][0-9A-F]\\)" file-name index)
+      (setq file-name (replace-match
+                      (char-to-string
+                       (car (read-from-string
+                             (concat "?\\x" (match-string 1 file-name)))))
+                      nil t file-name)
+           index (1+ index)))
+    file-name)
+  (if riece-log-file-name-coding-system
+      (setq file-name
+           (decode-coding-string file-name
+                                 riece-log-file-name-coding-system)))
+  file-name)
+
+(defun riece-log-flashback-1 (identity)
+  (if (eq riece-log-flashback t)
+      (let ((file (riece-log-get-file identity)))
+       (if (file-exists-p file)
+           (insert-file-contents file)))
+    (let ((files (riece-log-get-files identity))
+         (lines (- riece-log-flashback))
+         date point)
+      (while (and (< lines 0) files)
+       (if (and (file-exists-p (car files))
+                (string-match (concat "\\("
+                                      (riece-make-interval-regexp "[0-9]" 4)
+                                      "\\)\\("
+                                      (riece-make-interval-regexp "[0-9]" 2)
+                                      "\\)\\("
+                                      (riece-make-interval-regexp "[0-9]" 2)
+                                      "\\).log$")
+                              (car files)))
+           (save-restriction
+             (narrow-to-region (point-min) (point-min))
+             (setq date (concat " (" (match-string 1 (car files)) "/"
+                                (match-string 2 (car files)) "/"
+                                (match-string 3 (car files)) ")"))
+             (insert-file-contents (car files))
+             (goto-char (point-max))
+             (setq lines (forward-line lines)
+                   point (point))
+             (while (not (eobp))
+               (end-of-line)
+               (insert date)
+               (forward-line))
+             (goto-char point)))
+       (setq files (cdr files)))
+      (if (zerop lines)
+         (delete-region (point-min) (point))))))
+
 (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-min))
-           (while (re-search-forward
-                   "^[0-9][0-9]:[0-9][0-9] [<>]\\([^<>]+\\)[<>] " nil t)
-             (put-text-property (match-beginning 1) (match-end 1)
-                                'riece-identity
-                                (riece-make-identity
-                                 (riece-match-string-no-properties 1)
-                                 (riece-identity-server identity))))
-           (if (memq 'riece-button riece-addons)
-               (riece-button-update-buffer))
-           (goto-char (point-max))
-           (set-window-point (get-buffer-window (current-buffer))
-                             (point))))))))
+    (let (buffer-read-only
+         (point (goto-char (point-max))))
+      (insert (with-temp-buffer
+               (riece-log-flashback-1 identity)
+               (buffer-string)))
+      (goto-char point)
+      (while (re-search-forward
+             "^[0-9][0-9]:[0-9][0-9] [<>]\\([^<>]+\\)[<>] " nil t)
+       (put-text-property (match-beginning 1) (match-end 1)
+                          'riece-identity
+                          (riece-make-identity
+                           (riece-match-string-no-properties 1)
+                           (riece-identity-server identity))))
+      (when (and (memq 'riece-button riece-addons)
+                riece-button-enabled)
+       (riece-button-update-buffer))
+      (goto-char (point-max))
+      (set-window-point (get-buffer-window (current-buffer))
+                       (point)))))
 
 (defun riece-log-open-directory (&optional channel)
   (interactive)
@@ -139,16 +219,22 @@ If integer, flash back only this line numbers. t means all lines."
   (if (memq 'riece-button riece-addons)
       '(riece-button)))
 
-(defvar riece-command-mode-map)
 (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)
-  (define-key riece-command-mode-map
-    "\C-cd" 'riece-log-open-directory))
+           'riece-log-flashback))
+
+(defvar riece-command-mode-map)
+(defun riece-log-enable ()
+  (define-key riece-command-mode-map "\C-cd" 'riece-log-open-directory)
+  (setq riece-log-enabled t))
+
+(defun riece-log-disable ()
+  (define-key riece-command-mode-map "\C-cd" nil)
+  (setq riece-log-enabled nil))
 
 (provide 'riece-log)