lisp/erc/erc-stamp.el

   1 ;;; erc-stamp.el --- Timestamping for ERC messages
   2
   3 ;; Copyright (C) 2002-2004, 2006-2015 Free Software Foundation, Inc.
   4
   5 ;; Author: Mario Lang <mlang@delysid.org>
   6 ;; Maintainer: emacs-devel@gnu.org
   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 nil
 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   :version "24.5"
 155   :type 'boolean)
 156
 157 (defface erc-timestamp-face '((t :weight bold :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 (defvar erc-fill-column)
 269
 270 (defun erc-insert-timestamp-right (string)
 271   "Insert timestamp on the right side of the screen.
 272 STRING is the timestamp to insert.  The function is a possible value
 273 for `erc-insert-timestamp-function'.
 274
 275 If `erc-timestamp-only-if-changed-flag' is nil, a timestamp is always
 276 printed.  If this variable is non-nil, a timestamp is only printed if
 277 it is different from the last.
 278
 279 If `erc-timestamp-right-column' is set, its value will be used as the
 280 column at which the timestamp is to be printed.  If it is nil, and
 281 `erc-fill-mode' is active, then the timestamp will be printed just
 282 before `erc-fill-column'.  Otherwise, if the current buffer is
 283 shown in a window, that window's width is used.  If the buffer is
 284 not shown, and `fill-column' is set, then the timestamp will be
 285 printed just `fill-column'.  As a last resort, the timestamp will
 286 be printed just before the window-width."
 287   (unless (and erc-timestamp-only-if-changed-flag
 288                (string-equal string erc-timestamp-last-inserted))
 289     (setq erc-timestamp-last-inserted string)
 290     (goto-char (point-max))
 291     (forward-char -1);; before the last newline
 292     (let* ((current-window (get-buffer-window (current-buffer)))
 293            (str-width (string-width string))
 294            (pos (cond
 295                  (erc-timestamp-right-column erc-timestamp-right-column)
 296                  ((and (boundp 'erc-fill-mode)
 297                        erc-fill-mode
 298                        (boundp 'erc-fill-column)
 299                        erc-fill-column)
 300                   (1+ (- erc-fill-column str-width)))
 301                  (fill-column
 302                   (1+ (- fill-column str-width)))
 303                  (t
 304                   (- (window-width) str-width 1))))
 305            (from (point))
 306            (col (current-column))
 307            indent)
 308       ;; The following is a kludge used to calculate whether to move
 309       ;; to the next line before inserting a stamp.  It allows for
 310       ;; some margin of error if what is displayed on the line differs
 311       ;; from the number of characters on the line.
 312       (setq col (+ col (ceiling (/ (- col (- (point) (point-at-bol))) 1.6))))
 313       (if (< col pos)
 314           (erc-insert-aligned string pos)
 315         (newline)
 316         (indent-to pos)
 317         (setq from (point))
 318         (insert string))
 319       (erc-put-text-property from (point) 'field 'erc-timestamp)
 320       (erc-put-text-property from (point) 'rear-nonsticky t)
 321       (when erc-timestamp-intangible
 322         (erc-put-text-property from (1+ (point)) 'intangible t)))))
 323
 324 (defun erc-insert-timestamp-left-and-right (string)
 325   "This is another function that can be assigned to
 326 `erc-insert-timestamp-function'.  If the date is changed, it will
 327 print a blank line, the date, and another blank line.  If the time is
 328 changed, it will then print it off to the right."
 329   (let* ((ct (current-time))
 330          (ts-left (erc-format-timestamp ct erc-timestamp-format-left))
 331          (ts-right (erc-format-timestamp ct erc-timestamp-format-right)))
 332     ;; insert left timestamp
 333     (unless (string-equal ts-left erc-timestamp-last-inserted-left)
 334       (goto-char (point-min))
 335       (erc-put-text-property 0 (length ts-left) 'field 'erc-timestamp ts-left)
 336       (insert ts-left)
 337       (setq erc-timestamp-last-inserted-left ts-left))
 338     ;; insert right timestamp
 339     (let ((erc-timestamp-only-if-changed-flag t)
 340           (erc-timestamp-last-inserted erc-timestamp-last-inserted-right))
 341       (erc-insert-timestamp-right ts-right)
 342       (setq erc-timestamp-last-inserted-right ts-right))))
 343
 344 ;; for testing: (setq erc-timestamp-only-if-changed-flag nil)
 345
 346 (defun erc-format-timestamp (time format)
 347   "Return TIME formatted as string according to FORMAT.
 348 Return the empty string if FORMAT is nil."
 349   (if format
 350       (let ((ts (format-time-string format time)))
 351         (erc-put-text-property 0 (length ts) 'face 'erc-timestamp-face ts)
 352         (erc-put-text-property 0 (length ts) 'invisible 'timestamp ts)
 353         (erc-put-text-property 0 (length ts)
 354                                'isearch-open-invisible 'timestamp ts)
 355         ;; N.B. Later use categories instead of this harmless, but
 356         ;; inelegant, hack. -- BPT
 357         (and erc-timestamp-intangible
 358              (not erc-hide-timestamps)  ; bug#11706
 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