lisp/erc/erc-stamp.el

   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 3, 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-timestamp-format-left "\n[%a %b %e %Y]\n"
  62   "*If set to a string, messages will be timestamped.
  63 This string is processed using `format-time-string'.
  64 Good examples are \"%T\" and \"%H:%M\".
  65
  66 This timestamp is used for timestamps on the left side of the
  67 screen when `erc-insert-timestamp-function' is set to
  68 `erc-insert-timestamp-left-and-right'.
  69
  70 If nil, timestamping is turned off."
  71   :group 'erc-stamp
  72   :type '(choice (const nil)
  73                  (string)))
  74
  75 (defcustom erc-timestamp-format-right " [%H:%M]"
  76   "*If set to a string, messages will be timestamped.
  77 This string is processed using `format-time-string'.
  78 Good examples are \"%T\" and \"%H:%M\".
  79
  80 This timestamp is used for timestamps on the right side of the
  81 screen when `erc-insert-timestamp-function' is set to
  82 `erc-insert-timestamp-left-and-right'.
  83
  84 If nil, timestamping is turned off."
  85   :group 'erc-stamp
  86   :type '(choice (const nil)
  87                  (string)))
  88
  89 (defcustom erc-insert-timestamp-function 'erc-insert-timestamp-left-and-right
  90   "*Function to use to insert timestamps.
  91
  92 It takes a single argument STRING which is the final string
  93 which all text-properties already appended.  This function only cares about
  94 inserting this string at the right position.  Narrowing is in effect
  95 while it is called, so (point-min) and (point-max) determine the region to
  96 operate on.
  97
  98 You will probably want to set
  99 `erc-insert-away-timestamp-function' to the same value."
 100   :group 'erc-stamp
 101   :type '(choice (const :tag "Both sides" erc-insert-timestamp-left-and-right)
 102                  (const :tag "Right" erc-insert-timestamp-right)
 103                  (const :tag "Left" erc-insert-timestamp-left)
 104                  function))
 105
 106 (defcustom erc-away-timestamp-format "<%H:%M>"
 107   "*Timestamp format used when marked as being away.
 108
 109 If nil, timestamping is turned off when away unless `erc-timestamp-format'
 110 is set.
 111
 112 If `erc-timestamp-format' is set, this will not be used."
 113   :group 'erc-stamp
 114   :type '(choice (const nil)
 115                  (string)))
 116
 117 (defcustom erc-insert-away-timestamp-function
 118   'erc-insert-timestamp-left-and-right
 119   "*Function to use to insert the away timestamp.
 120
 121 See `erc-insert-timestamp-function' for details."
 122   :group 'erc-stamp
 123   :type '(choice (const :tag "Both sides" erc-insert-timestamp-left-and-right)
 124                  (const :tag "Right" erc-insert-timestamp-right)
 125                  (const :tag "Left" erc-insert-timestamp-left)
 126                  function))
 127
 128 (defcustom erc-hide-timestamps nil
 129   "*If non-nil, timestamps will be invisible.
 130
 131 This is useful for logging, because, although timestamps will be
 132 hidden, they will still be present in the logs."
 133   :group 'erc-stamp
 134   :type 'boolean)
 135
 136 (defcustom erc-echo-timestamps nil
 137   "*If non-nil, print timestamp in the minibuffer when point is moved.
 138 Using this variable, you can turn off normal timestamping,
 139 and simply move point to an irc message to see its timestamp
 140 printed in the minibuffer."
 141   :group 'erc-stamp
 142   :type 'boolean)
 143
 144 (defcustom erc-echo-timestamp-format "Timestamped %A, %H:%M:%S"
 145   "*Format string to be used when `erc-echo-timestamps' is non-nil.
 146 This string specifies the format of the timestamp being echoed in
 147 the minibuffer."
 148   :group 'erc-stamp
 149   :type 'string)
 150
 151 (defcustom erc-timestamp-intangible t
 152   "*Whether the timestamps should be intangible, i.e. prevent the point
 153 from entering them and instead jump over them."
 154   :group 'erc-stamp
 155   :type 'boolean)
 156
 157 (defface erc-timestamp-face '((t (:bold t :foreground "green")))
 158   "ERC timestamp face."
 159   :group 'erc-faces)
 160
 161 ;;;###autoload (autoload 'erc-timestamp-mode "erc-stamp" nil t)
 162 (define-erc-module stamp timestamp
 163   "This mode timestamps messages in the channel buffers."
 164   ((add-hook 'erc-mode-hook 'erc-munge-invisibility-spec)
 165    (add-hook 'erc-insert-modify-hook 'erc-add-timestamp t)
 166    (add-hook 'erc-send-modify-hook 'erc-add-timestamp t))
 167   ((remove-hook 'erc-mode-hook 'erc-munge-invisibility-spec)
 168    (remove-hook 'erc-insert-modify-hook 'erc-add-timestamp)
 169    (remove-hook 'erc-send-modify-hook 'erc-add-timestamp)))
 170
 171 (defun erc-add-timestamp ()
 172   "Add timestamp and text-properties to message.
 173
 174 This function is meant to be called from `erc-insert-modify-hook'
 175 or `erc-send-modify-hook'."
 176   (unless (get-text-property (point) 'invisible)
 177     (let ((ct (current-time)))
 178       (if (fboundp erc-insert-timestamp-function)
 179           (funcall erc-insert-timestamp-function
 180                    (erc-format-timestamp ct erc-timestamp-format))
 181         (error "Timestamp function unbound"))
 182       (when (and (fboundp erc-insert-away-timestamp-function)
 183                  erc-away-timestamp-format
 184                  (erc-away-time)
 185                  (not erc-timestamp-format))
 186         (funcall erc-insert-away-timestamp-function
 187                  (erc-format-timestamp ct erc-away-timestamp-format)))
 188       (add-text-properties (point-min) (point-max)
 189                            (list 'timestamp ct))
 190       (add-text-properties (point-min) (point-max)
 191                            (list 'point-entered 'erc-echo-timestamp)))))
 192
 193 (defvar erc-timestamp-last-inserted nil
 194   "Last timestamp inserted into the buffer.")
 195 (make-variable-buffer-local 'erc-timestamp-last-inserted)
 196
 197 (defvar erc-timestamp-last-inserted-left nil
 198   "Last timestamp inserted into the left side of the buffer.
 199 This is used when `erc-insert-timestamp-function' is set to
 200 `erc-timestamp-left-and-right'")
 201 (make-variable-buffer-local 'erc-timestamp-last-inserted-left)
 202
 203 (defvar erc-timestamp-last-inserted-right nil
 204   "Last timestamp inserted into the right side of the buffer.
 205 This is used when `erc-insert-timestamp-function' is set to
 206 `erc-timestamp-left-and-right'")
 207 (make-variable-buffer-local 'erc-timestamp-last-inserted-right)
 208
 209 (defcustom erc-timestamp-only-if-changed-flag t
 210   "*Insert timestamp only if its value changed since last insertion.
 211 If `erc-insert-timestamp-function' is `erc-insert-timestamp-left', a
 212 string of spaces which is the same size as the timestamp is added to
 213 the beginning of the line in its place. If you use
 214 `erc-insert-timestamp-right', nothing gets inserted in place of the
 215 timestamp."
 216   :group 'erc-stamp
 217   :type 'boolean)
 218
 219 (defcustom erc-timestamp-right-column nil
 220   "*If non-nil, the column at which the timestamp is inserted,
 221 if the timestamp is to be printed to the right.  If nil,
 222 `erc-insert-timestamp-right' will use other means to determine
 223 the correct column."
 224   :group 'erc-stamp
 225   :type '(choice
 226           (integer :tag "Column number")
 227           (const :tag "Unspecified" nil)))
 228
 229 (defcustom erc-timestamp-use-align-to (and (not (featurep 'xemacs))
 230                                            (>= emacs-major-version 22)
 231                                            (eq window-system 'x))
 232   "*If non-nil, use the :align-to display property to align the stamp.
 233 This gives better results when variable-width characters (like
 234 Asian language characters and math symbols) precede a timestamp.
 235 Unfortunately, it only works in Emacs 22 and when using the X
 236 Window System.
 237
 238 A side effect of enabling this is that there will only be one
 239 space before a right timestamp in any saved logs."
 240   :group 'erc-stamp
 241   :type 'boolean)
 242
 243 (defun erc-insert-timestamp-left (string)
 244   "Insert timestamps at the beginning of the line."
 245   (goto-char (point-min))
 246   (let* ((ignore-p (and erc-timestamp-only-if-changed-flag
 247                         (string-equal string erc-timestamp-last-inserted)))
 248          (len (length string))
 249          (s (if ignore-p (make-string len ? ) string)))
 250     (unless ignore-p (setq erc-timestamp-last-inserted string))
 251     (erc-put-text-property 0 len 'field 'erc-timestamp s)
 252     (erc-put-text-property 0 len 'invisible 'timestamp s)
 253     (insert s)))
 254
 255 (defun erc-insert-aligned (string pos)
 256   "Insert STRING at the POSth column.
 257
 258 If `erc-timestamp-use-align-to' is t, use the :align-to display
 259 property to get to the POSth column."
 260   (if (not erc-timestamp-use-align-to)
 261       (indent-to pos)
 262     (insert " ")
 263     (put-text-property (1- (point)) (point) 'display
 264                        (list 'space ':align-to pos)))
 265   (insert string))
 266
 267 (defun erc-insert-timestamp-right (string)
 268   "Insert timestamp on the right side of the screen.
 269 STRING is the timestamp to insert.  The function is a possible value
 270 for `erc-insert-timestamp-function'.
 271
 272 If `erc-timestamp-only-if-changed-flag' is nil, a timestamp is always
 273 printed.  If this variable is non-nil, a timestamp is only printed if
 274 it is different from the last.
 275
 276 If `erc-timestamp-right-column' is set, its value will be used as the
 277 column at which the timestamp is to be printed.  If it is nil, and
 278 `erc-fill-mode' is active, then the timestamp will be printed just
 279 before `erc-fill-column'.  Otherwise, if the current buffer is
 280 shown in a window, that window's width is used.  If the buffer is
 281 not shown, and `fill-column' is set, then the timestamp will be
 282 printed just `fill-column'.  As a last resort, the timestamp will
 283 be printed just before the window-width."
 284   (unless (and erc-timestamp-only-if-changed-flag
 285                (string-equal string erc-timestamp-last-inserted))
 286     (setq erc-timestamp-last-inserted string)
 287     (goto-char (point-max))
 288     (forward-char -1);; before the last newline
 289     (let* ((current-window (get-buffer-window (current-buffer)))
 290            (str-width (string-width string))
 291            (pos (cond
 292                  (erc-timestamp-right-column erc-timestamp-right-column)
 293                  ((and (boundp 'erc-fill-mode)
 294                        erc-fill-mode
 295                        (boundp 'erc-fill-column)
 296                        erc-fill-column)
 297                   (1+ (- erc-fill-column str-width)))
 298                  (fill-column
 299                   (1+ (- fill-column str-width)))
 300                  (t
 301                   (- (window-width) str-width 1))))
 302            (from (point))
 303            (col (current-column))
 304            indent)
 305       ;; The following is a kludge used to calculate whether to move
 306       ;; to the next line before inserting a stamp.  It allows for
 307       ;; some margin of error if what is displayed on the line differs
 308       ;; from the number of characters on the line.
 309       (setq col (+ col (ceiling (/ (- col (- (point) (point-at-bol))) 1.6))))
 310       (if (< col pos)
 311           (erc-insert-aligned string pos)
 312         (newline)
 313         (indent-to pos)
 314         (setq from (point))
 315         (insert string))
 316       (erc-put-text-property from (point) 'field 'erc-timestamp)
 317       (erc-put-text-property from (point) 'rear-nonsticky t)
 318       (when erc-timestamp-intangible
 319         (erc-put-text-property from (1+ (point)) 'intangible t)))))
 320
 321 (defun erc-insert-timestamp-left-and-right (string)
 322   "This is another function that can be assigned to
 323 `erc-insert-timestamp-function'.  If the date is changed, it will
 324 print a blank line, the date, and another blank line.  If the time is
 325 changed, it will then print it off to the right."
 326   (let* ((ct (current-time))
 327          (ts-left (erc-format-timestamp ct erc-timestamp-format-left))
 328          (ts-right (erc-format-timestamp ct erc-timestamp-format-right)))
 329     ;; insert left timestamp
 330     (unless (string-equal ts-left erc-timestamp-last-inserted-left)
 331       (goto-char (point-min))
 332       (erc-put-text-property 0 (length ts-left) 'field 'erc-timestamp ts-left)
 333       (insert ts-left)
 334       (setq erc-timestamp-last-inserted-left ts-left))
 335     ;; insert right timestamp
 336     (let ((erc-timestamp-only-if-changed-flag t)
 337           (erc-timestamp-last-inserted erc-timestamp-last-inserted-right))
 338       (erc-insert-timestamp-right ts-right)
 339       (setq erc-timestamp-last-inserted-right ts-right))))
 340
 341 ;; for testing: (setq erc-timestamp-only-if-changed-flag nil)
 342
 343 (defun erc-format-timestamp (time format)
 344   "Return TIME formatted as string according to FORMAT.
 345 Return the empty string if FORMAT is nil."
 346   (if format
 347       (let ((ts (format-time-string format time)))
 348         (erc-put-text-property 0 (length ts) 'face 'erc-timestamp-face ts)
 349         (erc-put-text-property 0 (length ts) 'invisible 'timestamp ts)
 350         (erc-put-text-property 0 (length ts)
 351                                'isearch-open-invisible 'timestamp ts)
 352         ;; N.B. Later use categories instead of this harmless, but
 353         ;; inelegant, hack. -- BPT
 354         (when erc-timestamp-intangible
 355           (erc-put-text-property 0 (length ts) 'intangible t ts))
 356         ts)
 357     ""))
 358
 359 ;; This function is used to munge `buffer-invisibility-spec to an
 360 ;; appropriate value. Currently, it only handles timestamps, thus its
 361 ;; location.  If you add other features which affect invisibility,
 362 ;; please modify this function and move it to a more appropriate
 363 ;; location.
 364 (defun erc-munge-invisibility-spec ()
 365   (if erc-hide-timestamps
 366       (setq buffer-invisibility-spec
 367             (if (listp buffer-invisibility-spec)
 368                 (cons 'timestamp buffer-invisibility-spec)
 369               (list 't 'timestamp)))
 370     (setq buffer-invisibility-spec
 371           (if (listp buffer-invisibility-spec)
 372               (remove 'timestamp buffer-invisibility-spec)
 373             (list 't)))))
 374
 375 (defun erc-hide-timestamps ()
 376   "Hide timestamp information from display."
 377   (interactive)
 378   (setq erc-hide-timestamps t)
 379   (erc-munge-invisibility-spec))
 380
 381 (defun erc-show-timestamps ()
 382   "Show timestamp information on display.
 383 This function only works if `erc-timestamp-format' was previously
 384 set, and timestamping is already active."
 385   (interactive)
 386   (setq erc-hide-timestamps nil)
 387   (erc-munge-invisibility-spec))
 388
 389 (defun erc-toggle-timestamps ()
 390   "Hide or show timestamps in ERC buffers.
 391
 392 Note that timestamps can only be shown for a message using this
 393 function if `erc-timestamp-format' was set and timestamping was
 394 enabled when the message was inserted."
 395   (interactive)
 396   (if erc-hide-timestamps
 397       (setq erc-hide-timestamps nil)
 398     (setq erc-hide-timestamps t))
 399   (mapc (lambda (buffer)
 400           (with-current-buffer buffer
 401             (erc-munge-invisibility-spec)))
 402         (erc-buffer-list)))
 403
 404 (defun erc-echo-timestamp (before now)
 405   "Print timestamp text-property of an IRC message.
 406 Argument BEFORE is where point was before it got moved and
 407 NOW is position of point currently."
 408   (when erc-echo-timestamps
 409     (let ((stamp (get-text-property now 'timestamp)))
 410       (when stamp
 411         (message (format-time-string erc-echo-timestamp-format
 412                                      stamp))))))
 413
 414 (provide 'erc-stamp)
 415
 416 ;;; erc-stamp.el ends here
 417 ;;
 418 ;; Local Variables:
 419 ;; indent-tabs-mode: t
 420 ;; tab-width: 8
 421 ;; End:
 422
 423 ;; arch-tag: 57aefab4-63e0-4c48-91d5-6efa145487e0