lv.el (4990B)
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 (require 'cl-lib) 37 38 (defgroup lv nil 39 "The other echo area." 40 :group 'minibuffer 41 :group 'hydra) 42 43 (defcustom lv-use-separator nil 44 "Whether to draw a line between the LV window and the Echo Area." 45 :group 'lv 46 :type 'boolean) 47 48 (defcustom lv-use-padding nil 49 "Whether to use horizontal padding in the LV window." 50 :group 'lv 51 :type 'boolean) 52 53 (defface lv-separator 54 '((((class color) (background light)) :background "grey80") 55 (((class color) (background dark)) :background "grey30")) 56 "Face used to draw line between the lv window and the echo area. 57 This is only used if option `lv-use-separator' is non-nil. 58 Only the background color is significant." 59 :group 'lv) 60 61 (defvar lv-wnd nil 62 "Holds the current LV window.") 63 64 (defvar display-line-numbers) 65 (defvar display-fill-column-indicator) 66 (defvar tab-line-format) 67 68 (defvar lv-window-hook nil 69 "Hook to run by `lv-window' when a new window is created.") 70 71 (defun lv-window () 72 "Ensure that LV window is live and return it." 73 (if (window-live-p lv-wnd) 74 lv-wnd 75 (let ((ori (selected-window)) 76 buf) 77 (prog1 (setq lv-wnd 78 (select-window 79 (let ((ignore-window-parameters t)) 80 (split-window 81 (frame-root-window) -1 'below)) 82 'norecord)) 83 (if (setq buf (get-buffer " *LV*")) 84 (switch-to-buffer buf 'norecord) 85 (switch-to-buffer " *LV*" 'norecord) 86 (fundamental-mode) 87 (set-window-hscroll lv-wnd 0) 88 (setq window-size-fixed t) 89 (setq mode-line-format nil) 90 (setq header-line-format nil) 91 (setq tab-line-format nil) 92 (setq cursor-type nil) 93 (setq display-line-numbers nil) 94 (setq display-fill-column-indicator nil) 95 (set-window-dedicated-p lv-wnd t) 96 (set-window-parameter lv-wnd 'no-other-window t) 97 (run-hooks 'lv-window-hook)) 98 (select-window ori 'norecord))))) 99 100 (defvar golden-ratio-mode) 101 102 (defvar lv-force-update nil 103 "When non-nil, `lv-message' will refresh even for the same string.") 104 105 (defun lv--pad-to-center (str width) 106 "Pad STR with spaces on the left to be centered to WIDTH." 107 (let* ((strs (split-string str "\n")) 108 (padding (make-string 109 (/ (- width (length (car strs))) 2) 110 ?\ ))) 111 (mapconcat (lambda (s) (concat padding s)) strs "\n"))) 112 113 (defun lv-message (format-string &rest args) 114 "Set LV window contents to (`format' FORMAT-STRING ARGS)." 115 (let* ((str (apply #'format format-string args)) 116 (n-lines (cl-count ?\n str)) 117 deactivate-mark 118 golden-ratio-mode) 119 (with-selected-window (lv-window) 120 (when lv-use-padding 121 (setq str (lv--pad-to-center str (window-width)))) 122 (unless (and (string= (buffer-string) str) 123 (null lv-force-update)) 124 (delete-region (point-min) (point-max)) 125 (insert str) 126 (when (and (window-system) lv-use-separator) 127 (unless (looking-back "\n" nil) 128 (insert "\n")) 129 (insert 130 (propertize "__" 'face 'lv-separator 'display '(space :height (1))) 131 (propertize "\n" 'face 'lv-separator 'line-height t))) 132 (set (make-local-variable 'window-min-height) n-lines) 133 (setq truncate-lines (> n-lines 1)) 134 (let ((window-resize-pixelwise t) 135 (window-size-fixed nil)) 136 (fit-window-to-buffer nil nil 1))) 137 (goto-char (point-min))))) 138 139 (defun lv-delete-window () 140 "Delete LV window and kill its buffer." 141 (when (window-live-p lv-wnd) 142 (let ((buf (window-buffer lv-wnd))) 143 (delete-window lv-wnd) 144 (kill-buffer buf)))) 145 146 (provide 'lv) 147 148 ;;; lv.el ends here