File: slime-typeout-frame.el

package info (click to toggle)
slime 1:20080223.dfsg-1
  • links: PTS
  • area: main
  • in suites: lenny
  • size: 2,600 kB
  • ctags: 3,345
  • sloc: lisp: 30,707; sh: 163; makefile: 119; awk: 10
file content (99 lines) | stat: -rw-r--r-- 3,370 bytes parent folder | download
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
;;; slime-typeout-frame.el --- display some message in a dedicated frame
;;
;; Author: Luke Gorrie  <luke@synap.se>
;; License: GNU GPL (same license as Emacs)
;;
;;; Installation:
;;
;; Add something like this to your .emacs: 
;;
;;   (add-to-list 'load-path "<directory-of-this-file>")
;;   (add-hook 'slime-load-hook (lambda () (require 'slime-typeout-frame)))
;;


;;;; Typeout frame

;; When a "typeout frame" exists it is used to display certain
;; messages instead of the echo area or pop-up windows.

(defvar slime-typeout-window nil
  "The current typeout window.")

(defvar slime-typeout-frame-properties
  '((height . 10) (minibuffer . nil))
  "The typeout frame properties (passed to `make-frame').")

(defun slime-typeout-active-p ()
  (and slime-typeout-window
       (window-live-p slime-typeout-window)))

(defun slime-typeout-message-aux (format-string &rest format-args)
  (slime-ensure-typeout-frame)
  (with-current-buffer (window-buffer slime-typeout-window)
    (let ((msg (apply #'format format-string format-args)))
      (unless (string= msg "")
	(erase-buffer)
	(insert msg)))))

(defun slime-typeout-message (format-string &rest format-args)
  (apply #'slime-typeout-message-aux format-string format-args)
  ;; Disable the timer for autodoc temporarily, as it would overwrite
  ;; the current typeout message otherwise.
  (when (and (featurep 'slime-autodoc) slime-autodoc-mode)
    (slime-autodoc-stop-timer)
    (add-hook 'pre-command-hook #'slime-autodoc-start-timer)))

(defun slime-make-typeout-frame ()
  "Create a frame for displaying messages (e.g. arglists)."
  (interactive)
  (let ((frame (make-frame slime-typeout-frame-properties)))
    (save-selected-window
      (select-window (frame-selected-window frame))
      (switch-to-buffer "*SLIME-Typeout*")
      (setq slime-typeout-window (selected-window)))))

(defun slime-ensure-typeout-frame ()
  "Create the typeout frame unless it already exists."
  (interactive)
  (unless (slime-typeout-active-p)
    (slime-make-typeout-frame)))

(defun slime-typeout-autodoc-message (doc)
  ;; No need for refreshing per `slime-autodoc-pre-command-refresh-echo-area'.
  (setq slime-autodoc-last-message "")
  (slime-typeout-message-aux "%s" doc))

(defun slime-typeout-autodoc-dimensions ()
  (cond ((slime-typeout-active-p)
	 (list (window-width slime-typeout-window) nil))
	(t
	 (list 75 nil))))


;;; Initialization

(defvar slime-typeout-frame-unbind-stack ())

(defun slime-typeout-frame-init ()
  (add-hook 'slime-connected-hook 'slime-ensure-typeout-frame)
  (loop for (var value) in 
	'((slime-message-function slime-typeout-message)
	  (slime-background-message-function slime-typeout-message)
	  (slime-autodoc-message-function slime-typeout-autodoc-message)
	  (slime-autodoc-dimensions-function slime-typeout-autodoc-dimensions))
	do (slime-typeout-frame-init-var var value)))

(defun slime-typeout-frame-init-var (var value)
  (push (list var (if (boundp var) (symbol-value var) 'slime-unbound))
	slime-typeout-frame-unbind-stack)
  (set var value))

(defun slime-typeout-frame-unload ()
  (remove-hook 'slime-connected-hook 'slime-ensure-typeout-frame)
  (loop for (var value) in slime-typeout-frame-unbind-stack 
	do (cond ((eq var 'slime-unbound) (makunbound var))
		 (t (set var value))))
  (setq slime-typeout-frame-unbind-stack nil))
  
(provide 'slime-typeout-frame)