Mercurial > emacs
comparison lisp/erc/erc-stamp.el @ 68451:fc745b05e928
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-22
Creator: Michael Olson <mwolson@gnu.org>
Install ERC.
author | Miles Bader <miles@gnu.org> |
---|---|
date | Sun, 29 Jan 2006 13:08:58 +0000 |
parents | |
children | 528aecb860cf |
comparison
equal
deleted
inserted
replaced
68450:a3ba4ef5d590 | 68451:fc745b05e928 |
---|---|
1 ;;; erc-stamp.el --- Timestamping for Emacs IRC CLient | |
2 | |
3 ;; Copyright (C) 2002, 2003, 2004 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 | |
43 useful to have individual messages timestamp. This | |
44 group provides settings related to the format and display | |
45 of timestamp information in `erc-mode' buffer. | |
46 | |
47 For timestamping to be activated, you just need to load `erc-stamp' | |
48 in 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. | |
53 This string is processed using `format-time-string'. | |
54 Good examples are \"%T\" and \"%H:%M\". | |
55 | |
56 If 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 | |
64 It takes a single argument STRING which is the final string | |
65 which all text-properties already appended. This function only cares about | |
66 inserting this string at the right position. Narrowing is in effect | |
67 while it is called, so (point-min) and (point-max) determine the region to | |
68 operate 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 | |
77 If nil, timestamping is turned off when away unless `erc-timestamp-format' | |
78 is set. | |
79 | |
80 If `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 | |
88 See `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 | |
97 This is useful for logging, because, although timestamps will be | |
98 hidden, 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. | |
104 Using this variable, you can turn off normal timestamping, | |
105 and simply move point to an irc message to see its timestamp | |
106 printed 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. | |
112 This string specifies the format of the timestamp being echoed in | |
113 the 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 | |
119 from 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 | |
140 This function is meant to be called from `erc-insert-modify-hook' | |
141 or `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 (with-current-buffer (erc-server-buffer) erc-away) | |
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. | |
165 If `erc-insert-timestamp-function' is `erc-insert-timestamp-left', a | |
166 string of spaces which is the same size as the timestamp is added to | |
167 the beginning of the line in its place. If you use | |
168 `erc-insert-timestamp-right', nothing gets inserted in place of the | |
169 timestamp." | |
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, | |
175 if the timestamp is to be printed to the right. If nil, | |
176 `erc-insert-timestamp-right' will use other means to determine | |
177 the correct column." | |
178 :group 'erc-stamp | |
179 :type '(choice | |
180 (integer :tag "Column number") | |
181 (const :tag "Unspecified" nil))) | |
182 | |
183 (defun erc-insert-timestamp-left (string) | |
184 "Insert timestamps at the beginning of the line." | |
185 (goto-char (point-min)) | |
186 (let* ((ignore-p (and erc-timestamp-only-if-changed-flag | |
187 (string-equal string erc-timestamp-last-inserted))) | |
188 (len (length string)) | |
189 (s (if ignore-p (make-string len ? ) string))) | |
190 (unless ignore-p (setq erc-timestamp-last-inserted string)) | |
191 (erc-put-text-property 0 len 'field 'erc-timestamp s) | |
192 (insert s))) | |
193 | |
194 (defun erc-insert-aligned (string pos &optional fallback) | |
195 "Insert STRING based on a fraction of the width of the buffer. | |
196 Fraction is roughly (/ POS (window-width)). | |
197 | |
198 If the current version of Emacs doesn't support this, use | |
199 \(- POS FALLBACK) to determine how many spaces to insert." | |
200 (if (or (featurep 'xemacs) | |
201 (< emacs-major-version 22) | |
202 (not (eq window-system 'x))) | |
203 (insert (make-string (- pos fallback) ? ) string) | |
204 (insert " ") | |
205 (let ((offset (floor (* (/ (1- pos) (window-width) 1.0) | |
206 (nth 2 (window-inside-pixel-edges)))))) | |
207 (put-text-property (1- (point)) (point) 'display | |
208 `(space :align-to (,offset)))) | |
209 (insert string))) | |
210 | |
211 (defun erc-insert-timestamp-right (string) | |
212 "Insert timestamp on the right side of the screen. | |
213 STRING is the timestamp to insert. The function is a possible value | |
214 for `erc-insert-timestamp-function'. | |
215 | |
216 If `erc-timestamp-only-if-changed-flag' is nil, a timestamp is always | |
217 printed. If this variable is non-nil, a timestamp is only printed if | |
218 it is different from the last. | |
219 | |
220 If `erc-timestamp-right-column' is set, its value will be used as the | |
221 column at which the timestamp is to be printed. If it is nil, and | |
222 `erc-fill-mode' is active, then the timestamp will be printed just | |
223 before `erc-fill-column'. Otherwise, if the current buffer is | |
224 shown in a window, that window's width is used. If the buffer is | |
225 not shown, and `fill-column' is set, then the timestamp will be | |
226 printed just `fill-column'. As a last resort, the timestamp will | |
227 be printed just before the window-width." | |
228 (unless (and erc-timestamp-only-if-changed-flag | |
229 (string-equal string erc-timestamp-last-inserted)) | |
230 (setq erc-timestamp-last-inserted string) | |
231 (goto-char (point-max)) | |
232 (forward-char -1);; before the last newline | |
233 (let* ((current-window (get-buffer-window (current-buffer))) | |
234 (pos (cond | |
235 (erc-timestamp-right-column | |
236 (+ erc-timestamp-right-column (length string))) | |
237 ((and (boundp 'erc-fill-mode) | |
238 erc-fill-mode | |
239 (boundp 'erc-fill-column)) | |
240 (1+ erc-fill-column)) | |
241 (current-window | |
242 (- (window-width current-window) | |
243 1)) | |
244 (fill-column | |
245 (1+ fill-column)) | |
246 (t | |
247 (- (window-width) | |
248 1)))) | |
249 (from (point)) | |
250 (col (current-column)) | |
251 indent) | |
252 ;; deal with variable-width characters | |
253 (setq pos (- pos (string-width string)) | |
254 ;; the following is a kludge that works with most | |
255 ;; international input | |
256 col (+ col (ceiling (/ (- col (- (point) (point-at-bol))) 1.6)))) | |
257 (if (< col pos) | |
258 (erc-insert-aligned string pos col) | |
259 (newline) | |
260 (setq from (point)) | |
261 (indent-to pos) | |
262 (insert string)) | |
263 (erc-put-text-property from (1+ (point)) 'field 'erc-timestamp) | |
264 (erc-put-text-property from (1+ (point)) 'rear-nonsticky t) | |
265 (when erc-timestamp-intangible | |
266 (erc-put-text-property from (1+ (point)) 'intangible t))))) | |
267 | |
268 ;; for testing: (setq erc-timestamp-only-if-changed-flag nil) | |
269 | |
270 (defun erc-format-timestamp (time format) | |
271 "Return TIME formatted as string according to FORMAT. | |
272 Return the empty string if FORMAT is nil." | |
273 (if format | |
274 (let ((ts (format-time-string format time))) | |
275 (erc-put-text-property 0 (length ts) 'face 'erc-timestamp-face ts) | |
276 (erc-put-text-property 0 (length ts) 'invisible 'timestamp ts) | |
277 (erc-put-text-property 0 (length ts) | |
278 'isearch-open-invisible 'timestamp ts) | |
279 ;; N.B. Later use categories instead of this harmless, but | |
280 ;; inelegant, hack. -- BPT | |
281 (when erc-timestamp-intangible | |
282 (erc-put-text-property 0 (length ts) 'intangible t ts)) | |
283 ts) | |
284 "")) | |
285 | |
286 ;; This function is used to munge `buffer-invisibility-spec to an | |
287 ;; appropriate value. Currently, it only handles timestamps, thus its | |
288 ;; location. If you add other features which affect invisibility, | |
289 ;; please modify this function and move it to a more appropriate | |
290 ;; location. | |
291 (defun erc-munge-invisibility-spec () | |
292 (if erc-hide-timestamps | |
293 (setq buffer-invisibility-spec | |
294 (if (listp buffer-invisibility-spec) | |
295 (cons 'timestamp buffer-invisibility-spec) | |
296 (list 't 'timestamp))) | |
297 (setq buffer-invisibility-spec | |
298 (if (listp buffer-invisibility-spec) | |
299 (remove 'timestamp buffer-invisibility-spec) | |
300 (list 't))))) | |
301 | |
302 (defun erc-hide-timestamps () | |
303 "Hide timestamp information from display." | |
304 (interactive) | |
305 (setq erc-hide-timestamps t) | |
306 (erc-munge-invisibility-spec)) | |
307 | |
308 (defun erc-show-timestamps () | |
309 "Show timestamp information on display. | |
310 This function only works if `erc-timestamp-format' was previously | |
311 set, and timestamping is already active." | |
312 (interactive) | |
313 (setq erc-hide-timestamps nil) | |
314 (erc-munge-invisibility-spec)) | |
315 | |
316 (defun erc-echo-timestamp (before now) | |
317 "Print timestamp text-property of an IRC message. | |
318 Argument BEFORE is where point was before it got moved and | |
319 NOW is position of point currently." | |
320 (when erc-echo-timestamps | |
321 (let ((stamp (get-text-property now 'timestamp))) | |
322 (when stamp | |
323 (message (format-time-string erc-echo-timestamp-format | |
324 stamp)))))) | |
325 | |
326 (provide 'erc-stamp) | |
327 | |
328 ;;; erc-stamp.el ends here | |
329 ;; | |
330 ;; Local Variables: | |
331 ;; indent-tabs-mode: t | |
332 ;; tab-width: 8 | |
333 ;; End: | |
334 | |
335 ;; arch-tag: 9f6d31bf-61ba-45c5-bdbf-56331486ea27 |