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 ;; Silence byte-compiler
 268 (eval-when-compile
 269   (defvar erc-fill-column))
 270
 271 (defun erc-insert-timestamp-right (string)
 272   "Insert timestamp on the right side of the screen.
 273 STRING is the timestamp to insert.  The function is a possible value
 274 for `erc-insert-timestamp-function'.
 275
 276 If `erc-timestamp-only-if-changed-flag' is nil, a timestamp is always
 277 printed.  If this variable is non-nil, a timestamp is only printed if
 278 it is different from the last.
 279
 280 If `erc-timestamp-right-column' is set, its value will be used as the
 281 column at which the timestamp is to be printed.  If it is nil, and
 282 `erc-fill-mode' is active, then the timestamp will be printed just
 283 before `erc-fill-column'.  Otherwise, if the current buffer is
 284 shown in a window, that window's width is used.  If the buffer is
 285 not shown, and `fill-column' is set, then the timestamp will be
 286 printed just `fill-column'.  As a last resort, the timestamp will
 287 be printed just before the window-width."
 288   (unless (and erc-timestamp-only-if-changed-flag
 289                (string-equal string erc-timestamp-last-inserted))
 290     (setq erc-timestamp-last-inserted string)
 291     (goto-char (point-max))
 292     (forward-char -1);; before the last newline
 293     (let* ((current-window (get-buffer-window (current-buffer)))
 294            (str-width (string-width string))
 295            (pos (cond
 296                  (erc-timestamp-right-column erc-timestamp-right-column)
 297                  ((and (boundp 'erc-fill-mode)
 298                        erc-fill-mode
 299                        (boundp 'erc-fill-column)
 300                        erc-fill-column)
 301                   (1+ (- erc-fill-column str-width)))
 302                  (fill-column
 303                   (1+ (- fill-column str-width)))
 304                  (t
 305                   (- (window-width) str-width 1))))
 306            (from (point))
 307            (col (current-column))
 308            indent)
 309       ;; The following is a kludge used to calculate whether to move
 310       ;; to the next line before inserting a stamp.  It allows for
 311       ;; some margin of error if what is displayed on the line differs
 312       ;; from the number of characters on the line.
 313       (setq col (+ col (ceiling (/ (- col (- (point) (point-at-bol))) 1.6))))
 314       (if (< col pos)
 315           (erc-insert-aligned string pos)
 316         (newline)
 317         (indent-to pos)
 318         (setq from (point))
 319         (insert string))
 320       (erc-put-text-property from (point) 'field 'erc-timestamp)
 321       (erc-put-text-property from (point) 'rear-nonsticky t)
 322       (when erc-timestamp-intangible
 323         (erc-put-text-property from (1+ (point)) 'intangible t)))))
 324
 325 (defun erc-insert-timestamp-left-and-right (string)
 326   "This is another function that can be assigned to
 327 `erc-insert-timestamp-function'.  If the date is changed, it will
 328 print a blank line, the date, and another blank line.  If the time is
 329 changed, it will then print it off to the right."
 330   (let* ((ct (current-time))
 331          (ts-left (erc-format-timestamp ct erc-timestamp-format-left))
 332          (ts-right (erc-format-timestamp ct erc-timestamp-format-right)))
 333     ;; insert left timestamp
 334     (unless (string-equal ts-left erc-timestamp-last-inserted-left)
 335       (goto-char (point-min))
 336       (erc-put-text-property 0 (length ts-left) 'field 'erc-timestamp ts-left)
 337       (insert ts-left)
 338       (setq erc-timestamp-last-inserted-left ts-left))
 339     ;; insert right timestamp
 340     (let ((erc-timestamp-only-if-changed-flag t)
 341           (erc-timestamp-last-inserted erc-timestamp-last-inserted-right))
 342       (erc-insert-timestamp-right ts-right)
 343       (setq erc-timestamp-last-inserted-right ts-right))))
 344
 345 ;; for testing: (setq erc-timestamp-only-if-changed-flag nil)
 346
 347 (defun erc-format-timestamp (time format)
 348   "Return TIME formatted as string according to FORMAT.
 349 Return the empty string if FORMAT is nil."
 350   (if format
 351       (let ((ts (format-time-string format time)))
 352         (erc-put-text-property 0 (length ts) 'face 'erc-timestamp-face ts)
 353         (erc-put-text-property 0 (length ts) 'invisible 'timestamp ts)
 354         (erc-put-text-property 0 (length ts)
 355                                'isearch-open-invisible 'timestamp ts)
 356         ;; N.B. Later use categories instead of this harmless, but
 357         ;; inelegant, hack. -- BPT
 358         (when erc-timestamp-intangible
 359           (erc-put-text-property 0 (length ts) 'intangible t ts))
 360         ts)
 361     ""))
 362
 363 ;; This function is used to munge `buffer-invisibility-spec to an
 364 ;; appropriate value. Currently, it only handles timestamps, thus its
 365 ;; location.  If you add other features which affect invisibility,
 366 ;; please modify this function and move it to a more appropriate
 367 ;; location.
 368 (defun erc-munge-invisibility-spec ()
 369   (if erc-hide-timestamps
 370       (setq buffer-invisibility-spec
 371             (if (listp buffer-invisibility-spec)
 372                 (cons 'timestamp buffer-invisibility-spec)
 373               (list 't 'timestamp)))
 374     (setq buffer-invisibility-spec
 375           (if (listp buffer-invisibility-spec)
 376               (remove 'timestamp buffer-invisibility-spec)
 377             (list 't)))))
 378
 379 (defun erc-hide-timestamps ()
 380   "Hide timestamp information from display."
 381   (interactive)
 382   (setq erc-hide-timestamps t)
 383   (erc-munge-invisibility-spec))
 384
 385 (defun erc-show-timestamps ()
 386   "Show timestamp information on display.
 387 This function only works if `erc-timestamp-format' was previously
 388 set, and timestamping is already active."
 389   (interactive)
 390   (setq erc-hide-timestamps nil)
 391   (erc-munge-invisibility-spec))
 392
 393 (defun erc-toggle-timestamps ()
 394   "Hide or show timestamps in ERC buffers.
 395
 396 Note that timestamps can only be shown for a message using this
 397 function if `erc-timestamp-format' was set and timestamping was
 398 enabled when the message was inserted."
 399   (interactive)
 400   (if erc-hide-timestamps
 401       (setq erc-hide-timestamps nil)
 402     (setq erc-hide-timestamps t))
 403   (mapc (lambda (buffer)
 404           (with-current-buffer buffer
 405             (erc-munge-invisibility-spec)))
 406         (erc-buffer-list)))
 407
 408 (defun erc-echo-timestamp (before now)
 409   "Print timestamp text-property of an IRC message.
 410 Argument BEFORE is where point was before it got moved and
 411 NOW is position of point currently."
 412   (when erc-echo-timestamps
 413     (let ((stamp (get-text-property now 'timestamp)))
 414       (when stamp
 415         (message "%s" (format-time-string erc-echo-timestamp-format
 416                                           stamp))))))
 417
 418 (provide 'erc-stamp)
 419
 420 ;;; erc-stamp.el ends here
 421 ;;
 422 ;; Local Variables:
 423 ;; indent-tabs-mode: t
 424 ;; tab-width: 8
 425 ;; End:
 426
 427 ;; arch-tag: 57aefab4-63e0-4c48-91d5-6efa145487e0