sly-messages.el (5151B)
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-y-or-n-p (format-string &rest args) 85 (let ((prompt (apply #'format (concat "[sly] " 86 format-string) 87 args))) 88 (y-or-n-p prompt))) 89 90 91 ;;; Flashing the region 92 ;;; 93 (defvar sly-flash-inhibit nil 94 "If non-nil `sly-flash-region' does nothing") 95 96 (defvar sly--flash-overlay (make-overlay 0 0)) 97 (overlay-put sly--flash-overlay 'priority 1000) 98 99 (cl-defun sly-flash-region (start end &key 100 timeout 101 face 102 times 103 (pattern '(0.2))) 104 "Temporarily highlight region from START to END." 105 (if pattern 106 (cl-assert (and (null times) (null timeout)) 107 nil 108 "If PATTERN is supplied, don't supply TIMES or TIMEOUT") 109 (setq pattern (make-list (* 2 times) timeout))) 110 (unless sly-flash-inhibit 111 (let ((buffer (current-buffer))) 112 (move-overlay sly--flash-overlay start end buffer) 113 (cl-labels 114 ((on () (overlay-put sly--flash-overlay 'face (or face 'highlight))) 115 (off () (overlay-put sly--flash-overlay 'face nil)) 116 (relevant-p () 117 (equal (list start end buffer) 118 (list (overlay-start sly--flash-overlay) 119 (overlay-end sly--flash-overlay) 120 (overlay-buffer sly--flash-overlay)))) 121 (onoff () 122 (when (and pattern (relevant-p)) 123 (on) 124 (run-with-timer (pop pattern) 125 nil 126 (lambda () 127 (when (relevant-p) 128 (off) 129 (when pattern 130 (run-with-timer 131 (pop pattern) 132 nil 133 (lambda () (onoff)))))))))) 134 (onoff))))) 135 136 (provide 'sly-messages) 137 ;;; sly-messages.el ends here