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 (defvar lv-wnd nil
  37   "Holds the current LV window.")
  38
  39 (defun lv-window ()
  40   "Ensure that LV window is live and return it."
  41   (if (window-live-p lv-wnd)
  42       lv-wnd
  43     (let ((ori (selected-window))
  44           buf)
  45       (prog1 (setq lv-wnd
  46                    (select-window
  47                     (split-window
  48                      (frame-root-window) -1 'below)))
  49         (if (setq buf (get-buffer "*LV*"))
  50             (switch-to-buffer buf)
  51           (switch-to-buffer "*LV*")
  52           (set-window-hscroll lv-wnd 0)
  53           (setq mode-line-format nil)
  54           (setq cursor-type nil)
  55           (set-window-dedicated-p lv-wnd t)
  56           (set-window-parameter lv-wnd 'no-other-window t))
  57         (select-window ori)))))
  58
  59 (defvar golden-ratio-mode)
  60
  61 (defun lv-message (format-string &rest args)
  62   "Set LV window contents to (`format' FORMAT-STRING ARGS)."
  63   (let* ((ori (selected-window))
  64          (str (apply #'format format-string args))
  65          (n-lines (cl-count ?\n str))
  66          deactivate-mark
  67          golden-ratio-mode)
  68     (select-window (lv-window))
  69     (unless (string= (buffer-string) str)
  70       (delete-region (point-min) (point-max))
  71       (insert str)
  72       (setq-local window-min-height n-lines)
  73       (setq truncate-lines (> n-lines 1))
  74       (fit-window-to-buffer nil nil 1))
  75     (goto-char (point-min))
  76     (select-window ori)))
  77
  78 (provide 'lv)
  79
  80 ;;; lv.el ends here