1;;; erc-stamp.el --- Timestamping for ERC messages
2
3;; Copyright (C) 2002, 2003, 2004, 2006, 2007 Free Software Foundation, Inc.
4
5;; Author: Mario Lang <mlang@delysid.org>
6;; Keywords: comm, processes, timestamp
7;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcStamp
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation; either version 2, or (at your option)
14;; any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs; see the file COPYING.  If not, write to the
23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24;; Boston, MA 02110-1301, USA.
25
26;;; Commentary:
27
28;; The code contained in this module is responsible for inserting
29;; timestamps into ERC buffers.  In order to actually activate this,
30;; you must call `erc-timestamp-mode'.
31
32;; You can choose between two different ways of inserting timestamps.
33;; Customize `erc-insert-timestamp-function' and
34;; `erc-insert-away-timestamp-function'.
35
36;;; Code:
37
38(require 'erc)
39(require 'erc-compat)
40
41(defgroup erc-stamp nil
42  "For long conversation on IRC it is sometimes quite
43useful to have individual messages timestamp.  This
44group provides settings related to the format and display
45of timestamp information in `erc-mode' buffer.
46
47For timestamping to be activated, you just need to load `erc-stamp'
48in your .emacs file or interactively using `load-library'."
49  :group 'erc)
50
51(defcustom erc-timestamp-format "[%H:%M]"
52  "*If set to a string, messages will be timestamped.
53This string is processed using `format-time-string'.
54Good examples are \"%T\" and \"%H:%M\".
55
56If nil, timestamping is turned off."
57  :group 'erc-stamp
58  :type '(choice (const nil)
59		 (string)))
60
61(defcustom erc-insert-timestamp-function 'erc-insert-timestamp-right
62  "*Function to use to insert timestamps.
63
64It takes a single argument STRING which is the final string
65which all text-properties already appended.  This function only cares about
66inserting this string at the right position.  Narrowing is in effect
67while it is called, so (point-min) and (point-max) determine the region to
68operate on."
69  :group 'erc-stamp
70  :type '(choice (const :tag "Right" erc-insert-timestamp-right)
71		 (const :tag "Left" erc-insert-timestamp-left)
72		 function))
73
74(defcustom erc-away-timestamp-format "<%H:%M>"
75  "*Timestamp format used when marked as being away.
76
77If nil, timestamping is turned off when away unless `erc-timestamp-format'
78is set.
79
80If `erc-timestamp-format' is set, this will not be used."
81  :group 'erc-stamp
82  :type '(choice (const nil)
83		 (string)))
84
85(defcustom erc-insert-away-timestamp-function 'erc-insert-timestamp-right
86  "*Function to use to insert the away timestamp.
87
88See `erc-insert-timestamp-function' for details."
89  :group 'erc-stamp
90  :type '(choice (const :tag "Right" erc-insert-timestamp-right)
91		 (const :tag "Left" erc-insert-timestamp-left)
92		 function))
93
94(defcustom erc-hide-timestamps nil
95  "*If non-nil, timestamps will be invisible.
96
97This is useful for logging, because, although timestamps will be
98hidden, they will still be present in the logs."
99  :group 'erc-stamp
100  :type 'boolean)
101
102(defcustom erc-echo-timestamps nil
103  "*If non-nil, print timestamp in the minibuffer when point is moved.
104Using this variable, you can turn off normal timestamping,
105and simply move point to an irc message to see its timestamp
106printed in the minibuffer."
107  :group 'erc-stamp
108  :type 'boolean)
109
110(defcustom erc-echo-timestamp-format "Timestamped %A, %H:%M:%S"
111  "*Format string to be used when `erc-echo-timestamps' is non-nil.
112This string specifies the format of the timestamp being echoed in
113the minibuffer."
114  :group 'erc-stamp
115  :type 'string)
116
117(defcustom erc-timestamp-intangible t
118  "*Whether the timestamps should be intangible, i.e. prevent the point
119from entering them and instead jump over them."
120  :group 'erc-stamp
121  :type 'boolean)
122
123(defface erc-timestamp-face '((t (:bold t :foreground "green")))
124  "ERC timestamp face."
125  :group 'erc-faces)
126
127;;;###autoload (autoload 'erc-timestamp-mode "erc-stamp" nil t)
128(define-erc-module stamp timestamp
129  "This mode timestamps messages in the channel buffers."
130  ((add-hook 'erc-mode-hook 'erc-munge-invisibility-spec)
131   (add-hook 'erc-insert-modify-hook 'erc-add-timestamp t)
132   (add-hook 'erc-send-modify-hook 'erc-add-timestamp t))
133  ((remove-hook 'erc-mode-hook 'erc-munge-invisibility-spec)
134   (remove-hook 'erc-insert-modify-hook 'erc-add-timestamp)
135   (remove-hook 'erc-send-modify-hook 'erc-add-timestamp)))
136
137(defun erc-add-timestamp ()
138  "Add timestamp and text-properties to message.
139
140This function is meant to be called from `erc-insert-modify-hook'
141or `erc-send-modify-hook'."
142  (unless (get-text-property (point) 'invisible)
143    (let ((ct (current-time)))
144      (if (fboundp erc-insert-timestamp-function)
145	  (funcall erc-insert-timestamp-function
146		   (erc-format-timestamp ct erc-timestamp-format))
147	(error "Timestamp function unbound"))
148      (when (and (fboundp erc-insert-away-timestamp-function)
149		 erc-away-timestamp-format
150		 (erc-away-time)
151		 (not erc-timestamp-format))
152	(funcall erc-insert-away-timestamp-function
153		 (erc-format-timestamp ct erc-away-timestamp-format)))
154      (add-text-properties (point-min) (point-max)
155			   (list 'timestamp ct))
156      (add-text-properties (point-min) (point-max)
157			   (list 'point-entered 'erc-echo-timestamp)))))
158
159(defvar erc-timestamp-last-inserted nil
160  "Last timestamp inserted into the buffer.")
161(make-variable-buffer-local 'erc-timestamp-last-inserted)
162
163(defcustom erc-timestamp-only-if-changed-flag t
164  "*Insert timestamp only if its value changed since last insertion.
165If `erc-insert-timestamp-function' is `erc-insert-timestamp-left', a
166string of spaces which is the same size as the timestamp is added to
167the beginning of the line in its place. If you use
168`erc-insert-timestamp-right', nothing gets inserted in place of the
169timestamp."
170  :group 'erc-stamp
171  :type 'boolean)
172
173(defcustom erc-timestamp-right-column nil
174  "*If non-nil, the column at which the timestamp is inserted,
175if the timestamp is to be printed to the right.  If nil,
176`erc-insert-timestamp-right' will use other means to determine
177the correct column."
178  :group 'erc-stamp
179  :type '(choice
180	  (integer :tag "Column number")
181	  (const :tag "Unspecified" nil)))
182
183(defcustom erc-timestamp-use-align-to (and (not (featurep 'xemacs))
184					   (>= emacs-major-version 22)
185					   (eq window-system 'x))
186  "*If non-nil, use the :align-to display property to align the stamp.
187This gives better results when variable-width characters (like
188Asian language characters and math symbols) precede a timestamp.
189Unfortunately, it only works in Emacs 22 and when using the X
190Window System.
191
192A side effect of enabling this is that there will only be one
193space before a right timestamp in any saved logs."
194  :group 'erc-stamp
195  :type 'boolean)
196
197(defun erc-insert-timestamp-left (string)
198  "Insert timestamps at the beginning of the line."
199  (goto-char (point-min))
200  (let* ((ignore-p (and erc-timestamp-only-if-changed-flag
201			(string-equal string erc-timestamp-last-inserted)))
202	 (len (length string))
203	 (s (if ignore-p (make-string len ? ) string)))
204    (unless ignore-p (setq erc-timestamp-last-inserted string))
205    (erc-put-text-property 0 len 'field 'erc-timestamp s)
206    (erc-put-text-property 0 len 'invisible 'timestamp s)
207    (insert s)))
208
209(defun erc-insert-aligned (string pos)
210  "Insert STRING at the POSth column.
211
212If `erc-timestamp-use-align-to' is t, use the :align-to display
213property to get to the POSth column."
214  (if (not erc-timestamp-use-align-to)
215      (indent-to pos)
216    (insert " ")
217    (put-text-property (1- (point)) (point) 'display
218		       (list 'space ':align-to pos)))
219  (insert string))
220
221(defun erc-insert-timestamp-right (string)
222  "Insert timestamp on the right side of the screen.
223STRING is the timestamp to insert.  The function is a possible value
224for `erc-insert-timestamp-function'.
225
226If `erc-timestamp-only-if-changed-flag' is nil, a timestamp is always
227printed.  If this variable is non-nil, a timestamp is only printed if
228it is different from the last.
229
230If `erc-timestamp-right-column' is set, its value will be used as the
231column at which the timestamp is to be printed.  If it is nil, and
232`erc-fill-mode' is active, then the timestamp will be printed just
233before `erc-fill-column'.  Otherwise, if the current buffer is
234shown in a window, that window's width is used.  If the buffer is
235not shown, and `fill-column' is set, then the timestamp will be
236printed just `fill-column'.  As a last resort, the timestamp will
237be printed just before the window-width."
238  (unless (and erc-timestamp-only-if-changed-flag
239	       (string-equal string erc-timestamp-last-inserted))
240    (setq erc-timestamp-last-inserted string)
241    (goto-char (point-max))
242    (forward-char -1);; before the last newline
243    (let* ((current-window (get-buffer-window (current-buffer)))
244	   (str-width (string-width string))
245	   (pos (cond
246		 (erc-timestamp-right-column erc-timestamp-right-column)
247		 ((and (boundp 'erc-fill-mode)
248		       erc-fill-mode
249		       (boundp 'erc-fill-column)
250		       erc-fill-column)
251		  (1+ (- erc-fill-column str-width)))
252		 (fill-column
253		  (1+ (- fill-column str-width)))
254		 (t
255		  (- (window-width) str-width 1))))
256	   (from (point))
257	   (col (current-column))
258	   indent)
259      ;; The following is a kludge used to calculate whether to move
260      ;; to the next line before inserting a stamp.  It allows for
261      ;; some margin of error if what is displayed on the line differs
262      ;; from the number of characters on the line.
263      (setq col (+ col (ceiling (/ (- col (- (point) (point-at-bol))) 1.6))))
264      (if (< col pos)
265	  (erc-insert-aligned string pos)
266	(newline)
267	(indent-to pos)
268	(setq from (point))
269	(insert string))
270      (erc-put-text-property from (point) 'field 'erc-timestamp)
271      (erc-put-text-property from (point) 'rear-nonsticky t)
272      (when erc-timestamp-intangible
273	(erc-put-text-property from (1+ (point)) 'intangible t)))))
274
275;; for testing: (setq erc-timestamp-only-if-changed-flag nil)
276
277(defun erc-format-timestamp (time format)
278  "Return TIME formatted as string according to FORMAT.
279Return the empty string if FORMAT is nil."
280  (if format
281      (let ((ts (format-time-string format time)))
282	(erc-put-text-property 0 (length ts) 'face 'erc-timestamp-face ts)
283	(erc-put-text-property 0 (length ts) 'invisible 'timestamp ts)
284	(erc-put-text-property 0 (length ts)
285			       'isearch-open-invisible 'timestamp ts)
286	;; N.B. Later use categories instead of this harmless, but
287	;; inelegant, hack. -- BPT
288	(when erc-timestamp-intangible
289	  (erc-put-text-property 0 (length ts) 'intangible t ts))
290	ts)
291    ""))
292
293;; This function is used to munge `buffer-invisibility-spec to an
294;; appropriate value. Currently, it only handles timestamps, thus its
295;; location.  If you add other features which affect invisibility,
296;; please modify this function and move it to a more appropriate
297;; location.
298(defun erc-munge-invisibility-spec ()
299  (if erc-hide-timestamps
300      (setq buffer-invisibility-spec
301	    (if (listp buffer-invisibility-spec)
302		(cons 'timestamp buffer-invisibility-spec)
303	      (list 't 'timestamp)))
304    (setq buffer-invisibility-spec
305	  (if (listp buffer-invisibility-spec)
306	      (remove 'timestamp buffer-invisibility-spec)
307	    (list 't)))))
308
309(defun erc-hide-timestamps ()
310  "Hide timestamp information from display."
311  (interactive)
312  (setq erc-hide-timestamps t)
313  (erc-munge-invisibility-spec))
314
315(defun erc-show-timestamps ()
316  "Show timestamp information on display.
317This function only works if `erc-timestamp-format' was previously
318set, and timestamping is already active."
319  (interactive)
320  (setq erc-hide-timestamps nil)
321  (erc-munge-invisibility-spec))
322
323(defun erc-toggle-timestamps ()
324  "Hide or show timestamps in ERC buffers.
325
326Note that timestamps can only be shown for a message using this
327function if `erc-timestamp-format' was set and timestamping was
328enabled when the message was inserted."
329  (interactive)
330  (if erc-hide-timestamps
331      (setq erc-hide-timestamps nil)
332    (setq erc-hide-timestamps t))
333  (mapc (lambda (buffer)
334	  (with-current-buffer buffer
335	    (erc-munge-invisibility-spec)))
336	(erc-buffer-list)))
337
338(defun erc-echo-timestamp (before now)
339  "Print timestamp text-property of an IRC message.
340Argument BEFORE is where point was before it got moved and
341NOW is position of point currently."
342  (when erc-echo-timestamps
343    (let ((stamp (get-text-property now 'timestamp)))
344      (when stamp
345	(message (format-time-string erc-echo-timestamp-format
346				     stamp))))))
347
348(provide 'erc-stamp)
349
350;;; erc-stamp.el ends here
351;;
352;; Local Variables:
353;; indent-tabs-mode: t
354;; tab-width: 8
355;; End:
356
357;; arch-tag: 57aefab4-63e0-4c48-91d5-6efa145487e0
358