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