[xyzzy:02372] save-winconf

[Seiya Suda <seiya.suda@xxxxxxxxxxx>]

こんちは。須田っす。

亀井さんか、どなたか、次の、特に横長の窓が3つ並んでるときの
不都合を正してもらえませんか?

-------------------------------------------------------------------------
;;; -*- Mode: Lisp; Package: EDITOR -*-
;;;
;;;  Is this file part of xyzzy?
;;;
;;;  save-winconf.l   version 1.02

;;; Code

(provide "save-winconf")

(in-package "editor")

(export '(*current-winconf* save-winconf restore-winconf))

(defvar *current-winconf* nil)

;;; window についてのデータをリストで得る

(defun window-data-list ()
  "window の data の list を返す"
  (let (wins data wb wl wc)
	(walk-windows #'(lambda (win)
					  (setq wb (window-buffer win))
					  (setq wl (window-lines win))
					  (setq wc (window-columns win))
					  (setq data (list wb wl wc))
					  (push data wins)))
	wins))

;;; save

(defun save-winconf ()
  (interactive)
  (when (yes-or-no-p "キャレットが一番左上の画面にありますか?")
	(setq *current-winconf* (window-data-list))))

;;; restore

(defun restore-winconf ()
  (interactive)
  (when *current-winconf*
	(delete-other-windows)
	(let ((n (length *current-winconf*)) ;; 窓数
		  (h (- (screen-height) 2))      ;; 1画面時窓高
		  (w (screen-width)))            ;; 1画面時窓幅
 ;; 窓1つ
	  (cond ((= n 1)
			 (let ((first (nth 0 *current-winconf*)))
			   (switch-to-buffer (car first))))
 ;; 窓2つ
			((= n 2)
			 (let ((first (nth 0 *current-winconf*))
				   (second (nth 1 *current-winconf*)))
			   (if (or (= (nth 1 first) h)
					   (= (nth 1 first) (+ h 1))) 
				   (progn
					 (split-window-vertically)
					 (switch-to-buffer (car first))
					 (adjust-win-width (nth 2 first))
					 (other-window)
					 (switch-to-buffer (car second)))
				 (progn
				   (split-window)
				   (switch-to-buffer (car first))
				   (adjust-win-height (nth 1 first))
				   (other-window)
				   (switch-to-buffer (car second))))))
 ;; 窓3つ
			((= n 3)
			 (let ((first (nth 0 *current-winconf*))
				   (second (nth 1 *current-winconf*))
				   (third (nth 2 *current-winconf*)))
			   (cond ((or (= (nth 1 first) h)
						  (= (nth 1 first) (+ h 1)))
					  (split-window-vertically)
					  (switch-to-buffer (car first))
					  (adjust-win-width (nth 2 first))
					  (other-window)
					  (cond ((= (nth 1 second) h)               ;;┌┬┬┐
							 (split-window-vertically)	        ;;││││
							 (switch-to-buffer (car third))     ;;└┴┴┘
							 #|  (adjust-win-width (nth 2 second)) |#
							 (other-window)
							 (switch-to-buffer (car second))
							 (adjust-win-width (nth 2 second))) ;; third?
							(t (split-window)                      ;;┌┬─┐
							   (switch-to-buffer (car third))      ;;│├─┤
							   (other-window)                      ;;└┴─┘
							   (switch-to-buffer (car second))
							   (adjust-win-height (nth 1 second)))))
					 ((= (nth 2 second) w)
					  (switch-to-buffer (car first))      ;;┌──┐
					  (split-window-horizontally)         ;;├──┤
					  (adjust-win-height (nth 1 first))   ;;├──┤
					  (other-window)                      ;;└──┘
					  (switch-to-buffer (car third))
					  (split-window-horizontally)
					  (other-window)
					  (switch-to-buffer (car second))
					  (adjust-win-height (nth 1 third))) ;; わからん
					 (t (switch-to-buffer (car first))
						(split-window-vertically)
						(adjust-win-width (nth 2 first))   ;;┌─┬┐
						(split-window-horizontally)        ;;├─┤│
						(adjust-win-height (nth 1 first))  ;;└─┴┘
						(next-window (selected-window))
						(switch-to-buffer (car second))
						(other-window)
						(switch-to-buffer (car third))))))
			(t (message "できません"))))))

;;; 現在の窓幅を arg にする

(defun adjust-win-width (arg)
  (cond ((< (window-columns) arg)
		 (enlarge-window-horizontally (- arg (window-columns))))
		((> (window-columns) arg)
		 (shrink-window-horizontally (- (window-columns) arg)))))

;;; 現在の窓丈を arg にする

(defun adjust-win-height (arg)
  (cond ((< (window-lines) arg)
		 (enlarge-window (- arg (window-lines))))
		((> (window-lines) arg)
		 (shrink-window (- (window-lines) arg)))))

;;; walk-windows    emacs の関連ファイルより

(defun walk-windows (proc)
  "窓を巡回しながら proc を呼ぶ"
  (let* ((walk-windows-start (selected-window))
		 (walk-windows-current walk-windows-start))
	(while (progn
			 (setq walk-windows-current
				   (next-window walk-windows-current))
			 (funcall proc walk-windows-current)
			 (not (eq walk-windows-current walk-windows-start))))))


--------
須田誠也(suda seiya)
seiya.suda@xxxxxxxxxxx
http://member.nifty.ne.jp/seiya-suda/