Added comment.

[riece] / lisp / riece-log.el

diff --git a/lisp/riece-log.el b/lisp/riece-log.el
index ddedc99..a905e73 100644 (file)
--- a/lisp/riece-log.el
+++ b/lisp/riece-log.el
@@ -55,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


@@ -75,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


@@ -90,7 +108,8 @@ If integer, flash back only this line numbers. t means all lines."
          (make-directory (file-name-directory file) t))
        (write-region (concat (format-time-string "%H:%M") " "
                              (riece-format-message message))
          (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


@@ -111,10 +130,9 @@ If integer, flash back only this line numbers. t means all lines."
   (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))


@@ -158,35 +176,49 @@ If integer, flash back only this line numbers. t means all 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]\\).txt$")
-                              (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


@@ -194,16 +226,17 @@ If LINES is t, insert today's logs entirely."
                (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)))))
 


@@ -220,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