aboutsummaryrefslogtreecommitdiffstats
path: root/elpa/lv-20200507.1518/lv.el
blob: 1e62477dc20ac7f6fdc7907110dd54bee5aa5936 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
;;; lv.el --- Other echo area
;; Package-Version: 20200507.1518
;; Package-Commit: 9e9e00cb240ea1903ffd36a54956b3902c379d29

;; Copyright (C) 2015  Free Software Foundation, Inc.

;; Author: Oleh Krehel

;; This file is part of GNU Emacs.

;; GNU Emacs 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.

;; GNU Emacs 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 GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:
;;
;; This package provides `lv-message' intended to be used in place of
;; `message' when semi-permanent hints are needed, in order to not
;; interfere with Echo Area.
;;
;;    "Я тихо-тихо пiдглядаю,
;;     І тiшуся собi, як бачу то,
;;     Шо страшить i не пiдпускає,
;;     А iншi п’ють тебе, як воду пiсок."
;;     --  Андрій Кузьменко, L.V.

;;; Code:

(require 'cl-lib)

(defgroup lv nil
  "The other echo area."
  :group 'minibuffer
  :group 'hydra)

(defcustom lv-use-separator nil
  "Whether to draw a line between the LV window and the Echo Area."
  :group 'lv
  :type 'boolean)

(defcustom lv-use-padding nil
  "Whether to use horizontal padding in the LV window."
  :group 'lv
  :type 'boolean)

(defface lv-separator
  '((((class color) (background light)) :background "grey80")
    (((class color) (background  dark)) :background "grey30"))
  "Face used to draw line between the lv window and the echo area.
This is only used if option `lv-use-separator' is non-nil.
Only the background color is significant."
  :group 'lv)

(defvar lv-wnd nil
  "Holds the current LV window.")

(defvar display-line-numbers)
(defvar display-fill-column-indicator)
(defvar tab-line-format)

(defvar lv-window-hook nil
  "Hook to run by `lv-window' when a new window is created.")

(defun lv-window ()
  "Ensure that LV window is live and return it."
  (if (window-live-p lv-wnd)
      lv-wnd
    (let ((ori (selected-window))
          buf)
      (prog1 (setq lv-wnd
                   (select-window
                    (let ((ignore-window-parameters t))
                      (split-window
                       (frame-root-window) -1 'below))
                    'norecord))
        (if (setq buf (get-buffer " *LV*"))
            (switch-to-buffer buf 'norecord)
          (switch-to-buffer " *LV*" 'norecord)
          (fundamental-mode)
          (set-window-hscroll lv-wnd 0)
          (setq window-size-fixed t)
          (setq mode-line-format nil)
          (setq header-line-format nil)
          (setq tab-line-format nil)
          (setq cursor-type nil)
          (setq display-line-numbers nil)
          (setq display-fill-column-indicator nil)
          (set-window-dedicated-p lv-wnd t)
          (set-window-parameter lv-wnd 'no-other-window t)
          (run-hooks 'lv-window-hook))
        (select-window ori 'norecord)))))

(defvar golden-ratio-mode)

(defvar lv-force-update nil
  "When non-nil, `lv-message' will refresh even for the same string.")

(defun lv--pad-to-center (str width)
  "Pad STR with spaces on the left to be centered to WIDTH."
  (let* ((strs (split-string str "\n"))
         (padding (make-string
                   (/ (- width (length (car strs))) 2)
                   ?\ )))
    (mapconcat (lambda (s) (concat padding s)) strs "\n")))

(defun lv-message (format-string &rest args)
  "Set LV window contents to (`format' FORMAT-STRING ARGS)."
  (let* ((str (apply #'format format-string args))
         (n-lines (cl-count ?\n str))
         deactivate-mark
         golden-ratio-mode)
    (with-selected-window (lv-window)
      (when lv-use-padding
        (setq str (lv--pad-to-center str (window-width))))
      (unless (and (string= (buffer-string) str)
                   (null lv-force-update))
        (delete-region (point-min) (point-max))
        (insert str)
        (when (and (window-system) lv-use-separator)
          (unless (looking-back "\n" nil)
            (insert "\n"))
          (insert
           (propertize "__" 'face 'lv-separator 'display '(space :height (1)))
           (propertize "\n" 'face 'lv-separator 'line-height t)))
        (set (make-local-variable 'window-min-height) n-lines)
        (setq truncate-lines (> n-lines 1))
        (let ((window-resize-pixelwise t)
              (window-size-fixed nil))
          (fit-window-to-buffer nil nil 1)))
      (goto-char (point-min)))))

(defun lv-delete-window ()
  "Delete LV window and kill its buffer."
  (when (window-live-p lv-wnd)
    (let ((buf (window-buffer lv-wnd)))
      (delete-window lv-wnd)
      (kill-buffer buf))))

(provide 'lv)

;;; lv.el ends here