🚀 go-pugleaf

大和です. 

frameを操作する方法を勉強しているうちに変なものを作ってしまいました. 
                                       ~~~~~~~~
切取り線以下をload-pathの通っているディレクトリに置き次のコードを
.emacsに書いて下さい. 

(autoload 'frame-handling-mode "frame-handling-mode" 
	"Frame handling minor mode." t)
(autoload 'frame-dance "frame-handling-mode" 
	"Frames dance well. " t)
(autoload 'screensaver "frame-handling-mode" 
	"Screensaver." t)

そしてmule再起動ののち, 
M-x frame-dance
あるいは関数frame-danceのエイリアスを
M-x screensaver
で呼びだします. 
満足したところで
C-g
で止めて下さい. 

他にframeの移動, 縮小, 拡大がキーの操作でできます. プログラムのコメン
トを御読みになって下さい. 

---------------------------------------------------------------
;;; frame-handling.el --- Move and change the size of frames with key.

;; Copyright (C) 1995, 1996 Masatake YAMATO.

;; Author: Masatake YAMATO <jet@airlab.cs.ritsumei.ac.jp>
;; Keywords: frame, screensaver

;; AN ADDITION, A PRETTY GOOD SCREENSAVER COMES WITH THIS PROGRAM!

;; 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 2, 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 GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

;; 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 2, or (at your option)
;; any later version.

;; Install: Put these codes into your .emacs file.
;;(autoload 'frame-handling-mode "frame-handling-mode" "Frame handling minor mode." t)
;;(autoload 'frame-dance "frame-handling-mode" "Frames dance well. " t)
;;(autoload 'screensaver "frame-handling-mode" "Screensaver." t)

;; Commentary:
;; * frame-handling minor mode
;; To entry frame-handling minor mode, type 'M-x frame-handling-mode'.
;; In frame handling mode:
;; -----------------------------------
;; f1: frameの幅の縮小
;; f2: frameの縦方向の拡張
;; f3: frameの縦方向の縮小
;; f4: frameの幅の拡張
;; C-f1: frameの左への移動
;; C-f2: frameの下への移動
;; C-f3: frameの上への移動
;; C-f4: frameの右への移動
;; -----------------------------------
;; ができる. それぞれ数引数を取り, 移動, 縮小, 拡大量を変えることがで
;; きる.
;; 再度 `M-x frame-handling-mode'でframe-handling-modeから出る. 

;; * Screen saver
;; M-x frame-danceあるいはM-x screensaverでスクリーンセーバーを起動する. 
;; C-g(keyboard-quit)でスクリーンセーバーを終了する. 
;; frame-handling-backgroundに色の名前の文字列を要素とするvectorで与え
;; ることスクリーンセーバーの選択する色が変更できる. 
;;
;; Example for a gray scale monitor.
;; (setq frame-handling-background  (vector 
;;             			  "white"
;;				  "gray75"
;;				  "gray50"
;;				  "gray25"
;;				  "black"))
;;
;; またframe-dance-seedにあたえる数値はスクリーンセーバーの1ステップに
;; 要する時間を決める. 

;; Getting:
;; You can get the newest version of frame-handling.el from:
;; ftp.airlab.cs.ritsumei.ac.jp:/pub/use/jet/elisp/frame-handling.el.gz
;;
;; History:
;; 1st: Wed Sep  6 16:26:51 1995
;; 2nd: Wed Sep  6 16:47:47 1995
;; 3rd: Tue Jan 16 19:47:24 1996
;; 4th: Thu Apr 18 12:43:25 1996
;; 5th: Tue Apr 23 00:16:44 1996
;;   o Screensaver is implemented.

;; Acknowledgment:
;; Terumoto HAYAKAWA <hayakawa@cv.cs.ritsumei.ac.jp> for a piece of
;; advice about size down operation. 

;; X-Working-Songs:
;; 5th: ruby,paraffin<harpie mix>.

;; Code:
(require 'assoc)

;; From skk-cursor.el
;; Check window system and emacs version.
(cond ((not window-system)
       (error "Not running on any window system") )
      ((not (eq (string-to-int emacs-version) 19))
       (error "Your Emacs does not provide frame handling.") ))
;;
;; ScreenSaver user vars
;;
(defvar frame-dance-seed 1
  "*The step interval for screensaver(second).
またframe-dance-seedにあたえる数値はスクリーンセーバーの1ステップに
要する時間を決める(秒). ")

(defvar frame-handling-background  (vector 
				    "red" 
				    "green"
				    "blue" 
				    "yellow" 
				    "orange" 
				    "purple" 
				    "black"
				    "gray" 
				    "white") 
  "*Color vector for screensaver.
frame-handling-backgroundに色の名前の文字列を要素とするvectorで与え
ることスクリーンセーバーの選択する色が変更できる. ")

;;
;; Minor mode
;;
(defvar frame-handling-mode nil
  "Non-nil if using Frame handling mode." )

(defvar frame-handling-mode-map nil
  "Key map for Frame handling minor mode.")

(or (assq 'frame-handling-mode minor-mode-alist)
    (setq minor-mode-alist
	  (cons '(frame-handling-mode " Frame") minor-mode-alist)))

(if frame-handling-mode-map
    ()
  (setq frame-handling-mode-map (make-sparse-keymap))
  ;;  (define-key frame-handling-mode-map [f1] 'shrink-window-horizontally )
  ;;  (define-key frame-handling-mode-map [f2] 'enlarge-window)
  ;;  (define-key frame-handling-mode-map [f3] 'shrink-window)
  ;;  (define-key frame-handling-mode-map [f4] 'enlarge-window-horizontally )

  (define-key frame-handling-mode-map [f1] 'frame-handling-un-widen)
  (define-key frame-handling-mode-map [f2] 'frame-handling-highten)
  (define-key frame-handling-mode-map [f3] 'frame-handling-un-highten)
  (define-key frame-handling-mode-map [f4] 'frame-handling-widen)

  (define-key frame-handling-mode-map [C-f1] 'frame-handling-left)
  (define-key frame-handling-mode-map [C-f2] 'frame-handling-down)
  (define-key frame-handling-mode-map [C-f3] 'frame-handling-up)
  (define-key frame-handling-mode-map [C-f4] 'frame-handling-right))

(or (assq 'frame-handling-mode minor-mode-map-alist)
    (setq minor-mode-map-alist
	  (cons (cons 'frame-handling-mode frame-handling-mode-map)
		minor-mode-map-alist)))

(defun frame-handling-mode ()
  "Toggle Frame handling mode.
 To entry frame-handling minor mode, type 'M-x frame-handling-mode'.
In frame handling mode:

f1: frameの幅の縮小
f2: frameの縦方向の拡張
f3: frameの縦方向の縮小
f4: frameの幅の拡張
C-f1: frameの左への移動
C-f2: frameの下への移動
C-f3: frameの上への移動
C-f4: frameの右への移動

ができる. それぞれ数引数を取る.
再度 `M-x frame-handling-mode'でframe-handling-modeから出る. "
  (interactive)
  (cond 
   ( (not frame-handling-mode)
     (setq frame-handling-mode t)
     (run-hooks 'frame-handling-mode-hook))
   ( t
     (setq frame-handling-mode nil))))

;;
;; Funs
;;
(defun frame-handling-right (num)
  "Move frame right."
  (interactive "p")
  (if (interactive-p)
      (setq num (* 3 num)))
  (set-frame-position 
   (selected-frame)
   (+ (aget (frame-parameters) 'left) num 4)
   (+ (aget (frame-parameters) 'top) 4)))

(defun frame-handling-left (num)
  "Move frame left."
  (interactive "p")
  (if (interactive-p)
      (setq num (* 3 num)))
  (set-frame-position 
   (selected-frame) 
   (- (+ (aget (frame-parameters) 'left) 4) num)
   (+ (aget (frame-parameters) 'top) 4)))

(defun frame-handling-down (num)
  "Move frame down."
  (interactive "p")
  (if (interactive-p)
      (setq num (* 3 num)))
  (set-frame-position 
   (selected-frame) 
   (+ (aget (frame-parameters) 'left) 4)
   (+ (aget (frame-parameters) 'top) num 4)))

(defun frame-handling-up (num)
  "Move frame up."
  (interactive "p")
  (if (interactive-p)
      (setq num (* 3 num)))
  (set-frame-position 
   (selected-frame) 
   (+ (aget (frame-parameters) 'left) 4)
   (- (+ (aget (frame-parameters) 'top) 4) num)))

(defun frame-handling-widen (num)
  "Widen current frame."
  (interactive "p")
  (if (<= num 1)
      (set-frame-width (selected-frame) (1+ (frame-width)))
    (set-frame-width (selected-frame) (+ num (frame-width)))))

(defun frame-handling-un-widen (num)
  "UN widen current frame."
  (interactive "p")
  (if (<= num 1)
      (set-frame-width (selected-frame) (1- (frame-width)))
    (set-frame-width (selected-frame) (- (frame-width) num))))

(defun frame-handling-highten (num)
  "Highten current frame."
  (interactive "p")
  (if (<= num 1)
      (set-frame-height (selected-frame) (1+ (frame-height)))
    (set-frame-height (selected-frame) (+ num (frame-height)))))

(defun frame-handling-un-highten (num)
  "UN highten current frame."
  (interactive "p")
  (if (<= num 1)
      (set-frame-height (selected-frame) (1- (frame-height)))
    (set-frame-height (selected-frame) (- (frame-height) num))))

(defun frame-handling-shrink (num)
  "Scale down current frame."
  (a2interactive "p")
  (if (<= num 1)
      (set-frame-size (selected-frame) 
		      (1-  (frame-width)) 
		      (1- (frame-height)))
    (set-frame-size (selected-frame) 
		    (- (frame-width) num) 
		    (- (frame-height) num))))

(defun frame-handling-enlarge (num)
  "Scale up current frame."
  (interactive "p")
  (if (<= num 1)
      (set-frame-size (selected-frame) 
		      (1+  (frame-width))
		      (1+ (frame-height)))
      (set-frame-size (selected-frame) 
		      (+ num (frame-width))
		      (+ num (frame-height)))))

;;
;; ScreenSaver.
;;
(defvar frame-handling-functions
  (vector
   'frame-handling-highten 'frame-handling-un-highten 
   'frame-handling-widen 'frame-handling-un-widen
   'frame-handling-left 'frame-handling-down 
   'frame-handling-up 'frame-handling-right)
  "Function table for screensaver.")

(defun frame-dance ()
  "Screensaver. To stop the screensaver type \\[keyboard-quit].
C-g(keyboard-quit)でスクリーンセーバーを終了する."
  (interactive)
  (call-interactively 'save-some-buffers)
  (let (fun				; Selected function by random number.
	conf				; Frame configuration stack.
	check				; error handler?
	no				; tmp number generated by `random'
	frm)				; Selected frame  by random number.
    ;; push frame config
    (setq conf (current-frame-configuration))
    (condition-case check		
	(while t
	  ;; select frame
	  (setq frm (elt (frame-list) (random (length (frame-list))))) 
	  (raise-frame frm)
	  (select-frame frm)
	  ;; select color
	  (set-background-color (aref frame-handling-background 
				      (random 
				       (1- (length frame-handling-background)))))
	  ;; select function
	  (setq no (random 8))
	  (fset 'fun (aref frame-handling-functions no))
	  (if (< no 4)			; call!
	      (funcall 'fun (random 10))
	    (funcall 'fun (random (* 4 10))))
	  (sleep-for frame-dance-seed))
      (quit
       ;; pop frame config
       (set-frame-configuration conf)))))

(defalias 'screensaver 'frame-dance)

(run-hooks 'frame-hadling-load-hook)

(provide 'frame-handling)
;;; frame-handling.el ends here