code.delx.au - gnu-emacs/blob - 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-insert-timestamp-function 'erc-insert-timestamp-right
  62   "*Function to use to insert timestamps.
  63
  64 It takes a single argument STRING which is the final string
  65 which all text-properties already appended.  This function only cares about
  66 inserting this string at the right position.  Narrowing is in effect
  67 while it is called, so (point-min) and (point-max) determine the region to
  68 operate on."
  69   :group 'erc-stamp
  70   :type '(choice (const :tag "Right" erc-insert-timestamp-right)
  71                  (const :tag "Left" erc-insert-timestamp-left)
  72                  function))
  73
  74 (defcustom erc-away-timestamp-format "<%H:%M>"
  75   "*Timestamp format used when marked as being away.
  76
  77 If nil, timestamping is turned off when away unless `erc-timestamp-format'
  78 is set.
  79
  80 If `erc-timestamp-format' is set, this will not be used."
  81   :group 'erc-stamp
  82   :type '(choice (const nil)
  83                  (string)))
  84
  85 (defcustom erc-insert-away-timestamp-function 'erc-insert-timestamp-right
  86   "*Function to use to insert the away timestamp.
  87
  88 See `erc-insert-timestamp-function' for details."
  89   :group 'erc-stamp
  90   :type '(choice (const :tag "Right" erc-insert-timestamp-right)
  91                  (const :tag "Left" erc-insert-timestamp-left)
  92                  function))
  93
  94 (defcustom erc-hide-timestamps nil
  95   "*If non-nil, timestamps will be invisible.
  96
  97 This is useful for logging, because, although timestamps will be
  98 hidden, they will still be present in the logs."
  99   :group 'erc-stamp
 100   :type 'boolean)
 101
 102 (defcustom erc-echo-timestamps nil
 103   "*If non-nil, print timestamp in the minibuffer when point is moved.
 104 Using this variable, you can turn off normal timestamping,
 105 and simply move point to an irc message to see its timestamp
 106 printed in the minibuffer."
 107   :group 'erc-stamp
 108   :type 'boolean)
 109
 110 (defcustom erc-echo-timestamp-format "Timestamped %A, %H:%M:%S"
 111   "*Format string to be used when `erc-echo-timestamps' is non-nil.
 112 This string specifies the format of the timestamp being echoed in
 113 the minibuffer."
 114   :group 'erc-stamp
 115   :type 'string)
 116
 117 (defcustom erc-timestamp-intangible t
 118   "*Whether the timestamps should be intangible, i.e. prevent the point
 119 from entering them and instead jump over them."
 120   :group 'erc-stamp
 121   :type 'boolean)
 122
 123 (defface erc-timestamp-face '((t (:bold t :foreground "green")))
 124   "ERC timestamp face."
 125   :group 'erc-faces)
 126
 127 ;;;###autoload (autoload 'erc-timestamp-mode "erc-stamp" nil t)
 128 (define-erc-module stamp timestamp
 129   "This mode timestamps messages in the channel buffers."
 130   ((add-hook 'erc-mode-hook 'erc-munge-invisibility-spec)
 131    (add-hook 'erc-insert-modify-hook 'erc-add-timestamp t)
 132    (add-hook 'erc-send-modify-hook 'erc-add-timestamp t))
 133   ((remove-hook 'erc-mode-hook 'erc-munge-invisibility-spec)
 134    (remove-hook 'erc-insert-modify-hook 'erc-add-timestamp)
 135    (remove-hook 'erc-send-modify-hook 'erc-add-timestamp)))
 136
 137 (defun erc-add-timestamp ()
 138   "Add timestamp and text-properties to message.
 139
 140 This function is meant to be called from `erc-insert-modify-hook'
 141 or `erc-send-modify-hook'."
 142   (unless (get-text-property (point) 'invisible)
 143     (let ((ct (current-time)))
 144       (if (fboundp erc-insert-timestamp-function)
 145           (funcall erc-insert-timestamp-function
 146                    (erc-format-timestamp ct erc-timestamp-format))
 147         (error "Timestamp function unbound"))
 148       (when (and (fboundp erc-insert-away-timestamp-function)
 149                  erc-away-timestamp-format
 150                  (erc-away-time)
 151                  (not erc-timestamp-format))
 152         (funcall erc-insert-away-timestamp-function
 153                  (erc-format-timestamp ct erc-away-timestamp-format)))
 154       (add-text-properties (point-min) (point-max)
 155                            (list 'timestamp ct))
 156       (add-text-properties (point-min) (point-max)
 157                            (list 'point-entered 'erc-echo-timestamp)))))
 158
 159 (defvar erc-timestamp-last-inserted nil
 160   "Last timestamp inserted into the buffer.")
 161 (make-variable-buffer-local 'erc-timestamp-last-inserted)
 162
 163 (defcustom erc-timestamp-only-if-changed-flag t
 164   "*Insert timestamp only if its value changed since last insertion.
 165 If `erc-insert-timestamp-function' is `erc-insert-timestamp-left', a
 166 string of spaces which is the same size as the timestamp is added to
 167 the beginning of the line in its place. If you use
 168 `erc-insert-timestamp-right', nothing gets inserted in place of the
 169 timestamp."
 170   :group 'erc-stamp
 171   :type 'boolean)
 172
 173 (defcustom erc-timestamp-right-column nil
 174   "*If non-nil, the column at which the timestamp is inserted,
 175 if the timestamp is to be printed to the right.  If nil,
 176 `erc-insert-timestamp-right' will use other means to determine
 177 the correct column."
 178   :group 'erc-stamp
 179   :type '(choice
 180           (integer :tag "Column number")
 181           (const :tag "Unspecified" nil)))
 182
 183 (defcustom erc-timestamp-use-align-to (and (not (featurep 'xemacs))
 184                                            (>= emacs-major-version 22)
 185                                            (eq window-system 'x))
 186   "*If non-nil, use the :align-to display property to align the stamp.
 187 This gives better results when variable-width characters (like
 188 Asian language characters and math symbols) precede a timestamp.
 189 Unfortunately, it only works in Emacs 22 and when using the X
 190 Window System.
 191
 192 A side effect of enabling this is that there will only be one
 193 space before a right timestamp in any saved logs."
 194   :group 'erc-stamp
 195   :type 'boolean)
 196
 197 (defun erc-insert-timestamp-left (string)
 198   "Insert timestamps at the beginning of the line."
 199   (goto-char (point-min))
 200   (let* ((ignore-p (and erc-timestamp-only-if-changed-flag
 201                         (string-equal string erc-timestamp-last-inserted)))
 202          (len (length string))
 203          (s (if ignore-p (make-string len ? ) string)))
 204     (unless ignore-p (setq erc-timestamp-last-inserted string))
 205     (erc-put-text-property 0 len 'field 'erc-timestamp s)
 206     (erc-put-text-property 0 len 'invisible 'timestamp s)
 207     (insert s)))
 208
 209 (defun erc-insert-aligned (string pos)
 210   "Insert STRING at the POSth column.
 211
 212 If `erc-timestamp-use-align-to' is t, use the :align-to display
 213 property to get to the POSth column."
 214   (if (not erc-timestamp-use-align-to)
 215       (indent-to pos)
 216     (insert " ")
 217     (put-text-property (1- (point)) (point) 'display
 218                        (list 'space ':align-to pos)))
 219   (insert string))
 220
 221 (defun erc-insert-timestamp-right (string)
 222   "Insert timestamp on the right side of the screen.
 223 STRING is the timestamp to insert.  The function is a possible value
 224 for `erc-insert-timestamp-function'.
 225
 226 If `erc-timestamp-only-if-changed-flag' is nil, a timestamp is always
 227 printed.  If this variable is non-nil, a timestamp is only printed if
 228 it is different from the last.
 229
 230 If `erc-timestamp-right-column' is set, its value will be used as the
 231 column at which the timestamp is to be printed.  If it is nil, and
 232 `erc-fill-mode' is active, then the timestamp will be printed just
 233 before `erc-fill-column'.  Otherwise, if the current buffer is
 234 shown in a window, that window's width is used.  If the buffer is
 235 not shown, and `fill-column' is set, then the timestamp will be
 236 printed just `fill-column'.  As a last resort, the timestamp will
 237 be printed just before the window-width."
 238   (unless (and erc-timestamp-only-if-changed-flag
 239                (string-equal string erc-timestamp-last-inserted))
 240     (setq erc-timestamp-last-inserted string)
 241     (goto-char (point-max))
 242     (forward-char -1);; before the last newline
 243     (let* ((current-window (get-buffer-window (current-buffer)))
 244            (str-width (string-width string))
 245            (pos (cond
 246                  (erc-timestamp-right-column erc-timestamp-right-column)
 247                  ((and (boundp 'erc-fill-mode)
 248                        erc-fill-mode
 249                        (boundp 'erc-fill-column)
 250                        erc-fill-column)
 251                   (1+ (- erc-fill-column str-width)))
 252                  (fill-column
 253                   (1+ (- fill-column str-width)))
 254                  (t
 255                   (- (window-width) str-width 1))))
 256            (from (point))
 257            (col (current-column))
 258            indent)
 259       ;; The following is a kludge used to calculate whether to move
 260       ;; to the next line before inserting a stamp.  It allows for
 261       ;; some margin of error if what is displayed on the line differs
 262       ;; from the number of characters on the line.
 263       (setq col (+ col (ceiling (/ (- col (- (point) (point-at-bol))) 1.6))))
 264       (if (< col pos)
 265           (erc-insert-aligned string pos)
 266         (newline)
 267         (indent-to pos)
 268         (setq from (point))
 269         (insert string))
 270       (erc-put-text-property from (point) 'field 'erc-timestamp)
 271       (erc-put-text-property from (point) 'rear-nonsticky t)
 272       (when erc-timestamp-intangible
 273         (erc-put-text-property from (1+ (point)) 'intangible t)))))
 274
 275 ;; for testing: (setq erc-timestamp-only-if-changed-flag nil)
 276
 277 (defun erc-format-timestamp (time format)
 278   "Return TIME formatted as string according to FORMAT.
 279 Return the empty string if FORMAT is nil."
 280   (if format
 281       (let ((ts (format-time-string format time)))
 282         (erc-put-text-property 0 (length ts) 'face 'erc-timestamp-face ts)
 283         (erc-put-text-property 0 (length ts) 'invisible 'timestamp ts)
 284         (erc-put-text-property 0 (length ts)
 285                                'isearch-open-invisible 'timestamp ts)
 286         ;; N.B. Later use categories instead of this harmless, but
 287         ;; inelegant, hack. -- BPT
 288         (when erc-timestamp-intangible
 289           (erc-put-text-property 0 (length ts) 'intangible t ts))
 290         ts)
 291     ""))
 292
 293 ;; This function is used to munge `buffer-invisibility-spec to an
 294 ;; appropriate value. Currently, it only handles timestamps, thus its
 295 ;; location.  If you add other features which affect invisibility,
 296 ;; please modify this function and move it to a more appropriate
 297 ;; location.
 298 (defun erc-munge-invisibility-spec ()
 299   (if erc-hide-timestamps
 300       (setq buffer-invisibility-spec
 301             (if (listp buffer-invisibility-spec)
 302                 (cons 'timestamp buffer-invisibility-spec)
 303               (list 't 'timestamp)))
 304     (setq buffer-invisibility-spec
 305           (if (listp buffer-invisibility-spec)
 306               (remove 'timestamp buffer-invisibility-spec)
 307             (list 't)))))
 308
 309 (defun erc-hide-timestamps ()
 310   "Hide timestamp information from display."
 311   (interactive)
 312   (setq erc-hide-timestamps t)
 313   (erc-munge-invisibility-spec))
 314
 315 (defun erc-show-timestamps ()
 316   "Show timestamp information on display.
 317 This function only works if `erc-timestamp-format' was previously
 318 set, and timestamping is already active."
 319   (interactive)
 320   (setq erc-hide-timestamps nil)
 321   (erc-munge-invisibility-spec))
 322
 323 (defun erc-toggle-timestamps ()
 324   "Hide or show timestamps in ERC buffers.
 325
 326 Note that timestamps can only be shown for a message using this
 327 function if `erc-timestamp-format' was set and timestamping was
 328 enabled when the message was inserted."
 329   (interactive)
 330   (if erc-hide-timestamps
 331       (setq erc-hide-timestamps nil)
 332     (setq erc-hide-timestamps t))
 333   (mapc (lambda (buffer)
 334           (with-current-buffer buffer
 335             (erc-munge-invisibility-spec)))
 336         (erc-buffer-list)))
 337
 338 (defun erc-echo-timestamp (before now)
 339   "Print timestamp text-property of an IRC message.
 340 Argument BEFORE is where point was before it got moved and
 341 NOW is position of point currently."
 342   (when erc-echo-timestamps
 343     (let ((stamp (get-text-property now 'timestamp)))
 344       (when stamp
 345         (message (format-time-string erc-echo-timestamp-format
 346                                      stamp))))))
 347
 348 (provide 'erc-stamp)
 349
 350 ;;; erc-stamp.el ends here
 351 ;;
 352 ;; Local Variables:
 353 ;; indent-tabs-mode: t
 354 ;; tab-width: 8
 355 ;; End:
 356
 357 ;; arch-tag: 57aefab4-63e0-4c48-91d5-6efa145487e0