code.delx.au - gnu-emacs/blob - lisp/erc/erc-stamp.el

   1 ;;; erc-stamp.el --- Timestamping for ERC messages
   2
   3 ;; Copyright (C) 2002-2004, 2006-2016 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 'cursor-sensor-functions
 192                                  (list #'erc-echo-timestamp))))))
 193
 194 (defvar erc-timestamp-last-inserted nil
 195   "Last timestamp inserted into the buffer.")
 196 (make-variable-buffer-local 'erc-timestamp-last-inserted)
 197
 198 (defvar erc-timestamp-last-inserted-left nil
 199   "Last timestamp inserted into the left side of the buffer.
 200 This is used when `erc-insert-timestamp-function' is set to
 201 `erc-timestamp-left-and-right'")
 202 (make-variable-buffer-local 'erc-timestamp-last-inserted-left)
 203
 204 (defvar erc-timestamp-last-inserted-right nil
 205   "Last timestamp inserted into the right side of the buffer.
 206 This is used when `erc-insert-timestamp-function' is set to
 207 `erc-timestamp-left-and-right'")
 208 (make-variable-buffer-local 'erc-timestamp-last-inserted-right)
 209
 210 (defcustom erc-timestamp-only-if-changed-flag t
 211   "Insert timestamp only if its value changed since last insertion.
 212 If `erc-insert-timestamp-function' is `erc-insert-timestamp-left', a
 213 string of spaces which is the same size as the timestamp is added to
 214 the beginning of the line in its place. If you use
 215 `erc-insert-timestamp-right', nothing gets inserted in place of the
 216 timestamp."
 217   :group 'erc-stamp
 218   :type 'boolean)
 219
 220 (defcustom erc-timestamp-right-column nil
 221   "If non-nil, the column at which the timestamp is inserted,
 222 if the timestamp is to be printed to the right.  If nil,
 223 `erc-insert-timestamp-right' will use other means to determine
 224 the correct column."
 225   :group 'erc-stamp
 226   :type '(choice
 227           (integer :tag "Column number")
 228           (const :tag "Unspecified" nil)))
 229
 230 (defcustom erc-timestamp-use-align-to (and (not (featurep 'xemacs))
 231                                            (>= emacs-major-version 22)
 232                                            (eq window-system 'x))
 233   "If non-nil, use the :align-to display property to align the stamp.
 234 This gives better results when variable-width characters (like
 235 Asian language characters and math symbols) precede a timestamp.
 236 Unfortunately, it only works in Emacs 22 and when using the X
 237 Window System.
 238
 239 A side effect of enabling this is that there will only be one
 240 space before a right timestamp in any saved logs."
 241   :group 'erc-stamp
 242   :type 'boolean)
 243
 244 (defun erc-insert-timestamp-left (string)
 245   "Insert timestamps at the beginning of the line."
 246   (goto-char (point-min))
 247   (let* ((ignore-p (and erc-timestamp-only-if-changed-flag
 248                         (string-equal string erc-timestamp-last-inserted)))
 249          (len (length string))
 250          (s (if ignore-p (make-string len ? ) string)))
 251     (unless ignore-p (setq erc-timestamp-last-inserted string))
 252     (erc-put-text-property 0 len 'field 'erc-timestamp s)
 253     (erc-put-text-property 0 len 'invisible 'timestamp s)
 254     (insert s)))
 255
 256 (defun erc-insert-aligned (string pos)
 257   "Insert STRING at the POSth column.
 258
 259 If `erc-timestamp-use-align-to' is t, use the :align-to display
 260 property to get to the POSth column."
 261   (if (not erc-timestamp-use-align-to)
 262       (indent-to pos)
 263     (insert " ")
 264     (put-text-property (1- (point)) (point) 'display
 265                        (list 'space ':align-to pos)))
 266   (insert string))
 267
 268 ;; Silence byte-compiler
 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* ((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       ;; 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)) 'cursor-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) 'cursor-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   (and erc-timestamp-intangible (not (bound-and-true-p cursor-intangible-mode))
 369        (cursor-intangible-mode 1))
 370   (and erc-echo-timestamps (not (bound-and-true-p cursor-sensor-mode))
 371        (cursor-sensor-mode 1))
 372   (if erc-hide-timestamps
 373       (add-to-invisibility-spec 'timestamp)
 374     (remove-from-invisibility-spec 'timestamp)))
 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 (window _before dir)
 406   "Print timestamp text-property of an IRC message."
 407   (when (and erc-echo-timestamps (eq 'entered dir))
 408     (let* ((now (window-point window))
 409            (stamp (get-text-property now 'timestamp)))
 410       (when stamp
 411         (message "%s" (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