home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / misc / wicos.el < prev    next >
Encoding:
Text File  |  1993-05-19  |  31.4 KB  |  989 lines
  1. ;;;;;;;;;;;;;;;;;;;;;;; -*- Mode: Emacs-Lisp -*- ;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;; wicos.el
  4. ;; Save and restore multiple window configurations (wicos) within emacs.
  5. ;; 
  6. ;; v1.43;  23 Apr 1993
  7. ;;
  8. ;; Copyright 1993 Heikki Suopanki
  9. ;;
  10. ;; email: suopanki@phoenix.oulu.fi
  11. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  12. ;;; This program is free software; you can redistribute it and/or modify
  13. ;;; it under the terms of the GNU General Public License as published by
  14. ;;; the Free Software Foundation; either version 1, or (at your option)
  15. ;;; any later version.
  16. ;;;
  17. ;;; This program is distributed in the hope that it will be useful,
  18. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20. ;;; GNU General Public License for more details.
  21. ;;;
  22. ;;; The GNU General Public License is available by anonymouse ftp from
  23. ;;; prep.ai.mit.edu in pub/gnu/COPYING.  Alternately, you can write to
  24. ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139,
  25. ;;; USA.
  26. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  27. ;; LCD Archive Entry:
  28. ;; wicos|Heikki T. Suopanki|suopanki@phoenix.oulu.fi|
  29. ;; Save and restore multiple window configurations within Emacs.|
  30. ;; 23-Apr-1993|1.43|~/misc/wicos.el.Z|
  31. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  32. ;;; You can have multiple window configurations ('wico screens' or
  33. ;;; 'wicos') within your emacs if you use wicos.el. 
  34. ;;; If you use applications which use many windows (like gnus) it's
  35. ;;; easy to switch to a different wico screen and back and find the old
  36. ;;; wico screen and its windows unchanged because each application can have its
  37. ;;; own wico.  
  38. ;;; You can create and kill wicos, jump to a specific wico etc.
  39. ;;;
  40. ;;; Bytecompile this file and put (require 'wicos) in your .emacs
  41. ;;;
  42. ;;; 'M-o c' creates a new wico, 'M-o k' kills one. Use 'M-o p' (previous)
  43. ;;; and 'M-o n' (next) or 'M-o g' (go to) to switch wicos. 
  44. ;;; 'M-o 1' goes directly to wico 1 (this works with numbers 0-9).
  45. ;;;
  46. ;;; 'M-o m' shows a wico menu, it is useful if you have many wicos open.
  47. ;;; 
  48. ;;; There are other functions, 'M-o ?' gives help. 
  49. ;;; All wicos functions use bindings 'M-o + key'. 
  50. ;;; You can bind M-o to something else, look at the variable wico-prefix-key.
  51. ;;;
  52. ;;; Wico name is shown in the mode line (like '<Elisp>') if you have a line: 
  53. ;;; (setq wico-show-ml t)
  54. ;;; in your .emacs. 
  55. ;;; Use 'M-o t' to toggle it interactively.
  56. ;;; The name is however updated only when you use some wico function.
  57. ;;; If you only want to update it use 'M-o v'
  58. ;;;
  59. ;;; Wicos are named automatically if possible or you can give them
  60. ;;; your own names. If wicos don't have a real name they get a name 'scratch'.
  61. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  62. ;;; X, Epoch (Emacs-19, Lucid Emacs) :
  63. ;;;
  64. ;;; If your Emacs supports x-popup-menu you can use functions:
  65. ;;; wico-x-menu and wico-x-show-list.
  66. ;;;
  67. ;;; There is now some _minimal_ Epoch support (it may work with
  68. ;;; Emacs-19 and Lucid Emacs too...???). It doesn't get confused if
  69. ;;; there are many screens open. It doesn't necessarily work properly if you
  70. ;;; change the screen size or do something "strange". Someone who has
  71. ;;; more Epoch experience should fix this....(volunteers?)
  72. ;;; If you use Epoch with multiple screens add:
  73. ;;; (setq wico-multi-screens t) 
  74. ;;; in your .emacs.
  75. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  76. ;;;
  77. ;;; Hints and tips:
  78. ;;;
  79. ;;; Many wicos are automatically named (gnus, mail, elisp, C etc.) and
  80. ;;; it's easy to switch to them. For example just type M-o g g RET
  81. ;;; (that is automatically completed to gnus, you can also use TAB or
  82. ;;; SPC to complete) and you should be in your gnus wico. But if
  83. ;;; you tend to have C files in many wicos you will have wicos called:
  84. ;;; C, C<2>, C<3> , and it's hard to remember what is what. Now it's
  85. ;;; time to give names.  If your driver project files are in wico C<2>,
  86. ;;; just go there and type 'M-o w driver RET' and that wico is now
  87. ;;; called 'driver' instead of 'C<2>'.  
  88. ;;; 
  89. ;;;
  90. ;;; You can copy wicos. Type 'M-o s' and current configuration is
  91. ;;; saved, go to another wico and type 'M-o r' and configuration is
  92. ;;; restored. That can be used inside one wico to temporarily do
  93. ;;; something that alters the normal configuration.
  94. ;;;
  95. ;;;
  96. ;;; If your screen gets really mangled (lot of useles windows) 'M-o z'
  97. ;;; may help. It resets the wico back to the configuration it had when
  98. ;;; you switched to it.
  99. ;;;
  100. ;;;
  101. ;;; 'M-o u' unkills the wico you last killed, it can be used to move wicos.
  102. ;;;
  103.  
  104. ;;; Here are things you can put in your .emacs:
  105. ;;;
  106. ;;;
  107. ;;; add a new mode to type-alist
  108. ;(setq wico-type-alist (cons '("texinfo" . "Texinfo ") wico-type-alist))
  109. ;
  110. ;;;
  111. ;;;
  112. ;;; 'M-o a' runs this hook. You can put something like this without
  113. ;;; the hook in your .emacs and whenever you run emacs you have 
  114. ;;; always automatically the same wicos, of course that slows
  115. ;;; down your emacs startup.
  116. ;(setq wico-open-useful-hook 
  117. ;  '(lambda()
  118. ;     (wico-create-new)
  119. ;     (shell)       ; wico #1  is shell
  120. ;     (wico-create-new)
  121. ;     (dired "~")   ; wico #2  is dired
  122. ;     (wico-jump-to 0))) ; back to wico #0
  123. ;
  124. ;;;
  125. ;;;
  126. ;;; wico-hook and wico-update-hook are the two most important hooks.
  127. ;;; wico-hook is run when the wico functions are used the first
  128. ;;; time, so it's run only once maximun during each emacs session.
  129. ;;; wico-update-hook is run everytime you use any of the wico functions
  130. ;;;
  131. ;;;
  132. ;;; If any wico function is used start to show the wico name in the
  133. ;;; mode line. 
  134. ;(setq wico-hook
  135. ;  '(lambda()
  136. ;     (setq wico-show-ml t)))
  137. ;;;
  138. ;;; If you want to show it always just add the bare line:
  139. ;;;       (setq wico-show-ml t)
  140. ;;; before (!) the line '(require 'wicos)' in your .emacs
  141. ;;;
  142. ;;; You can use 'M-o t' to toggle the value interactively.
  143. ;;;
  144. ;;;
  145. ;;; An example how to use wico-update-hook.
  146. ;;; Sets bg, fg and cursor colors for every wico.
  147. ;;; First try to check if wico type or wico number has preferred
  148. ;;; colors, otherwise use default colors.
  149. ;;; You can easily change this to modify other things.
  150. ;;; This example works only under X!
  151. ;(defvar wico-colors-alist 
  152. ;      (mapcar 'purecopy  
  153. ;          '(("gnus" . ("green" "blue" "red"))
  154. ;               ("tex" .  ("white" "blue" "black"))
  155. ;        ("0" . ("cyan" "black" "blue"))
  156. ;        ("1" . ("red" "black" "white"))
  157. ;        ("2" .  ("yellow" "red" "blue"))
  158. ;        )))
  159. ;(defvar wico-update-hook
  160. ;  '(lambda() 
  161. ;     (wico-set-type)
  162. ;     (let ((mode (aref wico-get-mode))
  163. ;        (alist wico-colors-alist) 
  164. ;           (colors nil))
  165. ;       (while (and (not colors) alist)
  166. ;     (if (and mode (string-match (downcase (car (car alist))) mode))
  167. ;         (setq colors (cdr (car alist)))
  168. ;       (if (string-match (car (car alist)) (int-to-string wico-this-wico))
  169. ;           (setq colors (cdr (car alist)))
  170. ;         (setq alist (cdr alist)))))
  171. ;       (if (not colors) (setq colors (list '"white" '"black" '"blue")))
  172. ;       (x-set-background-color (car colors))
  173. ;       (x-set-foreground-color (car (cdr colors)))
  174. ;    (x-set-cursor-color (car (cdr (cdr colors)))))))
  175. ;;;
  176. ;;The next variable and two hooks are used to enable new features.
  177. ;;For experienced users only....
  178. ;;
  179. ;;(defvar wico-user-vectors)
  180. ;;(defvar wico-current-configuration-hook)
  181. ;;(defvar wico-set-configuration-hook)
  182. ;
  183. ;;;
  184. ;;; change the prefix key.
  185. ;(setq wico-prefix-key "\C-c\C-o"
  186. ;;;  If wico-prefix-key is set _before_ wicos.el is loaded it replaces 
  187. ;;;  the normal binding (M-o) which can now have different function binded to it.
  188. ;;;  If it is set after loading wicos.el it doesn't have any effect,
  189. ;;;  use global-set-key method instead.
  190. ;;;
  191. ;;; and finally load the beast
  192. ;(require 'wicos)
  193. ;;;
  194. ;;; Add a new wico prefix key. Now you have two prefix keys.
  195. ;(global-set-key "\e[[L" 'wico-command-prefix); F12 in my terminal
  196. ;
  197. ;
  198. ;;;; end .emacs
  199.  
  200. (provide 'wicos)
  201.  
  202. ;; the key which the all wicos functions use
  203. (defvar wico-prefix-key "\eo")  ; M-o,  I had to bind it to something....
  204.                                   ; change it to whatever you want
  205.  
  206. (global-unset-key wico-prefix-key)
  207.  
  208. (defvar wico-show-ml nil
  209. "*Shows the wico name or number in the mode line if t.")
  210.  
  211. (defvar wico-show-numeric-ml nil
  212. "*Shows the wico number in the mode line instead of the name, if t,
  213. may be useful if your mode-line is short....")
  214.  
  215. (defvar wico-multi-screens nil
  216. "*Better support in multi screen environment if t.")
  217.  
  218. ;; set the mode line
  219. ;(if (not (listp (car global-mode-string)))
  220. ;    (setq global-mode-string (list global-mode-string)))
  221. (or (assoc 'wico-show-ml global-mode-string)
  222.      (setq global-mode-string
  223.        (cons '(wico-show-ml wico-mode-line)
  224.          global-mode-string)))
  225.  
  226. (if (not (memq 'wico-update-mode-line find-file-hooks))
  227.     (setq find-file-hooks (cons 'wico-update-mode-line find-file-hooks)))
  228.  
  229.  
  230. (defvar wico-mode-line "Scratch"  
  231. "*String that is shown in the mode line.") 
  232.  
  233. (defvar wico-type-alist 
  234.       (mapcar 'purecopy
  235.           '(("inbox\\|reply to\\|vm\\|mail" . "Mail")
  236.         ("article\\|subject\\|newsgroup" . "Gnus")
  237.         ("dired" . "Dired")
  238.         ("shell" .  "Shell")
  239.         ("^c \\|^c$\\| c \\| c$" . "C") ;; have to be a bit tricky
  240.                                                 ;; so we won't get unexpected
  241.                         ;; results....
  242.                 ("^tex \\|^tex$\\| tex \\| tex$" . "TeX")
  243.         ("emacs-lisp" . "Elisp")
  244.         ("info" .  "Info")
  245.         ("calc" . "Calc")
  246.         ("telnet" . "Telnet ")
  247.         ("gopher" . "Gopher")
  248.         ("wais" . "Wais")
  249.         ("compil" . "Compile")
  250.         ("calendar" . "Calendar")
  251.         ("gomoku" . "Gomoku")
  252.         ("manual" . "Man")
  253.         ("text" . "Text")
  254.         ("texinfo" . "Texinfo")
  255.         ("irc" . "IRC")
  256.         ("mud" . "Mud")
  257.         ("lisp interaction" . "Scratch")))) ;; only *scratch*
  258.                            ;; buffer use that
  259.                            ;; mode, right?
  260.  
  261.  
  262. (defvar wico-buf-count 10  ;; this was unlimited, but I prefer it this way
  263. "*How many buffers are associated with each wico")
  264.  
  265. (defvar wico-scratch-buffer "*scratch*")
  266.  
  267. ;;  you probably need not to change anything after this
  268. ;;  but go ahead if you want
  269.  
  270. (defvar wico-not-used t 
  271. "*Nil if any of the wico functions has been used.")
  272.  
  273. (defvar wico-confs (vector nil)
  274. "*Vector that contains the information about wico configurations." )
  275.  
  276. (defvar wico-types (vector nil)
  277. "*List of wico types (Gnus, Mail, Shell etc).")
  278.  
  279. (defvar wico-names (vector nil)
  280. "*Names user has given")
  281.  
  282. (defvar wico-windows (vector "")
  283. "*Names of windows in each wico")
  284.  
  285. (defvar wico-open-wicos 1
  286. "*How many wicos are used.")
  287.  
  288. (defvar wico-this-wico 0 
  289. "*Current wico.")
  290.  
  291. (defvar wico-user-vectors nil
  292. "*List of vectors user wants to use in hooks.")
  293.  
  294. (defvar wico-map (make-sparse-keymap)
  295.   "*Keymap for wicos.")
  296.  
  297. (define-key global-map wico-prefix-key 'wico-command-prefix)
  298. (fset 'wico-command-prefix wico-map)
  299. (define-key wico-map  "c" 'wico-create-new)
  300. (define-key wico-map  "k" 'wico-kill)
  301. (define-key wico-map  "p" 'wico-previous)
  302. (define-key wico-map  "n" 'wico-next)
  303. (define-key wico-map  "g" 'wico-goto)
  304. (define-key wico-map  "w" 'wico-name-wico)
  305. (define-key wico-map  "f" 'wico-find-file-new)
  306. (define-key wico-map  "v" 'wico-show-number)
  307. (define-key wico-map  "t" 'wico-toggle-mode-line)
  308. (define-key wico-map  "?" 'wico-help)
  309. (define-key wico-map  "0" 'wico-jump-0)
  310. (define-key wico-map  "1" 'wico-jump-1)
  311. (define-key wico-map  "2" 'wico-jump-2)
  312. (define-key wico-map  "3" 'wico-jump-3)
  313. (define-key wico-map  "4" 'wico-jump-4)
  314. (define-key wico-map  "5" 'wico-jump-5)
  315. (define-key wico-map  "6" 'wico-jump-6)
  316. (define-key wico-map  "7" 'wico-jump-7)
  317. (define-key wico-map  "8" 'wico-jump-8)
  318. (define-key wico-map  "9" 'wico-jump-9)
  319. (define-key wico-map  "s" 'wico-save-current-wico)
  320. (define-key wico-map  "r" 'wico-restore-wico)
  321. (define-key wico-map  "a" 'wico-open-useful)
  322. (define-key wico-map  "m" 'wico-menu)
  323. (define-key wico-map  "z" 'wico-zap)
  324. (define-key wico-map  "u" 'wico-unkill)
  325.  
  326. ;;  not really a mode, used only to show the help
  327. (defun wico-help-mode () 
  328.       "Wico keys:
  329.        \\[wico-create-new]    create a new wico         
  330.        \\[wico-kill]    kill current wico
  331.        \\[wico-previous]    previous wico
  332.        \\[wico-next]    next wico
  333.        \\[wico-menu]    wico menu  
  334.        \\[wico-name-wico]    give wico a name
  335.        \\[wico-toggle-mode-line]    toggle the wico number in the mode line
  336.        \\[wico-jump-0]  
  337.        .......     }  jump to wico #
  338.        \\[wico-jump-9]      
  339.        \\[wico-show-number]    show the number of the current wico
  340.        \\[wico-goto]    switch to a named wico
  341.        \\[wico-help]    show this help
  342.        \\[wico-save-current-wico]    save current configuration 
  343.        \\[wico-restore-wico]    restore last saved configuration
  344.        \\[wico-open-useful]    open some useful wicos
  345.        \\[wico-find-file-new]    find file in a new wico
  346.        \\[wico-unkill]    unkill a killed wico
  347.        \\[wico-zap]    resets the original config
  348. "
  349.       (interactive)
  350.       nil)
  351.  
  352. (defconst wico-menu-mode-map nil)
  353. (if wico-menu-mode-map
  354.     nil
  355.   (setq wico-menu-mode-map (make-keymap))
  356.   (suppress-keymap wico-menu-mode-map)
  357.   (define-key wico-menu-mode-map " " 'scroll-up)
  358.   (define-key wico-menu-mode-map "\177" 'scroll-down)
  359.   (define-key wico-menu-mode-map "h" 'wico-menu-help)  
  360.   (define-key wico-menu-mode-map "q" 'wico-menu-select)
  361.   (define-key wico-menu-mode-map "x" 'wico-menu-execute)
  362.   (define-key wico-menu-mode-map "?" 'describe-mode)
  363.   (define-key wico-menu-mode-map "n" 'wico-menu-new)
  364.   (define-key wico-menu-mode-map "u" 'wico-menu-unmark)
  365.   (define-key wico-menu-mode-map "d" 'wico-menu-delete))
  366.  
  367. (defun wico-current-window-configuration ()
  368.   (run-hooks 'wico-current-configuration-hook)
  369.   (if wico-multi-screens
  370.       (let ((origin (get-screen))
  371.         (conf-list (list (current-window-configuration))))
  372.     (while (progn (switch-screen)
  373.               (not (eq origin (get-screen))))
  374.       (setq conf-list (cons (current-window-configuration) conf-list)))
  375.     conf-list)
  376.     (let ((count-buf 0)
  377.       (buffer-list (list (buffer-name)))
  378.       (point-list (list (point)))
  379.       (win-config (current-window-configuration))
  380.       (origin-buffer (buffer-name))
  381.       (origin-window (selected-window)))
  382.       (while (progn (other-window 1)
  383.             (not (eq origin-window (selected-window))))
  384.     (setq point-list (cons (point) point-list)))
  385.       (while (progn (bury-buffer)
  386.             (and (not (eq origin-buffer (buffer-name)))
  387.              (< (setq count-buf (1+ count-buf)) wico-buf-count)))
  388.     (setq buffer-list (cons (buffer-name) buffer-list)))
  389.       (set-window-configuration win-config) ;; back where we started
  390.       (aset wico-windows wico-this-wico (wico-get-windows))
  391.       (wico-set-type)
  392.       (list win-config point-list buffer-list))))
  393.   
  394. (defun wico-set-window-configuration (config-and-points)
  395.   (if wico-multi-screens
  396.       (let ((origin (get-screen)))
  397.     (set-window-configuration (car config-and-points))
  398.     (setq config-and-points (cdr config-and-points))
  399.     (switch-screen)
  400.     (redisplay-screen)
  401.     (while (and (not (eq origin (get-screen)))
  402.             config-and-points)
  403.       (set-window-configuration (car config-and-points))
  404.       (setq config-and-points (cdr config-and-points))
  405.       (switch-screen))
  406.     (redisplay-screen))
  407.     (let ((point-list    (car (cdr config-and-points)))
  408.       (buffer-list    (car (cdr (cdr config-and-points))))
  409.       (origin    nil))
  410.       (mapcar '(lambda(arg)
  411.          (if (get-buffer arg)
  412.              (switch-to-buffer arg)))
  413.           buffer-list)
  414.       (delete-other-windows)
  415.       (set-window-configuration (car config-and-points))
  416.       (setq origin (selected-window))
  417.       (while (progn (other-window -1)
  418.             (not (eq origin (selected-window))))
  419.     (goto-char (car point-list))
  420.     (setq point-list (cdr point-list)))
  421.       (goto-char (car point-list))))
  422.   (run-hooks 'wico-set-configuration-hook))
  423.  
  424. (defun wico-open-useful ()
  425.   (interactive)
  426.   (run-hooks 'wico-open-useful-hook))
  427.  
  428. (defun wico-name-wico(name)
  429.   "Ask a name, if only RET removes name"
  430.   (interactive "sGive name :")
  431.   (if (string-match name "")
  432.       (setq name nil))
  433.   (aset wico-names wico-this-wico name)
  434.   (aset wico-types wico-this-wico name)
  435.   (wico-update))
  436.  
  437. (defun wico-zap ()
  438.   "Set window config to the original config of current wico."
  439.   (interactive)
  440.   (if (not (wico-check))
  441.       (progn
  442.        (wico-set-window-configuration (aref wico-confs
  443.                           wico-this-wico))
  444.        (wico-update))))
  445.  
  446. (defun wico-next () 
  447. "Switch to next wico."
  448.   (interactive)
  449.   (if (not (wico-check))
  450.       (progn   
  451.     (aset wico-confs wico-this-wico (wico-current-window-configuration))
  452.     (if (= wico-this-wico (- wico-open-wicos 1)) (setq wico-this-wico 0)
  453.       (setq wico-this-wico (+ wico-this-wico 1)))
  454.     (wico-set-window-configuration (aref wico-confs wico-this-wico))
  455.     (wico-update))))
  456.   
  457. (defun wico-previous () 
  458. "Switch to previous wico."
  459.   (interactive)                                                      
  460.   (if (not (wico-check))
  461.       (progn
  462.        (aset wico-confs wico-this-wico (wico-current-window-configuration))  
  463.        (if (= wico-this-wico 0) (setq wico-this-wico (- wico-open-wicos 1))
  464.      (setq wico-this-wico (- wico-this-wico 1)))                      
  465.        (wico-set-window-configuration (aref wico-confs wico-this-wico))      
  466.        (wico-update))))
  467.  
  468. (defun wico-save-current-wico () 
  469. "Save the current configuration."
  470.   (interactive)
  471.   (if (not (wico-check))
  472.       (progn
  473.     (setq wico-stored (wico-current-window-configuration))
  474.     (setq wico-stored-user 
  475.           (mapcar '(lambda(x) 
  476.              (if (vectorp (eval (intern-soft x)))
  477.                  (aref (eval (intern x)) wico-this-wico)
  478.                nil))
  479.               wico-user-vectors)))))
  480.  
  481. (defun wico-restore-wico () 
  482. "Switch to the configuration which has been saved last."
  483.   (interactive)
  484.   (if (not (wico-check))
  485.       (progn
  486.     (let ((list wico-stored-user))
  487.       (mapcar '(lambda(x) 
  488.              (progn
  489.                (aset (eval (intern x)) wico-this-wico
  490.                  (car list))
  491.                (setq list (cdr list))))
  492.           wico-user-vectors))
  493.     (wico-set-window-configuration wico-stored))))
  494.  
  495. (defun wico-create-new () 
  496. "Open a new wico."
  497.   (interactive)
  498.   (if (not (wico-check))
  499.       (progn 
  500.     (if (>= wico-open-wicos (length wico-confs))
  501.         (wico-enlarge-vectors)) ;; make the vectors bigger
  502.     (aset wico-confs wico-this-wico (wico-current-window-configuration))
  503.     (delete-other-windows) 
  504.     (switch-to-buffer wico-scratch-buffer)
  505.     (setq wico-open-wicos (+ 1 wico-open-wicos))
  506.     (setq wico-this-wico (- wico-open-wicos 1))
  507.     (aset wico-names wico-this-wico nil)
  508.     (aset wico-confs wico-this-wico (wico-current-window-configuration))
  509.     (wico-update))))
  510.  
  511. (defun wico-kill () 
  512. "Kill the current wico."
  513.   (interactive)
  514.   (if (not (wico-check))
  515.       (cond
  516.        ((= wico-open-wicos 1) (message "Only one wico, can't kill"))
  517.        ( t 
  518.      (let ((i wico-this-wico))
  519.        (while (< i (- wico-open-wicos 1))
  520.          (aset wico-confs i (aref wico-confs (+ i 1)))
  521.          (aset wico-types i (aref wico-types (+ i 1)))
  522.          (aset wico-names i (aref wico-names (+ i 1)))
  523.          (aset wico-windows i (aref wico-windows (+ i 1)))
  524.          (let ((list wico-user-vectors))  ;; update the user's vectors too
  525.            (while list
  526.          (let ((name (car list)))
  527.            (aset (eval (intern name)) i 
  528.              (aref (eval (intern name)) (+ i 1)))
  529.            (setq list (cdr list)))))
  530.          (setq i (+ i 1)))
  531.        (setq wico-killed-wico (wico-current-window-configuration))
  532.        (aset wico-names (1- wico-open-wicos) nil)
  533.        (aset wico-types (1- wico-open-wicos) nil)
  534.        (setq wico-open-wicos (- wico-open-wicos 1))
  535.        (if (= wico-this-wico wico-open-wicos) 
  536.            (setq wico-this-wico (- wico-this-wico 1)))
  537.        (wico-set-window-configuration (aref wico-confs wico-this-wico))
  538.        (wico-update))))))
  539.  
  540. (defun wico-unkill()
  541.   (interactive)
  542.   (wico-create-new)
  543.   (wico-set-window-configuration wico-killed-wico))
  544.  
  545. ;;
  546. (defun wico-jump-to (arg &optional non-ia) 
  547.   "Go to a specific wico."
  548.   (if (not (wico-check))
  549.       (if (>= arg 0)
  550.       (if (< arg wico-open-wicos)
  551.           (progn
  552.         (aset wico-confs wico-this-wico (wico-current-window-configuration))
  553.         (setq wico-this-wico arg)
  554.         (wico-set-window-configuration (aref wico-confs wico-this-wico))
  555.         (if (not non-ia) (wico-update)))
  556.         (message "No wico %d" arg))
  557.     (message "No wico %d" arg))))
  558.  
  559. (defun wico-goto (switch-var)
  560.   "Switch to a named wico."
  561.   (interactive (let ((switch-var (wico-set-type)) 
  562.              (completion-ignore-case t)
  563.              (type-alist
  564.               (let ((i 0)
  565.                 (types wico-types)
  566.                 (types-alist (list)))
  567.             (while (< i wico-open-wicos)
  568.               (setq types-alist 
  569.                 (cons (list (aref types i)) types-alist))
  570.               (setq i (1+ i)))
  571.             types-alist)))
  572.          ;; if I was the author of 'terminal.el'
  573.          ;; there would be some dirty words here....
  574.          (setq switch-var 
  575.                (completing-read    
  576.             "Switch to wico: "
  577.             type-alist
  578.             nil
  579.             t
  580.             nil
  581.             ))
  582.          (list switch-var)))
  583.   (let ((i 0)
  584.     (new-wico nil))
  585.     (while (and (< i wico-open-wicos) (not new-wico))
  586.       (if (string-equal (downcase (aref wico-types i)) (downcase switch-var))
  587.       (setq new-wico i)
  588.     (setq i (1+ i))))
  589.     (if new-wico
  590.     (wico-jump-to new-wico)
  591.       (message "No wico called %s!" switch-var))))
  592.  
  593. (defun wico-show-number () 
  594. "Show the number of the current wico."
  595.   (interactive)
  596.   (message "wico: %d" wico-this-wico)
  597.   (wico-update)
  598.   (switch-to-buffer (current-buffer)))
  599.  
  600. (defun wico-help () 
  601. "Help about wico functions."
  602.  (interactive)
  603.  (with-output-to-temp-buffer "*Wico Help*"
  604.    (princ (documentation 'wico-help-mode))
  605.    (print-help-return-message)))
  606.  
  607. (defun wico-jump-0 ()
  608.   (interactive)
  609.   (wico-jump-to 0))
  610.  
  611. (defun wico-jump-1 () 
  612.    (interactive)
  613.    (wico-jump-to 1))
  614.  
  615. (defun wico-jump-2 ()
  616.   (interactive)
  617.   (wico-jump-to 2))
  618.  
  619. (defun wico-jump-3 ()
  620.   (interactive)
  621.   (wico-jump-to 3))
  622.  
  623. (defun wico-jump-4 ()
  624.   (interactive)
  625.   (wico-jump-to 4))
  626.  
  627. (defun wico-jump-5 ()
  628.   (interactive)
  629.   (wico-jump-to 5))
  630.  
  631. (defun wico-jump-6 ()
  632.   (interactive)
  633.   (wico-jump-to 6))
  634.  
  635. (defun wico-jump-7 ()
  636.   (interactive)
  637.   (wico-jump-to 7))
  638.  
  639. (defun wico-jump-8 ()
  640.   (interactive)
  641.   (wico-jump-to 8))
  642.  
  643. (defun wico-jump-9 ()
  644.   (interactive)
  645.   (wico-jump-to 9))
  646.  
  647. (defun wico-toggle-mode-line (&optional arg)
  648. "If no ARG toggles the wico info in the mode line.
  649. if ARG 1 turns on
  650. if ARG 0 turns off."
  651.   (interactive)
  652.   (if (not arg)
  653.       (setq wico-show-ml (not wico-show-ml))
  654.     (if (= arg 0)         
  655.     (setq wico-show-ml nil)
  656.       (setq wico-show-ml t)))
  657.   (wico-update)
  658.   (switch-to-buffer (current-buffer)))
  659.  
  660. (defun wico-update () 
  661.   "Update wico variables 
  662.     Most wico functions call this function."
  663.   (interactive)
  664.   (if wico-not-used 
  665.       (progn
  666.     (setq wico-not-used nil)
  667.     (run-hooks 'wico-hook)))
  668.   (run-hooks 'wico-update-hook)
  669.   ;; update the wico name in the mode line
  670.   (if wico-show-ml
  671.       (wico-update-mode-line)))
  672.  
  673. (defun wico-update-mode-line ()
  674.   (let ((name ""))
  675.     (wico-set-type)
  676.     (setq name (if wico-show-numeric-ml
  677.            wico-this-wico
  678.          (aref wico-types wico-this-wico)))
  679.     (setq wico-mode-line (concat "<" name "> "))))
  680.  
  681. (defun wico-check()
  682.   "Check if the wico functions can be used,
  683.     returns nil if everything is okay"
  684.   ;;
  685.   ;; if there's a minibuffer open, do nothing
  686.   (if (= (minibuffer-depth) 0) nil 
  687.     (message "Minibuffer open, close it first!")))
  688.  
  689. ;; an example how to use wico functions
  690. ;; saves couple of key strokes ...   :)
  691. (defun wico-find-file-new (filename)
  692.   (interactive "FFind file in new wico: ")
  693.   (wico-create-new)
  694.   (find-file filename)
  695.   )
  696.  
  697. (defun wico-show-list ()
  698.   (interactive)
  699.   (let ((i 0))
  700.     (with-output-to-temp-buffer "*wico-list*"
  701.       (while (< i wico-open-wicos)
  702.     ;; isn't lisp beautiful?
  703.     (princ (concat " +" i "+   " 
  704.                (if (< i 10)
  705.                (eval " ")
  706.              (eval ""))
  707.                (aref wico-types i)
  708.                (let ((count (- 12 (length (aref wico-types i))))
  709.                  (spaces ""))
  710.              (while (> count 0)
  711.                (setq count (1- count))
  712.                (setq spaces (concat " " spaces)))
  713.              (eval spaces))
  714.                (aref wico-windows i) "\n"))
  715.     (setq i (+ i 1)))))
  716.   (wico-update))
  717.  
  718. (defun wico-menu ()
  719.   (interactive)
  720.   (aset wico-confs wico-this-wico (wico-current-window-configuration))
  721.   (if (not (wico-check))
  722.       (progn
  723.     (wico-show-list)
  724.     (pop-to-buffer "*wico-list*")
  725.     (wico-menu-mode))))
  726.  
  727. (defun wico-menu-mode ()
  728. "Shows wico numbers and the name of the buffers in each wico, also
  729. tries to guess which application is run in each wico.
  730.  
  731. Move to the line where desired wico is and type \\[wico-menu-select] to select that wico.
  732. \\[wico-menu-delete] marks the wicos you want to delete, 
  733. \\[wico-menu-execute] deletes the marked wicos.
  734.  
  735. \\{wico-menu-mode-map}"
  736.   (interactive)
  737.   (kill-all-local-variables)
  738.   (setq major-mode 'wico-menu-mode)
  739.   (setq mode-name "Wico-menu")
  740.   (setq truncate-lines t)
  741.   (setq buffer-auto-save-file-name nil)
  742.   (use-local-map wico-menu-mode-map)
  743.   (setq buffer-read-only t)
  744.   (beginning-of-line)
  745.   (forward-line wico-this-wico)
  746.   (message "q:select,n:new,d:delete,u:unmark,x:execute,h:help,?:more help"))
  747.  
  748. (defun wico-menu-select ()
  749.   (interactive)
  750.   (if (not (wico-check))
  751.       (let (string start)
  752.     (beginning-of-line)
  753.     (search-forward "+")
  754.     (setq start (point))
  755.     (search-forward "+")
  756.     (setq string (buffer-substring start (point)))
  757.     (bury-buffer)
  758.     (wico-set-window-configuration (aref wico-confs wico-this-wico))
  759.     (wico-jump-to (string-to-int string)))))
  760.  
  761. (defun wico-menu-new ()
  762.   "Create a new wico."
  763.   (interactive)
  764.   (if (not (wico-check))
  765.       (progn
  766.     (bury-buffer)
  767.     (wico-set-window-configuration (aref wico-confs wico-this-wico))
  768.     (wico-create-new))))
  769.  
  770. (defun wico-menu-help ()
  771.   (interactive)
  772.   (message "q:select,n:new,d:delete,u:unmark,x:execute,h:help,?:more help"))
  773.  
  774. (defun wico-menu-unmark ()
  775.   "Unmark wico on this line."
  776.   (interactive)
  777.   (beginning-of-line)
  778.   (let ((buffer-read-only nil))
  779.     (delete-char 1)
  780.     (insert ? )
  781.     (forward-line 1)))
  782.  
  783. (defun wico-menu-delete ()
  784.   "Mark wico on this line to be deleted by \\[wico-menu-execute] command."
  785.   (interactive)
  786.   (beginning-of-line)
  787.   (let ((buffer-read-only nil))
  788.     (delete-char 1)
  789.     (insert ?D)
  790.     (forward-line 1)))
  791.  
  792. (defun wico-menu-execute ()
  793.   (interactive)
  794.   (goto-char (point-min))
  795.   (let ((kill-list nil))
  796.     (while (re-search-forward "^D" nil t)
  797.       (let (string start wico-to-kill)
  798.     (search-forward "+" nil t)
  799.     (setq start (point))
  800.     (search-forward "+" nil t)
  801.     (setq string (buffer-substring start (point)))
  802.     (setq wico-to-kill (string-to-int string))
  803.     (cond
  804.      ((< wico-to-kill 0) nil)
  805.      ((>= wico-to-kill wico-open-wicos) nil)
  806.      (t 
  807.       (setq kill-list (cons wico-to-kill kill-list))))))
  808.     (while kill-list
  809.       (let* ((wico-to-kill (car kill-list))
  810.          (i wico-to-kill))
  811.     (setq kill-list (cdr kill-list))
  812.     (setq wico-killed-wico (aref wico-confs wico-to-kill))
  813.     (while (< i (- wico-open-wicos 1))
  814.       (aset wico-confs i (aref wico-confs (+ i 1)))
  815.       (aset wico-types i (aref wico-types (+ i 1)))
  816.       (aset wico-names i (aref wico-names (+ i 1)))
  817.       (aset wico-windows i (aref wico-windows (+ i 1)))
  818.       (let ((list wico-user-vectors))  ;; update the user's vectors too
  819.         (while list
  820.           (let ((name (car list)))
  821.         (aset (eval (intern name)) i 
  822.               (aref (eval (intern name)) (+ i 1)))
  823.         (setq list (cdr list)))))
  824.       (setq i (+ i 1)))
  825.     (aset wico-names (1- wico-open-wicos) nil)
  826.     (aset wico-types (1- wico-open-wicos) nil)
  827.     (setq wico-open-wicos (1- wico-open-wicos))
  828.     (if (or
  829.          (> wico-this-wico wico-to-kill) 
  830.          (= wico-this-wico wico-open-wicos))
  831.         (setq wico-this-wico (1- wico-this-wico)))))
  832.     (if (< wico-open-wicos 1)
  833.     (progn
  834.       (setq wico-open-wicos 1)
  835.       (setq wico-this-wico 0)
  836.       (delete-other-windows)
  837.       (switch-to-buffer wico-scratch-buffer)
  838.       (aset wico-confs wico-this-wico 
  839.         (wico-current-window-configuration))))
  840.     (wico-set-window-configuration (aref wico-confs wico-this-wico))
  841.     (wico-show-list)  
  842.     (pop-to-buffer "*wico-list*")
  843.     (forward-line wico-this-wico)
  844.     (wico-update)))
  845.  
  846. (defun wico-set-type ()
  847.   (let ((mode (wico-get-mode)))
  848.    (if (aref wico-names wico-this-wico) 
  849.      (aset wico-types wico-this-wico (aref wico-names wico-this-wico))
  850.      (if (or (not (stringp (aref wico-types wico-this-wico)))
  851.          (not (string-match mode (aref wico-types wico-this-wico))))
  852.      (let ((i 0) 
  853.            (k 2)
  854.            (new-type mode))
  855.        (while (< i wico-open-wicos)
  856.          (if (and (stringp (aref wico-types i))
  857.               (string-equal new-type (aref wico-types i)))
  858.          (progn
  859.            (setq new-type (concat mode "<" (int-to-string k) ">")) 
  860.            (setq k (1+ k))
  861.            (setq i 0)))
  862.          (setq i (1+ i)))
  863.        (aset wico-types wico-this-wico new-type))))))
  864.  
  865.  
  866. (defun wico-get-mode()
  867.   (let ((alist wico-type-alist)
  868.     (type nil)
  869.     (org (selected-window))
  870.     (modes mode-name))
  871.     (while (progn (other-window 1)
  872.           (not (eq org (selected-window))))
  873.       (setq modes (concat mode-name "  " modes)))
  874.     (while (and (not type) alist)
  875.       (if (string-match (downcase (car (car alist)))   
  876.             (downcase  modes )) 
  877.       (setq type (cdr (car alist)))
  878.     (setq alist (cdr alist))))
  879.     (if type 
  880.     type
  881.       "Scratch")))
  882.   
  883. (defun wico-get-windows ()
  884.   (let ((org (selected-window))
  885.     (window-list (buffer-name)))
  886.     (while (progn (other-window 1)
  887.           (not (eq org (selected-window))))
  888.       (setq window-list (concat (buffer-name) "  " window-list)))
  889.     window-list))
  890.  
  891. ;;  couple of functions which can be used with X
  892. (defun wico-x-menu (&optional arg)
  893.   (interactive)
  894.   (if (null arg)
  895.       (setq arg x-mouse-pos))
  896.   (let ((selection
  897.      (x-popup-menu
  898.       arg
  899.       '("wico menu"
  900.         ("wico menu"
  901.          ("x : x wico list"           . wico-x-show-list)
  902.          ("n : next"                    . wico-next)
  903.          ("p : previous"                . wico-previous)
  904.          ("c : create new"              . wico-create-new)
  905.              ("k : kill wico"             . wico-kill)
  906.          ("g : goto "                   . wico-goto)
  907.          ("f : find file"               . wico-find-file-new)
  908.          ("t : toggle mode line"        . wico-toggle-mode-line)
  909.          ("m : wico menu"             . wico-menu)
  910.          ("z : reset orig config"          . wico-zap)
  911.          ("s : wico save config"      . wico-save-current-wico)
  912.          ("r : restore saved config"      . wico-restore-wico)
  913.          ("t : toggle wico # mode line" . wico-toggle-mode-line)
  914.          ("v : show number"             . wico-show-number)
  915.          ("u : unkill"                  . wico-unkill)
  916.          ("? : help"                    . wico-help))))))
  917.     (and selection (call-interactively selection))))
  918.  
  919. (defun wico-x-show-list (&optional arg)
  920.   (interactive)
  921.   (if (null arg)
  922.       (setq arg x-mouse-pos))
  923.   (let ((i 0)
  924.     (slist))
  925.     ;;
  926.     ;; build a x-menu...
  927.     ;;
  928.     (setq slist
  929.       (list "wico list"
  930.         (cons "wico list"
  931.                (let (j (tlist '()))
  932.              (setq i 0)
  933.              (while (< i wico-open-wicos)
  934.                (progn
  935.                  (setq j i)
  936.                  (setq i (+ i 1))
  937.                  (setq tlist
  938.                    (cons
  939.                     (cons
  940.                      (format " %d:  %s  %s"
  941.                          j
  942.                          (aref wico-types j))
  943.                      (int-to-string j))
  944.                     tlist))))
  945.              (reverse tlist)))))
  946.     (setq i (x-popup-menu arg slist))
  947.     (if (and
  948.      (stringp i)
  949.      (integerp (setq i (string-to-int i))))
  950.     (wico-jump-to i)
  951.       (message "dont change wico anyway."))))
  952.  
  953.  
  954. ;; is this really a good way to do it???
  955. (defun wico-enlarge-vectors () 
  956.   (setq wico-confs (vconcat wico-confs (vector nil)))
  957.   (setq wico-names (vconcat wico-names (vector nil)))
  958.   (setq wico-windows (vconcat wico-windows (vector "")))
  959.   (setq wico-types (vconcat wico-types (vector nil)))
  960.   (let ((list wico-user-vectors))  ;; enlarge the user's vectors too
  961.     (while list
  962.       (let ((name (car list)))
  963.     (if (vectorp (eval (intern-soft name)))
  964.         (set (intern name) (vconcat (eval (intern name)) (vector nil)))
  965.       (set (intern name) (make-vector (length wico-confs) nil))))
  966.       (setq list (cdr list))))
  967. )
  968.  
  969. ;; and finally define some things
  970.  
  971. (defvar wico-killed-wico (wico-current-window-configuration))
  972.  
  973. (defvar wico-stored (wico-current-window-configuration)
  974. "*Configuration which has beens saved last.")
  975.  
  976. (defvar wico-stored-user 
  977.     (mapcar '(lambda(x) 
  978.            (if (vectorp (eval (intern-soft x)))
  979.            (aref (eval (intern x)) wico-this-wico)
  980.            nil))
  981.            wico-user-vectors))
  982.  
  983. (aset wico-confs wico-this-wico (wico-current-window-configuration))
  984. (aset wico-names wico-this-wico nil)
  985.  
  986. (wico-update-mode-line)
  987.  
  988. ;; end
  989.