dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

geiser-log.el (4233B)

      1 ;;; geiser-log.el -- logging utilities  -*- lexical-binding: t; -*-
      2 
      3 ;; Copyright (C) 2009, 2010, 2012, 2019, 2021, 2022 Jose Antonio Ortega Ruiz
      4 
      5 ;; This program is free software; you can redistribute it and/or
      6 ;; modify it under the terms of the Modified BSD License. You should
      7 ;; have received a copy of the license along with this program. If
      8 ;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
      9 
     10 ;; Start date: Sat Feb 07, 2009 12:07
     11 
     12 ;;; Commentary:
     13 
     14 ;; Some utilities for maintaining a simple log buffer, mainly for
     15 ;; debugging purposes.
     16 
     17 
     18 ;;; Code:
     19 
     20 (require 'geiser-custom)
     21 (require 'geiser-popup)
     22 (require 'geiser-base)
     23 
     24 (require 'comint)
     25 
     26 
     27 ;;; Customization:
     28 
     29 (geiser-custom--defcustom geiser-log-autoscroll-buffer-p nil
     30   "Set this so than the buffer *Geiser Messages* always shows the last message"
     31   :group 'geiser
     32   :type 'boolean)
     33 
     34 (defvar geiser-log--buffer-name "*Geiser Messages*"
     35   "Name of the Geiser log buffer.")
     36 
     37 (defvar geiser-log--max-buffer-size 320000
     38   "Maximum size of the Geiser messages log.")
     39 
     40 (defvar geiser-log--max-message-size 20480
     41   "Maximum size of individual Geiser log messages.")
     42 
     43 (define-obsolete-variable-alias
     44   'geiser-log-verbose-p 'geiser-log-verbose "0.26.2")
     45 
     46 (defvar geiser-log-verbose nil
     47   "Log purely informational messages.")
     48 
     49 (define-obsolete-variable-alias
     50   'geiser-log-verbose-debug-p 'geiser-log-verbose-debug "0.26.2")
     51 
     52 (defvar geiser-log-verbose-debug nil
     53   "Log very verbose informational messages. Useful only for debugging.")
     54 
     55 
     56 (defvar geiser-log--inhibit nil
     57   "Set this to t to inhibit all log messages")
     58 
     59 
     60 ;;; Log buffer and mode:
     61 
     62 (defvar geiser-messages-mode-map
     63   (let ((map (make-sparse-keymap)))
     64     (define-key map "c" 'geiser-log-clear)
     65     (define-key map "Q" 'geiser-log--deactivate)
     66     map))
     67 
     68 (define-derived-mode geiser-messages-mode fundamental-mode "Geiser Messages"
     69   "Simple mode for Geiser log messages buffer."
     70   (buffer-disable-undo)
     71   (add-hook 'after-change-functions
     72             (lambda (b _e _len)
     73               (let ((inhibit-read-only t))
     74                 (when (> b geiser-log--max-buffer-size)
     75                   (delete-region (point-min) b))))
     76             nil t)
     77   ;; Maybe this feature would better be implemented as a revert-buffer function?
     78   (add-hook 'after-change-functions
     79             (lambda (_b _e _len)
     80               (when geiser-log-autoscroll-buffer-p
     81                 (let ((my-window (get-buffer-window (geiser-log--buffer) t)))
     82                   (when (window-live-p my-window)
     83                     (set-window-point my-window (point))))))
     84             nil t)
     85   (setq buffer-read-only t))
     86 
     87 (geiser-popup--define log geiser-log--buffer-name geiser-messages-mode)
     88 
     89 
     90 ;;; Logging functions:
     91 
     92 (defun geiser-log--msg (type &rest args)
     93   (unless geiser-log--inhibit
     94     (geiser-log--with-buffer
     95       (goto-char (point-max))
     96       (insert (geiser--shorten-str (format "\n%s: %s\n" type
     97                                            (apply 'format args))
     98                                    geiser-log--max-message-size)))))
     99 
    100 (defsubst geiser-log--warn (&rest args)
    101   (apply 'geiser-log--msg 'WARNING args))
    102 
    103 (defsubst geiser-log--error (&rest args)
    104   (apply 'geiser-log--msg 'ERROR args))
    105 
    106 (defsubst geiser-log--info (&rest args)
    107   (when geiser-log-verbose
    108     (apply 'geiser-log--msg 'INFO args) ""))
    109 
    110 (defsubst geiser-log--debug (&rest args)
    111   (when geiser-log-verbose-debug
    112     (apply 'geiser-log--msg 'DEBUG args) ""))
    113 
    114 
    115 ;;; User commands:
    116 
    117 (defun geiser-show-logs (&optional arg)
    118   "Show Geiser log messages.
    119 
    120 With prefix, activates all logging levels."
    121   (interactive "P")
    122   (setq geiser-log-verbose t)
    123   (when arg
    124     (setq geiser-log-verbose-debug t))
    125   (geiser-log--pop-to-buffer))
    126 
    127 (defun geiser-log-clear ()
    128   "Clean all logs."
    129   (interactive)
    130   (geiser-log--with-buffer (delete-region (point-min) (point-max))))
    131 
    132 (defun geiser-log-toggle-verbose ()
    133   "Toggle verbose logs"
    134   (interactive)
    135   (setq geiser-log-verbose (not geiser-log-verbose))
    136   (message "Geiser verbose logs %s"
    137            (if geiser-log-verbose "enabled" "disabled")))
    138 
    139 (defun geiser-log--deactivate ()
    140   (interactive)
    141   (setq geiser-log-verbose nil)
    142   (when (eq (current-buffer) (geiser-log--buffer)) (View-quit)))
    143 
    144 
    145 (provide 'geiser-log)