sly-messages.el (6059B)
1 ;;; sly-messages.el --- Messages, errors, echo-area and visual feedback utils for SLY -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2014 João Távora 4 5 ;; Author: João Távora <joaotavora@gmail.com> 6 ;; Keywords: 7 8 ;; This program is free software; you can redistribute it and/or modify 9 ;; it under the terms of the GNU General Public License as published by 10 ;; the Free Software Foundation, either version 3 of the License, or 11 ;; (at your option) any later version. 12 13 ;; This program is distributed in the hope that it will be useful, 14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 ;; GNU General Public License for more details. 17 18 ;; You should have received a copy of the GNU General Public License 19 ;; along with this program. If not, see <http://www.gnu.org/licenses/>. 20 21 ;;; Commentary: 22 23 ;; 24 25 ;;; Code: 26 27 (require 'cl-lib) 28 29 (defvar sly--last-message nil) 30 31 (defun sly-message (format-string &rest args) 32 "Like `message', but use a prefix." 33 (let ((body (apply #'format format-string args))) 34 (setq sly--last-message (format "[sly] %s" body)) 35 (message "%s" sly--last-message))) 36 37 (add-hook 'echo-area-clear-hook 38 'sly--message-clear-last-message) 39 40 (defun sly--message-clear-last-message () 41 (setq sly--last-message nil)) 42 43 (defun sly-temp-message (wait sit-for format &rest args) 44 "Wait WAIT seconds then display a message for SIT-FOR seconds. 45 A nil value for WAIT means \"now\". 46 SIT-FOR is has the semantincs of `minibuffer-message-timeout', which see." 47 (run-with-timer 48 wait nil 49 #'(lambda () 50 (let ((existing sly--last-message) 51 (text (apply #'format format args))) 52 (if (minibuffer-window-active-p (minibuffer-window)) 53 (let ((minibuffer-message-timeout sit-for)) 54 (minibuffer-message "[sly] %s" text)) 55 (message "[sly] %s" text) ; don't sly-message here 56 (run-with-timer 57 sit-for 58 nil 59 #'(lambda () 60 ;; restore the message 61 (when existing 62 (message "%s" existing))))))))) 63 64 (defun sly-warning (format-string &rest args) 65 (display-warning '(sly warning) (apply #'format format-string args))) 66 67 (defun sly-error (format-string &rest args) 68 (apply #'error (format "[sly] %s" format-string) args)) 69 70 (defun sly-user-error (format-string &rest args) 71 (apply #'user-error (format "[sly] %s" format-string) args)) 72 73 (defun sly-display-oneliner (format-string &rest format-args) 74 (let* ((msg (apply #'format format-string format-args))) 75 (unless (minibuffer-window-active-p (minibuffer-window)) 76 (sly-message (sly-oneliner msg))))) 77 78 (defun sly-oneliner (string) 79 "Return STRING truncated to fit in a single echo-area line." 80 (substring string 0 (min (length string) 81 (or (cl-position ?\n string) most-positive-fixnum) 82 (1- (window-width (minibuffer-window)))))) 83 84 (defun sly-completing-read (prompt choices &optional 85 predicate 86 require-match 87 initial-input 88 hist 89 def 90 inherit-input-method) 91 "Like `completing-read', but tweak `completing-read-function'. 92 Specifically, if the `completion-read-function' has not been 93 tweaked, and `icomplete-mode' is not being used, use 94 `ido-completing-read' to provide a better UX." 95 (let ((completing-read-function 96 (if (and (eq completing-read-function 'completing-read-default) 97 (not icomplete-mode)) 98 #'ido-completing-read 99 completing-read-function))) 100 (completing-read prompt choices predicate require-match initial-input hist def 101 inherit-input-method))) 102 103 (defun sly-y-or-n-p (format-string &rest args) 104 (let ((prompt (apply #'format (concat "[sly] " 105 format-string) 106 args))) 107 (y-or-n-p prompt))) 108 109 110 ;;; Flashing the region 111 ;;; 112 (defvar sly-flash-inhibit nil 113 "If non-nil `sly-flash-region' does nothing") 114 115 (defvar sly--flash-overlay (make-overlay 0 0)) 116 (overlay-put sly--flash-overlay 'priority 1000) 117 118 (cl-defun sly-flash-region (start end &key 119 timeout 120 face 121 times 122 (pattern '(0.2))) 123 "Temporarily highlight region from START to END." 124 (if pattern 125 (cl-assert (and (null times) (null timeout)) 126 nil 127 "If PATTERN is supplied, don't supply TIMES or TIMEOUT") 128 (setq pattern (make-list (* 2 times) timeout))) 129 (unless sly-flash-inhibit 130 (let ((buffer (current-buffer))) 131 (move-overlay sly--flash-overlay start end buffer) 132 (cl-labels 133 ((on () (overlay-put sly--flash-overlay 'face (or face 'highlight))) 134 (off () (overlay-put sly--flash-overlay 'face nil)) 135 (relevant-p () 136 (equal (list start end buffer) 137 (list (overlay-start sly--flash-overlay) 138 (overlay-end sly--flash-overlay) 139 (overlay-buffer sly--flash-overlay)))) 140 (onoff () 141 (when (and pattern (relevant-p)) 142 (on) 143 (run-with-timer (pop pattern) 144 nil 145 (lambda () 146 (when (relevant-p) 147 (off) 148 (when pattern 149 (run-with-timer 150 (pop pattern) 151 nil 152 (lambda () (onoff)))))))))) 153 (onoff))))) 154 155 (provide 'sly-messages) 156 ;;; sly-messages.el ends here