code.delx.au - gnu-emacs-elpa/blob - packages/hydra/lv.el

   1 ;;; lv.el --- Other echo area
   2
   3 ;; Copyright (C) 2015  Free Software Foundation, Inc.
   4
   5 ;; Author: Oleh Krehel
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software: you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;;; Commentary:
  23 ;;
  24 ;; This package provides `lv-message' intended to be used in place of
  25 ;; `message' when semi-permanent hints are needed, in order to not
  26 ;; interfere with Echo Area.
  27 ;;
  28 ;;    "Я тихо-тихо пiдглядаю,
  29 ;;     І тiшуся собi, як бачу то,
  30 ;;     Шо страшить i не пiдпускає,
  31 ;;     А iншi п’ють тебе, як воду пiсок."
  32 ;;     --  Андрій Кузьменко, L.V.
  33
  34 ;;; Code:
  35
  36 (defgroup lv nil
  37   "The other echo area."
  38   :group 'minibuffer
  39   :group 'hydra)
  40
  41 (defcustom lv-use-separator nil
  42   "Whether to draw a line between the LV window and the Echo Area."
  43   :group 'lv
  44   :type 'boolean)
  45
  46 (defface lv-separator
  47   '((((class color) (background light)) :background "grey80")
  48     (((class color) (background  dark)) :background "grey30"))
  49   "Face used to draw line between the lv window and the echo area.
  50 This is only used if option `lv-use-separator' is non-nil.
  51 Only the background color is significant."
  52   :group 'lv)
  53
  54 (defvar lv-wnd nil
  55   "Holds the current LV window.")
  56
  57 (defun lv-window ()
  58   "Ensure that LV window is live and return it."
  59   (if (window-live-p lv-wnd)
  60       lv-wnd
  61     (let ((ori (selected-window))
  62           buf)
  63       (prog1 (setq lv-wnd
  64                    (select-window
  65                     (let ((ignore-window-parameters t))
  66                       (split-window
  67                        (frame-root-window) -1 'below))))
  68         (if (setq buf (get-buffer "*LV*"))
  69             (switch-to-buffer buf)
  70           (switch-to-buffer "*LV*")
  71           (set-window-hscroll lv-wnd 0)
  72           (setq window-size-fixed t)
  73           (setq mode-line-format nil)
  74           (setq cursor-type nil)
  75           (set-window-dedicated-p lv-wnd t)
  76           (set-window-parameter lv-wnd 'no-other-window t))
  77         (select-window ori)))))
  78
  79 (defvar golden-ratio-mode)
  80
  81 (defvar lv-force-update nil
  82   "When non-nil, `lv-message' will refresh even for the same string.")
  83
  84 (defun lv-message (format-string &rest args)
  85   "Set LV window contents to (`format' FORMAT-STRING ARGS)."
  86   (let* ((str (apply #'format format-string args))
  87          (n-lines (cl-count ?\n str))
  88          deactivate-mark
  89          golden-ratio-mode)
  90     (with-selected-window (lv-window)
  91       (unless (and (string= (buffer-string) str)
  92                    (null lv-force-update))
  93         (delete-region (point-min) (point-max))
  94         (insert str)
  95         (when (and (window-system) lv-use-separator)
  96           (unless (looking-back "\n" nil)
  97             (insert "\n"))
  98           (insert
  99            (propertize "__" 'face 'lv-separator 'display '(space :height (1)))
 100            (propertize "\n" 'face 'lv-separator 'line-height t)))
 101         (set (make-local-variable 'window-min-height) n-lines)
 102         (setq truncate-lines (> n-lines 1))
 103         (let ((window-resize-pixelwise t)
 104               (window-size-fixed nil))
 105           (fit-window-to-buffer nil nil 1)))
 106       (goto-char (point-min)))))
 107
 108 (defun lv-delete-window ()
 109   "Delete LV window and kill its buffer."
 110   (when (window-live-p lv-wnd)
 111     (let ((buf (window-buffer lv-wnd)))
 112       (delete-window lv-wnd)
 113       (kill-buffer buf))))
 114
 115 (provide 'lv)
 116
 117 ;;; lv.el ends here