emacs.d/elpa/racket-mode-20200412.1611/racket-show.el

70 lines
2.2 KiB
EmacsLisp
Raw Normal View History

2020-03-24 18:20:37 +01:00
;;; racket-show.el -*- lexical-binding: t -*-
;; Copyright (c) 2013-2020 by Greg Hendershott.
;; Portions Copyright (C) 1985-1986, 1999-2013 Free Software Foundation, Inc.
;; Author: Greg Hendershott
;; URL: https://github.com/greghendershott/racket-mode
;; License:
;; This 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 2, or (at your option)
;; any later version. This 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. See
;; http://www.gnu.org/licenses/ for details.
(require 'racket-util)
(require 'racket-custom)
(require 'pos-tip)
(defun racket-show (val &optional pos)
(dolist (f racket-show-functions)
(funcall f val pos)))
(defun racket-show-echo-area (v &optional _pos)
"Show things in the echo area.
A value for the variable `racket-show-functions'."
(if v
(message "%s" v)
(message "")))
(defun racket-show-header-line (v &optional _pos)
"Show things using a buffer header line.
A value for the variable `racket-show-functions'.
When there is nothing to show, keep a blank header-line. That
way, the buffer below doesn't \"jump up and down\" by a line as
messages appear and disappear. Only when V is nil do we remove
the header line."
(setq-local header-line-format
(and v (format "%s" (racket--only-first-line v)))))
(defun racket--only-first-line (str)
(save-match-data
(string-match (rx (group (* (not (any ?\n))))) str)
(match-string 1 str)))
(defun racket-show-pos-tip (v &optional pos)
"Show things using `pos-tip-show' if available.
A value for the variable `racket-show-functions'."
(when (racket--pos-tip-available-p)
(if (racket--non-empty-string-p v)
(pos-tip-show v nil pos)
(pos-tip-hide))))
(defun racket--pos-tip-available-p ()
"Is `pos-tip' available and expected to work on current frame?"
(and (fboundp 'x-hide-tip)
(fboundp 'x-show-tip)
(not (memq window-system (list nil 'pc)))))
(provide 'racket-show)
;; racket-show.el ends here