← Back to branch summary

~ubuntu-branches/ubuntu/intrepid/slime/intrepid

« back to all changes in this revision

Viewing changes to contrib/slime-typeout-frame.el

  • Committer: Bazaar Package Importer
  • Author(s): Peter Van Eynde
  • Date: 2007-10-04 09:09:47 UTC
  • mfrom: (1.1.4 upstream)
  • Revision ID: james.westby@ubuntu.com-20071004090947-8oy7djtx8no3erxy
Tags: 1:20070927-2
http://bugs.debian.org/445174
Readded tree-widget to the sources. emacs21 on
debian does _not_ have that file. emacs22 and xemacs do.
(Closes: #445174)

Show diffs side-by-side

added added

removed removed

Lines of Context:
contrib/slime-typeout-frame.el
 
1
;;; slime-typeout-frame.el --- display some message in a dedicated frame
 
2
;;
 
3
;; Author: Luke Gorrie  <luke@synap.se>
 
4
;; License: GNU GPL (same license as Emacs)
 
5
;;
 
6
;;; Installation:
 
7
;;
 
8
;; Add something like this to your .emacs: 
 
9
;;
 
10
;;   (add-to-list 'load-path "<directory-of-this-file>")
 
11
;;   (add-hook 'slime-load-hook (lambda () (require 'slime-typeout-frame)))
 
12
;;
 
13
 
 
14
 
 
15
;;;; Typeout frame
 
16
 
 
17
;; When a "typeout frame" exists it is used to display certain
 
18
;; messages instead of the echo area or pop-up windows.
 
19
 
 
20
(defvar slime-typeout-window nil
 
21
  "The current typeout window.")
 
22
 
 
23
(defvar slime-typeout-frame-properties
 
24
  '((height . 10) (minibuffer . nil))
 
25
  "The typeout frame properties (passed to `make-frame').")
 
26
 
 
27
(defun slime-typeout-active-p ()
 
28
  (and slime-typeout-window
 
29
       (window-live-p slime-typeout-window)))
 
30
 
 
31
(defun slime-typeout-message (format-string &rest format-args)
 
32
  (slime-ensure-typeout-frame)
 
33
  (with-current-buffer (window-buffer slime-typeout-window)
 
34
    (erase-buffer)
 
35
    (insert (apply #'format format-string format-args))))
 
36
 
 
37
(defun slime-make-typeout-frame ()
 
38
  "Create a frame for displaying messages (e.g. arglists)."
 
39
  (interactive)
 
40
  (let ((frame (make-frame slime-typeout-frame-properties)))
 
41
    (save-selected-window
 
42
      (select-window (frame-selected-window frame))
 
43
      (switch-to-buffer "*SLIME-Typeout*")
 
44
      (setq slime-typeout-window (selected-window)))))
 
45
 
 
46
(defun slime-ensure-typeout-frame ()
 
47
  "Create the typeout frame unless it already exists."
 
48
  (interactive)
 
49
  (unless (slime-typeout-active-p)
 
50
    (slime-make-typeout-frame)))
 
51
 
 
52
(defun slime-typeout-autodoc-message (doc)
 
53
  (setq slime-autodoc-last-message "") ; no need for refreshing
 
54
  (slime-typeout-message "%s" doc))
 
55
 
 
56
 
 
57
;;; Initialization
 
58
 
 
59
(defvar slime-typeout-frame-unbind-stack ())
 
60
 
 
61
(defun slime-typeout-frame-init ()
 
62
  (add-hook 'slime-connected-hook 'slime-ensure-typeout-frame)
 
63
  (loop for (var value) in 
 
64
        '((slime-message-function #'slime-typeout-message)
 
65
          (slime-background-message-function #'slime-typeout-message)
 
66
          (slime-autodoc-message-function #'slime-typeout-autodoc-message))
 
67
        do (slime-typeout-frame-init-var var value)))
 
68
 
 
69
(defun slime-typeout-frame-init-var (var value)
 
70
  (push (list var (if (boundp var) (symbol-value var) 'slime-unbound))
 
71
        slime-typeout-frame-unbind-stack)
 
72
  (set var value))
 
73
 
 
74
(defun slime-typeout-frame-unload ()
 
75
  (remove-hook 'slime-connected-hook 'slime-ensure-typeout-frame)
 
76
  (loop for (var value) in slime-typeout-frame-unbind-stack 
 
77
        do (cond ((eq var 'slime-unbound) (makunbound var))
 
78
                 (t (set var value)))))
 
79
  
 
80
(provide 'slime-typeout-frame)