🚀 go-pugleaf

大和です. 投稿したframe-handling.elにプログラムにバグがあったので修正
しました. 

修正点は
   o muleがどっかにいっちゃうバグの修正(_0_)
   o フレームの動きの修正
です。

---------------------------------------------------------------------
;;; 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.
;; 6th: Wed Apr 24 17:45:50 1996
;;   o muleがどっかにいっちゃうバグの修正
;;   o フレームのあやしい動きの修正

;; 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)
   (aget (frame-parameters) 'top)))

(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) num)
   (aget (frame-parameters) 'top)))

(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)
   (+ (aget (frame-parameters) 'top) num)))

(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)
   (- (aget (frame-parameters) 'top) 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."
  (interactive "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'
	top_tmp				;
	left_tmp			;
	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)))))
	  (setq top_tmp (aget (frame-parameters) 'top))
	  (setq left_tmp (aget (frame-parameters) 'left))
	  ;; select function
	  (cond 
	   ((> top_tmp (- (x-display-pixel-height) 10))
	    (frame-handling-up (random 30)))
	   ((< top_tmp 10)
	    (frame-handling-down (random 30)))

	   ((> left_tmp (- (x-display-pixel-width) 10))
	    (frame-handling-left (random 30)))
	   ((< left_tmp 10)
	    (frame-handling-right (random 30)))

	   ((> (* (frame-width) (frame-height)) 5000)
	    (frame-handling-shrink (random 20)))
	   ((< (* (frame-width) (frame-height)) 500)
	    (frame-handling-enlarge (random 10)))

	   (t
	    (setq no (random 8))
	    (fset 'fun (aref frame-handling-functions no))
	    (if (< no 4)			; call!
		(funcall 'fun (random 10)) ;size funs
	      (funcall 'fun (random 50))))) ; move funs
	  (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