lisp/erc/erc-stamp.el

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