my-emacs-d/elpa/circe-20160608.1315/lui-logging.el

;;; lui-logging.el --- Logging support for lui

;; Copyright (C) 2006  Jorgen Schaefer,
;;               2012  Anthony Martinez

;; Author: Anthony Martinez <pi+circe@pihost.us>

;; This file is part of Lui.

;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License
;; as published by the Free Software Foundation; either version 3
;; of the License, or (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
;; 02110-1301  USA

;;; Commentary:

;; This lui module enables logging. Lui applications can change the
;; values of `lui-logging-format-arguments' to provide further
;; possibilities of customizing `lui-logging-file-format' for users.

;;; Code:

(require 'lui-format)
(require 'url-util)

(defgroup lui-logging nil
  "Logging support."
  :prefix "lui-logging-"
  :group 'lui)

(defcustom lui-logging-format "[%T] {text}"
  "The format used for log file entries.
This is first passed through `format-time-string' and then through
`lui-format'. The following format strings exist:

  {text} - the text to be logged"
  :type 'string
  :group 'lui-logging)

(defcustom lui-logging-directory "~/.logs"
  "The directory where log files are stored."
  :type 'directory
  :group 'lui-logging)

(defcustom lui-logging-file-format "{buffer}_%Y-%m-%d.txt"
  "The format to be used for the log file name.
This is first passed through `format-time-string', and then
through `lui-format'. Possible lui format strings are:

  {buffer} - the buffer name where the logging happened.

Lui applications can provide further format strings. See
`lui-logging-format-arguments' in the appropriate buffer."
  :type 'string
  :group 'lui-logging)

(defcustom lui-logging-flush-delay 0
  "The number of seconds to delay writing newly-received messages
to disk. This can increase performance/decrease IO-wait at the
cost of a little bit of safety."
  :type 'integer
  :group 'lui-logging)

(defvar lui-logging-format-arguments nil
  "A list of arguments to be passed to `lui-format'.
This can be used to extend the formatting possibilities of the
file name for lui applications.")
(make-variable-buffer-local 'lui-logging-format-arguments)

(defvar lui-logging-file-name-unreserved-chars
  ;; All but '/' is fine actually, but also omit '%' because otherwise there's
  ;; ambiguity between one introduced by encoding and a literal one.
  '(?! ?\" ?# ?$ ?& ?` ?\( ?\) ?* ?+ ?,?: ?\; ?< ?= ?> ?? ?@?\[ ?\\ ?\] ?^ ?`
       ?\{ ?| ?\})
  "A list of characters that should not be percent-encoded by
`url-hexify-string' while generating a logging file name.")

(defvar lui-pending-logs
  (make-hash-table :test 'equal)
  "Storage for log messages awaiting write. It is structured as a
hash table mapping filenames to a list-of-strings, which serves as
a queue.")

(defvar lui-logging-timer nil
  "The timer used to flush lui-logged buffers")

(defun lui-logging-delayed-p ()
  (> lui-logging-flush-delay 0))

(defun enable-lui-logging ()
  "Enable lui logging for this buffer. Also create the log
file's directory, should it not exist."
  (interactive)
  (add-hook 'lui-pre-output-hook 'lui-logging
            nil t))

(defun disable-lui-logging ()
  "Disable lui logging for this buffer, and flush any pending
logs to disk."
  (interactive)
  (remove-hook 'lui-pre-output-hook 'lui-logging t)
  (lui-logging-flush))

(defun enable-lui-logging-globally ()
  "Enable lui logging for all Lui buffers.

This affects current as well as future buffers."
  (interactive)
  (add-hook 'lui-mode-hook 'enable-lui-logging)
  (dolist (buf (buffer-list))
    (with-current-buffer buf
      (when lui-input-marker
        (enable-lui-logging)))))

(defun disable-lui-logging-globally ()
  "Disable logging in all future Lui buffers.

This affects current as well as future buffers."
  (interactive)
  (remove-hook 'lui-mode-hook 'enable-lui-logging)
  (dolist (buf (buffer-list))
    (with-current-buffer buf
      (when lui-input-marker
        (disable-lui-logging)))))

(defun lui-logging-file-name ()
  "Create the name of the log file based on `lui-logging-file-format'."
  (let* ((time-formatted (format-time-string lui-logging-file-format))
         (buffer (let ((url-unreserved-chars
                        (append url-unreserved-chars
                                lui-logging-file-name-unreserved-chars))
                       (downcased (downcase (buffer-name (current-buffer)))))
                   (url-hexify-string downcased)))
         (filename (apply 'lui-format
                          time-formatted
                          :buffer buffer
                          lui-logging-format-arguments)))
    (concat lui-logging-directory "/" filename)))

(defun lui-logging-flush ()
  "Flush out the lui-logging queue, and clear the timer set by
`lui-logging'."
  (maphash #'lui-logging-flush-file lui-pending-logs)
  (clrhash lui-pending-logs)
  (cancel-timer lui-logging-timer)
  (setq lui-logging-timer nil))

(defun lui-logging-write-to-log (file-name content)
  "Actually perform a write to the logfile."
  (let ((coding-system-for-write 'raw-text)
        (dir (file-name-directory file-name)))
    (when (not (file-directory-p dir))
      (make-directory dir t))
    (write-region content nil file-name t 'nomessage)))

(defun lui-logging-flush-file (file-name queue)
  "Consume the logging queue and write the content to the log
file."
  (let ((content (apply #'concat (nreverse queue))))
    (lui-logging-write-to-log file-name content)))

(defun lui-logging-format-string (text)
  "Generate a string to be either directly written or enqueued."
  (substring-no-properties
   (lui-format
    (format-time-string lui-logging-format)
    :text text)))

(defun lui-logging-enqueue (file-name text)
  "Given a filename, push text onto its queue, and tickle the
timer, if necessary."
  (puthash file-name
           (cons text (gethash file-name lui-pending-logs))
           lui-pending-logs)
  (when (null lui-logging-timer)
    (setq lui-logging-timer
          (run-with-timer lui-logging-flush-delay nil
                          #'lui-logging-flush))))

(defun lui-logging ()
  "If output-queueing is enabled, append the to-be-logged string
to the output queue. Otherwise, write directly to the logfile.
This should be added to `lui-pre-output-hook' by way of
`enable-lui-logging'."
  (let ((text (lui-logging-format-string (buffer-string))))
    (if (lui-logging-delayed-p)
        (lui-logging-enqueue (lui-logging-file-name) text)
      (lui-logging-write-to-log (lui-logging-file-name) text))))

(provide 'lui-logging)
;;; lui-logging.el ends here