;;; frame-toggle.el --- multi-frame toggling independent of window systems

;; Copyright (C) 2004 !!
;;   Free Software Foundation, Inc.

;; Maintainer: mol
;; Keywords: internal frame

;; This file is part of GNU Emacs.

;; GNU Emacs 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.

;; GNU Emacs 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, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;;; Using multiple frames usually means that you want to switch back and forth
;;; between them. The frame package funtion 'other-frame' merely chooses this
;;; according to some cyclic order.
;;; When using several virual screens, you want to toggle between the frames
;;; in ONE virtual screen. Package frame-toggle maintains a list of cyclic
;;; lists. 
;;; New frames are not added automatically to one list (this is usually not 
;;; what you want with more than one virtual screen). To add a new frame f,
;;; there are two possibilities:
;;;   - foreground the f and call 'frame-toggle-toggle-frame'. 
;;;     This inserts this frame into the last one reached by 
;;;     frame-toggle-toggle-frame. 
;;;   - !! derive newest frame
;;; 
;;; The only function you usually should call is 'frame-toggle-toggle-frame'

;;; ------------------------------------------------------------------------
;;; $Id: frame-toggle.el,v 1.4 2004/10/11 14:43:25 oli Exp $
;;; ------------------------------------------------------------------------

;;; Code:

;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; @TABLE OF CONTENTS:			[TOCD: 07:31 11 Oct 2004]
;;;
;;;      [0.1] DEPENDENCIES
;;;  [1] Constants
;;;  [2] Variable Settings
;;;  [3] AUX Functions
;;;  [4] CORE FUNCTIONS
;;;  [5] Key Bindings (suggested)
;;; /////////////////////////////////////////////////////////
;;; @FILE: frame-toggle.el

;;; //////////////////////////////////////////////
;;; [0.1] DEPENDENCIES
;;; //////////////////////////////////////////////

(require 'frame)

;;; //////////////////////////////////////////////////////////////////////
;;; [1] Constants
;;; //////////////////////////////////////////////////////////////////////

	
;;; //////////////////////////////////////////////////////////////////////
;;; [2] Variable Settings
;;; //////////////////////////////////////////////////////////////////////

(defvar frame-toggle-framelist nil 
  "*List for \\[frame-toggle-toggle-frame]
can be reset via
   \\[frame-toggle-clear-frame-toggle-framelist]
   \\[remove-this-frame-frmo-frame-toggle-toggle-frame-framelist]
")

(defvar next-frame-for-frame-toggle-toggle-frame-framelist nil
  "*Frame to be used for next call to
      \\[frame-toggle-toggle-frame]
")

(defvar second-next-frame-for-frame-toggle-toggle-frame-framelist nil
  "*Frame to be used for next call to
      \\[frame-toggle-toggle-frame]
if  next-frame-for-frame-toggle-toggle-frame-framelist happens to be the one frame
you are in.")



;;; //////////////////////////////////////////////////////////////////////
;;; [3] AUX Functions
;;; //////////////////////////////////////////////////////////////////////

(defun frame-toggle-member (element list &rest cmp)
  "Returns list-tail, where element is the first member;
i.e., the result is null if element is not a member of the list.

If an optional third argument is given, use this as comparison 
function, otherwise use #'equal.
"
  (let ((comparison (if (null cmp) 'equal (car cmp)))
	(l list)
	(notfound t))
    (while (and notfound
		l)
      (if (funcall comparison (car l) element)
	  (setq notfound nil)
	  (setq l (cdr l))))
    l))


;;; //////////////////////////////////////////////////////////////////
;;; [4] CORE FUNCTIONS
;;; //////////////////////////////////////////////////////////////////



(defun frame-toggle-clear-frame-toggle-framelist ()
  (interactive)
  "Resets frame-toggle-framelist to nil."
  (setq frame-toggle-framelist nil)
  (message "** toggle frame framelist cleared."))


(defun frame-toggle-set-next-frame-for-toggle-frame-framelist (&rest tail)
  "Assigns next-frame-for-frame-toggle-toggle-frame-framelist to the current frame.
Stores the previous value of it in
  second-next-frame-for-frame-toggle-toggle-frame-framelist
With optional argument
     FRAME
use FRAME instead of current frame.

This means, it is used as 'other-frame' in the next call to 
         \\[frame-toggle-toggle-frame]
\(second-next-frame-for-frame-toggle-toggle-frame-framelist is used, if the frame is
identical with the current one.)
"
  (interactive)
  (let ((new-value (if tail (car tail)
		       (selected-frame))))
  (setq second-next-frame-for-frame-toggle-toggle-frame-framelist
	next-frame-for-frame-toggle-toggle-frame-framelist)
  (setq next-frame-for-frame-toggle-toggle-frame-framelist new-value)
  (message (format "** set next-frame-for-frame-toggle-toggle-frame-framelist to %s."
		   (if tail new-value
		       "current frame")))))


(defun frame-toggle-remove-this-frame-from-frame-toggle-framelist (&rest frame)
  (interactive)
  "Removes the current frame from any list in 
frame-toggle-framelist.

With optional argument 
     FRAME
remove FRAME instead.
"
  (let ((list frame-toggle-framelist)
	(ring nil)
	(new-ring nil)
	(cf (if frame
		(car frame)
		(selected-frame))))
    (setq frame-toggle-framelist nil)
    (while list
      (setq ring (car list))
      (if (frame-toggle-member cf ring #'eq)
	  (progn
	    (setq new-ring ring)
	    (setq ring nil)
	    (while new-ring
	      (if (not (eq cf (car new-ring)))
		  (setq ring (append ring (list (car new-ring)))))
	      (setq new-ring (cdr new-ring)))
	    (message (format "** removed frame from framelist "))
	    ))
      (setq frame-toggle-framelist 
	    (cons ring frame-toggle-framelist))
      (setq list (cdr list)))))


(defun frame-toggle-remove-this-ring-from-frame-toggle-framelist (&rest frame)
  (interactive)
  "Removes the ring containing the current frame from 
frame-toggle-framelist.

With optional argument 
     FRAME
remove the ring containing FRAME instead.
"
  (let ((list frame-toggle-framelist)
	(cf (if frame
		(car frame)
		(selected-frame))))
    (setq frame-toggle-framelist nil)
    (while list
      (if (frame-toggle-member cf (car list) #'eq)
	  (message (format "** removed cycle containing current frame from framelist (%d members)" (length (car list))))
	  (setq frame-toggle-framelist 
		(cons (car list) frame-toggle-framelist)))
      (setq list (cdr list)))))


(defun frame-toggle-toggle-frame ()
  "Tries to toggle between only those frames that are in the \(expanding)
frame-toggle-framelist

frame-toggle-framelist is a list of lists of frames:
  \( \( f1 f2 f3 )   \(f4 f5)  ... )
The purpose of each list is to establish a cycle that is toggled, i.e., 
in order to ADD a frame to a cycle, you must call the function from it and
'hope' that it will hit one of the existing cycles.
If hope is vain, you can also determine the next frame to hit via the function
  \\[frame-toggle-set-next-frame-for-toggle-frame-framelist]

This makes sense if you want to toggle frames inside one virtual screen.
"
  (interactive)
  ;; --------------------------------------------------
  (frame-toggle-purge-frame-toggle-framelist)
  ;; --------------------------------------------------
  (if window-system
      (let ((cf  (selected-frame))
	    (next-frame nil)
	    (mem nil)
	    (pos  -1)
	    ;; -------------------------
	    (found nil)
	    (list frame-toggle-framelist))
	(while (and list (null found))
	  (setq mem   (car list))
	  (setq found (frame-toggle-member cf mem #'eq))
	  (setq list  (cdr list)))
	(cond
	  ((and found (cdr found))
	   ;; -- next cycle elem -------------------------------
	   (select-frame-set-input-focus (car (cdr found))))
	  (found
	   ;; -- wraparound in cycle ---------------------------
	   (select-frame-set-input-focus (car mem)))
	  ;; -- not found --------------------------------------
	  (t
	   
	   ;; -- toggle and search for existing cycle -
	   (setq next-frame 
		 (cond
		   ((and next-frame-for-frame-toggle-toggle-frame-framelist
			 (not (equal cf next-frame-for-frame-toggle-toggle-frame-framelist)))
		    next-frame-for-frame-toggle-toggle-frame-framelist)
		   ((and second-next-frame-for-frame-toggle-toggle-frame-framelist
			 (not (equal cf second-next-frame-for-frame-toggle-toggle-frame-framelist)))
		    second-next-frame-for-frame-toggle-toggle-frame-framelist)
		   (t 
		    (other-frame -1)
		    (selected-frame))))
	   (setq next-frame-for-frame-toggle-toggle-frame-framelist nil)
	   (select-frame-set-input-focus next-frame)

	   (setq list  frame-toggle-framelist)
	   (setq found nil)

	   (while (and list (null found))
	     (setq pos (+ pos 1))
	     (setq found (frame-toggle-member next-frame (car list) #'eq))
	     (setq list  (cdr list)))
	   
	   
	   (if found
	       (let ((pos2 0))
		 ;; replaces nth element
		 (setq mem (cons cf (nth pos frame-toggle-framelist)))
		 (setq list frame-toggle-framelist)
		 (setq frame-toggle-framelist nil)

		 (while list
		   (if (= pos2 pos)
		       (setq frame-toggle-framelist
			     (cons mem frame-toggle-framelist))
		       (setq frame-toggle-framelist
			     (cons (car list) frame-toggle-framelist)))
		   (setq list (cdr list)
			 pos2 (+ 1 pos2))))
	       ;; -- otherwise: new cycle ----------------------------------
	       
	       (setq frame-toggle-framelist
		     (cons (list cf next-frame)
			   frame-toggle-framelist))))))))


(defun frame-toggle-purge-frame-toggle-framelist ()
  "Remove all dead frames from the variable
frame-toggle-framelist
"
  (interactive)
  (let ((list frame-toggle-framelist)
	(ring nil)
	(ndelete 0)
	(delete nil))
    (while list 
      (setq ring (car list))
      (setq list (cdr list))
      (while ring
	(if (frame-live-p (car ring))
	    nil
	    (setq delete (cons (car ring) delete)))
	(setq ring (cdr ring))))
    ;; ------------------------------------------------
    (setq ndelete (length delete))
    (while delete
      (frame-toggle-remove-this-frame-from-frame-toggle-framelist (car delete))
      (setq delete (cdr delete)))
    (if (> ndelete 0)
	(message (format "** frame-toggle: deleted %d dead frames." ndelete)))))


;;; //////////////////////////////////////////////////////////////////////
;;; [5] Key Bindings (suggested)
;;; //////////////////////////////////////////////////////////////////////

;; -- toggle-frames -----------------------------------
;; A-f              frame-toggle-toggle-frame
;; A-C-f            frame-toggle-clear-frame-toggle-framelist
;; A-s-f            frame-toggle-remove-this-frame-from-frame-toggle-framelist
;; H-s-f            frame-toggle-set-next-frame-for-toggle-frame-framelist
;; A-H-f            frame-toggle-remove-this-ring-from-frame-toggle-framelist


;;;; Key bindings



;;; ------------------------------------------------------------------

(provide 'frame-toggle)

;;; frame-toggle.el ends here