glass.el 5.38 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24
;;; glass.el --- transparent panes of emacs glass, augmenting apps

;; Copyright (C) 2012  David O'Toole

;; Author: David O'Toole <dto@ioforms.org>
;; Keywords: lisp, frames

;; This program 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 3 of the License, or
;; (at your option) any later version.

;; This program 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.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

;;; Code:

(require 'cl)

25 26 27 28 29 30 31 32 33 34 35
(defun eval-in-cl (cl-expression-string &optional process-result-values)
  (slime-eval-async `(swank:eval-and-grab-output ,cl-expression-string)
    (lexical-let  ((here (current-buffer))
                   (process-result-values process-result-values))
      (lambda (result-values)
	(when process-result-values
	  (set-buffer here)
	  (funcall process-result-values (rest result-values)))))))

(setq slime-enable-evaluate-in-emacs t)

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 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163
;; Emacs glass frame is transparent

(defvar glass-transparent-alpha 80)
(defvar glass-opaque-alpha 100)

(defun glass-transparent ()
  (set-frame-parameter nil 'alpha glass-transparent-alpha))

(defun glass-opaque ()
  (set-frame-parameter nil 'alpha glass-opaque-alpha))

(defvar glass-font nil)

(defvar glass-use-themes nil)

(defun glass-theme ()
  (when glass-use-themes
    (unless (custom-theme-p 'glass)
      (load-theme 'glass :no-confirm :no-enable)
      (enable-theme 'glass))))

(defun glass-font ()
  (when glass-font 
    (set-frame-font glass-font)))

;;; Glass frame can be fixed on top of other windows

(defvar glass-wm-toggle 2)
(defvar glass-wm-add 1)
(defvar glass-wm-remove 0)

(defun* glass-set-on-top-property (&optional frame (state glass-wm-toggle))
  (x-send-client-message
   frame 0 frame "_NET_WM_STATE" 32
   (list state "_NET_WM_STATE_ABOVE" 0 1)))

(defun glass-on-top (&optional frame)
  (glass-set-on-top-property frame glass-wm-add))

(defun glass-off-top (&optional frame)
  (glass-set-on-top-property frame glass-wm-remove))

;;; Without window-borders

(defun make-hinted-frame (hints)
   (let ((frame (make-frame '((visibility . nil)))))
     (prog1 frame
       (x-change-window-property 
	"_MOTIF_WM_HINTS" hints 
	frame
	"_MOTIF_WM_HINTS" 32 t)
       (make-frame-visible frame))))

(defvar glass-wm-without-decoration '(2 0 0 0 0))

(defun make-frame-without-decoration ()
  (interactive)
  (make-hinted-frame glass-wm-without-decoration))

(defvar glass-frame nil)

(defvar glass-use-special-frame nil)

(defun* make-glass-frame (&key width height)
  (let ((frame (make-frame-without-decoration)))
    (prog1 frame
      (select-frame frame)
      (when width (set-frame-width frame width))
      (when height (set-frame-height frame height))
      (menu-bar-mode -1)
      (glass-transparent)
      (glass-font)
      (glass-on-top))))
  
(defvar glass-showing nil)

(defun glass-live-p ()
  (and glass-frame (frame-live-p glass-frame)))

(defvar glass-scroll-bar-mode nil)

(defun glass-raise (&optional frame)
  (setf glass-scroll-bar-mode scroll-bar-mode)
  (set-scroll-bar-mode 'nil)
  (redirect-frame-focus frame)
  (raise-frame frame)
  (make-frame-visible frame)
  (select-frame frame)
  (glass-on-top)
  (select-frame-set-input-focus frame))

(make-variable-buffer-local 
 (defvar glass-local-mode-line-format nil))
  
(defun* glass-show (&key x y (buffer (current-buffer)) (width 80) (height 12))
  (interactive)
  (when (not (glass-live-p))
    (setf glass-frame (make-glass-frame :width width :height height)))
  (when (and (numberp x) (numberp y))
    (set-frame-position glass-frame (+ 40 x) (+ 40 y)))
  (glass-theme)
  (glass-raise glass-frame)
  (switch-to-buffer buffer)
  (setq indicate-buffer-boundaries 'left)
  ;; (setq glass-local-mode-line-format mode-line-format)
  ;; (setq mode-line-format nil)
  (setf glass-showing t))

(defun* glass-hide ()
  (interactive)
  (when (glass-live-p)
    ;; (when (null mode-line-format)
    ;;   (setq mode-line-format glass-local-mode-line-format))
    ;; lower all frames
    (mapc #'lower-frame (frame-list))
    (when (buffer-narrowed-p) (widen))
    (glass-off-top)
    ;; restore previous scroll bars, if any
    (set-scroll-bar-mode 'glass-scroll-bar-mode)
    (setf glass-showing nil)))

(defun glass-toggle ()
  (interactive)
  (when glass-use-special-frame
    (if glass-showing (glass-hide) (glass-show))))

(defun glass-toggle-play ()
  (interactive)
164
  (eval-in-cl "(xelf::toggle-play)"))
165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186

(global-set-key [f12] 'glass-toggle)
(global-set-key [pause] 'glass-toggle-play)

(defun* glass-destroy ()
  (interactive)
  (when (glass-live-p)
    (glass-hide)
    (delete-frame glass-frame))
  (setf glass-frame nil))

(defun glass-show-definition (name &rest params)
  (slime-edit-definition name)
  (delete-other-windows)
  (let ((mouse-autoselect-window nil))
    (select-frame-set-input-focus (selected-frame)))
  (when glass-use-special-frame 
    (narrow-to-defun)
    (apply #'glass-show params)
    (let ((height (min 16 (max 8 (count-lines (point-min) (point-max))))))
      (set-frame-height glass-frame height))))

187 188
;; (glass-show :x 20 :y 200 :width 78 :height 14)

189 190
(provide 'glass)
;;; glass.el ends here