X-Git-Url: http://cgit.sxemacs.org/?p=riece;a=blobdiff_plain;f=lisp%2Friece-log.el;h=f511d700224b69e89c9a37e32cc05dc1d0e6a9bf;hp=caa1e9cf1221ceaba4017af49d96a47be254f115;hb=f9bf8dbbbb31f38ff7ff94e14c6b8f404a40fc69;hpb=72c9efc77044504c7a2ffbb7f34a6c2f2f263130

diff --git a/lisp/riece-log.el b/lisp/riece-log.el
index caa1e9c..f511d70 100644
--- a/lisp/riece-log.el
+++ b/lisp/riece-log.el
@@ -30,7 +30,8 @@
 
 ;;; Code:
 
-(eval-when-compile (require 'riece-message))
+(require 'riece-message)
+(require 'riece-button)
 
 (defgroup riece-log nil
   "Save irc log"
@@ -60,34 +61,54 @@ 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 ((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)))
-	(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") " "
-			  open-bracket name close-bracket
-			  " " (riece-message-text message) "\n")
-		  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-prefix identity))
+  (let ((channel (riece-identity-canonicalize-prefix
+		  (riece-identity-prefix identity)))
 	(server (riece-identity-server identity))
 	(map (assoc (riece-format-identity identity) riece-log-directory-map))
 	name)
     (cond (map (setq name (cdr map)))
-	  ((string-match riece-channel-regexp channel)
+	  ((string-match riece-strict-channel-regexp channel)
 	   (let ((suffix (match-string 2 channel)))
 	     (setq name (substring channel (match-end 1) (match-beginning 2)))
 	     (when (and (stringp suffix)
@@ -98,30 +119,105 @@ 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-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)
-  (if channel
-      (find-file (riece-log-get-directory channel))
-    (find-file riece-log-directory)))
+  (let ((directory (riece-log-get-directory
+		    (or channel riece-current-channel))))
+    (if (file-directory-p directory)
+	(funcall riece-log-open-directory-function directory)
+      (error "No log directory"))))
+
+(defun riece-log-requires ()
+  (if (memq 'riece-button riece-addons)
+      '(riece-button)))
 
 (defun riece-log-insinuate ()
   ;; FIXME: Use `riece-after-insert-functions' for trapping change,
@@ -131,6 +227,15 @@ If integer, flash back only this line numbers. t means all lines."
   (add-hook 'riece-channel-buffer-create-functions
 	    '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)
 
 ;;; riece-log.el ends here