Added comment.

[riece] / lisp / riece-log.el

diff --git a/lisp/riece-log.el b/lisp/riece-log.el
index adc766f..a905e73 100644 (file)
--- a/lisp/riece-log.el
+++ b/lisp/riece-log.el
@@ -1,7 +1,9 @@
 ;;; riece-log.el --- saving irc logs add-on
 ;; Copyright (C) 2003 OHASHI Akira
 ;;; riece-log.el --- saving irc logs add-on
 ;; Copyright (C) 2003 OHASHI Akira

+;; Copyright (C) 2004 Daiki Ueno

 
 ;; Author: OHASHI Akira <bg66@koka-in.org>
 
 ;; Author: OHASHI Akira <bg66@koka-in.org>

+;;     Daiki Ueno <ueno@unixuser.org>

 ;; Keywords: IRC, riece
 
 ;; This file is part of Riece.
 ;; Keywords: IRC, riece
 
 ;; This file is part of Riece.


@@ -53,7 +55,8 @@
   "*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")
   "*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"))
+                (const t :tag "of the day")
+                (const nil :tag "no flashback"))

   :group 'riece-log)
 
 (defcustom riece-log-coding-system nil
   :group 'riece-log)
 
 (defcustom riece-log-coding-system nil


@@ -73,6 +76,23 @@ If integer, flash back only this line numbers. t means all lines."
   :type 'function
   :group 'riece-log)
 
   :type 'function
   :group 'riece-log)
 

+(defface riece-log-date-face
+  '((((class color)
+      (background dark))
+     (:foreground "Gray70"))
+    (((class color)
+      (background light))
+     (:foreground "DimGray"))
+    (t
+     (:bold t)))
+  "Face used for displaying \"(YYYY/MM/dd)\" extent."
+  :group 'riece-highlight-faces)
+(defvar riece-log-date-face 'riece-log-date-face)
+
+(defvar riece-log-lock-file nil
+  "Lock file for riece-log.
+It is created if there is at least one instance of Emacs running riece-log.")
+

 (defvar riece-log-enabled nil)
 
 (defconst riece-log-description
 (defvar riece-log-enabled nil)
 
 (defconst riece-log-description


@@ -81,52 +101,38 @@ If integer, flash back only this line numbers. t means all lines."
 (defun riece-log-display-message-function (message)
   (if riece-log-enabled
       (let ((file (riece-log-get-file (riece-message-target message)))
 (defun riece-log-display-message-function (message)
   (if riece-log-enabled
       (let ((file (riece-log-get-file (riece-message-target message)))

-           (coding-system-for-write riece-log-coding-system))
+           (coding-system-for-write riece-log-coding-system)
+           file-name-coding-system
+           default-file-name-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))
        (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))))
+                     nil file t 0
+                     riece-log-lock-file))))

 
 (defun riece-log-get-file (identity)
   (expand-file-name
 
 (defun riece-log-get-file (identity)
   (expand-file-name

-   (concat (format-time-string "%Y%m%d") ".log")
+   (concat (format-time-string "%Y%m%d") ".txt")

    (riece-log-get-directory identity)))
 
 (defun riece-log-get-files (identity)
    (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))))
+  (let ((directory (riece-log-get-directory identity)))
+    (if (file-directory-p directory)
+       (nreverse (sort (directory-files directory t
+                        (concat "^"
+                                (riece-make-interval-regexp "[0-9]" 8)
+                                "\\.txt$")
+                        t)
+                 #'string-lessp)))))

 
 (defun riece-log-get-directory (identity)
 
 (defun riece-log-get-directory (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-strict-channel-regexp channel)
-          (let ((suffix (match-string 2 channel)))
-            (setq name (substring channel (match-end 1) (match-beginning 2)))
-            (when (and (stringp suffix)
-                       (string-match "^:\\*\\.\\(.*\\)" suffix))
-              (setq name (concat name "-" (match-string 1 suffix))))))
-         (t (setq name "priv")))
-    (if server
-       (expand-file-name name (expand-file-name server riece-log-directory))
-      (expand-file-name name riece-log-directory))))
-
-(defun riece-log-get-directory-1 (identity)

   (let ((prefix (riece-identity-canonicalize-prefix
                 (riece-identity-prefix identity)))
        (server (riece-identity-server identity))
   (let ((prefix (riece-identity-canonicalize-prefix
                 (riece-identity-prefix identity)))
        (server (riece-identity-server identity))

-       (map (assoc (riece-format-identity identity) riece-log-directory-map))
-       name)
+       (map (assoc (riece-format-identity identity) riece-log-directory-map)))

     (if map
     (if map

-       (setq name (cdr map))
+       (expand-file-name (cdr map) riece-log-directory)

       (expand-file-name (riece-log-encode-file-name prefix)
                        (expand-file-name
                         (concat "." (riece-log-encode-file-name server))
       (expand-file-name (riece-log-encode-file-name prefix)
                        (expand-file-name
                         (concat "." (riece-log-encode-file-name server))


@@ -166,56 +172,71 @@ If integer, flash back only this line numbers. t means all lines."
                                  riece-log-file-name-coding-system)))
   file-name)
 
                                  riece-log-file-name-coding-system)))
   file-name)
 

-(defun riece-log-insert-log (identity lines)
+(defun riece-log-insert (identity lines)

   "Insert logs for IDENTITY at most LINES.
 If LINES is t, insert today's logs entirely."
   (if (eq lines t)
   "Insert logs for IDENTITY at most LINES.
 If LINES is t, insert today's logs entirely."
   (if (eq lines t)

-      (let ((file (riece-log-get-file identity)))
+      (let* (file-name-coding-system
+            default-file-name-coding-system
+            (file (riece-log-get-file identity)))

        (if (file-exists-p file)
            (insert-file-contents file)))
        (if (file-exists-p file)
            (insert-file-contents file)))

-    (let ((files (riece-log-get-files identity))
-         (lines (- lines))
-         date point)
+    (let* (file-name-coding-system
+          default-file-name-coding-system
+          (files (riece-log-get-files identity))
+          (lines (- lines))
+          name date point)

       (while (and (< lines 0) files)
        (if (and (file-exists-p (car files))
       (while (and (< lines 0) files)
        (if (and (file-exists-p (car files))

-                (string-match (concat "\\([0-9][0-9][0-9][0-9]\\)"
-                                      "\\([0-9][0-9]\\)\\([0-9][0-9]\\).log$")
-                              (car files)))
+                (string-match (concat (riece-make-interval-regexp "[0-9]" 8)
+                                      "\\.txt$")
+                              (setq name (file-name-nondirectory
+                                          (car files)))))

            (save-restriction
              (narrow-to-region (point) (point))
            (save-restriction
              (narrow-to-region (point) (point))

-             (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))
              (delete-region (point-min) (point))
              (insert-file-contents (car files))
              (goto-char (point-max))
              (setq lines (forward-line lines))
              (delete-region (point-min) (point))

-             (while (not (eobp))
-               (end-of-line)
-               (insert date)
-               (forward-line))
-             (goto-char (point-min))))
+             (unless (equal name (format-time-string "%Y%m%d.txt"))
+               (setq date (concat " (" (substring name 0 4) "/"
+                                  (substring name 4 6) "/"
+                                  (substring name 6 8) ")"))
+               (while (not (eobp))
+                 (end-of-line)
+                 (setq point (point))
+                 (insert date)
+                 (put-text-property point (point)
+                                    'riece-overlay-face 'riece-log-date-face)
+                 (forward-line))
+               (goto-char (point-min)))))

        (setq files (cdr files))))))
 
 (defun riece-log-flashback (identity)
   (when riece-log-flashback
        (setq files (cdr files))))))
 
 (defun riece-log-flashback (identity)
   (when riece-log-flashback

+    (riece-insert-info (current-buffer)
+                      (if (eq riece-log-flashback t)
+                          "Recent messages of the day:\n"
+                        (format "Recent messages up to %d lines:\n"
+                                riece-log-flashback)))

     (let (buffer-read-only
          (point (goto-char (point-max))))
       (insert (with-temp-buffer
     (let (buffer-read-only
          (point (goto-char (point-max))))
       (insert (with-temp-buffer

-               (riece-log-insert-log identity riece-log-flashback)
+               (riece-log-insert identity riece-log-flashback)

                (buffer-string)))
       (goto-char point)
       (while (re-search-forward
                (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)
+             (concat "^" riece-time-prefix-regexp
+                      "\\(<[^>]+>\\|>[^<]+<\\|([^)]+)\\|{[^}]+}\\|=[^=]+=\\)")
+             nil t)
+       (put-text-property (1+ (match-beginning 1)) (1- (match-end 1))

                           'riece-identity
                           (riece-make-identity
                           'riece-identity
                           (riece-make-identity

-                           (riece-match-string-no-properties 1)
+                           (buffer-substring (1+ (match-beginning 1))
+                                             (1- (match-end 1)))

                            (riece-identity-server identity))))
                            (riece-identity-server identity))))

-      (when (and (memq 'riece-button riece-addons)
-                riece-button-enabled)
-       (riece-button-update-buffer))
-      (goto-char (point-max))
+      (run-hook-with-args 'riece-after-insert-functions
+                         point (goto-char (point-max)))

       (set-window-point (get-buffer-window (current-buffer))
                        (point)))))
 
       (set-window-point (get-buffer-window (current-buffer))
                        (point)))))
 


@@ -232,6 +253,13 @@ If LINES is t, insert today's logs entirely."
       '(riece-button)))
 
 (defun riece-log-insinuate ()
       '(riece-button)))
 
 (defun riece-log-insinuate ()

+  (make-directory riece-log-directory t)
+  (setq riece-log-lock-file
+       (expand-file-name (format "!%s-%d-%d"
+                                 (riece-log-encode-file-name (system-name))
+                                 (user-uid)
+                                 (emacs-pid))
+                         riece-log-directory))

   ;; 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
   ;; 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