From: ueno Date: Mon, 6 Dec 2004 09:16:21 +0000 (+0000) Subject: * test/test-riece-log.el: New test cases. X-Git-Tag: riece-1_0_7~126 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=8d45469125e816e28a9ef180c48d1db61f4c5463;p=elisp%2Friece.git * test/test-riece-log.el: New test cases. * riece-log.el: Collect logs across dates. (riece-log-get-files): New function. (riece-log-flashback-1): New function. (riece-log-flashback): Use it. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index a2f9b18..2695dd7 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,12 @@ +2004-12-06 Daiki Ueno + + * test/test-riece-log.el: New test cases. + + * riece-log.el: Collect logs across dates. + (riece-log-get-files): New function. + (riece-log-flashback-1): New function. + (riece-log-flashback): Use it. + 2004-12-05 Daiki Ueno * riece-message.el (riece-display-message-1): Call diff --git a/lisp/riece-log.el b/lisp/riece-log.el index 352fa03..559efe2 100644 --- a/lisp/riece-log.el +++ b/lisp/riece-log.el @@ -86,6 +86,14 @@ If integer, flash back only this line numbers. t means all lines." (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))) @@ -104,35 +112,63 @@ 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-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)))) - (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)))))))) + (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) diff --git a/lisp/test/test-riece-log.el b/lisp/test/test-riece-log.el new file mode 100644 index 0000000..ea03b55 --- /dev/null +++ b/lisp/test/test-riece-log.el @@ -0,0 +1,40 @@ +(require 'riece-log) + +(luna-define-class test-riece-log (lunit-test-case)) + +(defun test-riece-log-delete-directory (directory) + (let ((files (directory-files directory t nil t))) + (while files + (if (file-directory-p (car files)) + (unless (member (file-name-nondirectory (car files)) '("." "..")) + (test-riece-log-delete-directory (car files))) + (delete-file (car files))) + (setq files (cdr files))) + (delete-directory directory))) + +(luna-define-method test-riece-log-flashback ((case test-riece-log)) + (let ((riece-log-directory + (expand-file-name (make-temp-name "test-riece-log") + (if (featurep 'xemacs) + (temp-directory) + temporary-file-directory))) + riece-addons) + (unwind-protect + (let ((dir (expand-file-name "riece" riece-log-directory)) + (riece-log-flashback 2) + riece-log-directory-map) + (make-directory riece-log-directory) + (make-directory dir) + (write-region "03:14 a b c\n" nil + (expand-file-name "20380119.log" dir) t 0) + (write-region "03:14 1 2 3\n" nil + (expand-file-name "20380118.log" dir) t 0) + (lunit-assert-2 + case + (equal + "03:14 1 2 3 (2038/01/18)\n03:14 a b c (2038/01/19)\n" + (with-temp-buffer + (riece-log-flashback (riece-make-identity "#riece" "")) + (buffer-string))))) + (test-riece-log-delete-directory riece-log-directory)))) +