.emacs.d.git - Gitblit

Chizi123

2018-11-18 8f6f2705a38e2515b6c57fda12c5be29fb9a798f

commit \| author \| age
5cb5f7	1	;;; workgroups2.el --- New workspaces for Emacs
C	2	;;; -- coding: utf-8; lexical-binding: t --
	3	;;
	4	;; Copyright (C) 2013-2014 Sergey Pashinin
	5	;; Copyright (C) 2010-2011 tlh
	6	;;
	7	;; Author: Sergey Pashinin <sergey at pashinin dot com>
	8	;; Keywords: session management window-configuration persistence
	9	;; Package-Version: 20141102.1922
	10	;; Homepage: https://github.com/pashinin/workgroups2
	11	;; Version: 1.2.0
	12	;; Package-Requires: ((cl-lib "0.4") (dash "2.8.0") (anaphora "1.0.0") (f "0.17"))
	13	;;
	14	;; This program is free software; you can redistribute it and/or modify
	15	;; it under the terms of the GNU General Public License as published by
	16	;; the Free Software Foundation; either version 2 of the License, or (at
	17	;; your option) any later version.
	18	;;
	19	;; This program is distributed in the hope that it will be useful, but
	20	;; WITHOUT ANY WARRANTY; without even the implied warranty of
	21	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
	22	;; General Public License for more details.
	23	;;
	24	;; You should have received a copy of the GNU General Public License
	25	;; along with this program; if not, write to the Free Software
	26	;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
	27	;; USA
	28	;;
	29	;;; Commentary:
	30	;;
	31	;; Workgroups2 is an Emacs session manager. It is based on the
	32	;; experimental branch of the original "workgroups" extension.
	33	;;
	34	;; If you find a bug - please post it here:
	35	;; https://github.com/pashinin/workgroups2/issues
	36	;;
	37	;;
	38	;; Install
	39	;; ----------------------
	40	;; See the README.md file at: https://github.com/pashinin/workgroups2
	41	;; Add the lines below to your .emacs configuration.
	42	;;
	43	;; (require 'workgroups2)
	44	;;
	45	;; <settings here>
	46	;;
	47	;; (workgroups-mode 1) ; put this one at the bottom of .emacs
	48	;;
	49	;;
	50	;; Configure
	51	;; ----------------------
	52	;; ;; Change prefix key (before activating WG)
	53	;; (setq wg-prefix-key (kbd "C-c z"))
	54	;;
	55	;; ;; Change workgroups session file
	56	;; (setq wg-session-file "~/.emacs.d/.emacs_workgroups"
	57	;;
	58	;; ;; Set your own keyboard shortcuts to reload/save/switch WG:
	59	;; (global-set-key (kbd "<pause>") 'wg-reload-session)
	60	;; (global-set-key (kbd "C-S-<pause>") 'wg-save-session)
	61	;; (global-set-key (kbd "s-z") 'wg-switch-to-workgroup)
	62	;; (global-set-key (kbd "s-/") 'wg-switch-to-previous-workgroup)
	63	;;
	64	;;
	65	;; Use
	66	;; ----------------------
	67	;; Most commands start with prefix `wg-prefix-key'.
	68	;; You can change it before activating workgroups.
	69	;; By default prefix is: "C-c z"
	70	;;
	71	;; <prefix> <key>
	72	;;
	73	;; <prefix> c - create workgroup
	74	;; <prefix> A - rename workgroup
	75	;; <prefix> k - kill workgroup
	76	;; <prefix> v - switch to workgroup
	77	;; <prefix> C-s - save session
	78	;; <prefix> C-f - load session
	79	;;
	80	;;
	81	;; Help
	82	;; ----------------------
	83	;; Type "<prefix> ?" for more help
	84	;;
	85	;; See also: https://github.com/pashinin/workgroups2/wiki
	86	;;
	87	;;; Code:
	88
	89	(require 'cl-lib)
	90	(require 'f)
	91	(require 'dash)
	92	(require 'ring)
	93	(require 'anaphora)
	94
	95
	96	(defconst wg-version "1.2.0" "Current version of Workgroups.")
	97
	98	(defgroup workgroups nil
	99	"Workgroups for Emacs -- Emacs session manager"
	100	:group 'convenience)
	101
	102	(defcustom wg-session-file "~/.emacs_workgroups"
	103	"Default filename to be used to save workgroups."
	104	:type 'file
	105	:group 'workgroups)
	106	(defvaralias 'wg-default-session-file 'wg-session-file)
	107
	108	(defcustom wg-prefix-key (kbd "C-c z")
	109	"Workgroups' prefix key.
	110	Setting this variable requires that `workgroups-mode' be turned
	111	off and then on again to take effect."
	112	:type 'string
	113	:group 'workgroups)
	114
	115	(defvar workgroups-mode-map nil "Workgroups Mode's keymap.")
	116
	117	(defvar wg-incorrectly-restored-bufs nil
	118	"FIXME: docstring this.")
	119	;; TODO: check it on switching WG
	120
	121	(defvar wg-record-incorrectly-restored-bufs nil
	122	"FIXME: docstring this.")
	123
	124	(defvar wg-log-level 1
	125	"Use later.
	126	0 means no messages at all (for tests)")
	127
	128	(defcustom wg-emacs-exit-save-behavior 'save
	129	"Determines save behavior on Emacs exit.
	130
	131	`ask' Ask the user whether to save if there are unsaved changes
	132	`save' Call `wg-save-session' when there are unsaved changes
	133	Anything else Exit Emacs without saving changes"
	134	:type 'symbol
	135	:group 'workgroups)
	136
	137	(defcustom wg-workgroups-mode-exit-save-behavior 'save
	138	"Determines save behavior on `workgroups-mode' exit.
	139
	140	`ask' Ask the user whether to saveif there are unsaved changes
	141	`save' Call `wg-save-session' when there are unsaved changes
	142	Anything else Exit `workgroups-mode' without saving changes"
	143	:type 'symbol
	144	:group 'workgroups)
	145
	146	(defcustom wg-session-load-on-start (not (daemonp))
	147	"Load a session file on Workgroups start.
	148	Don't do it with Emacs --daemon option."
	149	:type 'boolean
	150	:group 'workgroups)
	151	(defvaralias 'wg-use-default-session-file 'wg-session-load-on-start)
	152
	153	(defcustom workgroups-mode nil
	154	"Non-nil if Workgroups mode is enabled."
	155	:set 'custom-set-minor-mode
	156	:initialize 'custom-initialize-default
	157	:group 'workgroups
	158	:type 'boolean)
	159
	160	(defcustom wg-first-wg-name "First workgroup"
	161	"Title of the first workgroup created."
	162	:type 'string
	163	:group 'workgroups)
	164
	165	(defcustom wg-modeline-string " wg"
	166	"Appears in modeline."
	167	:type 'string
	168	:group 'workgroups)
	169
	170	(defcustom wg-mode-line-display-on (not (featurep 'powerline))
	171	"Toggles Workgroups' mode-line display."
	172	:type 'boolean
	173	:group 'workgroups
	174	:set (lambda (sym val)
	175	(custom-set-default sym val)
	176	(force-mode-line-update)))
	177
	178	(defcustom wg-mode-line-use-faces nil
	179	"Non-nil means use faces in the mode-line display.
	180	It can be tricky to choose faces that are visible in both active
	181	and inactive mode-lines, so this feature defaults to off."
	182	:type 'boolean
	183	:group 'workgroups)
	184
	185	(defcustom wg-mode-line-decor-left-brace "("
	186	"String displayed at the left of the mode-line display."
	187	:type 'string
	188	:group 'workgroups)
	189
	190	(defcustom wg-mode-line-decor-right-brace ")"
	191	"String displayed at the right of the mode-line display."
	192	:type 'string
	193	:group 'workgroups)
	194
	195	(defcustom wg-mode-line-decor-divider ":"
	196	"String displayed between elements of the mode-line display."
	197	:type 'string
	198	:group 'workgroups)
	199
	200	(defcustom wg-mode-line-decor-window-dedicated
	201	#("#" 0 1 (help-echo "This window is dedicated to its buffer."))
	202	"Indicates that the window is dedicated to its buffer."
	203	:type 'string
	204	:group 'workgroups)
	205
	206	(defcustom wg-mode-line-decor-window-undedicated
	207	#("-" 0 1 (help-echo "This window is not dedicated to its buffer."))
	208	"Indicates that the window is not dedicated to its buffer."
	209	:type 'string
	210	:group 'workgroups)
	211
	212	(defcustom wg-mode-line-decor-session-modified
	213	#("*" 0 1 (help-echo "The session is modified"))
	214	"Indicates that the session is modified."
	215	:type 'string
	216	:group 'workgroups)
	217
	218	(defcustom wg-mode-line-decor-session-unmodified
	219	#("-" 0 1 (help-echo "The session is unmodified"))
	220	"Indicates that the session is unmodified."
	221	:type 'string
	222	:group 'workgroups)
	223
	224	(defcustom wg-mode-line-decor-workgroup-modified
	225	#("*" 0 1 (help-echo "The current workgroup is modified"))
	226	"Indicates that the current workgroup is modified."
	227	:type 'string
	228	:group 'workgroups)
	229
	230	(defcustom wg-mode-line-decor-workgroup-unmodified
	231	#("-" 0 1 (help-echo "The current workgroup is unmodified"))
	232	"Indicates that the current workgroup is unmodified."
	233	:type 'string
	234	:group 'workgroups)
	235
	236	(defcustom wg-load-last-workgroup t
	237	"Load last active (not first) workgroup from all your workgroups if it exists."
	238	:group 'workgroups
	239	:type 'boolean)
	240
	241	(defcustom wg-control-frames t
	242	"Save/restore frames."
	243	:group 'workgroups
	244	:type 'boolean)
	245
	246	(defcustom workgroups-mode-hook nil
	247	"Hook run when `workgroups-mode' is turned on."
	248	:type 'hook
	249	:group 'workgroups)
	250
	251	(defcustom workgroups-mode-exit-hook nil
	252	"Hook run when `workgroups-mode' is turned off."
	253	:type 'hook
	254	:group 'workgroups)
	255
	256	(defcustom wg-before-switch-to-workgroup-hook nil
	257	"Hook run by `wg-switch-to-workgroup'."
	258	:type 'hook
	259	:group 'workgroups)
	260
	261	(defcustom wg-after-switch-to-workgroup-hook nil
	262	"Hook run by `wg-switch-to-workgroup'."
	263	:type 'hook
	264	:group 'workgroups)
	265	(define-obsolete-variable-alias 'wg-switch-to-workgroup-hook 'wg-after-switch-to-workgroup-hook)
	266
	267	(defcustom wg-pre-window-configuration-change-hook nil
	268	"Hook run before any function that triggers `window-configuration-change-hook'."
	269	:type 'hook
	270	:group 'workgroups)
	271
	272	(defcustom wg-open-this-wg nil
	273	"Try to open this workgroup on start.
	274	If nil - nothing happens."
	275	:type 'string
	276	:group 'workgroups)
	277
	278
	279	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	280	;;
	281	;; FIXME:
	282	;;
	283	;; Only set `wg-workgroup-base-wconfig' on `wg-save-session-as' or
	284	;; `delete-frame' and only with the most recently changed working-wconfig.
	285	;; Then, since it's not overwritten on every call to
	286	;; `wg-workgroup-working-wconfig', its restoration can be retried after manually
	287	;; recreating buffers that couldn't be restored. So it takes over the
	288	;; 'incorrect restoration' portion of the base wconfig's duty. All that leaves
	289	;; to base wconfigs is that they're a saved wconfig the user felt was important.
	290	;; So why not allow more of of them? A workgroup could stash an unlimited
	291	;; number of wconfigs.
	292	;;
	293	;; TODO:
	294	;;
	295	;; * Write new commands for restoring stashed wconfigs
	296	;;
	297	;; * Add this message on improper restoration of `base-wconfig':
	298	;;
	299	;; "Unable to restore 'buf1', 'buf2'... Hit C-whatever to retry after
	300	;; manually recreating these buffers."
	301	;;
	302	;;
	303	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	304
	305
	306	;; TODO: possibly add `buffer-file-coding-system', `text-scale-mode-amount'
	307	(defcustom wg-buffer-local-variables-alist
	308	`((major-mode nil wg-deserialize-buffer-major-mode)
	309	(mark-ring wg-serialize-buffer-mark-ring wg-deserialize-buffer-mark-ring)
	310	(left-fringe-width nil nil)
	311	(right-fringe-width nil nil)
	312	(fringes-outside-margins nil nil)
	313	(left-margin-width nil nil)
	314	(right-margin-width nil nil)
	315	(vertical-scroll-bar nil nil))
	316	"Alist mapping buffer-local variable symbols to serdes functions.
	317
	318	The `car' of each entry should be a buffer-local variable symbol.
	319
	320	The `cadr' of the entry should be either nil or a function of no
	321	arguments. If nil, the variable's value is used as-is, and
	322	should have a readable printed representation. If a function,
	323	`funcall'ing it should yield a serialization of the value of the
	324	variable.
	325
	326	The `caddr' of the entry should be either nil or a function of
	327	one argument. If nil, the serialized value from above is
	328	assigned to the variable as-is. It a function, `funcall'ing it
	329	on the serialized value from above should do whatever is
	330	necessary to properly restore the original value of the variable.
	331	For example, in the case of `major-mode' it should funcall the
	332	value (a major-mode function symbol) rather than just assigning
	333	it to `major-mode'."
	334	:type 'alist
	335	:group 'workgroups)
	336
	337
	338	(defcustom wg-nowg-string "No workgroups"
	339	"Display this string if there are no workgroups and
	340	`wg-display-nowg' is t."
	341	:type 'string
	342	:group 'workgroups)
	343
	344	(defcustom wg-display-nowg nil
	345	"Display something if there are no workgroups."
	346	:type 'boolean
	347	:group 'workgroups)
	348
	349	(defcustom wg-restore-remote-buffers t
	350	"Restore buffers that get \"t\" with `file-remote-p'."
	351	:type 'boolean
	352	:group 'workgroups)
	353
	354	(defcustom wg-restore-frame-position t
	355	"Non-nil means restore frame position on workgroup restore."
	356	:type 'boolean
	357	:group 'workgroups)
	358
	359	(defcustom wg-restore-scroll-bars t
	360	"Non-nil means restore scroll-bar settings on workgroup restore."
	361	:type 'boolean
	362	:group 'workgroups)
	363
	364	(defcustom wg-restore-fringes t
	365	"Non-nil means restore fringe settings on workgroup restore."
	366	:type 'boolean
	367	:group 'workgroups)
	368
	369	(defcustom wg-restore-margins t
	370	"Non-nil means restore margin settings on workgroup restore."
	371	:type 'boolean
	372	:group 'workgroups)
	373
	374	(defcustom wg-restore-point t
	375	"Non-nil means restore `point' on workgroup restore.
	376	This is included mainly so point restoration can be suspended
	377	during `wg-morph' -- you probably want this non-nil."
	378	:type 'boolean
	379	:group 'workgroups)
	380
	381	(defcustom wg-restore-point-max t
	382	"Controls point restoration when point is at `point-max'.
	383	If `point' is at `point-max' when a wconfig is created, put
	384	`point' back at `point-max' when the wconfig is restored, even if
	385	`point-max' has increased in the meantime. This is useful in,
	386	say, irc buffers where `point-max' is constantly increasing."
	387	:type 'boolean
	388	:group 'workgroups)
	389
	390	(defcustom wg-restore-mark t
	391	"Non-nil means restore mark data on workgroup restore."
	392	:type 'boolean
	393	:group 'workgroups)
	394
	395	(defcustom wg-restore-window-dedicated-p t
	396	"Non-nil means restore `window-dedicated-p' on workgroup restore."
	397	:type 'boolean
	398	:group 'workgroups)
	399
	400	(defcustom wg-remember-frame-for-each-wg nil
	401	"When switching workgroups - restore frame parameters for each workgroup.
	402
	403	When nil - save/restore frame parameters to/from the first workgroup."
	404	:type 'boolean
	405	:group 'workgroups)
	406
	407
	408	(defcustom wg-wconfig-undo-list-max 20
	409	"Number of past window configs to retain for undo."
	410	:type 'integer
	411	:group 'workgroups)
	412
	413	(defcustom wg-wconfig-kill-ring-max 20
	414	"Maximum length of the `wg-wconfig-kill-ring'."
	415	:type 'integer
	416	:group 'workgroups)
	417
	418	(defvar wg-wconfig-kill-ring nil
	419	"Ring of killed or kill-ring-saved wconfigs.")
	420
	421	(defvar wg-buffer-uid nil
	422	"Symbol for the current buffer's wg-buf's uid.
	423	Every Workgroups buffer object (wg-buf) has a uid. When
	424	Workgroups creates or encounters an Emacs buffer object
	425	corresponding to a wg-buf, it tags it with the wg-buf's uid to
	426	unambiguously pair the two.")
	427	(make-variable-buffer-local 'wg-buffer-uid)
	428
	429	(defcustom wg-flag-modified t
	430	"Show \"modified\" flags in modeline."
	431	:type 'boolean
	432	:group 'workgroups
	433	:set (lambda (sym val)
	434	(custom-set-default sym val)
	435	(force-mode-line-update)))
	436
	437
	438
	439	(defvar wg-window-configuration-changed nil
	440	"Flag set by `window-configuration-change-hook'.")
	441
	442	(defvar wg-already-updated-working-wconfig nil
	443	"Flag set by `wg-update-working-wconfig-hook'.")
	444
	445	(defvar wg-undoify-window-configuration-change t
	446	"Should windows undo info be updated or not.
	447	When you change window configuration.")
	448
	449	(defvar wg-current-workgroup nil "Bound to the current workgroup.")
	450
	451	(defvar wg-window-min-width 2
	452	"Bound to `window-min-width' when restoring wtrees.")
	453
	454	(defvar wg-window-min-height 1
	455	"Bound to `window-min-height' when restoring wtrees.")
	456
	457	(defvar wg-window-min-pad 2
	458	"Added to `wg-window-min-foo' to produce the actual minimum window size.")
	459
	460	(defvar wg-actual-min-width (+ wg-window-min-width wg-window-min-pad)
	461	"Actual minimum window width when creating windows.")
	462
	463	(defvar wg-actual-min-height (+ wg-window-min-height wg-window-min-pad)
	464	"Actual minimum window height when creating windows.")
	465
	466	(defvar wg-min-edges `(0 0 ,wg-actual-min-width ,wg-actual-min-height)
	467	"Smallest allowable edge list of windows created by Workgroups.")
	468
	469	(defvar wg-null-edges '(0 0 0 0) "Null edge list.")
	470
	471	(defvar wg-window-tree-selected-window nil
	472	"Used during wconfig restoration to hold the selected window.")
	473
	474	(defvar wg-buffer-workgroup nil
	475	"A workgroup in which this buffer most recently appeared.
	476	Buffer-local.")
	477	(make-variable-buffer-local 'wg-buffer-workgroup)
	478
	479	(defcustom wg-default-buffer "scratch"
	480	"Show this in case everything else fails.
	481	When a buffer can't be restored, when creating a blank wg."
	482	:type 'string
	483	:group 'workgroups)
	484
	485
	486	;;
	487	;; Crazy stuff...
	488	;;
	489	(defcustom wg-associate-blacklist (list "helm mini" "Messages" "scratch"
	490	"helm action")
	491	"Do not autoassociate these buffers."
	492	:type 'list
	493	:group 'workgroups)
	494
	495	(defconst wg-buffer-list-original (symbol-function 'buffer-list))
	496	(fset 'wg-buffer-list-emacs wg-buffer-list-original)
	497
	498	(defun buffer-list (&optional frame)
	499	"Redefinition of `buffer-list'.
	500	Pass FRAME to it.
	501	Remove file and dired buffers that are not associated with workgroup."
	502	(let ((res (wg-buffer-list-emacs frame))
	503	(wg-buf-uids (wg-workgroup-associated-buf-uids)))
	504	(--remove (and (or (buffer-file-name it)
	505	(eq (buffer-local-value 'major-mode it) 'dired-mode))
	506	;;(not (member b wg-buffers))
	507	(not (member (wg-buffer-uid-or-add it) wg-buf-uids)))
	508	res)))
	509
	510	(defconst wg-buffer-list-function (symbol-function 'buffer-list))
	511	(fset 'buffer-list wg-buffer-list-original)
	512
	513	;; locate-dominating-file
	514	(defcustom wg-mess-with-buffer-list nil
	515	"Redefine `buffer-list' to show buffers for each workgroup.
	516
	517	Crazy stuff that allows to reduce amount of code, gives new
	518	features but is fucking unstable, so disabled by default"
	519	:type 'boolean
	520	:group 'workgroups
	521	:set (lambda (sym val)
	522	(custom-set-default sym val)
	523	(if (and workgroups-mode val)
	524	(fset 'buffer-list wg-buffer-list-function)
	525	(fset 'buffer-list wg-buffer-list-original))))
	526	(fset 'buffer-list wg-buffer-list-original)
	527
	528	(defcustom wg-use-faces t
	529	"Non-nil means use faces in various messages."
	530	:type 'boolean
	531	:group 'workgroups)
	532
	533	(defcustom wg-list-display-decor-left-brace "( "
	534	"String displayed to the left of the list display."
	535	:type 'string
	536	:group 'workgroups)
	537
	538	(defcustom wg-list-display-decor-right-brace " )"
	539	"String displayed to the right of the list display."
	540	:type 'string
	541	:group 'workgroups)
	542
	543	(defcustom wg-list-display-decor-divider " \| "
	544	"String displayed between elements of the list display."
	545	:type 'string
	546	:group 'workgroups)
	547
	548	(defcustom wg-list-display-decor-current-left "-<{ "
	549	"String displayed to the left of the current element of the list display."
	550	:type 'string
	551	:group 'workgroups)
	552
	553	(defcustom wg-list-display-decor-current-right " }>-"
	554	"String displayed to the right of the current element of the list display."
	555	:type 'string
	556	:group 'workgroups)
	557
	558	(defcustom wg-list-display-decor-previous-left "< "
	559	"String displayed to the left of the previous element of the list display."
	560	:type 'string
	561	:group 'workgroups)
	562
	563	(defcustom wg-list-display-decor-previous-right " >"
	564	"String displayed to the right of the previous element of the list display."
	565	:type 'string
	566	:group 'workgroups)
	567
	568
	569	(defvar wg-face-abbrevs nil
	570	"Assoc list mapping face abbreviations to face names.")
	571
	572	(defmacro wg-defface (face key spec doc &rest args)
	573	"`defface' wrapper adding a lookup key used by `wg-fontify'."
	574	(declare (indent 2))
	575	`(progn
	576	(cl-pushnew (cons ,key ',face) wg-face-abbrevs :test #'equal)
	577	(defface ,face ,spec ,doc ,@args)))
	578
	579	(wg-defface wg-current-workgroup-face :cur
	580	'((t :inherit font-lock-constant-face :bold nil))
	581	"Face used for current elements in list displays."
	582	:group 'workgroups)
	583
	584	(wg-defface wg-previous-workgroup-face :prev
	585	'((t :inherit font-lock-keyword-face :bold nil))
	586	"Face used for the name of the previous workgroup in the list display."
	587	:group 'workgroups)
	588
	589	(wg-defface wg-other-workgroup-face :other
	590	'((t :inherit font-lock-string-face :bold nil))
	591	"Face used for the names of other workgroups in the list display."
	592	:group 'workgroups)
	593
	594	(wg-defface wg-command-face :cmd
	595	'((t :inherit font-lock-function-name-face :bold nil))
	596	"Face used for command/operation strings."
	597	:group 'workgroups)
	598
	599	(wg-defface wg-divider-face :div
	600	'((t :inherit font-lock-builtin-face :bold nil))
	601	"Face used for dividers."
	602	:group 'workgroups)
	603
	604	(wg-defface wg-brace-face :brace
	605	'((t :inherit font-lock-builtin-face :bold nil))
	606	"Face used for left and right braces."
	607	:group 'workgroups)
	608
	609	(wg-defface wg-message-face :msg
	610	'((t :inherit font-lock-string-face :bold nil))
	611	"Face used for messages."
	612	:group 'workgroups)
	613
	614	(wg-defface wg-mode-line-face :mode
	615	'((t :inherit font-lock-doc-face :bold nil))
	616	"Face used for workgroup position and name in the mode-line display."
	617	:group 'workgroups)
	618
	619	(wg-defface wg-filename-face :file
	620	'((t :inherit font-lock-keyword-face :bold nil))
	621	"Face used for filenames."
	622	:group 'workgroups)
	623
	624
	625	;;; fancy displays
	626
	627	(defun wg-element-display (elt elt-string &optional current-elt-p previous-elt-p)
	628	"Return display string for ELT."
	629	(cond ((and current-elt-p (funcall current-elt-p elt))
	630	(wg-fontify (:cur (concat wg-list-display-decor-current-left
	631	elt-string
	632	wg-list-display-decor-current-right))))
	633	((and previous-elt-p (funcall previous-elt-p elt))
	634	(wg-fontify (:prev (concat wg-list-display-decor-previous-left
	635	elt-string
	636	wg-list-display-decor-previous-right))))
	637	(t (wg-fontify (:other elt-string)))))
	638
	639	(defun wg-workgroup-display (workgroup index)
	640	"Return display string for WORKGROUP at INDEX."
	641	(if (not workgroup) wg-nowg-string
	642	(wg-element-display
	643	workgroup
	644	(format "%d: %s" index (wg-workgroup-name workgroup))
	645	'wg-current-workgroup-p
	646	'wg-previous-workgroup-p)))
	647
	648	(defun wg-buffer-display (buffer index)
	649	"Return display string for BUFFER. INDEX is ignored."
	650	(if (not buffer) "No buffers"
	651	(wg-element-display
	652	(wg-get-buffer buffer)
	653	(format "%s" (wg-buffer-name buffer))
	654	'wg-current-buffer-p)))
	655
	656	(defun wg-message (format-string &rest args)
	657	"Call `message' with FORMAT-STRING and ARGS."
	658	(if (> wg-log-level 0) (apply #'message format-string args)))
	659
	660	(defmacro wg-fontified-message (&rest format)
	661	"`wg-fontify' FORMAT and call `wg-message' on it."
	662	(declare (indent defun))
	663	`(wg-message (wg-fontify ,@format)))
	664
	665	(defun wg-add-face (facekey string)
	666	"Return a copy of STRING fontified according to FACEKEY.
	667	FACEKEY must be a key in `wg-face-abbrevs'."
	668	(let ((face (wg-aget wg-face-abbrevs facekey))
	669	(string (copy-sequence string)))
	670	(unless face (error "No face with key %s" facekey))
	671	(if (not wg-use-faces) string
	672	(put-text-property 0 (length string) 'face face string)
	673	string)))
	674
	675	(defmacro wg-fontify (&rest specs)
	676	"A small fontification DSL.
	677	The results of all SPECS are `concat'd together.
	678	If a spec is a cons with a keyword car, apply `wg-add-face' to it.
	679	Other conses get evaluated, and should produce a strings.
	680	If a spec is a string it is used unmodified.
	681	Anything else is formatted with %s to produce a string."
	682	(declare (indent defun))
	683	`(concat
	684	,@(wg-docar (spec specs)
	685	(cond ((and (consp spec)
	686	(keywordp (car spec)))
	687	`(wg-add-face ,@spec))
	688	;;((listp spec) (cdr (eval spec)))
	689	;;((listp spec)
	690	;; ;;(prin1-to-string (nth 1 (eval spec)))
	691	;; )
	692	((consp spec) spec)
	693	((stringp spec) spec)
	694	(t `(format "%s" ,spec))))))
	695
	696	(defmacro wg-with-gensyms (syms &rest body)
	697	"Bind all symbols in SYMS to `gensym's, and eval BODY."
	698	(declare (indent 1))
	699	`(let (,@(mapcar (lambda (sym) `(,sym (cl-gensym))) syms)) ,@body))
	700
	701	(defmacro wg-dbind (args expr &rest body)
	702	"Bind the variables in ARGS to the result of EXPR and execute BODY.
	703	Abbreviation of `destructuring-bind'."
	704	(declare (indent 2))
	705	`(cl-destructuring-bind ,args ,expr ,@body))
	706
	707	(defun wg-partition (list &optional n step)
	708	"Take LIST, return a list of N length sublists, offset by STEP.
	709	N defaults to 2, and STEP defaults to N.
	710	Iterative to prevent stack overflow."
	711	(let* ((n (or n 2)) (step (or step n)) acc)
	712	(while list
	713	(push (-take n list) acc)
	714	(setq list (nthcdr step list)))
	715	(nreverse acc)))
	716
	717	(defmacro wg-when-boundp (symbols &rest body)
	718	"When all SYMBOLS are bound, `eval' BODY."
	719	(declare (indent 1))
	720	`(when (and ,@(mapcar (lambda (sym) `(boundp ',sym)) symbols))
	721	,@body))
	722
	723	(defmacro wg-docar (spec &rest body)
	724	"do-style wrapper for `mapcar'.
	725
	726	\(fn (VAR LIST) BODY...)"
	727	(declare (indent 1))
	728	`(mapcar (lambda (,(car spec)) ,@body) ,(cadr spec)))
	729
	730	(defmacro wg-dohash (spec &rest body)
	731	"do-style wrapper for `maphash'.
	732
	733	\(fn (KEY VALUE TABLE [RESULT]) BODY...)"
	734	(declare (indent 1))
	735	(wg-dbind (key val table &optional result) spec
	736	`(progn (maphash (lambda (,key ,val) ,@body) ,table) ,result)))
	737
	738	(defmacro wg-doconcat (spec &rest body)
	739	"do-style wrapper for `mapconcat'.
	740
	741	\(fn (VAR SEQ [SEPARATOR]) BODY...)"
	742	(declare (indent 1))
	743	(wg-dbind (elt seq &optional sep) spec
	744	`(mapconcat (lambda (,elt) ,@body) ,seq (or ,sep ""))))
	745
	746	(defmacro wg-asetf (&rest places-and-values)
	747	"Anaphoric `setf'."
	748	`(progn ,@(mapcar (lambda (pv) `(let ((it ,(car pv))) (setf ,@pv)))
	749	(wg-partition places-and-values 2))))
	750
	751	(defmacro wg-destructuring-dolist (spec &rest body)
	752	"Loop over a list.
	753	Evaluate BODY, destructuring LIST into SPEC, then evaluate RESULT
	754	to get a return value, defaulting to nil. The only hitch is that
	755	spec must end in dotted style, collecting the rest of the list
	756	into a var, like so: (a (b c) . rest)
	757
	758	\(fn (SPEC LIST [RESULT]) BODY...)"
	759	(declare (indent 1))
	760	(wg-dbind (loopspec list &optional result) spec
	761	(let ((rest (cdr (last loopspec))))
	762	(wg-with-gensyms (list-sym)
	763	`(let ((,list-sym ,list))
	764	(while ,list-sym
	765	(wg-dbind ,loopspec ,list-sym
	766	,@body
	767	(setq ,list-sym ,rest)))
	768	,result)))))
	769
	770
	771	;;; numbers
	772
	773	(defun wg-step-to (n m step)
	774	"Increment or decrement N toward M by STEP.
	775	Return M when the difference between N and M is less than STEP."
	776	(cond ((= n m) n)
	777	((< n m) (min (+ n step) m))
	778	((> n m) (max (- n step) m))))
	779
	780	(defun wg-within (num lo hi &optional hi-inclusive)
	781	"Return t when NUM is within bounds LO and HI.
	782	HI-INCLUSIVE non-nil means the HI bound is inclusive."
	783	(and (>= num lo) (if hi-inclusive (<= num hi) (< num hi))))
	784
	785	(defun wg-int-to-b36-one-digit (i)
	786	"Return a character in 0..9 or A..Z from I, and integer 0<=I<32.
	787	Cribbed from `org-id-int-to-b36-one-digit'."
	788	(cond ((not (wg-within i 0 36))
	789	(error "%s out of range" i))
	790	((< i 10) (+ ?0 i))
	791	((< i 36) (+ ?A i -10))))
	792
	793	(defun wg-b36-to-int-one-digit (i)
	794	"Turn a character 0..9, A..Z, a..z into a number 0..61.
	795	The input I may be a character, or a single-letter string.
	796	Cribbed from `org-id-b36-to-int-one-digit'."
	797	(and (stringp i) (setq i (string-to-char i)))
	798	(cond ((and (>= i ?0) (<= i ?9)) (- i ?0))
	799	((and (>= i ?A) (<= i ?Z)) (+ (- i ?A) 10))
	800	(t (error "Invalid b36 character"))))
	801
	802	(defun wg-int-to-b36 (i &optional length)
	803	"Return a base 36 string from I."
	804	(let ((base 36) b36)
	805	(cl-labels ((add-digit () (push (wg-int-to-b36-one-digit (mod i base)) b36)
	806	(setq i (/ i base))))
	807	(add-digit)
	808	(while (> i 0) (add-digit))
	809	(setq b36 (cl-map 'string 'identity b36))
	810	(if (not length) b36
	811	(concat (make-string (max 0 (- length (length b36))) ?0) b36)))))
	812
	813	(defun wg-b36-to-int (str)
	814	"Convert STR, a base-36 string, into the corresponding integer.
	815	Cribbed from `org-id-b36-to-int'."
	816	(let ((result 0))
	817	(mapc (lambda (i)
	818	(setq result (+ (* result 36)
	819	(wg-b36-to-int-one-digit i))))
	820	str)
	821	result))
	822
	823
	824
	825	;;; lists
	826
	827	(defmacro wg-removef-p (item seq-place &rest keys)
	828	"If ITEM is a `member*' of SEQ-PLACE, remove it from SEQ-PLACE and return t.
	829	Otherwise return nil. KEYS can be any keywords accepted by `remove*'."
	830	`(> (length ,seq-place)
	831	(length (setf ,seq-place (cl-remove ,item ,seq-place ,@keys)))))
	832
	833	(defmacro wg-pushnew-p (item seq-place &rest keys)
	834	"If ITEM is not a `member' of SEQ-PLACE, push it to SEQ-PLACE and return t.
	835	Otherwise return nil. KEYS can be any keyword args accepted by `pushnew'."
	836	`(< (length ,seq-place)
	837	(length (cl-pushnew ,item ,seq-place ,@keys))))
	838
	839	(defun wg-range (start end)
	840	"Return a list of integers from START up to but not including END."
	841	(let (accum)
	842	(dotimes (i (- end start) (nreverse accum))
	843	(push (+ start i) accum))))
	844
	845	(defun wg-insert-before (elt list index)
	846	"Insert ELT into LIST before INDEX."
	847	(if (zerop index) (cons elt list)
	848	(-insert-at index elt list)))
	849
	850	(defun wg-move-elt (elt list index &rest keys)
	851	"Move ELT before INDEX in LIST.
	852	KEYS is passed to `remove*'."
	853	(wg-insert-before elt (apply 'cl-remove elt list keys) index))
	854
	855	(defun wg-cyclic-nth (list n)
	856	"Return the Nth element of LIST, modded by the length of list."
	857	(nth (mod n (length list)) list))
	858
	859	(defun wg-cyclic-offset-elt (elt list n)
	860	"Cyclically offset ELT's position in LIST by N."
	861	(-when-let (pos (cl-position elt list))
	862	(wg-move-elt elt list (mod (+ n pos) (length list)))))
	863
	864	(defun wg-cyclic-nth-from-elt (elt list n &rest keys)
	865	"Return the elt in LIST N places cyclically from ELT.
	866	If ELT is not present is LIST, return nil.
	867	KEYS is passed to `position'."
	868	(-when-let (pos (apply 'cl-position elt list keys))
	869	(wg-cyclic-nth list (+ pos n))))
	870
	871	(defun wg-util-swap (elt1 elt2 list)
	872	"Return a copy of LIST with ELT1 and ELT2 swapped.
	873	Return nil when ELT1 and ELT2 aren't both present."
	874	(-when-let* ((p1 (cl-position elt1 list))
	875	(p2 (cl-position elt2 list)))
	876	(wg-move-elt elt1 (wg-move-elt elt2 list p1) p2)))
	877
	878	(defun wg-dups-p (list &rest keys)
	879	"Return non-nil when LIST contains duplicate elements.
	880
	881	Keywords supported: :test :key
	882
	883	\(fn LIST [KEYWORD VALUE]...)"
	884	(let ((test (or (plist-get keys :test) 'eq))
	885	(key (or (plist-get keys :key) 'identity)))
	886	(cl-loop for (elt . rest) on list
	887	for elt = (funcall key elt)
	888	when (cl-find elt rest :test test :key key) return elt)))
	889
	890	(defun wg-string-list-union (&optional list1 list2)
	891	"Return the `union' of LIST1 and LIST2, using `string=' as the test.
	892	This only exists to get rid of duplicate lambdas in a few reductions."
	893	(cl-union list1 list2 :test 'string=))
	894
	895
	896
	897	;;; alists
	898
	899	(defun wg-aget (alist key &optional default)
	900	"Return the value of KEY in ALIST. Uses `assq'.
	901	If PARAM is not found, return DEFAULT which defaults to nil."
	902	(aif (assq key alist) (cdr it) default))
	903
	904	(defun wg-aput (alist key value)
	905	"Return a new alist from ALIST with KEY's value set to VALUE."
	906	(let* ((found nil)
	907	(new (wg-docar (kvp alist)
	908	(if (not (eq key (car kvp))) kvp
	909	(setq found (cons key value))))))
	910	(if found new (cons (cons key value) new))))
	911
	912	(defun wg-aremove (alist key)
	913	"`remove' KEY's key-value-pair from ALIST."
	914	(remove (assoc key alist) alist))
	915
	916
	917	;;; symbols and strings
	918
	919	(defun wg-toggle (symbol)
	920	"Toggle SYMBOL's truthiness."
	921	(set symbol (not (symbol-value symbol))))
	922
	923	(defun wg-get-buffer (buffer-or-name)
	924	"Return BUFFER-OR-NAME's buffer, or error."
	925	(or (get-buffer buffer-or-name)
	926	(error "%S does not identify a buffer" buffer-or-name)))
	927
	928	(defun wg-buffer-name (buffer-or-name)
	929	"Return BUFFER-OR-NAME's `buffer-name', or error."
	930	(buffer-name (wg-get-buffer buffer-or-name)))
	931
	932	(defun wg-buffer-major-mode (buffer-or-name)
	933	"Return BUFFER's major-mode."
	934	(with-current-buffer buffer-or-name major-mode))
	935
	936	(defun wg-current-buffer-p (buffer-or-name)
	937	"Return t if BUFFER-OR-NAME is the current buffer, nil otherwise."
	938	(eq (wg-get-buffer buffer-or-name) (current-buffer)))
	939
	940	(defun wg-symcat (&rest symbols-and-strings)
	941	"Return a new interned symbol by concatenating SYMBOLS-AND-STRINGS."
	942	(intern (mapconcat (lambda (obj) (if (symbolp obj) (symbol-name obj) obj))
	943	symbols-and-strings "")))
	944
	945	(defmacro wg-defstruct (prefix name-form &rest slot-defs)
	946	"`defstruct' wrapper that namespace-prefixes all generated functions.
	947	Note: this doesn't yet work with :conc-name, and possibly other
	948	options."
	949	(declare (indent 2))
	950	(let* ((name (if (consp name-form) (car name-form) name-form))
	951	(prefixed-name (wg-symcat prefix "-" name)))
	952	(cl-labels ((rebind (opstr)
	953	(let ((oldfnsym (wg-symcat opstr "-" prefix "-" name)))
	954	`((fset ',(wg-symcat prefix "-" opstr "-" name)
	955	(symbol-function ',oldfnsym))
	956	(fmakunbound ',oldfnsym)))))
	957	;; `eval-and-compile' gets rid of byte-comp warnings ("function `foo' not
	958	;; known to be defined"). We can accomplish this with `declare-function'
	959	;; too, but it annoyingly requires inclusion of the function's arglist,
	960	;; which gets ugly.
	961	`(eval-and-compile
	962	(cl-defstruct ,(if (symbolp name-form) prefixed-name
	963	`(,prefixed-name ,@(cdr name-form)))
	964	,@slot-defs)
	965	,@(rebind "make")
	966	,@(rebind "copy")
	967	',prefixed-name))))
	968
	969	(wg-defstruct wg session
	970	(uid (wg-generate-uid))
	971	(name)
	972	(modified)
	973	(parameters)
	974	(file-name)
	975	(version wg-version)
	976	(workgroup-list)
	977	(buf-list))
	978
	979	(wg-defstruct wg workgroup
	980	(uid (wg-generate-uid))
	981	(name)
	982	(modified)
	983	(parameters)
	984	(base-wconfig)
	985	(selected-frame-wconfig)
	986	(saved-wconfigs)
	987	(strong-buf-uids)
	988	(weak-buf-uids))
	989
	990	(wg-defstruct wg workgroup-state
	991	(undo-pointer)
	992	(undo-list))
	993
	994	(wg-defstruct wg wconfig
	995	(uid (wg-generate-uid))
	996	(name)
	997	(parameters)
	998	(left)
	999	(top)
	1000	(width)
	1001	(height)
	1002	(vertical-scroll-bars)
	1003	(scroll-bar-width)
	1004	(wtree))
	1005
	1006	(wg-defstruct wg wtree
	1007	(uid)
	1008	(dir)
	1009	(edges)
	1010	(wlist))
	1011
	1012	(wg-defstruct wg win
	1013	(uid)
	1014	(parameters)
	1015	(edges)
	1016	(point)
	1017	(start)
	1018	(hscroll)
	1019	(dedicated)
	1020	(selected)
	1021	(minibuffer-scroll)
	1022	(buf-uid))
	1023
	1024	(wg-defstruct wg buf
	1025	(uid (wg-generate-uid))
	1026	(name)
	1027	(file-name)
	1028	(point)
	1029	(mark)
	1030	(local-vars)
	1031	(special-data)
	1032	;; This may be used later:
	1033	(gc))
	1034
	1035
	1036	(defmacro wg-with-slots (obj slot-bindings &rest body)
	1037	"Bind OBJ's slot values to symbols in BINDS, then eval BODY.
	1038	The car of each element of SLOT-BINDINGS is the bound symbol, and
	1039	the cadr as the accessor function."
	1040	(declare (indent 2))
	1041	(wg-with-gensyms (objsym)
	1042	`(let* ((,objsym ,obj)
	1043	,@(wg-docar (slot slot-bindings)
	1044	`(,(car slot) (,(cadr slot) ,objsym))))
	1045	,@body)))
	1046
	1047	(defun wg-add-or-remove-hooks (remove &rest pairs)
	1048	"Add FUNCTION to or remove it from HOOK, depending on REMOVE."
	1049	(dolist (pair (wg-partition pairs 2))
	1050	(funcall (if remove 'remove-hook 'add-hook)
	1051	(car pair) (cadr pair))))
	1052
	1053	(defmacro wg-set-parameter (place parameter value)
	1054	"Set PARAMETER to VALUE at PLACE.
	1055	This needs to be a macro to allow specification of a setf'able place."
	1056	(wg-with-gensyms (p v)
	1057	`(let ((,p ,parameter) (,v ,value))
	1058	(wg-pickelable-or-error ,p)
	1059	(wg-pickelable-or-error ,v)
	1060	(setf ,place (wg-aput ,place ,p ,v))
	1061	,v)))
	1062
	1063	(defun wg-time-to-b36 ()
	1064	"Convert `current-time' into a b36 string."
	1065	(apply 'concat (wg-docar (time (current-time))
	1066	(wg-int-to-b36 time 4))))
	1067
	1068	(defun wg-b36-to-time (b36)
	1069	"Parse the time in B36 string from UID."
	1070	(cl-loop for i from 0 to 8 by 4
	1071	collect (wg-b36-to-int (cl-subseq b36 i (+ i 4)))))
	1072	(defalias 'wg-uid-to-time 'wg-b36-to-time)
	1073
	1074	(defun wg-generate-uid (&optional prefix)
	1075	"Return a new uid, optionally prefixed by PREFIX."
	1076	(concat prefix (wg-time-to-b36) "-" (wg-int-to-b36 string-chars-consed)))
	1077
	1078	(defun wg-uid-to-seconds (uid)
	1079	"Return the `float-time' parsed from UID with `wg-uid-to-time'."
	1080	(float-time (wg-uid-to-time uid)))
	1081
	1082
	1083	(defun wg-get-value (arg)
	1084	"Get a value of ARG if it exists."
	1085	(if (boundp `,arg) arg))
	1086
	1087	(defmacro wg-support (mode pkg params)
	1088	"Macro to create (de)serialization functions for a buffer.
	1089	You need to save/restore a specific MODE which is loaded from a
	1090	package PKG. In PARAMS you give local variables to save and a
	1091	deserialization function."
	1092	(declare (indent 2))
	1093	`(let ((mode-str (symbol-name ,mode))
	1094	(args ,params))
	1095
	1096	(eval `(defun ,(intern (format "wg-deserialize-%s-buffer" mode-str)) (buffer)
	1097	"DeSerialization function created with `wg-support'.
	1098	Gets saved variables and runs code to restore a BUFFER."
	1099	(when (require ',,pkg nil 'noerror)
	1100	(wg-dbind (this-function variables) (wg-buf-special-data buffer)
	1101	(let ((default-directory (car variables))
	1102	(df (cdr (assoc 'deserialize ',,params)))
	1103	(user-vars (cadr variables)))
	1104	(if df
	1105	(funcall df buffer user-vars)
	1106	(get-buffer-create wg-default-buffer))
	1107	)))))
	1108
	1109	(eval `(defun ,(intern (format "wg-serialize-%s-buffer" mode-str)) (buffer)
	1110	"Serialization function created with `wg-support'.
	1111	Saves some variables to restore a BUFFER later."
	1112	(when (get-buffer buffer)
	1113	(with-current-buffer buffer
	1114	(when (eq major-mode ',,mode)
	1115	(let ((sf (cdr (assoc 'serialize ',,params)))
	1116	(save (cdr (assoc 'save ',,params))))
	1117	(list ',(intern (format "wg-deserialize-%s-buffer" mode-str))
	1118	(list default-directory
	1119	(if sf
	1120	(funcall sf buffer)
	1121	(if save (mapcar 'wg-get-value save)))
	1122	))))))))
	1123	;; Maybe change a docstring for functions
	1124	;;(put (intern (format "wg-serialize-%s-buffer" (symbol-name mode)))
	1125	;; 'function-documentation
	1126	;; (format "A function created by `wg-support'."))
	1127
	1128	;; Add function to `wg-special-buffer-serdes-functions' variable
	1129	(eval `(add-to-list 'wg-special-buffer-serdes-functions
	1130	',(intern (format "wg-serialize-%s-buffer" mode-str)) t))
	1131	))
	1132
	1133	(defconst wg-font-lock-keywords
	1134	'(("(\\(wg-support\\\|wg-support\\)[ \t]*"
	1135	(1 font-lock-keyword-face)
	1136	;;(2 font-lock-keyword-face)
	1137	)))
	1138	(font-lock-add-keywords 'emacs-lisp-mode wg-font-lock-keywords)
	1139
	1140	(defvar wg-current-session nil "Current session object.")
	1141	(defun wg-current-session (&optional noerror)
	1142	"Return `wg-current-session' or error unless NOERROR."
	1143	(or wg-current-session
	1144	(if workgroups-mode
	1145	(unless noerror (error "No session is defined"))
	1146	(unless noerror
	1147	(error "Activate workgroups with (workgroups-mode 1)")))))
	1148
	1149	;; locate-dominating-file
	1150	(defun wg-get-first-existing-dir (&optional dir)
	1151	"Test if DIR exists and return it.
	1152	If not - try to go to the parent dir and do the same."
	1153	(let* ((d (or dir default-directory)))
	1154	(if (file-directory-p d) d
	1155	(let* ((cur d) (parent (file-name-directory (directory-file-name cur))))
	1156	(while (and (> (length cur) (length parent))
	1157	(not (file-directory-p parent)))
	1158	(message "Test %s" parent)
	1159	(setq cur parent)
	1160	(setq parent (file-name-directory (directory-file-name cur))))
	1161	parent))))
	1162
	1163
	1164	(defvar wg-pickel-identifier '~pickel!~
	1165	"Symbol identifying a stream as a pickel.")
	1166
	1167	(defvar wg-pickel-pickelable-types
	1168	'(integer
	1169	float
	1170	symbol
	1171	string
	1172	cons
	1173	vector
	1174	hash-table
	1175	buffer
	1176	marker
	1177	;;window-configuration
	1178	;;frame
	1179	;;window
	1180	;;process
	1181	)
	1182	"Types pickel can serialize.")
	1183
	1184	(defvar wg-pickel-object-serializers
	1185	'((integer . identity)
	1186	(float . identity)
	1187	(string . identity)
	1188	(symbol . wg-pickel-symbol-serializer)
	1189	(cons . wg-pickel-cons-serializer)
	1190	(vector . wg-pickel-vector-serializer)
	1191	(hash-table . wg-pickel-hash-table-serializer)
	1192	(buffer . wg-pickel-buffer-serializer)
	1193	(marker . wg-pickel-marker-serializer)
	1194	;;(window-configuration . wg-pickel-window-configuration-serializer)
	1195	)
	1196	"Alist mapping types to object serialization functions.")
	1197	(defvar wg-pickel-object-deserializers
	1198	'((s . wg-pickel-deserialize-uninterned-symbol)
	1199	(c . wg-pickel-deserialize-cons)
	1200	(v . wg-pickel-deserialize-vector)
	1201	(h . wg-pickel-deserialize-hash-table)
	1202	(b . wg-pickel-deserialize-buffer)
	1203	(m . wg-pickel-deserialize-marker)
	1204	;;(f . wg-pickel-deserialize-frame)
	1205	)
	1206	"Alist mapping type keys to object deserialization functions.")
	1207
	1208	(defvar wg-pickel-link-serializers
	1209	'((cons . wg-pickel-cons-link-serializer)
	1210	(vector . wg-pickel-vector-link-serializer)
	1211	(hash-table . wg-pickel-hash-table-link-serializer))
	1212	"Alist mapping types to link serialization functions.")
	1213	(defvar wg-pickel-link-deserializers
	1214	`((c . wg-pickel-cons-link-deserializer)
	1215	(v . wg-pickel-vector-link-deserializer)
	1216	(h . wg-pickel-hash-table-link-deserializer))
	1217	"Alist mapping type keys to link deserialization functions.")
	1218
	1219
	1220
	1221	;;; errors and predicates
	1222
	1223	(put 'wg-pickel-unpickelable-type-error
	1224	'error-conditions
	1225	'(error wg-pickel-errors wg-pickel-unpickelable-type-error))
	1226
	1227	(put 'wg-pickel-unpickelable-type-error
	1228	'error-message
	1229	"Attemp to pickel unpickelable type")
	1230
	1231	(defun wg-pickelable-or-error (obj)
	1232	"Error when OBJ isn't pickelable."
	1233	(unless (memq (type-of obj) wg-pickel-pickelable-types)
	1234	(signal 'wg-pickel-unpickelable-type-error
	1235	(format "Can't pickel objects of type: %S" (type-of obj))))
	1236	(cl-typecase obj
	1237	(cons
	1238	(wg-pickelable-or-error (car obj))
	1239	(wg-pickelable-or-error (cdr obj)))
	1240	(vector
	1241	(cl-map nil 'wg-pickelable-or-error obj))
	1242	(hash-table
	1243	(wg-dohash (key value obj)
	1244	(wg-pickelable-or-error key)
	1245	(wg-pickelable-or-error value)))))
	1246
	1247	(defun wg-pickelable-p (obj)
	1248	(condition-case err
	1249	(progn (wg-pickelable-or-error obj) t)
	1250	(wg-pickel-unpickelable-type-error nil)))
	1251
	1252	(defun wg-pickel-p (obj)
	1253	"Return t when OBJ is a pickel, nil otherwise."
	1254	(and (consp obj) (eq (car obj) wg-pickel-identifier)))
	1255
	1256
	1257
	1258	;; accessor functions
	1259
	1260	(defun wg-pickel-object-serializer (obj)
	1261	"Return the object serializer for the `type-of' OBJ."
	1262	(or (wg-aget wg-pickel-object-serializers (type-of obj))
	1263	(error "Invalid type: %S" (type-of obj))))
	1264
	1265	(defun wg-pickel-link-serializer (obj)
	1266	"Return the link serializer for the `type-of' OBJ."
	1267	(wg-aget wg-pickel-link-serializers (type-of obj)))
	1268
	1269	(defun wg-pickel-object-deserializer (key)
	1270	"Return the object deserializer for type key KEY, or error."
	1271	(or (wg-aget wg-pickel-object-deserializers key)
	1272	(error "Invalid object deserializer key: %S" key)))
	1273
	1274	(defun wg-pickel-link-deserializer (key)
	1275	"Return the link deserializer for type key KEY, or error."
	1276	(or (wg-aget wg-pickel-link-deserializers key)
	1277	(error "Invalid link deserializer key: %S" key)))
	1278
	1279
	1280
	1281	;;; bindings
	1282
	1283	(defun wg-pickel-make-bindings-table (obj)
	1284	"Return a table binding unique subobjects of OBJ to ids."
	1285	(let ((binds (make-hash-table :test 'eq))
	1286	(id -1))
	1287	(cl-labels
	1288	((inner (obj)
	1289	(unless (gethash obj binds)
	1290	(puthash obj (cl-incf id) binds)
	1291	(cl-case (type-of obj)
	1292	(cons
	1293	(inner (car obj))
	1294	(inner (cdr obj)))
	1295	(vector
	1296	(dotimes (idx (length obj))
	1297	(inner (aref obj idx))))
	1298	(hash-table
	1299	(wg-dohash (key val obj)
	1300	(inner key)
	1301	(inner val)))))))
	1302	(inner obj)
	1303	binds)))
	1304
	1305
	1306
	1307	;;; Objects
	1308	(defun wg-pickel-symbol-serializer (symbol)
	1309	"Return SYMBOL's serialization."
	1310	(cond ((eq symbol t) t)
	1311	((eq symbol nil) nil)
	1312	((intern-soft symbol) symbol)
	1313	(t (list 's (symbol-name symbol)))))
	1314	(defun wg-pickel-deserialize-uninterned-symbol (name)
	1315	"Return a new uninterned symbol from NAME."
	1316	(make-symbol name))
	1317
	1318
	1319	;; buffer
	1320	(defun wg-pickel-buffer-serializer (buffer)
	1321	"Return BUFFER's UID in workgroups buffer list."
	1322	(list 'b (wg-add-buffer-to-buf-list buffer)))
	1323	(defun wg-pickel-deserialize-buffer (uid)
	1324	"Return a restored buffer from it's UID."
	1325	(wg-restore-buffer (wg-find-buf-by-uid uid)))
	1326
	1327
	1328	;; marker
	1329	(defun wg-pickel-marker-serializer (marker)
	1330	"Return MARKER's data."
	1331	(list 'm (list (marker-position marker)
	1332	(wg-add-buffer-to-buf-list (marker-buffer marker)))))
	1333	(defun wg-pickel-deserialize-marker (data)
	1334	"Return marker from it's DATA."
	1335	(let ((m (make-marker)))
	1336	(set-marker m (car data) (wg-pickel-deserialize-buffer (car (cdr data))))))
	1337
	1338
	1339	;; cons - http://www.gnu.org/software/emacs/manual/html_node/eintr/cons.html
	1340	(defun wg-pickel-cons-serializer (cons)
	1341	"Return CONS's serialization."
	1342	(list 'c))
	1343	(defun wg-pickel-deserialize-cons ()
	1344	"Return a new cons cell initialized to nil."
	1345	(cons nil nil))
	1346	(defun wg-pickel-cons-link-serializer (cons binds)
	1347	"Return the serialization of CONS's links in BINDS."
	1348	(list 'c
	1349	(gethash cons binds)
	1350	(gethash (car cons) binds)
	1351	(gethash (cdr cons) binds)))
	1352	(defun wg-pickel-cons-link-deserializer (cons-id car-id cdr-id binds)
	1353	"Relink a cons cell with its car and cdr in BINDS."
	1354	(let ((cons (gethash cons-id binds)))
	1355	(setcar cons (gethash car-id binds))
	1356	(setcdr cons (gethash cdr-id binds))))
	1357
	1358
	1359
	1360	;; vector - http://www.gnu.org/software/emacs/manual/html_node/elisp/Vector-Functions.html
	1361	;; (wg-unpickel (wg-pickel (make-vector 9 'Z)))
	1362	;;
	1363	(defun wg-pickel-vector-serializer (vector)
	1364	"Return VECTOR's serialization."
	1365	(list 'v (length vector)))
	1366	(defun wg-pickel-deserialize-vector (length)
	1367	"Return a new vector of length LENGTH."
	1368	(make-vector length nil))
	1369	(defun wg-pickel-vector-link-serializer (vector binds)
	1370	"Return the serialization of VECTOR's links in BINDS."
	1371	(let (result)
	1372	(dotimes (i (length vector) result)
	1373	(setq result
	1374	(nconc (list 'v
	1375	(gethash vector binds)
	1376	i
	1377	(gethash (aref vector i) binds))
	1378	result)))))
	1379	(defun wg-pickel-vector-link-deserializer (vector-id index value-id binds)
	1380	"Relink a vector with its elements in BINDS."
	1381	(aset (gethash vector-id binds) index (gethash value-id binds)))
	1382
	1383
	1384	;; hash table - http://www.gnu.org/software/emacs/manual/html_node/elisp/Hash-Tables.html
	1385	(defun wg-pickel-hash-table-serializer (table)
	1386	"Return HASH-TABLE's serialization."
	1387	(list 'h
	1388	(hash-table-test table)
	1389	(hash-table-size table)
	1390	(hash-table-rehash-size table)
	1391	(hash-table-rehash-threshold table)
	1392	(hash-table-weakness table)))
	1393	(defun wg-pickel-deserialize-hash-table (test size rsize rthresh weakness)
	1394	"Return a new hash-table with the specified properties."
	1395	(make-hash-table :test test :size size :rehash-size rsize
	1396	:rehash-threshold rthresh :weakness weakness))
	1397	(defun wg-pickel-hash-table-link-serializer (table binds)
	1398	"Return the serialization of TABLE's links in BINDS."
	1399	(let (result)
	1400	(wg-dohash (key value table result)
	1401	(setq result
	1402	(nconc (list 'h
	1403	(gethash key binds)
	1404	(gethash value binds)
	1405	(gethash table binds))
	1406	result)))))
	1407	(defun wg-pickel-hash-table-link-deserializer (key-id value-id table-id binds)
	1408	"Relink a hash-table with its keys and values in BINDS."
	1409	(puthash (gethash key-id binds)
	1410	(gethash value-id binds)
	1411	(gethash table-id binds)))
	1412
	1413
	1414	;; TODO
	1415	(defun wg-pickel-window-configuration-serializer (wc)
	1416	"Return Window configuration WC's serialization."
	1417	(list 'wc 1))
	1418
	1419
	1420	(defun wg-pickel-serialize-objects (binds)
	1421	"Return a list of serializations of the objects in BINDS."
	1422	(let (result)
	1423	(wg-dohash (obj id binds result)
	1424	(setq result
	1425	(nconc (list id (funcall (wg-pickel-object-serializer obj) obj))
	1426	result)))))
	1427	(defun wg-pickel-deserialize-objects (serial-objects)
	1428	"Return a hash-table of objects deserialized from SERIAL-OBJECTS."
	1429	(let ((binds (make-hash-table)))
	1430	(wg-destructuring-dolist ((id obj . rest) serial-objects binds)
	1431	(puthash id
	1432	(if (atom obj) obj
	1433	(wg-dbind (key . data) obj
	1434	(apply (wg-pickel-object-deserializer key) data)))
	1435	binds))))
	1436
	1437
	1438
	1439	(defun wg-pickel-serialize-links (binds)
	1440	"Return a list of serializations of the links between objects in BINDS."
	1441	(let (result)
	1442	(wg-dohash (obj id binds result)
	1443	(awhen (wg-pickel-link-serializer obj)
	1444	(setq result (nconc (funcall it obj binds) result))))))
	1445	(defun wg-pickel-deserialize-links (serial-links binds)
	1446	"Return BINDS after relinking all its objects according to SERIAL-LINKS."
	1447	(wg-destructuring-dolist ((key arg1 arg2 arg3 . rest) serial-links binds)
	1448	(funcall (wg-pickel-link-deserializer key) arg1 arg2 arg3 binds)))
	1449
	1450	(defun wg-pickel (obj)
	1451	"Return the serialization of OBJ."
	1452	(wg-pickelable-or-error obj)
	1453	(let ((binds (wg-pickel-make-bindings-table obj)))
	1454	(list wg-pickel-identifier
	1455	(wg-pickel-serialize-objects binds)
	1456	(wg-pickel-serialize-links binds)
	1457	(gethash obj binds))))
	1458
	1459	(defun wg-pickel-to-string (obj)
	1460	"Serialize OBJ to a string and return the string."
	1461	(format "%S" (wg-pickel obj)))
	1462
	1463	(defun wg-unpickel (pickel)
	1464	"Return the deserialization of PICKEL."
	1465	(unless (wg-pickel-p pickel)
	1466	(error "Attempt to unpickel a non-pickel."))
	1467	(wg-dbind (id serial-objects serial-links result) pickel
	1468	(gethash
	1469	result
	1470	(wg-pickel-deserialize-links
	1471	serial-links
	1472	(wg-pickel-deserialize-objects serial-objects)))))
	1473
	1474	;; `wg-pre-window-configuration-change-hook' implementation advice
	1475	(cl-macrolet ((define-p-w-c-c-h-advice
	1476	(fn)
	1477	`(defadvice ,fn (before wg-pre-window-configuration-change-hook)
	1478	"Call `wg-update-working-wconfig-hook' before this
	1479	function to save up-to-date undo information before the
	1480	window-configuration changes."
	1481	(run-hooks 'wg-pre-window-configuration-change-hook))))
	1482	(define-p-w-c-c-h-advice split-window)
	1483	(define-p-w-c-c-h-advice enlarge-window)
	1484	(define-p-w-c-c-h-advice delete-window)
	1485	(define-p-w-c-c-h-advice delete-other-windows)
	1486	(define-p-w-c-c-h-advice delete-windows-on)
	1487	(define-p-w-c-c-h-advice switch-to-buffer)
	1488	(define-p-w-c-c-h-advice set-window-buffer))
	1489
	1490
	1491	(defadvice save-buffers-kill-emacs (around wg-freeze-wconfig)
	1492	"`save-buffers-kill-emacs' calls `list-processes' when active
	1493	processes exist, screwing up the window config right before
	1494	Workgroups saves it. This advice freezes `wg-current-wconfig' in
	1495	its correct state, prior to any window-config changes caused by
	1496	`s-b-k-e'."
	1497	(wg-with-current-wconfig nil (wg-frame-to-wconfig)
	1498	ad-do-it))
	1499
	1500	(defadvice select-frame (before wg-update-current-workgroup-working-wconfig)
	1501	"Update `selected-frame's current workgroup's working-wconfig.
	1502	Before selecting a new frame."
	1503	(wg-update-current-workgroup-working-wconfig))
	1504
	1505	(defun wg-enable-all-advice ()
	1506	"Enable and activate all of Workgroups' advice."
	1507	;; switch-to-buffer
	1508	(ad-enable-advice 'switch-to-buffer 'after 'wg-auto-associate-buffer)
	1509	(ad-enable-advice 'switch-to-buffer 'before 'wg-pre-window-configuration-change-hook)
	1510	(ad-activate 'switch-to-buffer)
	1511
	1512	;; set-window-buffer
	1513	(ad-enable-advice 'set-window-buffer 'after 'wg-auto-associate-buffer)
	1514	(ad-enable-advice 'set-window-buffer 'before 'wg-pre-window-configuration-change-hook)
	1515	(ad-activate 'set-window-buffer)
	1516
	1517	;; split-window
	1518	(ad-enable-advice 'split-window 'before 'wg-pre-window-configuration-change-hook)
	1519	(ad-activate 'split-window)
	1520
	1521	;; enlarge-window
	1522	(ad-enable-advice 'enlarge-window 'before 'wg-pre-window-configuration-change-hook)
	1523	(ad-activate 'enlarge-window)
	1524
	1525	;; delete-window
	1526	(ad-enable-advice 'delete-window 'before 'wg-pre-window-configuration-change-hook)
	1527	(ad-activate 'delete-window)
	1528
	1529	;; delete-other-windows
	1530	(ad-enable-advice 'delete-other-windows 'before 'wg-pre-window-configuration-change-hook)
	1531	(ad-activate 'delete-other-windows)
	1532
	1533	;; delete-windows-on
	1534	(ad-enable-advice 'delete-windows-on 'before 'wg-pre-window-configuration-change-hook)
	1535	(ad-activate 'delete-windows-on)
	1536
	1537	;; save-buffers-kill-emacs
	1538	(ad-enable-advice 'save-buffers-kill-emacs 'around 'wg-freeze-wconfig)
	1539	(ad-activate 'save-buffers-kill-emacs)
	1540
	1541	;; select-frame
	1542	;;(ad-enable-advice 'select-frame 'before
	1543	;; 'wg-update-current-workgroup-working-wconfig)
	1544	;;(ad-activate 'select-frame)
	1545	)
	1546
	1547
	1548	;; disable all advice
	1549	;; (wg-disable-all-advice)
	1550	(defun wg-disable-all-advice ()
	1551	"Disable and deactivate all of Workgroups' advice."
	1552	;; switch-to-buffer
	1553	(ad-disable-advice 'switch-to-buffer 'after 'wg-auto-associate-buffer)
	1554	(ad-disable-advice 'switch-to-buffer 'before 'wg-pre-window-configuration-change-hook)
	1555	(ad-deactivate 'switch-to-buffer)
	1556
	1557	;; set-window-buffer
	1558	(ad-disable-advice 'set-window-buffer 'after 'wg-auto-associate-buffer)
	1559	(ad-disable-advice 'set-window-buffer 'before 'wg-pre-window-configuration-change-hook)
	1560	(ad-deactivate 'set-window-buffer)
	1561
	1562	;; split-window
	1563	(ad-disable-advice 'split-window 'before 'wg-pre-window-configuration-change-hook)
	1564	(ad-deactivate 'split-window)
	1565
	1566	;; enlarge-window
	1567	(ad-disable-advice 'enlarge-window 'before 'wg-pre-window-configuration-change-hook)
	1568	(ad-deactivate 'enlarge-window)
	1569
	1570	;; delete-window
	1571	(ad-disable-advice 'delete-window 'before 'wg-pre-window-configuration-change-hook)
	1572	(ad-deactivate 'delete-window)
	1573
	1574	;; delete-other-windows
	1575	(ad-disable-advice 'delete-other-windows 'before 'wg-pre-window-configuration-change-hook)
	1576	(ad-deactivate 'delete-other-windows)
	1577
	1578	;; delete-windows-on
	1579	(ad-disable-advice 'delete-windows-on 'before 'wg-pre-window-configuration-change-hook)
	1580	(ad-deactivate 'delete-windows-on)
	1581
	1582	;; save-buffers-kill-emacs
	1583	(ad-disable-advice 'save-buffers-kill-emacs 'around 'wg-freeze-wconfig)
	1584	(ad-deactivate 'save-buffers-kill-emacs)
	1585
	1586	;; select-frame
	1587	;;(ad-disable-advice 'select-frame 'before
	1588	;; 'wg-update-current-workgroup-working-wconfig)
	1589	;;(ad-deactivate 'select-frame)
	1590	)
	1591
	1592
	1593	;; buffer auto-association advice
	1594
	1595	(defcustom wg-buffer-auto-association-on t
	1596	"Non-nil means buffer auto-association is on.
	1597	-nil means it's off. See `wg-buffer-auto-association'."
	1598	:type 'boolean
	1599	:group 'workgroups)
	1600
	1601	(defcustom wg-buffer-auto-association 'weak
	1602	"Specifies the behavior for auto-associating buffers with workgroups.
	1603
	1604	When a buffer is made visible in a window it can be automatically
	1605	associated with the current workgroup in the window's frame.
	1606	This setting determines whether and how that happens.
	1607
	1608	Allowable values:
	1609
	1610	`weak' - weakly associate the buffer with the workgroup
	1611	`strong' - strongly associate the buffer with the workgroup
	1612
	1613	A function (a function-symbol or a lambda) - `funcall' the function to
	1614	determine whether and how to associate the buffer with the
	1615	workgroup. The function should accept two arguments -- the
	1616	buffer and the workgroup -- and should return one of the
	1617	allowable values for this variable.
	1618
	1619	`nil' or any other value - don't associate the buffer with the
	1620	workgroup.
	1621
	1622	Becomes workgroup-local when set with `wg-set-workgroup-parameter'.
	1623	Becomes session-local when set with `wg-set-session-parameter'."
	1624	:type 'sexp
	1625	:group 'workgroups)
	1626
	1627	(defcustom wg-dissociate-buffer-on-kill-buffer t
	1628	"Non-nil means dissociate buffers killed with `kill-buffer'."
	1629	:type 'boolean
	1630	:group 'workgroups)
	1631
	1632	(defun wg-auto-associate-buffer-helper (workgroup buffer assoc)
	1633	"Associate BUFFER with WORKGROUP based on ASSOC.
	1634	See `wg-buffer-auto-association' for allowable values of ASSOC."
	1635	(cond ((memq assoc '(weak strong))
	1636	(wg-workgroup-associate-bufobj workgroup buffer (eq assoc 'weak)))
	1637	((functionp assoc)
	1638	(wg-auto-associate-buffer-helper
	1639	workgroup buffer (funcall assoc workgroup buffer)))
	1640	(t nil)))
	1641
	1642	(defun wg-auto-associate-buffer (buffer &optional frame)
	1643	"Conditionally associate BUFFER with the current workgroup in FRAME.
	1644	Frame defaults to `selected-frame'. See `wg-buffer-auto-association'."
	1645	(when wg-buffer-auto-association-on
	1646	(-when-let* ((wg (wg-current-workgroup t frame))
	1647	(b (get-buffer buffer)))
	1648	(unless (or (wg-workgroup-bufobj-association-type wg buffer)
	1649	(member wg wg-deactivation-list)
	1650	(member (buffer-name b) wg-associate-blacklist)
	1651	(not (or (buffer-file-name b)
	1652	(eq (buffer-local-value 'major-mode b) 'dired-mode))))
	1653	(wg-auto-associate-buffer-helper
	1654	wg buffer (wg-local-value 'wg-buffer-auto-association wg))))))
	1655
	1656	(defadvice switch-to-buffer (after wg-auto-associate-buffer)
	1657	"Automatically associate the buffer with the current workgroup."
	1658	(wg-auto-associate-buffer ad-return-value))
	1659
	1660	(defadvice set-window-buffer (after wg-auto-associate-buffer)
	1661	"Automatically associate the buffer with the current workgroup."
	1662	(wg-auto-associate-buffer
	1663	(ad-get-arg 1)
	1664	(window-frame (or (ad-get-arg 0) (selected-window)))))
	1665
	1666	(defun wg-mode-line-string ()
	1667	"Return the string to be displayed in the mode-line."
	1668	(let ((wg (wg-current-workgroup t))
	1669	(wg-use-faces wg-mode-line-use-faces))
	1670	(cond (wg (wg-fontify " "
	1671	(:brace wg-mode-line-decor-left-brace)
	1672	(:mode (wg-workgroup-name wg))
	1673	(if wg-flag-modified
	1674	(concat
	1675	(wg-add-face :div wg-mode-line-decor-divider)
	1676	;;(if (window-dedicated-p)
	1677	;; wg-mode-line-decor-window-dedicated
	1678	;; wg-mode-line-decor-window-undedicated)
	1679	;;(wg-add-face :div wg-mode-line-decor-divider)
	1680	(if (wg-session-modified (wg-current-session))
	1681	wg-mode-line-decor-session-modified
	1682	wg-mode-line-decor-session-unmodified)
	1683	(if (wg-workgroup-modified wg)
	1684	wg-mode-line-decor-workgroup-modified
	1685	wg-mode-line-decor-workgroup-unmodified)))
	1686	(:brace wg-mode-line-decor-right-brace)))
	1687	(t (if wg-display-nowg
	1688	(wg-fontify " "
	1689	(:brace wg-mode-line-decor-left-brace)
	1690	(:mode wg-nowg-string)
	1691	(:brace wg-mode-line-decor-right-brace))
	1692	"")))))
	1693
	1694	(defun wg-change-modeline ()
	1695	"Add Workgroups' mode-line format to `mode-line-format'."
	1696	(unless (assq 'wg-mode-line-display-on mode-line-format)
	1697	(let ((format '(wg-mode-line-display-on (:eval (wg-mode-line-string))))
	1698	(pos (or (cl-position 'mode-line-position mode-line-format) 10)))
	1699	(set-default 'mode-line-format (-insert-at (1+ pos) format mode-line-format))
	1700	(force-mode-line-update))))
	1701
	1702	(defun wg-remove-mode-line-display ()
	1703	"Remove Workgroups' mode-line format from `mode-line-format'."
	1704	(awhen (assq 'wg-mode-line-display-on mode-line-format)
	1705	(set-default 'mode-line-format (remove it mode-line-format))
	1706	(force-mode-line-update)))
	1707
	1708	(defun wg-add-workgroups-mode-minor-mode-entries ()
	1709	"Add Workgroups' minor-mode entries.
	1710	Adds entries to `minor-mode-list', `minor-mode-alist' and
	1711	`minor-mode-map-alist'."
	1712	(cl-pushnew 'workgroups-mode minor-mode-list)
	1713	(cl-pushnew '(workgroups-mode wg-modeline-string) minor-mode-alist :test 'equal)
	1714	(setq minor-mode-map-alist
	1715	(cons (cons 'workgroups-mode (wg-make-workgroups-mode-map))
	1716	(delete (assoc 'workgroups-mode minor-mode-map-alist)
	1717	minor-mode-map-alist))))
	1718
	1719	(defun wg-fill-keymap (keymap &rest binds)
	1720	"Return KEYMAP after defining in it all keybindings in BINDS."
	1721	(while binds
	1722	(define-key keymap (car binds) (cadr binds))
	1723	(setq binds (cddr binds)))
	1724	keymap)
	1725
	1726	(defvar wg-prefixed-map
	1727	(wg-fill-keymap
	1728	(make-sparse-keymap)
	1729
	1730	;; workgroups
	1731	(kbd "C-c") 'wg-create-workgroup
	1732	(kbd "c") 'wg-create-workgroup
	1733	(kbd "C") 'wg-clone-workgroup
	1734	(kbd "A") 'wg-rename-workgroup
	1735	(kbd "C-'") 'wg-switch-to-workgroup
	1736	(kbd "'") 'wg-switch-to-workgroup
	1737	(kbd "C-v") 'wg-switch-to-workgroup
	1738	(kbd "v") 'wg-switch-to-workgroup
	1739
	1740	;; session
	1741	(kbd "C-s") 'wg-save-session
	1742	(kbd "C-w") 'wg-save-session-as
	1743	(kbd "C-f") 'wg-open-session
	1744
	1745	;; killing and yanking
	1746	(kbd "C-k") 'wg-kill-workgroup
	1747	(kbd "k") 'wg-kill-workgroup
	1748	(kbd "M-W") 'wg-kill-ring-save-base-wconfig
	1749	(kbd "M-w") 'wg-kill-ring-save-working-wconfig
	1750	(kbd "C-y") 'wg-yank-wconfig
	1751	(kbd "y") 'wg-yank-wconfig
	1752	(kbd "M-k") 'wg-kill-workgroup-and-buffers
	1753	(kbd "K") 'wg-delete-other-workgroups
	1754
	1755
	1756	;; workgroup switching
	1757	(kbd "C-j") 'wg-switch-to-workgroup-at-index
	1758	(kbd "j") 'wg-switch-to-workgroup-at-index
	1759	(kbd "0") 'wg-switch-to-workgroup-at-index-0
	1760	(kbd "1") 'wg-switch-to-workgroup-at-index-1
	1761	(kbd "2") 'wg-switch-to-workgroup-at-index-2
	1762	(kbd "3") 'wg-switch-to-workgroup-at-index-3
	1763	(kbd "4") 'wg-switch-to-workgroup-at-index-4
	1764	(kbd "5") 'wg-switch-to-workgroup-at-index-5
	1765	(kbd "6") 'wg-switch-to-workgroup-at-index-6
	1766	(kbd "7") 'wg-switch-to-workgroup-at-index-7
	1767	(kbd "8") 'wg-switch-to-workgroup-at-index-8
	1768	(kbd "9") 'wg-switch-to-workgroup-at-index-9
	1769	(kbd "C-p") 'wg-switch-to-workgroup-left
	1770	(kbd "p") 'wg-switch-to-workgroup-left
	1771	(kbd "C-n") 'wg-switch-to-workgroup-right
	1772	(kbd "n") 'wg-switch-to-workgroup-right
	1773	(kbd "C-a") 'wg-switch-to-previous-workgroup
	1774	(kbd "a") 'wg-switch-to-previous-workgroup
	1775
	1776
	1777	;; updating and reverting
	1778	;; wconfig undo/redo
	1779	(kbd "C-r") 'wg-revert-workgroup
	1780	(kbd "r") 'wg-revert-workgroup
	1781	(kbd "C-S-r") 'wg-revert-all-workgroups
	1782	(kbd "R") 'wg-revert-all-workgroups
	1783	(kbd "<left>") 'wg-undo-wconfig-change
	1784	(kbd "<right>") 'wg-redo-wconfig-change
	1785	(kbd "[") 'wg-undo-wconfig-change
	1786	(kbd "]") 'wg-redo-wconfig-change
	1787	(kbd "{") 'wg-undo-once-all-workgroups
	1788	(kbd "}") 'wg-redo-once-all-workgroups
	1789
	1790
	1791	;; wconfig save/restore
	1792	(kbd "C-d C-s") 'wg-save-wconfig
	1793	(kbd "C-d C-'") 'wg-restore-saved-wconfig
	1794	(kbd "C-d C-k") 'wg-kill-saved-wconfig
	1795
	1796
	1797	;; workgroup movement
	1798	(kbd "C-x") 'wg-swap-workgroups
	1799	(kbd "C-,") 'wg-offset-workgroup-left
	1800	(kbd "C-.") 'wg-offset-workgroup-right
	1801
	1802
	1803	;; window moving and frame reversal
	1804	(kbd "\|") 'wg-reverse-frame-horizontally
	1805	(kbd "\\") 'wg-reverse-frame-vertically
	1806	(kbd "/") 'wg-reverse-frame-horizontally-and-vertically
	1807
	1808
	1809	;; toggling
	1810	(kbd "C-t C-m") 'wg-toggle-mode-line-display
	1811	(kbd "C-t C-d") 'wg-toggle-window-dedicated-p
	1812
	1813
	1814	;; misc
	1815	(kbd "!") 'wg-reset
	1816	(kbd "?") 'wg-help
	1817
	1818	)
	1819	"The keymap that sits on `wg-prefix-key'.")
	1820
	1821	(defun wg-make-workgroups-mode-map ()
	1822	"Return Workgroups' minor-mode-map.
	1823	This map includes `wg-prefixed-map' on `wg-prefix-key', as well
	1824	as Workgroups' command remappings."
	1825	(let ((map (make-sparse-keymap)))
	1826	(define-key map wg-prefix-key
	1827	wg-prefixed-map)
	1828	(when (and (fboundp 'winner-undo)
	1829	(fboundp 'winner-redo))
	1830	(define-key map [remap winner-undo] 'wg-undo-wconfig-change)
	1831	(define-key map [remap winner-redo] 'wg-redo-wconfig-change))
	1832	(setq workgroups-mode-map map)))
	1833
	1834
	1835	(defun wg-min-size (dir)
	1836	"Return the minimum window size in split direction DIR."
	1837	(if dir wg-window-min-height wg-window-min-width))
	1838
	1839	(defun wg-actual-min-size (dir)
	1840	"Return the actual minimum window size in split direction DIR."
	1841	(if dir wg-actual-min-height wg-actual-min-width))
	1842
	1843	(defmacro wg-with-edges (w spec &rest body)
	1844	"Bind W's edge list to SPEC and eval BODY."
	1845	(declare (indent 2))
	1846	`(wg-dbind ,spec (wg-w-edges ,w) ,@body))
	1847
	1848	(defmacro wg-with-bounds (wtree dir spec &rest body)
	1849	"Bind SPEC to W's bounds in DIR, and eval BODY.
	1850	\"bounds\" are a direction-independent way of dealing with edge lists."
	1851	(declare (indent 3))
	1852	(wg-with-gensyms (dir-sym l1 t1 r1 b1)
	1853	(wg-dbind (ls1 hs1 lb1 hb1) spec
	1854	`(wg-with-edges ,wtree (,l1 ,t1 ,r1 ,b1)
	1855	(cond (,dir (let ((,ls1 ,l1) (,hs1 ,r1) (,lb1 ,t1) (,hb1 ,b1))
	1856	,@body))
	1857	(t (let ((,ls1 ,t1) (,hs1 ,b1) (,lb1 ,l1) (,hb1 ,r1))
	1858	,@body)))))))
	1859
	1860	(defun wg-set-bounds (w dir ls hs lb hb)
	1861	"Set W's edges in DIR with bounds LS HS LB and HB."
	1862	(wg-set-edges w (if dir (list ls lb hs hb) (list lb ls hb hs))))
	1863
	1864	(defun wg-step-edges (edges1 edges2 hstep vstep)
	1865	"Return W1's edges stepped once toward W2's by HSTEP and VSTEP."
	1866	(wg-dbind (l1 t1 r1 b1) edges1
	1867	(wg-dbind (l2 t2 r2 b2) edges2
	1868	(let ((left (wg-step-to l1 l2 hstep))
	1869	(top (wg-step-to t1 t2 vstep)))
	1870	(list left top
	1871	(+ left (wg-step-to (- r1 l1) (- r2 l2) hstep))
	1872	(+ top (wg-step-to (- b1 t1) (- b2 t2) vstep)))))))
	1873
	1874	(defun wg-w-edge-operation (w edges op)
	1875	"Return a copy of W with its edges mapped against EDGES through OP."
	1876	(wg-set-edges w (cl-mapcar op (wg-w-edges w) edges)))
	1877
	1878	(defun wg-first-win (w)
	1879	"Return the first actual window in W."
	1880	(if (wg-win-p w) w
	1881	(wg-first-win (car (wg-wtree-wlist w)))))
	1882
	1883	(defun wg-last-win (w)
	1884	"Return the last actual window in W."
	1885	(if (wg-win-p w) w
	1886	(wg-last-win (-last-item (wg-wtree-wlist w)))))
	1887
	1888	(defun wg-minify-win (w)
	1889	"Set W's edges to the smallest allowable."
	1890	(let* ((edges (wg-w-edges w))
	1891	(left (car edges))
	1892	(top (cadr edges)))
	1893	(wg-set-edges w (list left top
	1894	(+ left wg-actual-min-width)
	1895	(+ top wg-actual-min-height)))))
	1896
	1897	(defun wg-minified-copy-of-last-win (w)
	1898	"Minify a copy of the last actual window in W."
	1899	(wg-minify-win (wg-copy-win (wg-last-win w))))
	1900
	1901	(defun wg-w-size (w &optional height)
	1902	"Return the width or height of W, calculated from its edge list."
	1903	(wg-with-edges w (l1 t1 r1 b1)
	1904	(if height (- b1 t1) (- r1 l1))))
	1905
	1906	(defun wg-adjust-w-size (w width-fn height-fn &optional new-left new-top)
	1907	"Adjust W's width and height with WIDTH-FN and HEIGHT-FN."
	1908	(wg-with-edges w (left top right bottom)
	1909	(let ((left (or new-left left)) (top (or new-top top)))
	1910	(wg-set-edges (wg-copy-w w)
	1911	(list left
	1912	top
	1913	(+ left (funcall width-fn (- right left)))
	1914	(+ top (funcall height-fn (- bottom top))))))))
	1915
	1916	(defun wg-scale-w-size (w width-scale height-scale)
	1917	"Scale W's size by WIDTH-SCALE and HEIGHT-SCALE."
	1918	(cl-labels
	1919	((wscale (width) (truncate (* width width-scale)))
	1920	(hscale (height) (truncate (* height height-scale))))
	1921	(wg-adjust-w-size w #'wscale #'hscale)))
	1922
	1923	(defun wg-restore-window (win)
	1924	"Restore WIN in `selected-window'."
	1925	(let ((selwin (selected-window))
	1926	(buf (wg-find-buf-by-uid (wg-win-buf-uid win))))
	1927	(if (not buf)
	1928	(wg-restore-default-buffer)
	1929	(when (wg-restore-buffer buf t)
	1930
	1931	;; Restore various positions in WINDOW from their values in WIN
	1932	;; (wg-restore-window-positions win selwin)
	1933	(let ((window (or selwin (selected-window))))
	1934	(wg-with-slots win
	1935	((win-point wg-win-point)
	1936	(win-start wg-win-start)
	1937	(win-hscroll wg-win-hscroll))
	1938	(set-window-start window win-start t)
	1939	(set-window-hscroll window win-hscroll)
	1940	(set-window-point
	1941	window
	1942	(cond ((not wg-restore-point) win-start)
	1943	((eq win-point :max) (point-max))
	1944	(t win-point)))
	1945	(when (>= win-start (point-max)) (recenter))))
	1946
	1947	(when wg-restore-window-dedicated-p
	1948	(set-window-dedicated-p selwin (wg-win-dedicated win)))))
	1949	(ignore-errors
	1950	(set-window-prev-buffers
	1951	selwin (wg-unpickel (wg-win-parameter win 'prev-buffers)))
	1952	(set-window-next-buffers
	1953	selwin (wg-unpickel (wg-win-parameter win 'next-buffers)))
	1954	)))
	1955
	1956
	1957	(defun wg-window-point (ewin)
	1958	"Return `point' or :max. See `wg-restore-point-max'.
	1959	EWIN should be an Emacs window object."
	1960	(let ((p (window-point ewin)))
	1961	(if (and wg-restore-point-max (= p (point-max))) :max p)))
	1962
	1963	(defun wg-win-parameter (win parameter &optional default)
	1964	"Return WIN's value for PARAMETER.
	1965	If PARAMETER is not found, return DEFAULT which defaults to nil.
	1966	SESSION nil defaults to the current session."
	1967	(wg-aget (wg-win-parameters win) parameter default))
	1968
	1969	(defun wg-set-win-parameter (win parameter value)
	1970	"Set WIN's value of PARAMETER to VALUE.
	1971	SESSION nil means use the current session.
	1972	Return value."
	1973	(wg-set-parameter (wg-win-parameters win) parameter value)
	1974	value)
	1975	;; (wg-win-parameters (wg-window-to-win (selected-window)))
	1976
	1977	(defun wg-remove-win-parameter (win parameter)
	1978	"Remove parameter PARAMETER from WIN's parameters."
	1979	(wg-asetf (wg-win-parameters win) (wg-aremove it parameter)))
	1980
	1981	(defun wg-window-to-win (&optional window)
	1982	"Return the serialization (a wg-win) of Emacs window WINDOW."
	1983	(let ((window (or window (selected-window)))
	1984	(selected (eq window (selected-window)))
	1985	win)
	1986	(with-selected-window window
	1987	(setq win
	1988	(wg-make-win
	1989	:edges (window-edges window)
	1990	:point (wg-window-point window)
	1991	:start (window-start window)
	1992	:hscroll (window-hscroll window)
	1993	:selected selected
	1994	:minibuffer-scroll (eq window minibuffer-scroll-window)
	1995	:dedicated (window-dedicated-p window)
	1996	:buf-uid (wg-buffer-uid-or-add (window-buffer window))))
	1997	(unless (version< emacs-version "24")
	1998	;; To solve: https://github.com/pashinin/workgroups2/issues/51
	1999	;; shouldn't ignore here
	2000	(ignore-errors
	2001	(wg-set-win-parameter
	2002	win 'next-buffers (wg-pickel (remove nil (cl-subseq (window-next-buffers window) 0 4))))
	2003	(wg-set-win-parameter
	2004	win 'prev-buffers (wg-pickel (remove nil (cl-subseq (window-prev-buffers window) 0 4)))))))
	2005	win))
	2006
	2007	(defun wg-toggle-window-dedicated-p ()
	2008	"Toggle `window-dedicated-p' in `selected-window'."
	2009	(interactive)
	2010	(set-window-dedicated-p nil (not (window-dedicated-p)))
	2011	(force-mode-line-update t)
	2012	(wg-fontified-message
	2013	(:cmd "Window:")
	2014	(:cur (concat (unless (window-dedicated-p) " not") " dedicated"))))
	2015
	2016	(defun wg-w-edges (w)
	2017	"Return W's edge list."
	2018	(cl-etypecase w
	2019	(wg-win (wg-win-edges w))
	2020	(wg-wtree (wg-wtree-edges w))))
	2021
	2022	(defun wg-copy-w (w)
	2023	"Return a copy of W. W should be a wg-win or a wg-wtree."
	2024	(cl-etypecase w
	2025	(wg-win (wg-copy-win w))
	2026	(wg-wtree (wg-copy-wtree w))))
	2027
	2028	(defun wg-set-edges (w edges)
	2029	"Set W's EDGES list, and return W."
	2030	(cl-etypecase w
	2031	(wg-win (setf (wg-win-edges w) edges))
	2032	(wg-wtree (setf (wg-wtree-edges w) edges)))
	2033	w)
	2034
	2035	(defun wg-equal-wtrees (w1 w2)
	2036	"Return t when W1 and W2 have equal structure."
	2037	(cond ((and (wg-win-p w1) (wg-win-p w2))
	2038	(equal (wg-w-edges w1) (wg-w-edges w2)))
	2039	((and (wg-wtree-p w1) (wg-wtree-p w2))
	2040	(and (eq (wg-wtree-dir w1) (wg-wtree-dir w2))
	2041	(equal (wg-wtree-edges w1) (wg-wtree-edges w2))
	2042	(cl-every #'wg-equal-wtrees
	2043	(wg-wtree-wlist w1)
	2044	(wg-wtree-wlist w2))))))
	2045
	2046	(defun wg-normalize-wtree (wtree)
	2047	"Clean up and return a new wtree from WTREE.
	2048	Recalculate the edge lists of all subwins, and remove subwins
	2049	outside of WTREE's bounds. If there's only one element in the
	2050	new wlist, return it instead of a new wtree."
	2051	(if (wg-win-p wtree) wtree
	2052	(wg-with-slots wtree ((dir wg-wtree-dir)
	2053	(wlist wg-wtree-wlist))
	2054	(wg-with-bounds wtree dir (ls1 hs1 lb1 hb1)
	2055	(let* ((min-size (wg-min-size dir))
	2056	(max (- hb1 1 min-size))
	2057	(lastw (-last-item wlist)))
	2058	(cl-labels
	2059	((mapwl
	2060	(wl)
	2061	(wg-dbind (sw . rest) wl
	2062	(cons (wg-normalize-wtree
	2063	(wg-set-bounds
	2064	sw dir ls1 hs1 lb1
	2065	(setq lb1 (if (eq sw lastw) hb1
	2066	(let ((hb2 (+ lb1 (wg-w-size sw dir))))
	2067	(if (>= hb2 max) hb1 hb2))))))
	2068	(when (< lb1 max) (mapwl rest))))))
	2069	(let ((new (mapwl wlist)))
	2070	(if (not (cdr new)) (car new)
	2071	(setf (wg-wtree-wlist wtree) new)
	2072	wtree))))))))
	2073
	2074	(defun wg-scale-wtree (wtree wscale hscale)
	2075	"Return a copy of WTREE with its dimensions scaled by WSCALE and HSCALE.
	2076	All WTREE's subwins are scaled as well."
	2077	(let ((scaled (wg-scale-w-size wtree wscale hscale)))
	2078	(if (wg-win-p wtree) scaled
	2079	(wg-asetf (wg-wtree-wlist scaled)
	2080	(wg-docar (sw it) (wg-scale-wtree sw wscale hscale)))
	2081	scaled)))
	2082
	2083
	2084	(defun wg-resize-frame-scale-wtree (wconfig)
	2085	"Set FRAME's size to WCONFIG's, returning a possibly scaled wtree.
	2086	If the frame size was set correctly, return WCONFIG's wtree
	2087	unchanged. If it wasn't, return a copy of WCONFIG's wtree scaled
	2088	with `wg-scale-wconfigs-wtree' to fit the frame as it exists."
	2089	(let ((frame (selected-frame)))
	2090	(wg-with-slots wconfig ((wcwidth wg-wconfig-width)
	2091	(wcheight wg-wconfig-height))
	2092	(when window-system (set-frame-size frame wcwidth wcheight))
	2093	(let ((fwidth (frame-parameter frame 'width))
	2094	(fheight (frame-parameter frame 'height)))
	2095	(if (and (= wcwidth fwidth) (= wcheight fheight))
	2096	(wg-wconfig-wtree wconfig)
	2097	(wg-scale-wconfigs-wtree wconfig fwidth fheight))))))
	2098
	2099	(defun wg-wtree-buf-uids (wtree)
	2100	"Return a new list of the buf uids of all wins in WTREE."
	2101	(if (not wtree)
	2102	(error "WTREE is nil in `wg-wtree-buf-uids'!"))
	2103	(wg-flatten-wtree wtree 'wg-win-buf-uid))
	2104
	2105
	2106	(defun wg-wtree-unique-buf-uids (wtree)
	2107	"Return a list of the unique buf uids of all wins in WTREE."
	2108	(cl-remove-duplicates (wg-wtree-buf-uids wtree) :test 'string=))
	2109
	2110
	2111	(defun wg-reset-window-tree ()
	2112	"Delete all but one window in `selected-frame', and reset
	2113	various parameters of that window in preparation for restoring
	2114	a wtree."
	2115	(delete-other-windows)
	2116	(set-window-dedicated-p nil nil))
	2117
	2118	(defun wg-restore-window-tree-helper (w)
	2119	"Recursion helper for `wg-restore-window-tree' W."
	2120	(if (wg-wtree-p w)
	2121	(cl-loop with dir = (wg-wtree-dir w)
	2122	for (win . rest) on (wg-wtree-wlist w)
	2123	do (when rest (split-window nil (wg-w-size win dir) (not dir)))
	2124	do (wg-restore-window-tree-helper win))
	2125	(wg-restore-window w)
	2126	(when (wg-win-selected w)
	2127	(setq wg-window-tree-selected-window (selected-window)))
	2128	(when (wg-win-minibuffer-scroll w)
	2129	(setq minibuffer-scroll-window (selected-window)))
	2130	(other-window 1)))
	2131
	2132	(defun wg-restore-window-tree (wtree)
	2133	"Restore WTREE in `selected-frame'."
	2134	(let ((window-min-width wg-window-min-width)
	2135	(window-min-height wg-window-min-height)
	2136	(wg-window-tree-selected-window nil))
	2137	(wg-reset-window-tree)
	2138	(wg-restore-window-tree-helper wtree)
	2139	(awhen wg-window-tree-selected-window (select-window it))))
	2140
	2141	(defun wg-window-tree-to-wtree (&optional window-tree)
	2142	"Return the serialization (a wg-wtree) of Emacs window tree WINDOW-TREE."
	2143	(wg-barf-on-active-minibuffer)
	2144	(unless window-tree
	2145	(setq window-tree (window-tree)))
	2146	(cl-labels
	2147	((inner (w) (if (windowp w) (wg-window-to-win w)
	2148	(wg-dbind (dir edges . wins) w
	2149	(wg-make-wtree
	2150	:dir dir
	2151	:edges edges
	2152	:wlist (mapcar #'inner wins))))))
	2153	(let ((w (car window-tree)))
	2154	(when (and (windowp w) (window-minibuffer-p w))
	2155	(error "Workgroups can't operate on minibuffer-only frames."))
	2156	(inner w))))
	2157
	2158
	2159	(defun wg-flatten-wtree (wtree &optional key)
	2160	"Return a new list by flattening WTREE.
	2161	KEY non returns returns a list of WTREE's wins.
	2162	KEY non-nil returns a list of the results of calling KEY on each win."
	2163	(cl-labels
	2164	((inner (w) (if (wg-win-p w) (list (if key (funcall key w) w))
	2165	(cl-mapcan #'inner (wg-wtree-wlist w)))))
	2166	(inner wtree)))
	2167
	2168	(defun wg-reverse-wlist (w &optional dir)
	2169	"Reverse W's wlist and those of all its sub-wtrees in direction DIR.
	2170	If DIR is nil, reverse WTREE horizontally.
	2171	If DIR is 'both, reverse WTREE both horizontally and vertically.
	2172	Otherwise, reverse WTREE vertically."
	2173	(cl-labels
	2174	((inner (w) (if (wg-win-p w) w
	2175	(wg-with-slots w ((d1 wg-wtree-dir))
	2176	(wg-make-wtree
	2177	:dir d1
	2178	:edges (wg-wtree-edges w)
	2179	:wlist (let ((wl2 (mapcar #'inner (wg-wtree-wlist w))))
	2180	(if (or (eq dir 'both) (eq dir d1))
	2181	(nreverse wl2)
	2182	wl2)))))))
	2183	(wg-normalize-wtree (inner w))))
	2184
	2185	(defun wg-wtree-move-window (wtree offset)
	2186	"Offset `selected-window' OFFSET places in WTREE."
	2187	(cl-labels
	2188	((inner (w) (if (wg-win-p w) w
	2189	(wg-with-slots w ((wlist wg-wtree-wlist))
	2190	(wg-make-wtree
	2191	:dir (wg-wtree-dir w)
	2192	:edges (wg-wtree-edges w)
	2193	:wlist (aif (cl-find t wlist :key 'wg-win-selected)
	2194	(wg-cyclic-offset-elt it wlist offset)
	2195	(mapcar #'inner wlist)))))))
	2196	(wg-normalize-wtree (inner wtree))))
	2197
	2198	(defun wg-frame-to-wconfig (&optional frame)
	2199	"Return the serialization (a wg-wconfig) of Emacs frame FRAME.
	2200	FRAME nil defaults to `selected-frame'."
	2201	(let* ((frame (or frame (selected-frame)))
	2202	(fullscrn (frame-parameter frame 'fullscreen)))
	2203	(wg-make-wconfig
	2204	:left (frame-parameter frame 'left)
	2205	:top (frame-parameter frame 'top)
	2206	:width (frame-parameter frame 'width)
	2207	:height (frame-parameter frame 'height)
	2208	:parameters `((fullscreen . ,fullscrn))
	2209	:vertical-scroll-bars (frame-parameter frame 'vertical-scroll-bars)
	2210	:scroll-bar-width (frame-parameter frame 'scroll-bar-width)
	2211	:wtree (wg-window-tree-to-wtree (window-tree frame))
	2212	)))
	2213
	2214	(defun wg-current-wconfig ()
	2215	"Return the current wconfig.
	2216	If `wg-current-wconfig' is non-nil, return it. Otherwise return
	2217	`wg-frame-to-wconfig'."
	2218	(or (frame-parameter nil 'wg-current-wconfig)
	2219	(wg-frame-to-wconfig)))
	2220
	2221	(defmacro wg-with-current-wconfig (frame wconfig &rest body)
	2222	"Eval BODY with WCONFIG current in FRAME.
	2223	FRAME nil defaults to `selected-frame'."
	2224	(declare (indent 2))
	2225	(wg-with-gensyms (frame-sym old-value)
	2226	`(let* ((,frame-sym (or ,frame (selected-frame)))
	2227	(,old-value (frame-parameter ,frame-sym 'wg-current-wconfig)))
	2228	(unwind-protect
	2229	(progn
	2230	(set-frame-parameter ,frame-sym 'wg-current-wconfig ,wconfig)
	2231	,@body)
	2232	(when (frame-live-p ,frame-sym)
	2233	(set-frame-parameter ,frame-sym 'wg-current-wconfig ,old-value))))))
	2234
	2235	(defun wg-make-blank-wconfig (&optional buffer)
	2236	"Return a new blank wconfig.
	2237	BUFFER or `wg-default-buffer' is visible in the only window."
	2238	(save-window-excursion
	2239	(delete-other-windows)
	2240	(switch-to-buffer (or buffer wg-default-buffer))
	2241	(wg-frame-to-wconfig)))
	2242
	2243	(defun wg-wconfig-move-window (wconfig offset)
	2244	"Offset `selected-window' OFFSET places in WCONFIG."
	2245	(wg-asetf (wg-wconfig-wtree wconfig) (wg-wtree-move-window it offset))
	2246	wconfig)
	2247
	2248
	2249	;;; base wconfig updating
	2250
	2251	(defun wg-update-working-wconfig-on-delete-frame (frame)
	2252	"Update FRAME's current workgroup's working-wconfig before
	2253	FRAME is deleted, so we don't lose its state."
	2254	(wg-flag-session-modified)
	2255	(with-selected-frame frame
	2256	(wg-update-current-workgroup-working-wconfig)))
	2257
	2258	(defun wg-update-working-wconfig-on-make-frame (frame)
	2259	"Update FRAME's current workgroup's working-wconfig before
	2260	FRAME is deleted, so we don't lose its state."
	2261	(if (> (length (frame-list)) 1)
	2262	(wg-flag-session-modified))
	2263	;;(with-selected-frame frame
	2264	;; (wg-update-current-workgroup-working-wconfig))
	2265	)
	2266
	2267	(defun wg-wconfig-buf-uids (wconfig)
	2268	"Return WCONFIG's wtree's `wg-wtree-buf-uids'."
	2269	(if (not (wg-wconfig-wtree wconfig))
	2270	(error "WTREE is nil in `wg-wconfig-buf-uids'!"))
	2271	(wg-wtree-unique-buf-uids (wg-wconfig-wtree wconfig)))
	2272
	2273
	2274
	2275
	2276
	2277	(defun wg-wconfig-restore-frame-position (wconfig &optional frame)
	2278	"Use WCONFIG to restore FRAME's position.
	2279	If frame is nil then `selected-frame'."
	2280	(-when-let* ((left (wg-wconfig-left wconfig))
	2281	(top (wg-wconfig-top wconfig)))
	2282	;; Check that arguments are integers
	2283	;; Problem: https://github.com/pashinin/workgroups2/issues/15
	2284	(if (and (integerp left)
	2285	(integerp top))
	2286	(set-frame-position frame left top))))
	2287
	2288	(defun wg-wconfig-restore-scroll-bars (wconfig)
	2289	"Restore `selected-frame's scroll-bar settings from WCONFIG."
	2290	(set-frame-parameter
	2291	nil 'vertical-scroll-bars (wg-wconfig-vertical-scroll-bars wconfig))
	2292	(set-frame-parameter
	2293	nil 'scroll-bar-width (wg-wconfig-scroll-bar-width wconfig)))
	2294
	2295	;;(defun wg-wconfig-restore-fullscreen (wconfig)
	2296	;; "Restore `selected-frame's fullscreen settings from WCONFIG."
	2297	;; (set-frame-parameter
	2298	;; nil 'fullscreen (wg-wconfig-parameters wconfig))
	2299	;; )
	2300
	2301	(defun wg-scale-wconfigs-wtree (wconfig new-width new-height)
	2302	"Scale WCONFIG's wtree with NEW-WIDTH and NEW-HEIGHT.
	2303	Return a copy WCONFIG's wtree scaled with `wg-scale-wtree' by the
	2304	ratio or NEW-WIDTH to WCONFIG's width, and NEW-HEIGHT to
	2305	WCONFIG's height."
	2306	(wg-normalize-wtree
	2307	(wg-scale-wtree
	2308	(wg-wconfig-wtree wconfig)
	2309	(/ (float new-width) (wg-wconfig-width wconfig))
	2310	(/ (float new-height) (wg-wconfig-height wconfig)))))
	2311
	2312	(defun wg-scale-wconfig-to-frame (wconfig)
	2313	"Scale WCONFIG buffers to fit current frame size.
	2314	Return a scaled copy of WCONFIG."
	2315	(interactive)
	2316	(wg-scale-wconfigs-wtree wconfig
	2317	(frame-parameter nil 'width)
	2318	(frame-parameter nil 'height)))
	2319
	2320	(defun wg-frame-resize-and-position (wconfig &optional frame)
	2321	"Apply WCONFIG's size and position to a FRAME."
	2322	(interactive)
	2323	(unless frame (setq frame (selected-frame)))
	2324	(let* ((params (wg-wconfig-parameters wconfig))
	2325	fullscreen)
	2326	(set-frame-parameter frame 'fullscreen (if (assoc 'fullscreen params)
	2327	(cdr (assoc 'fullscreen params))
	2328	nil))
	2329	(when (and wg-restore-frame-position
	2330	(not (frame-parameter frame 'fullscreen)))
	2331	(wg-wconfig-restore-frame-position wconfig frame))
	2332	))
	2333
	2334	(defun wg-restore-frame-size-position (wconfig &optional fs)
	2335	"Smart-restore of frame size and position.
	2336
	2337	Depending on `wg-remember-frame-for-each-wg' frame parameters may
	2338	be restored for each workgroup.
	2339
	2340	If `wg-remember-frame-for-each-wg' is nil (by default) then
	2341	current frame parameters are saved/restored to/from first
	2342	workgroup. And frame parameters for all other workgroups are just
	2343	ignored.
	2344	"
	2345	(interactive)
	2346	(let* ((params (wg-wconfig-parameters wconfig))
	2347	fullscreen)
	2348	;; Frame maximized / fullscreen / none
	2349	(unless wg-remember-frame-for-each-wg
	2350	(setq params (wg-wconfig-parameters (wg-workgroup-working-wconfig (wg-first-workgroup)))))
	2351	(setq fullscreen (if (assoc 'fullscreen params)
	2352	(cdr (assoc 'fullscreen params))
	2353	nil))
	2354	(when (and fs
	2355	fullscreen
	2356	(or wg-remember-frame-for-each-wg
	2357	(null (wg-current-workgroup t))))
	2358	(set-frame-parameter nil 'fullscreen fullscreen)
	2359	;; I had bugs restoring maximized frame:
	2360	;; Frame could be maximized but buffers are not scaled to fit it.
	2361	;;
	2362	;; Maybe because of `set-frame-parameter' takes some time to finish and is async.
	2363	;; So I tried this and it helped
	2364	(sleep-for 0 100))
	2365
	2366	;; Position
	2367	(when (and wg-restore-frame-position
	2368	wg-remember-frame-for-each-wg
	2369	(not (frame-parameter nil 'fullscreen)))
	2370	(wg-wconfig-restore-frame-position wconfig))
	2371	))
	2372
	2373
	2374	(defun wg-restore-frames ()
	2375	"Try to recreate opened frames, take info from session's 'frame-list parameter."
	2376	(interactive)
	2377	(delete-other-frames)
	2378	(awhen (wg-current-session t)
	2379	(let ((fl (wg-session-parameter 'frame-list nil it))
	2380	(frame (selected-frame)))
	2381	(mapc (lambda (wconfig)
	2382	(with-selected-frame (make-frame)
	2383	;;(wg-frame-resize-and-position wconfig)
	2384	;;(wg-restore-frame-size-position wconfig)
	2385	;;(wg-wconfig-restore-frame-position wconfig)
	2386	(wg-restore-wconfig wconfig)
	2387	)) fl)
	2388	(select-frame-set-input-focus frame))))
	2389
	2390	;; FIXME: throw a specific error if the restoration was unsuccessful
	2391	(defun wg-restore-wconfig (wconfig &optional frame)
	2392	"Restore a workgroup configuration WCONFIG in a FRAME.
	2393	Runs each time you're switching workgroups."
	2394	(unless frame (setq frame (selected-frame)))
	2395	(let ((wg-record-incorrectly-restored-bufs t)
	2396	(wg-incorrectly-restored-bufs nil)
	2397	(params (wg-wconfig-parameters wconfig))
	2398	fullscreen)
	2399	(wg-barf-on-active-minibuffer)
	2400	(when wg-restore-scroll-bars
	2401	(wg-wconfig-restore-scroll-bars wconfig))
	2402
	2403	(when (null (wg-current-workgroup t))
	2404	(set-frame-parameter frame 'fullscreen (if (assoc 'fullscreen params)
	2405	(cdr (assoc 'fullscreen params))
	2406	nil)))
	2407
	2408	;; Restore frame position
	2409	(when (and wg-restore-frame-position
	2410	(not (frame-parameter nil 'fullscreen))
	2411	(null (wg-current-workgroup t)))
	2412	(wg-wconfig-restore-frame-position wconfig frame))
	2413
	2414	;; Restore buffers
	2415	(wg-restore-window-tree (wg-scale-wconfig-to-frame wconfig))
	2416
	2417	(when wg-incorrectly-restored-bufs
	2418	(message "Unable to restore these buffers: %S\
	2419	If you want, restore them manually and try again."
	2420	(mapcar 'wg-buf-name wg-incorrectly-restored-bufs)))))
	2421
	2422
	2423	;;; saved wconfig commands
	2424
	2425	(defun wg-save-wconfig ()
	2426	"Save the current wconfig to the current workgroup's saved wconfigs."
	2427	(interactive)
	2428	(let* ((workgroup (wg-current-workgroup))
	2429	(name (wg-read-saved-wconfig-name workgroup))
	2430	(wconfig (wg-current-wconfig)))
	2431	(setf (wg-wconfig-name wconfig) name)
	2432	(wg-workgroup-save-wconfig wconfig workgroup)
	2433	(wg-fontified-message
	2434	(:cmd "Saved: ")
	2435	(:cur name))))
	2436
	2437	(defun wg-restore-saved-wconfig ()
	2438	"Restore one of the current workgroup's saved wconfigs in `selected-frame'."
	2439	(interactive)
	2440	(let ((workgroup (wg-current-workgroup)))
	2441	(wg-restore-wconfig-undoably
	2442	(wg-workgroup-get-saved-wconfig
	2443	(wg-completing-read "Saved wconfig: "
	2444	(mapcar 'wg-wconfig-name (wg-workgroup-saved-wconfigs workgroup))
	2445	nil t)
	2446	workgroup))))
	2447
	2448	(defun wg-kill-saved-wconfig ()
	2449	"Kill one of the current workgroup's saved wconfigs.
	2450	Also add it to the wconfig kill-ring."
	2451	(interactive)
	2452	(let* ((workgroup (wg-current-workgroup))
	2453	(wconfig (wg-read-saved-wconfig workgroup)))
	2454	(wg-workgroup-kill-saved-wconfig workgroup wconfig)
	2455	(wg-add-to-wconfig-kill-ring wconfig)
	2456	(wg-fontified-message
	2457	(:cmd "Deleted: ")
	2458	(:cur (wg-wconfig-name wconfig)))))
	2459
	2460
	2461	(defun wg-reverse-wconfig (wconfig &optional dir)
	2462	"Reverse WCONFIG's wtree's wlist in direction DIR."
	2463	(wg-asetf (wg-wconfig-wtree wconfig) (wg-reverse-wlist it dir))
	2464	wconfig)
	2465
	2466
	2467	;; specialbufs
	2468	(defcustom wg-special-buffer-serdes-functions
	2469	'(wg-serialize-comint-buffer
	2470	)
	2471	"Functions providing serialization/deserialization for complex buffers.
	2472
	2473	Use `wg-support' macro and this variable will be filled
	2474	automatically.
	2475
	2476	An entry should be either a function symbol or a lambda, and should
	2477	accept a single Emacs buffer object as an argument.
	2478
	2479	When a buffer is to be serialized, it is passed to each of these
	2480	functions in turn until one returns non-nil, or the list ends. A
	2481	return value of nil indicates that the function can't handle
	2482	buffers of that type. A non-nil return value indicates that it
	2483	can. The first non-nil return value becomes the buffer's special
	2484	serialization data. The return value should be a cons, with a
	2485	deserialization function (a function symbol or a lambda) as the car,
	2486	and any other serialization data as the cdr.
	2487
	2488	When it comes time to deserialize the buffer, the deserialization
	2489	function (the car of the cons mentioned above) is passed the
	2490	wg-buf object, from which it should restore the buffer. The
	2491	special serialization data itself can be accessed
	2492	with (cdr (wg-buf-special-data <wg-buf>)). The deserialization
	2493	function must return the restored Emacs buffer object.
	2494
	2495	See the definitions of the functions in this list for examples of
	2496	how to write your own."
	2497	:type 'alist
	2498	:group 'workgroups)
	2499
	2500	;; Dired
	2501	(wg-support 'dired-mode 'dired
	2502	`((deserialize . ,(lambda (buffer vars)
	2503	(when (or wg-restore-remote-buffers
	2504	(not (file-remote-p default-directory)))
	2505	(let ((d (wg-get-first-existing-dir)))
	2506	(if (file-directory-p d) (dired d))))))))
	2507
	2508	;; `Info-mode' C-h i
	2509	(wg-support 'Info-mode 'info
	2510	`((save . (Info-current-file Info-current-node))
	2511	(deserialize . ,(lambda (buffer vars)
	2512	;;(with-current-buffer
	2513	;; (get-buffer-create (wg-buf-name buffer))
	2514	(aif vars
	2515	(if (fboundp 'Info-find-node)
	2516	(apply #'Info-find-node it))
	2517	(info)
	2518	(get-buffer (wg-buf-name buffer)))))))
	2519
	2520	;; `help-mode'
	2521	;; Bug: https://github.com/pashinin/workgroups2/issues/29
	2522	;; bug in wg-get-value
	2523	(wg-support 'help-mode 'help-mode
	2524	`((save . (help-xref-stack-item help-xref-stack help-xref-forward-stack))
	2525	(deserialize . ,(lambda (buffer vars)
	2526	(wg-dbind (item stack forward-stack) vars
	2527	(condition-case err
	2528	(apply (car item) (cdr item))
	2529	(error (message "%s" err)))
	2530	(awhen (get-buffer "Help")
	2531	(set-buffer it)
	2532	(wg-when-boundp (help-xref-stack help-xref-forward-stack)
	2533	(setq help-xref-stack stack
	2534	help-xref-forward-stack forward-stack))))))))
	2535
	2536	;; ielm
	2537	(wg-support 'inferior-emacs-lisp-mode 'ielm
	2538	`((deserialize . ,(lambda (buffer vars)
	2539	(ielm) (get-buffer "ielm")))))
	2540
	2541	;; Magit status
	2542	(wg-support 'magit-status-mode 'magit
	2543	`((deserialize . ,(lambda (buffer vars)
	2544	(if (file-directory-p default-directory)
	2545	(magit-status default-directory)
	2546	(let ((d (wg-get-first-existing-dir)))
	2547	(if (file-directory-p d) (dired d))))))))
	2548
	2549	;; Shell
	2550	(wg-support 'shell-mode 'shell
	2551	`((deserialize . ,(lambda (buffer vars)
	2552	(shell (wg-buf-name buffer))))))
	2553
	2554	;; org-agenda buffer
	2555	(defun wg-get-org-agenda-view-commands ()
	2556	"Return commands to restore the state of Agenda buffer.
	2557	Can be restored using \"(eval commands)\"."
	2558	(interactive)
	2559	(when (boundp 'org-agenda-buffer-name)
	2560	(if (get-buffer org-agenda-buffer-name)
	2561	(with-current-buffer org-agenda-buffer-name
	2562	(let* ((p (or (and (looking-at "\\'") (1- (point))) (point)))
	2563	(series-redo-cmd (get-text-property p 'org-series-redo-cmd)))
	2564	(if series-redo-cmd
	2565	(get-text-property p 'org-series-redo-cmd)
	2566	(get-text-property p 'org-redo-cmd)))))))
	2567
	2568	(defun wg-run-agenda-cmd (f)
	2569	"Run commands F in Agenda buffer.
	2570	You can get these commands using `wg-get-org-agenda-view-commands'."
	2571	(when (and (boundp 'org-agenda-buffer-name)
	2572	(fboundp 'org-current-line)
	2573	(fboundp 'org-goto-line))
	2574	(if (get-buffer org-agenda-buffer-name)
	2575	(save-window-excursion
	2576	(with-current-buffer org-agenda-buffer-name
	2577	(let* ((line (org-current-line)))
	2578	(if f (eval f))
	2579	(org-goto-line line)))))))
	2580
	2581	(wg-support 'org-agenda-mode 'org-agenda
	2582	'((serialize . (lambda (buffer)
	2583	(wg-get-org-agenda-view-commands)))
	2584	(deserialize . (lambda (buffer vars)
	2585	(org-agenda-list)
	2586	(awhen (get-buffer org-agenda-buffer-name)
	2587	(with-current-buffer it
	2588	(wg-run-agenda-cmd vars))
	2589	it)))))
	2590
	2591	;; eshell
	2592	(wg-support 'eshell-mode 'esh-mode
	2593	'((deserialize . (lambda (buffer vars)
	2594	(prog1 (eshell t)
	2595	(rename-buffer (wg-buf-name buffer) t))))))
	2596
	2597	;; term-mode
	2598	;;
	2599	;; This should work for `ansi-term's, too, as there doesn't seem to
	2600	;; be any difference between the two except how the name of the
	2601	;; buffer is generated.
	2602	;;
	2603	(wg-support 'term-mode 'term
	2604	`((serialize . ,(lambda (buffer)
	2605	(if (get-buffer-process buffer)
	2606	(-last-item (process-command (get-buffer-process buffer)))
	2607	"/bin/bash")))
	2608	(deserialize . ,(lambda (buffer vars)
	2609	(cl-labels ((term-window-width () 80)
	2610	(window-height () 24))
	2611	(prog1 (term vars)
	2612	(rename-buffer (wg-buf-name buffer) t)))))))
	2613
	2614	;; `inferior-python-mode'
	2615	(wg-support 'inferior-python-mode 'python
	2616	`((save . (python-shell-interpreter python-shell-interpreter-args))
	2617	(deserialize . ,(lambda (buffer vars)
	2618	(wg-dbind (pythoncmd pythonargs) vars
	2619	(run-python (concat pythoncmd " " pythonargs))
	2620	(awhen (get-buffer (process-buffer
	2621	(python-shell-get-or-create-process)))
	2622	(with-current-buffer it (goto-char (point-max)))
	2623	it))))))
	2624
	2625
	2626	;; Sage shell ;;
	2627	(wg-support 'inferior-sage-mode 'sage-mode
	2628	`((deserialize . ,(lambda (buffer vars)
	2629	(save-window-excursion
	2630	(if (boundp' sage-command)
	2631	(run-sage t sage-command t)))
	2632	(if (boundp 'sage-buffer)
	2633	(awhen sage-buffer
	2634	(set-buffer it)
	2635	(switch-to-buffer sage-buffer)
	2636	(goto-char (point-max))))))))
	2637
	2638	;; `inferior-ess-mode' M-x R
	2639	(wg-support 'inferior-ess-mode 'ess-inf
	2640	`((save . (inferior-ess-program))
	2641	(deserialize . ,(lambda (buffer vars)
	2642	(wg-dbind (cmd) vars
	2643	(let ((ess-ask-about-transfile nil)
	2644	(ess-ask-for-ess-directory nil)
	2645	(ess-history-file nil))
	2646	(R)
	2647	(get-buffer (wg-buf-name buffer))))))))
	2648
	2649	;; `inferior-octave-mode'
	2650	(wg-support 'inferior-octave-mode 'octave
	2651	`((deserialize . ,(lambda (buffer vars)
	2652	(prog1 (run-octave)
	2653	(rename-buffer (wg-buf-name buffer) t))))))
	2654
	2655	;; `prolog-inferior-mode'
	2656	(wg-support 'prolog-inferior-mode 'prolog
	2657	`((deserialize . ,(lambda (buffer vars)
	2658	(save-window-excursion
	2659	(run-prolog nil))
	2660	(switch-to-buffer "prolog")
	2661	(goto-char (point-max))))))
	2662
	2663	;; `ensime-inf-mode'
	2664	(wg-support 'ensime-inf-mode 'ensime
	2665	`((deserialize . ,(lambda (buffer vars)
	2666	(save-window-excursion
	2667	(ensime-inf-switch))
	2668	(when (boundp 'ensime-inf-buffer-name)
	2669	(switch-to-buffer ensime-inf-buffer-name)
	2670	(goto-char (point-max)))))))
	2671
	2672	;; compilation-mode
	2673	;;
	2674	;; I think it's not a good idea to compile a program just to switch
	2675	;; workgroups. So just restoring a buffer name.
	2676	(wg-support 'compilation-mode 'compile
	2677	`((serialize . ,(lambda (buffer)
	2678	(if (boundp' compilation-arguments) compilation-arguments)))
	2679	(deserialize . ,(lambda (buffer vars)
	2680	(save-window-excursion
	2681	(get-buffer-create (wg-buf-name buffer)))
	2682	(with-current-buffer (wg-buf-name buffer)
	2683	(when (boundp' compilation-arguments)
	2684	(make-local-variable 'compilation-arguments)
	2685	(setq compilation-arguments vars)))
	2686	(switch-to-buffer (wg-buf-name buffer))
	2687	(goto-char (point-max))))))
	2688
	2689	;; grep-mode
	2690	;; see grep.el - `compilation-start' - it is just a compilation buffer
	2691	;; local variables:
	2692	;; `compilation-arguments' == (cmd mode nil nil)
	2693	(wg-support 'grep-mode 'grep
	2694	`((serialize . ,(lambda (buffer)
	2695	(if (boundp' compilation-arguments) compilation-arguments)))
	2696	(deserialize . ,(lambda (buffer vars)
	2697	(compilation-start (car vars) (nth 1 vars))
	2698	(switch-to-buffer "grep")))))
	2699
	2700
	2701	;; `speedbar-mode' (has bugs)
	2702	;; only from sr-speedbar.el
	2703	;;(wg-support 'speedbar-mode 'sr-speedbar
	2704	;; `((deserialize . ,(lambda (buffer vars)
	2705	;; ;;(with-current-buffer (get-buffer-create "SPEEDBAR")
	2706	;; (with-no-warnings
	2707	;; (setq speedbar-buffer (get-buffer-create "SPEEDBAR"))
	2708	;; (setq speedbar-frame (selected-frame)
	2709	;; dframe-attached-frame (selected-frame)
	2710	;; speedbar-select-frame-method 'attached
	2711	;; speedbar-verbosity-level 0
	2712	;; speedbar-last-selected-file nil)
	2713	;; (set-buffer speedbar-buffer)
	2714	;; (speedbar-mode)
	2715	;; (speedbar-reconfigure-keymaps)
	2716	;; (speedbar-update-contents)
	2717	;; (speedbar-set-timer 1)
	2718	;; (aif (get-buffer-window "SPEEDBAR")
	2719	;; (set-window-dedicated-p it t))
	2720	;; (get-buffer-create "SPEEDBAR"))))))
	2721
	2722
	2723	(defun wg-deserialize-slime-buffer (buf)
	2724	"Deserialize `slime' buffer BUF."
	2725	(when (require 'slime nil 'noerror)
	2726	(wg-dbind (this-function args) (wg-buf-special-data buf)
	2727	(let ((default-directory (car args))
	2728	(arguments (nth 1 args)))
	2729	(when (and (fboundp 'slime-start*)
	2730	(fboundp 'slime-process))
	2731	(save-window-excursion
	2732	(slime-start* arguments))
	2733	(switch-to-buffer (process-buffer (slime-process)))
	2734	(current-buffer))))))
	2735
	2736	;; `comint-mode' (general mode for all shells)
	2737	;;
	2738	;; It may have different shells. So we need to determine which shell is
	2739	;; now in `comint-mode' and how to restore it.
	2740	;;
	2741	;; Just executing `comint-exec' may be not enough because we can miss
	2742	;; some hooks or any other stuff that is executed when you run a
	2743	;; specific shell.
	2744	(defun wg-serialize-comint-buffer (buffer)
	2745	"Serialize comint BUFFER."
	2746	(with-current-buffer buffer
	2747	(if (fboundp 'comint-mode)
	2748	(when (eq major-mode 'comint-mode)
	2749	;; `slime-inferior-lisp-args' var is used when in `slime'
	2750	(when (and (boundp 'slime-inferior-lisp-args)
	2751	slime-inferior-lisp-args)
	2752	(list 'wg-deserialize-slime-buffer
	2753	(list default-directory slime-inferior-lisp-args)
	2754	))))))
	2755
	2756	;; inf-mongo
	2757	;; https://github.com/tobiassvn/inf-mongo
	2758	;; `mongo-command' - command used to start inferior mongo
	2759	(wg-support 'inf-mongo-mode 'inf-mongo
	2760	`((serialize . ,(lambda (buffer)
	2761	(if (boundp 'inf-mongo-command) inf-mongo-command)))
	2762	(deserialize . ,(lambda (buffer vars)
	2763	(save-window-excursion
	2764	(when (fboundp 'inf-mongo)
	2765	(inf-mongo vars)))
	2766	(when (get-buffer "mongo")
	2767	(switch-to-buffer "mongo")
	2768	(goto-char (point-max)))))))
	2769
	2770	(defun wg-temporarily-rename-buffer-if-exists (buffer)
	2771	"Rename BUFFER if it exists."
	2772	(when (get-buffer buffer)
	2773	(with-current-buffer buffer
	2774	(rename-buffer "wg--temp-buffer" t))))
	2775
	2776	;; SML shell
	2777	;; Functions to serialize deserialize inferior sml buffer
	2778	;; `inf-sml-program' is the program run as inferior sml, is the
	2779	;; `inf-sml-args' are the extra parameters passed, `inf-sml-host'
	2780	;; is the host on which sml was running when serialized
	2781	(wg-support 'inferior-sml-mode 'sml-mode
	2782	`((serialize . ,(lambda (buffer)
	2783	(list (if (boundp 'sml-program-name) sml-program-name)
	2784	(if (boundp 'sml-default-arg) sml-default-arg)
	2785	(if (boundp 'sml-host-name) sml-host-name))))
	2786	(deserialize . ,(lambda (buffer vars)
	2787	(wg-dbind (program args host) vars
	2788	(save-window-excursion
	2789	;; If a inf-sml buffer already exists rename it temporarily
	2790	;; otherwise `run-sml' will simply switch to the existing
	2791	;; buffer, however we want to create a separate buffer with
	2792	;; the serialized name
	2793	(let* ((inf-sml-buffer-name (concat "*"
	2794	(file-name-nondirectory program)
	2795	"*"))
	2796	(existing-sml-buf (wg-temporarily-rename-buffer-if-exists
	2797	inf-sml-buffer-name)))
	2798	(with-current-buffer (run-sml program args host)
	2799	;; Rename the buffer
	2800	(rename-buffer (wg-buf-name buffer) t)
	2801
	2802	;; Now we can re-rename the previously renamed buffer
	2803	(when existing-sml-buf
	2804	(with-current-buffer existing-sml-buf
	2805	(rename-buffer inf-sml-buffer-name t))))))
	2806	(switch-to-buffer (wg-buf-name buffer))
	2807	(goto-char (point-max)))))))
	2808
	2809	;; Geiser repls
	2810	;; http://www.nongnu.org/geiser/
	2811	(wg-support 'geiser-repl-mode 'geiser
	2812	`((save . (geiser-impl--implementation))
	2813	(deserialize . ,(lambda (buffer vars)
	2814	(when (fboundp 'run-geiser)
	2815	(wg-dbind (impl) vars
	2816	(run-geiser impl)
	2817	(goto-char (point-max))))
	2818	(switch-to-buffer (wg-buf-name buffer))))))
	2819
	2820	;; w3m-mode
	2821	(wg-support 'w3m-mode 'w3m
	2822	`((save . (w3m-current-url))
	2823	(deserialize . ,(lambda (buffer vars)
	2824	(wg-dbind (url) vars
	2825	(w3m-goto-url url))))))
	2826
	2827	;; notmuch
	2828	(wg-support 'notmuch-hello-mode 'notmuch
	2829	`((deserialize . ,(lambda (buffer vars)
	2830	(notmuch)
	2831	(get-buffer (wg-buf-name buffer))))))
	2832
	2833	;; Wanderlust modes:
	2834	;; WL - folders
	2835	;;(defun wg-deserialize-wl-folders-buffer (buf)
	2836	;; ""
	2837	;; (if (fboundp 'wl)
	2838	;; (wg-dbind (this-function) (wg-buf-special-data buf)
	2839	;; ;;(when (not (eq major-mode 'wl-folder-mode))
	2840	;; (wl)
	2841	;; (goto-char (point-max))
	2842	;; (current-buffer)
	2843	;; )))
	2844	;;
	2845	;;(defun wg-serialize-wl-folders-buffer (buffer)
	2846	;; ""
	2847	;; (if (fboundp 'wl)
	2848	;; (with-current-buffer buffer
	2849	;; (when (eq major-mode 'wl-folder-mode)
	2850	;; (list 'wg-deserialize-wl-folders-buffer
	2851	;; )))))
	2852
	2853	;; WL - summary mode (list of mails)
	2854	;;(defun wg-deserialize-wl-summary-buffer (buf)
	2855	;; ""
	2856	;; (interactive)
	2857	;; (if (fboundp 'wl)
	2858	;; (wg-dbind (this-function param-list) (wg-buf-special-data buf)
	2859	;; (when (not (eq major-mode 'wl-summary-mode))
	2860	;; (let ((fld-name (car param-list)))
	2861	;; ;;(switch-to-buffer "scratch")
	2862	;; ;;(wl)
	2863	;; ;;(wl-folder-jump-folder fld-name)
	2864	;; ;;(message fld-name)
	2865	;; ;;(goto-char (point-max))
	2866	;; ;;(insert fld-name)
	2867	;; (current-buffer)
	2868	;; )))))
	2869	;;
	2870	;;(defun wg-serialize-wl-summary-buffer (buffer)
	2871	;; ""
	2872	;; (if (fboundp 'wl)
	2873	;; (with-current-buffer buffer
	2874	;; (when (eq major-mode 'wl-summary-mode)
	2875	;; (list 'wg-deserialize-wl-summary-buffer
	2876	;; (wg-take-until-unreadable (list wl-summary-buffer-folder-name))
	2877	;; )))))
	2878	;;
	2879	;;
	2880	;;;; mime-view-mode
	2881	;;
	2882	;;(defun wg-deserialize-mime-view-buffer (buf)
	2883	;; ""
	2884	;; (wg-dbind (this-function) (wg-buf-special-data buf)
	2885	;; (when (not (eq major-mode 'mime-view-mode))
	2886	;; ;;(wl-summary-enter-handler 3570) ; only in wl-summary-mode
	2887	;; ;;(wl-summary-enter-handler) ; only in wl-summary-mode
	2888	;; (current-buffer)
	2889	;; )))
	2890	;;
	2891	;;(defun wg-serialize-mime-view-buffer (buffer)
	2892	;; ""
	2893	;; (with-current-buffer buffer
	2894	;; (when (eq major-mode 'mime-view-mode)
	2895	;; (list 'wg-deserialize-mime-view-buffer
	2896	;; ))))
	2897
	2898
	2899	;; emms-playlist-mode
	2900	;;
	2901	;; Help me on this one:
	2902	;; 1. How to start emms without any user interaction?
	2903	;;
	2904	;;(defun wg-deserialize-emms-buffer (buf)
	2905	;; "Deserialize emms-playlist buffer BUF."
	2906	;; (when (require 'emms-setup nil 'noerror)
	2907	;; (require 'emms-player-mplayer)
	2908	;; (emms-standard)
	2909	;; (emms-default-players)
	2910	;; (if (fboundp 'emms-playlist-mode)
	2911	;; (wg-dbind (this-function args) (wg-buf-special-data buf)
	2912	;; (let ((default-directory (car args)))
	2913	;; (save-window-excursion
	2914	;; ;;(emms)
	2915	;; (if (or (null emms-playlist-buffer)
	2916	;; (not (buffer-live-p emms-playlist-buffer)))
	2917	;; ;;(call-interactively 'emms-add-file)
	2918	;; (emms-source-directory "/usr/data/disk_3/Music/SORT/")
	2919	;; ))
	2920	;; ;; (emms)
	2921	;; ;;(with-current-buffer emms-playlist-buffer-name
	2922	;; ;;(emms-source-playlist-directory-tree "/usr/data/disk_3/Music/SORT/")
	2923	;; ;;(emms-source-directory "/usr/data/disk_3/Music/SORT")
	2924	;; ;;(switch-to-buffer emms-playlist-buffer-name)
	2925	;; (emms-playlist-mode-go)
	2926	;; (current-buffer)
	2927	;; )))))
	2928	;;
	2929	;;(defun wg-serialize-emms-buffer (buffer)
	2930	;; "Serialize emms BUFFER."
	2931	;; (with-current-buffer buffer
	2932	;; (if (fboundp 'emms-playlist-mode)
	2933	;; (when (eq major-mode 'emms-playlist-mode)
	2934	;; (list 'wg-deserialize-emms-buffer
	2935	;; (wg-take-until-unreadable (list default-directory))
	2936	;; )))))
	2937
	2938
	2939	;;; buffer-local variable serdes
	2940
	2941	(defun wg-serialize-buffer-mark-ring ()
	2942	"Return a new list of the positions of the marks in `mark-ring'."
	2943	(mapcar 'marker-position mark-ring))
	2944
	2945	(defun wg-deserialize-buffer-mark-ring (positions)
	2946	"Set `mark-ring' to a new list of markers created from POSITIONS."
	2947	(setq mark-ring
	2948	(mapcar (lambda (pos) (set-marker (make-marker) pos))
	2949	positions)))
	2950
	2951	(defun wg-deserialize-buffer-major-mode (major-mode-symbol)
	2952	"Conditionally retore MAJOR-MODE-SYMBOL in `current-buffer'."
	2953	(and (fboundp major-mode-symbol)
	2954	(not (eq major-mode-symbol major-mode))
	2955	(funcall major-mode-symbol)))
	2956
	2957	(defun wg-deserialize-buffer-local-variables (buf)
	2958	"Restore BUF's buffer local variables in `current-buffer'."
	2959	(cl-loop for ((var . val) . rest) on (wg-buf-local-vars buf)
	2960	do (awhen (assq var wg-buffer-local-variables-alist)
	2961	(wg-dbind (var ser des) it
	2962	(if des (funcall des val)
	2963	(set var val))))))
	2964
	2965	(defmacro wg-workgroup-list ()
	2966	"Setf'able `wg-current-session' modified slot accessor."
	2967	`(wg-session-workgroup-list (wg-current-session)))
	2968
	2969	(defmacro wg-buf-list ()
	2970	"Setf'able `wg-current-session' buf-list slot accessor."
	2971	`(wg-session-buf-list (wg-current-session)))
	2972
	2973	(defun wg-restore-default-buffer (&optional switch)
	2974	"Return `wg-default-buffer' and maybe SWITCH to it."
	2975	(if switch
	2976	(switch-to-buffer wg-default-buffer t)
	2977	(get-buffer-create wg-default-buffer)))
	2978
	2979	(defun wg-restore-existing-buffer (buf &optional switch)
	2980	"Return existing buffer from BUF and maybe SWITCH to it."
	2981	(-when-let (b (wg-find-buf-in-buffer-list buf (wg-buffer-list-emacs)))
	2982	(if switch (switch-to-buffer b t))
	2983	(with-current-buffer b
	2984	(wg-set-buffer-uid-or-error (wg-buf-uid buf))
	2985	b)))
	2986
	2987	(defun wg-restore-file-buffer (buf &optional switch)
	2988	"Restore BUF by finding its file and maybe SWITCH to it.
	2989	Return the created buffer.
	2990	If BUF's file doesn't exist, call `wg-restore-default-buffer'"
	2991	;;(-when-let ((file-name (wg-buf-file-name buf)))
	2992	(let ((file-name (wg-buf-file-name buf)))
	2993	(when (and file-name
	2994	(or wg-restore-remote-buffers
	2995	(not (file-remote-p file-name))))
	2996	(cond ((file-exists-p file-name)
	2997	;; jit ignore errors
	2998	;;(ignore-errors
	2999	(condition-case err
	3000	(let ((b (find-file-noselect file-name nil nil nil)))
	3001	(with-current-buffer b
	3002	(rename-buffer (wg-buf-name buf) t)
	3003	(wg-set-buffer-uid-or-error (wg-buf-uid buf))
	3004	(when wg-restore-mark
	3005	(set-mark (wg-buf-mark buf))
	3006	(deactivate-mark))
	3007	(wg-deserialize-buffer-local-variables buf)
	3008	)
	3009	(if switch (switch-to-buffer b))
	3010	b)
	3011	(error
	3012	(message "Error while restoring a file %s:\n %s" file-name (error-message-string err))
	3013	nil)))
	3014	(t
	3015	;; try directory
	3016	(if (file-directory-p (file-name-directory file-name))
	3017	(dired (file-name-directory file-name))
	3018	(progn
	3019	(message "Attempt to restore nonexistent file: %S" file-name)
	3020	nil))
	3021	)))))
	3022
	3023	(defun wg-restore-special-buffer (buf &optional switch)
	3024	"Restore a buffer BUF with DESERIALIZER-FN and maybe SWITCH to it."
	3025	(-when-let*
	3026	((special-data (wg-buf-special-data buf))
	3027	(buffer (save-window-excursion
	3028	(condition-case err
	3029	(funcall (car special-data) buf)
	3030	(error (message "Error deserializing %S: %S" (wg-buf-name buf) err)
	3031	nil)))))
	3032	(if switch (switch-to-buffer buffer t))
	3033	(with-current-buffer buffer
	3034	(wg-set-buffer-uid-or-error (wg-buf-uid buf)))
	3035	buffer))
	3036
	3037	(defun wg-restore-buffer (buf &optional switch)
	3038	"Restore BUF, return it and maybe SWITCH to it."
	3039	(when buf
	3040	(fset 'buffer-list wg-buffer-list-original)
	3041	(prog1
	3042	(or (wg-restore-existing-buffer buf switch)
	3043	(wg-restore-special-buffer buf switch) ;; non existent dired problem
	3044	(wg-restore-file-buffer buf switch)
	3045	(progn (wg-restore-default-buffer switch) nil))
	3046	(if wg-mess-with-buffer-list
	3047	(fset 'buffer-list wg-buffer-list-function)))))
	3048
	3049
	3050
	3051	;;; buffer object utils
	3052
	3053	(defun wg-completing-read (prompt choices &optional pred require-match initial-input history default)
	3054	"Do a completing read. Use `ido-mode` if enabled."
	3055	(if ido-mode
	3056	(ido-completing-read prompt choices pred require-match
	3057	initial-input history default)
	3058	(completing-read prompt choices pred require-match
	3059	initial-input history default)))
	3060
	3061	(defun wg-buffer-uid (buffer-or-name)
	3062	"Return BUFFER-OR-NAME's buffer-local value of `wg-buffer-uid'."
	3063	(buffer-local-value 'wg-buffer-uid (wg-get-buffer buffer-or-name)))
	3064
	3065	(defun wg-bufobj-uid (bufobj)
	3066	"Return BUFOBJ's uid."
	3067	(cl-etypecase bufobj
	3068	(buffer (wg-buffer-uid bufobj))
	3069	(wg-buf (wg-buf-uid bufobj))
	3070	(string (wg-bufobj-uid (wg-get-buffer bufobj)))))
	3071
	3072	(defun wg-bufobj-name (bufobj)
	3073	"Return BUFOBJ's buffer name."
	3074	(cl-etypecase bufobj
	3075	(buffer (buffer-name bufobj))
	3076	(wg-buf (wg-buf-name bufobj))
	3077	(string (wg-buffer-name bufobj))))
	3078
	3079	(defun wg-bufobj-file-name (bufobj)
	3080	"Return BUFOBJ's filename."
	3081	(cl-etypecase bufobj
	3082	(buffer (buffer-file-name bufobj))
	3083	(wg-buf (wg-buf-file-name bufobj))
	3084	(string (wg-bufobj-file-name (wg-get-buffer bufobj)))))
	3085
	3086	(defun wg-buf-major-mode (buf)
	3087	"Return BUF's `major-mode'.
	3088	It's stored in BUF's local-vars list, since it's a local variable."
	3089	(wg-aget (wg-buf-local-vars buf) 'major-mode))
	3090
	3091	(defun wg-buffer-major-mode (bufobj)
	3092	"Return BUFOBJ's `major-mode'.
	3093	It works with Emacs buffer, Workgroups buffer object and a simple string."
	3094	(cl-etypecase bufobj
	3095	(buffer (wg-buffer-major-mode bufobj))
	3096	(wg-buf (wg-buf-major-mode bufobj))
	3097	(string (wg-buffer-major-mode bufobj))))
	3098
	3099	;; `wg-equal-bufobjs' and `wg-find-bufobj' may need to be made a lot smarter
	3100	(defun wg-equal-bufobjs (bufobj1 bufobj2)
	3101	"Return t if BUFOBJ1 is \"equal\" to BUFOBJ2."
	3102	(let ((fname1 (wg-bufobj-file-name bufobj1))
	3103	(fname2 (wg-bufobj-file-name bufobj2)))
	3104	(cond ((and fname1 fname2) (string= fname1 fname2))
	3105	((or fname1 fname2) nil)
	3106	((string= (wg-bufobj-name bufobj1) (wg-bufobj-name bufobj2)) t))))
	3107
	3108	(defun wg-find-bufobj (bufobj bufobj-list)
	3109	"Find BUFOBJ in BUFOBJ-LIST, testing with `wg-equal-bufobjs'."
	3110	(cl-find bufobj bufobj-list :test 'wg-equal-bufobjs))
	3111
	3112	(defun wg-find-bufobj-by-uid (uid bufobj-list)
	3113	"Find the bufobj in BUFOBJ-LIST with uid UID."
	3114	(cl-find uid bufobj-list :test 'string= :key 'wg-bufobj-uid))
	3115
	3116	(defun wg-find-buffer-in-buf-list (buffer-or-name buf-list)
	3117	"Find BUFFER-OR-NAME in BUF-LIST."
	3118	(aif (wg-buffer-uid buffer-or-name)
	3119	(wg-find-bufobj-by-uid it buf-list)
	3120	(wg-find-bufobj buffer-or-name buf-list)))
	3121
	3122	(defun wg-find-buf-in-buffer-list (buf buffer-list)
	3123	"Find BUF in BUFFER-LIST."
	3124	(or (wg-find-bufobj-by-uid (wg-buf-uid buf) buffer-list)
	3125	(wg-find-bufobj buf buffer-list)))
	3126
	3127	(defun wg-find-buf-by-uid (uid)
	3128	"Find a buf in `wg-buf-list' by UID."
	3129	(when uid
	3130	(wg-find-bufobj-by-uid uid (wg-buf-list))))
	3131
	3132	(defun wg-set-buffer-uid-or-error (uid &optional buffer)
	3133	"Change UID value of a BUFFER's local var `wg-buffer-uid'.
	3134	If BUFFER already has a buffer local value of `wg-buffer-uid',
	3135	and it's not equal to UID, error."
	3136	(if wg-buffer-uid
	3137	;;(if (string= wg-buffer-uid uid) uid
	3138	;; (error "uids don't match %S and %S" uid wg-buffer-uid))
	3139	(setq wg-buffer-uid uid)))
	3140
	3141
	3142	(defun wg-buffer-special-data (buffer)
	3143	"Return BUFFER's auxiliary serialization, or nil."
	3144	(cl-some (lambda (fn) (funcall fn buffer)) wg-special-buffer-serdes-functions))
	3145
	3146
	3147	(defun wg-serialize-buffer-local-variables ()
	3148	"Return an alist of buffer-local variable symbols and their values.
	3149	See `wg-buffer-local-variables-alist' for details."
	3150	(wg-docar (entry wg-buffer-local-variables-alist)
	3151	(wg-dbind (var ser des) entry
	3152	(when (local-variable-p var)
	3153	(cons var (if ser (funcall ser) (symbol-value var)))))))
	3154
	3155	(defun wg-buffer-to-buf (buffer)
	3156	"Return the serialization (a wg-buf) of Emacs buffer BUFFER."
	3157	(with-current-buffer buffer
	3158	(wg-make-buf
	3159	:name (buffer-name)
	3160	:file-name (buffer-file-name)
	3161	:point (point)
	3162	:mark (mark)
	3163	:local-vars (wg-serialize-buffer-local-variables)
	3164	:special-data (wg-buffer-special-data buffer))))
	3165
	3166	(defun wg-add-buffer-to-buf-list (buffer)
	3167	"Make a buf from BUFFER, and add it to `wg-buf-list' if necessary.
	3168	If there isn't already a buf corresponding to BUFFER in
	3169	`wg-buf-list', make one and add it. Return BUFFER's uid
	3170	in either case."
	3171	(when buffer
	3172	(with-current-buffer buffer
	3173	(setq wg-buffer-uid
	3174	(aif (wg-find-buffer-in-buf-list buffer (wg-buf-list))
	3175	(wg-buf-uid it)
	3176	(let ((buf (wg-buffer-to-buf buffer)))
	3177	(push buf (wg-buf-list))
	3178	(wg-buf-uid buf)))))))
	3179
	3180	(defun wg-buffer-uid-or-add (buffer)
	3181	"Return BUFFER's uid.
	3182	If there isn't already a buf corresponding to BUFFER in
	3183	`wg-buf-list', make one and add it."
	3184	(or (wg-buffer-uid buffer) (wg-add-buffer-to-buf-list buffer)))
	3185
	3186	(defun wg-bufobj-uid-or-add (bufobj)
	3187	"If BUFOBJ is a wg-buf, return its uid.
	3188	If BUFOBJ is a buffer or a buffer name, see `wg-buffer-uid-or-add'."
	3189	(cl-etypecase bufobj
	3190	(wg-buf (wg-buf-uid bufobj)) ;; possibly also add to `wg-buf-list'
	3191	(buffer (wg-buffer-uid-or-add bufobj))
	3192	(string (wg-bufobj-uid-or-add (wg-get-buffer bufobj)))))
	3193
	3194	(defun wg-reset-buffer (buffer)
	3195	"Return BUFFER.
	3196	Currently only sets BUFFER's `wg-buffer-uid' to nil."
	3197	(with-current-buffer buffer (setq wg-buffer-uid nil)))
	3198
	3199	(defun wg-update-buffer-in-buf-list (&optional buffer)
	3200	"Update BUFFER's corresponding buf in `wg-buf-list'.
	3201	BUFFER nil defaults to `current-buffer'."
	3202	(let ((buffer (or buffer (current-buffer))))
	3203	(-when-let* ((uid (wg-buffer-uid buffer))
	3204	(old-buf (wg-find-buf-by-uid uid))
	3205	(new-buf (wg-buffer-to-buf buffer)))
	3206	(setf (wg-buf-uid new-buf) (wg-buf-uid old-buf))
	3207	(wg-asetf (wg-buf-list) (cons new-buf (remove old-buf it))))))
	3208
	3209	(defvar wg-just-exited-minibuffer nil
	3210	"Flag set by `minibuffer-exit-hook'.
	3211	To exempt from undoification those window-configuration changes
	3212	caused by exiting the minibuffer. This is ugly, but necessary.
	3213	It may seem like we could just null out
	3214	`wg-undoify-window-configuration-change' in
	3215	`minibuffer-exit-hook', but that also prevents undoification of
	3216	window configuration changes triggered by commands called with
	3217	`execute-extended-command' -- i.e. it's just too coarse.")
	3218
	3219	(defcustom wg-no-confirm-on-destructive-operation nil
	3220	"Do not request confirmation before various destructive operations."
	3221	:type 'boolean
	3222	:group 'workgroups)
	3223
	3224	(defcustom wg-minibuffer-message-timeout 0.75
	3225	"Bound to `minibuffer-message-timeout' when messaging while the
	3226	minibuffer is active."
	3227	:type 'float
	3228	:group 'workgroups)
	3229
	3230	(defun wg-read-object (prompt test warning &optional initial-contents keymap
	3231	read hist default-value inherit-input-method)
	3232	"PROMPT for an object that satisfies TEST. WARNING if necessary.
	3233	INITIAL-CONTENTS KEYMAP READ HIST DEFAULT-VALUE
	3234	INHERIT-INPUT-METHOD are `read-from-minibuffer's args."
	3235	(cl-labels ((read () (read-from-minibuffer
	3236	prompt initial-contents keymap read hist
	3237	default-value inherit-input-method)))
	3238	(let ((obj (read)))
	3239	(when (and (equal obj "") default-value) (setq obj default-value))
	3240	(while (not (funcall test obj))
	3241	(message warning)
	3242	(sit-for wg-minibuffer-message-timeout)
	3243	(setq obj (read)))
	3244	obj)))
	3245
	3246	(defun wg-read-new-workgroup-name (&optional prompt)
	3247	"Read a non-empty name string from the minibuffer.
	3248	Print PROMPT"
	3249	(let ((default (wg-new-default-workgroup-name)))
	3250	(wg-read-object
	3251	(or prompt (format "Name (default: %S): " default))
	3252	(lambda (new) (and (stringp new)
	3253	(not (equal new ""))
	3254	(wg-unique-workgroup-name-p new)))
	3255	"Please enter a unique, non-empty name"
	3256	nil nil nil nil default)))
	3257
	3258	(defun wg-read-workgroup-index ()
	3259	"Prompt for the index of a workgroup."
	3260	(let ((max (1- (length (wg-workgroup-list-or-error)))))
	3261	(wg-read-object
	3262	(format "%s\n\nEnter [0-%d]: " (wg-workgroup-list-display) max)
	3263	(lambda (obj) (and (integerp obj) (wg-within obj 0 max t)))
	3264	(format "Please enter an integer [%d-%d]" 0 max)
	3265	nil nil t)))
	3266
	3267	(defun wg-minibuffer-inactive-p ()
	3268	"Return t when `minibuffer-depth' is zero, nil otherwise."
	3269	(zerop (minibuffer-depth)))
	3270
	3271	(defun wg-barf-on-active-minibuffer ()
	3272	"Throw an error when the minibuffer is active."
	3273	(when (not (wg-minibuffer-inactive-p))
	3274	(error "Exit minibuffer to use workgroups functions!")))
	3275
	3276	(defvar wg-deactivation-list nil
	3277	"A stack of workgroups that are currently being switched away from.
	3278	Used to avoid associating the old workgroup's buffers with the
	3279	new workgroup during a switch.")
	3280
	3281	(defun wg-flag-session-modified (&optional session)
	3282	"Set SESSION's modified flag."
	3283	(when (and wg-flag-modified
	3284	(or session (wg-current-session t)))
	3285	(setf (wg-session-modified (or session (wg-current-session t))) t)))
	3286
	3287	(defun wg-flag-workgroup-modified (&optional workgroup)
	3288	"Set WORKGROUP's and the current session's modified flags."
	3289	(unless workgroup
	3290	(setq workgroup (wg-get-workgroup nil t)))
	3291	(when (and wg-flag-modified workgroup)
	3292	(setf (wg-workgroup-modified workgroup) t)
	3293	(wg-flag-session-modified)))
	3294
	3295	(defun wg-current-workgroup (&optional noerror frame)
	3296	"Return current workgroup in frame.
	3297	Error unless NOERROR, in FRAME if specified."
	3298	(or wg-current-workgroup
	3299	(aif (frame-parameter frame 'wg-current-workgroup-uid)
	3300	(wg-find-workgroup-by :uid it noerror)
	3301	(unless noerror (error "No current workgroup in this frame")))))
	3302
	3303	(defun wg-previous-workgroup (&optional noerror frame)
	3304	"Return the previous workgroup in FRAME, or error unless NOERROR."
	3305	(aif (frame-parameter frame 'wg-previous-workgroup-uid)
	3306	(wg-find-workgroup-by :uid it noerror)
	3307	(unless noerror (error "No previous workgroup in this frame"))))
	3308
	3309	(defun wg-set-current-workgroup (workgroup &optional frame)
	3310	"Set the current workgroup to WORKGROUP in FRAME.
	3311	WORKGROUP should be a workgroup or nil."
	3312	(set-frame-parameter frame 'wg-current-workgroup-uid
	3313	(when workgroup (wg-workgroup-uid workgroup))))
	3314
	3315	(defun wg-set-previous-workgroup (workgroup &optional frame)
	3316	"Set the previous workgroup to WORKGROUP in FRAME.
	3317	WORKGROUP should be a workgroup or nil."
	3318	(set-frame-parameter frame 'wg-previous-workgroup-uid
	3319	(when workgroup (wg-workgroup-uid workgroup))))
	3320
	3321	(defun wg-current-workgroup-p (workgroup &optional frame)
	3322	"Return t when WORKGROUP is the current workgroup, nil otherwise."
	3323	(awhen (wg-current-workgroup t frame)
	3324	(eq workgroup it)))
	3325
	3326	(defun wg-previous-workgroup-p (workgroup &optional frame)
	3327	"Return t when WORKGROUP is the previous workgroup, nil otherwise."
	3328	(awhen (wg-previous-workgroup t frame)
	3329	(eq workgroup it)))
	3330
	3331	(defun wg-get-workgroup (obj &optional noerror)
	3332	"Return a workgroup from OBJ.
	3333	If OBJ is a workgroup, return it.
	3334	If OBJ is a string, return the workgroup named OBJ, or error unless NOERROR.
	3335	If OBJ is nil, return the current workgroup, or error unless NOERROR."
	3336	(cond ((wg-workgroup-p obj) obj)
	3337	((stringp obj) (wg-find-workgroup-by :name obj noerror))
	3338	((null obj) (wg-current-workgroup noerror))
	3339	(t (error "Can't get workgroup from type:: %S" (type-of obj)))))
	3340
	3341
	3342	;;; workgroup parameters
	3343	;;
	3344	;; Quick test:
	3345	;; (wg-workgroup-parameters (wg-current-workgroup))
	3346	;; (wg-set-workgroup-parameter (wg-current-workgroup) 'test1 t)
	3347	;; (wg-workgroup-parameter (wg-current-workgroup) 'test1)
	3348	(defun wg-workgroup-parameter (workgroup parameter &optional default)
	3349	"Return WORKGROUP's value for PARAMETER.
	3350	If PARAMETER is not found, return DEFAULT which defaults to nil.
	3351	WORKGROUP should be accepted by `wg-get-workgroup'."
	3352	(wg-aget (wg-workgroup-parameters (wg-get-workgroup workgroup))
	3353	parameter default))
	3354
	3355	(defun wg-set-workgroup-parameter (parameter value &optional workgroup)
	3356	"Set PARAMETER to VALUE in a WORKGROUP.
	3357	WORKGROUP should be a value accepted by `wg-get-workgroup'.
	3358	Return VALUE."
	3359	(-when-let (workgroup (wg-get-workgroup (or workgroup (wg-current-workgroup t)) t))
	3360	(wg-set-parameter (wg-workgroup-parameters workgroup) parameter value)
	3361	(wg-flag-workgroup-modified workgroup)
	3362	value))
	3363
	3364	(defun wg-remove-workgroup-parameter (parameter &optional workgroup)
	3365	"Remove PARAMETER from WORKGROUP's parameters."
	3366	(-when-let (workgroup (wg-get-workgroup workgroup t))
	3367	(wg-flag-workgroup-modified workgroup)
	3368	(wg-asetf (wg-workgroup-parameters workgroup) (wg-aremove it parameter))))
	3369
	3370	(defun wg-workgroup-local-value (variable &optional workgroup)
	3371	"Return the value of VARIABLE in WORKGROUP.
	3372	WORKGROUP nil defaults to the current workgroup. If there is no
	3373	current workgroup, or if VARIABLE does not have a workgroup-local
	3374	binding in WORKGROUP, resolve VARIABLE with `wg-session-local-value'."
	3375	(let ((workgroup (wg-get-workgroup workgroup t)))
	3376	(if (not workgroup) (wg-session-local-value variable)
	3377	(let* ((undefined (cl-gensym))
	3378	(value (wg-workgroup-parameter workgroup variable undefined)))
	3379	(if (not (eq value undefined)) value
	3380	(wg-session-local-value variable))))))
	3381	(defalias 'wg-local-value 'wg-workgroup-local-value)
	3382
	3383
	3384	(defun wg-workgroup-saved-wconfig-names (workgroup)
	3385	"Return a new list of the names of all WORKGROUP's saved wconfigs."
	3386	(mapcar 'wg-wconfig-name (wg-workgroup-saved-wconfigs workgroup)))
	3387
	3388	(defun wg-workgroup-get-saved-wconfig (wconfig-or-name &optional workgroup)
	3389	"Return the wconfig by WCONFIG-OR-NAME from WORKGROUP's saved wconfigs.
	3390	WCONFIG-OR-NAME must be either a string or a wconfig. If
	3391	WCONFIG-OR-NAME is a string and there is no saved wconfig with
	3392	that name, return nil. If WCONFIG-OR-NAME is a wconfig, and it
	3393	is a member of WORKGROUP's saved wconfigs, return is as given.
	3394	Otherwise return nil."
	3395	(let ((wconfigs (wg-workgroup-saved-wconfigs (or workgroup (wg-current-workgroup)))))
	3396	(cl-etypecase wconfig-or-name
	3397	(wg-wconfig (car (memq wconfig-or-name wconfigs)))
	3398	(string (cl-find wconfig-or-name wconfigs
	3399	:key 'wg-wconfig-name
	3400	:test 'string=)))))
	3401
	3402	(defun wg-workgroup-save-wconfig (wconfig &optional workgroup)
	3403	"Add WCONFIG to WORKGROUP's saved wconfigs.
	3404	WCONFIG must have a name. If there's already a wconfig with the
	3405	same name in WORKGROUP's saved wconfigs, replace it."
	3406	(let ((name (wg-wconfig-name wconfig)))
	3407	(unless name (error "Attempt to save a nameless wconfig"))
	3408	(setf (wg-workgroup-modified workgroup) t)
	3409	(wg-asetf (wg-workgroup-saved-wconfigs workgroup)
	3410	(cons wconfig (cl-remove name it
	3411	:key 'wg-wconfig-name
	3412	:test 'string=)))))
	3413
	3414	(defun wg-workgroup-kill-saved-wconfig (workgroup wconfig-or-name)
	3415	"Delete WCONFIG-OR-NAME from WORKGROUP's saved wconfigs.
	3416	WCONFIG-OR-NAME is resolved with `wg-workgroup-get-saved-wconfig'."
	3417	(-when-let (wconfig (wg-workgroup-get-saved-wconfig
	3418	workgroup wconfig-or-name))
	3419	(wg-asetf (wg-workgroup-saved-wconfigs workgroup) (remq wconfig it)
	3420	(wg-workgroup-modified workgroup) t)))
	3421
	3422
	3423
	3424	(defun wg-workgroup-base-wconfig-buf-uids (workgroup)
	3425	"Return a new list of all unique buf uids in WORKGROUP's working wconfig."
	3426	(wg-wconfig-buf-uids (wg-workgroup-base-wconfig workgroup)))
	3427
	3428	(defun wg-workgroup-saved-wconfigs-buf-uids (workgroup)
	3429	"Return a new list of all unique buf uids in WORKGROUP's base wconfig."
	3430	(cl-reduce 'wg-string-list-union
	3431	(wg-workgroup-saved-wconfigs workgroup)
	3432	:key 'wg-wconfig-buf-uids))
	3433
	3434	(defun wg-workgroup-all-wconfig-buf-uids (workgroup)
	3435	"Return a new list of all unique buf uids in WORKGROUP's wconfigs."
	3436	(cl-union (wg-workgroup-base-wconfig-buf-uids workgroup)
	3437	(wg-workgroup-saved-wconfigs-buf-uids workgroup)
	3438	:test 'string=))
	3439
	3440	(defun wg-workgroup-all-buf-uids (workgroup)
	3441	"Return a new list of all unique buf uids in WORKGROUP."
	3442	(cl-reduce 'wg-string-list-union
	3443	(list (wg-workgroup-base-wconfig-buf-uids workgroup)
	3444	(wg-workgroup-saved-wconfigs-buf-uids workgroup))))
	3445
	3446	(defun wg-restore-workgroup (workgroup)
	3447	"Restore WORKGROUP in `selected-frame'."
	3448	(let (wg-flag-modified)
	3449	(wg-restore-wconfig-undoably (wg-workgroup-working-wconfig workgroup) t)))
	3450
	3451	(defun wg-workgroup-list-or-error (&optional noerror)
	3452	"Return the value of `wg-current-session's :workgroup-list slot.
	3453	Or scream unless NOERROR."
	3454	(aif (wg-current-session noerror)
	3455	(or (wg-session-workgroup-list it)
	3456	(unless noerror (error "No workgroups are defined.")))
	3457	(unless noerror (error "Current session is nil. No workgroups are defined"))))
	3458
	3459	(defun wg-find-workgroup-by (slotkey value &optional noerror)
	3460	"Return the workgroup on which ACCESSOR returns VALUE or error."
	3461	(let ((accessor (cl-ecase slotkey
	3462	(:name 'wg-workgroup-name)
	3463	(:uid 'wg-workgroup-uid))))
	3464	(or (cl-find value (wg-workgroup-list-or-error noerror) :test 'equal :key accessor)
	3465	(unless noerror
	3466	(error "There are no workgroups with a %S of %S"
	3467	accessor value)))))
	3468
	3469	(defun wg-cyclic-nth-from-workgroup (workgroup &optional n)
	3470	"Return the workgroup N places from WORKGROUP in `wg-workgroup-list'."
	3471	(wg-cyclic-nth-from-elt workgroup (wg-workgroup-list-or-error) (or n 1)))
	3472
	3473	(defun wg-workgroup-names (&optional noerror)
	3474	"Return a list of workgroup names or scream unless NOERROR."
	3475	(mapcar 'wg-workgroup-name (wg-workgroup-list-or-error noerror)))
	3476
	3477	(defun wg-read-workgroup-name (&optional require-match)
	3478	"Read a workgroup name from `wg-workgroup-names'.
	3479	REQUIRE-MATCH to match."
	3480	(wg-completing-read "Workgroup: " (wg-workgroup-names) nil require-match nil nil
	3481	(awhen (wg-current-workgroup t) (wg-workgroup-name it))))
	3482
	3483	(defun wg-new-default-workgroup-name ()
	3484	"Return a new, unique, default workgroup name."
	3485	(let ((names (wg-workgroup-names t)) (index -1) result)
	3486	(while (not result)
	3487	(let ((new-name (format "wg%s" (cl-incf index))))
	3488	(unless (member new-name names)
	3489	(setq result new-name))))
	3490	result))
	3491
	3492	(defun wg-unique-workgroup-name-p (new-name)
	3493	"Return t if NEW-NAME is unique in `wg-workgroup-list', nil otherwise."
	3494	(cl-every (lambda (existing-name) (not (equal new-name existing-name)))
	3495	(wg-workgroup-names t)))
	3496
	3497	(defun wg-read-saved-wconfig-name (workgroup &optional prompt require-match)
	3498	"Read the name of a saved wconfig, completing on the names of
	3499	WORKGROUP's saved wconfigs."
	3500	(wg-completing-read (or prompt "Saved wconfig name: ")
	3501	(wg-workgroup-saved-wconfig-names workgroup)
	3502	nil require-match))
	3503
	3504	(defun wg-read-saved-wconfig (workgroup)
	3505	"Read the name of and return one of WORKGROUP's saved wconfigs."
	3506	(wg-workgroup-get-saved-wconfig
	3507	workgroup (wg-read-saved-wconfig-name workgroup nil t)))
	3508
	3509
	3510	;;; workgroup-list reorganization commands
	3511
	3512	(defun wg-swap-workgroups ()
	3513	"Swap the previous and current workgroups."
	3514	(interactive)
	3515	(wg-swap-workgroups-in-workgroup-list
	3516	(wg-current-workgroup) (wg-previous-workgroup))
	3517	(wg-fontified-message
	3518	(:cmd "Swapped: ")
	3519	(wg-workgroup-list-display)))
	3520
	3521	(defun wg-offset-workgroup-left (&optional workgroup n)
	3522	"Offset WORKGROUP leftward in `wg-workgroup-list' cyclically."
	3523	(interactive (list nil current-prefix-arg))
	3524	(wg-cyclic-offset-workgroup (wg-get-workgroup workgroup) (or n -1))
	3525	(wg-fontified-message
	3526	(:cmd "Offset left: ")
	3527	(wg-workgroup-list-display)))
	3528
	3529	(defun wg-offset-workgroup-right (&optional workgroup n)
	3530	"Offset WORKGROUP rightward in `wg-workgroup-list' cyclically."
	3531	(interactive (list nil current-prefix-arg))
	3532	(wg-cyclic-offset-workgroup (wg-get-workgroup workgroup) (or n 1))
	3533	(wg-fontified-message
	3534	(:cmd "Offset right: ")
	3535	(wg-workgroup-list-display)))
	3536
	3537
	3538	;;; undo/redo commands
	3539
	3540	(defun wg-undo-wconfig-change (&optional workgroup)
	3541	"Undo a change to the current workgroup's window-configuration."
	3542	(interactive)
	3543	(let* ((workgroup (wg-get-workgroup workgroup))
	3544	(undid? (wg-workgroup-offset-position-in-undo-list workgroup 1)))
	3545	(wg-fontified-message
	3546	(:cmd "Undo")
	3547	(:cur (if undid? "" " No more undo info")))))
	3548
	3549	(defun wg-redo-wconfig-change (&optional workgroup)
	3550	"Redo a change to the current workgroup's window-configuration."
	3551	(interactive)
	3552	(let* ((workgroup (wg-get-workgroup workgroup))
	3553	(redid? (wg-workgroup-offset-position-in-undo-list workgroup -1)))
	3554	(wg-fontified-message
	3555	(:cmd "Redo")
	3556	(:cur (if redid? "" " No more redo info")))))
	3557
	3558	(defun wg-undo-once-all-workgroups ()
	3559	"Do what the name says. Useful for instance when you
	3560	accidentally call `wg-revert-all-workgroups' and want to return
	3561	all workgroups to their un-reverted state."
	3562	(interactive)
	3563	(mapc 'wg-undo-wconfig-change (wg-workgroup-list-or-error))
	3564	(wg-message "Undid once on all workgroups."))
	3565
	3566	(defun wg-redo-once-all-workgroups ()
	3567	"Do what the name says. Probably useless. Included for
	3568	symetry with `wg-undo-once-all-workgroups'."
	3569	(interactive)
	3570	(mapc 'wg-redo-wconfig-change (wg-workgroup-list-or-error))
	3571	(wg-message "Redid once on all workgroups."))
	3572
	3573
	3574
	3575	;;; window-tree commands
	3576	;;
	3577	;; TODO: These are half-hearted. Clean them up; allow specification of the
	3578	;; window-tree depth at which to operate; add complex window creation commands;
	3579	;; and add window splitting, deletion and locking commands.
	3580
	3581	(defun wg-reverse-frame-horizontally (&optional workgroup)
	3582	"Reverse the order of all horizontally split wtrees."
	3583	(interactive)
	3584	(wg-restore-wconfig-undoably
	3585	(wg-reverse-wconfig
	3586	(wg-workgroup-working-wconfig
	3587	(wg-get-workgroup workgroup)))))
	3588
	3589	(defun wg-reverse-frame-vertically (&optional workgroup)
	3590	"Reverse the order of all vertically split wtrees."
	3591	(interactive)
	3592	(wg-restore-wconfig-undoably
	3593	(wg-reverse-wconfig
	3594	(wg-workgroup-working-wconfig
	3595	(wg-get-workgroup workgroup))
	3596	t)))
	3597
	3598	(defun wg-reverse-frame-horizontally-and-vertically (&optional workgroup)
	3599	"Reverse the order of all wtrees."
	3600	(interactive)
	3601	(wg-restore-wconfig-undoably
	3602	(wg-reverse-wconfig
	3603	(wg-workgroup-working-wconfig
	3604	(wg-get-workgroup workgroup))
	3605	'both)))
	3606
	3607	(defun wg-rename-workgroup (newname &optional workgroup)
	3608	"Set NEWNAME to WORKGROUP's name."
	3609	(interactive (list (wg-read-new-workgroup-name "New name: ") nil))
	3610	(-when-let (workgroup (wg-get-workgroup workgroup))
	3611	(let* ((oldname (wg-workgroup-name workgroup)))
	3612	(setf (wg-workgroup-name workgroup) newname)
	3613	(wg-flag-workgroup-modified workgroup)
	3614	(wg-fontified-message
	3615	(:cmd "Renamed: ")
	3616	(:cur oldname)
	3617	(:msg " to ")
	3618	(:cur (wg-workgroup-name workgroup))))))
	3619
	3620	(defun wg-reset (&optional force)
	3621	"Reset Workgroups.
	3622	Resets all frame parameters, buffer-local vars, the current
	3623	Workgroups session object, etc."
	3624	(interactive "P")
	3625	(unless (or force wg-no-confirm-on-destructive-operation
	3626	(y-or-n-p "Really reset Workgroups? "))
	3627	(error "Canceled"))
	3628	(wg-reset-internal)
	3629	(wg-fontified-message (:cmd "Reset: ") (:msg "Workgroups")))
	3630
	3631	(defun wg-query-and-save-if-modified ()
	3632	"Query for save when `wg-modified-p'."
	3633	(or (not (wg-modified-p))
	3634	(when (y-or-n-p "Save modified workgroups? ")
	3635	(wg-save-session))))
	3636
	3637	(defun wg-create-workgroup (name &optional blank)
	3638	"Create and add a workgroup named NAME.
	3639	Optional argument BLANK non-nil (set interactively with a prefix
	3640	arg) means use a blank, one window window-config. Otherwise use
	3641	the current window-configuration. Keep in mind that even though
	3642	the current window-config may be used, other parameters of the
	3643	current workgroup are not copied to the created workgroup. For
	3644	that, use `wg-clone-workgroup'."
	3645	(interactive (list (wg-read-new-workgroup-name) current-prefix-arg))
	3646	(wg-switch-to-workgroup (wg-make-and-add-workgroup name blank))
	3647	(wg-fontified-message
	3648	(:cmd "Created: ") (:cur name) " " (wg-workgroup-list-display)))
	3649
	3650	(defun wg-clone-workgroup (workgroup name)
	3651	"Create and add a clone of WORKGROUP named NAME.
	3652	Keep in mind that only WORKGROUP's top level alist structure is
	3653	copied, so destructive operations on the keys or values of
	3654	WORKGROUP will be reflected in the clone, and vice-versa. Be
	3655	safe -- don't mutate them."
	3656	(interactive (list nil (wg-read-new-workgroup-name)))
	3657	(let* ((workgroup (wg-get-workgroup workgroup))
	3658	(clone (wg-copy-workgroup workgroup)))
	3659	(setf (wg-workgroup-name clone) name
	3660	(wg-workgroup-uid clone) (wg-generate-uid))
	3661	(when (wg-check-and-add-workgroup clone)
	3662	(wg-flag-workgroup-modified clone))
	3663	(wg-set-workgroup-working-wconfig
	3664	clone (wg-workgroup-working-wconfig workgroup))
	3665	(wg-switch-to-workgroup clone)
	3666	(wg-fontified-message
	3667	(:cmd "Cloned: ")
	3668	(:cur (wg-workgroup-name workgroup))
	3669	(:msg " to ")
	3670	(:cur name) " "
	3671	(wg-workgroup-list-display))))
	3672
	3673	(defun wg-switch-to-workgroup (workgroup &optional noerror)
	3674	"Switch to WORKGROUP.
	3675	NOERROR means fail silently."
	3676	(interactive (list (wg-read-workgroup-name)))
	3677	(fset 'buffer-list wg-buffer-list-original)
	3678	(let ((workgroup (wg-get-workgroup-create workgroup))
	3679	(current (wg-current-workgroup t)))
	3680	(when (and (eq workgroup current) (not noerror))
	3681	(error "Already on: %s" (wg-workgroup-name current)))
	3682	(when current (push current wg-deactivation-list))
	3683	(unwind-protect
	3684	(progn
	3685	;; Before switch
	3686	(run-hooks 'wg-before-switch-to-workgroup-hook)
	3687	;; Save info about some hard-to-work-with libraries
	3688	(let (wg-flag-modified)
	3689	(wg-set-workgroup-parameter 'ecb (and (boundp 'ecb-minor-mode)
	3690	ecb-minor-mode)))
	3691	;;(wg-set-workgroup-parameter (wg-current-workgroup t) 'ecb-win-config (ecb-current-window-configuration))
	3692	;; (type-of (ecb-current-window-configuration))
	3693	;; (type-of (car (ecb-current-window-configuration)))
	3694	;; (type-of (car (nthcdr 3 (ecb-current-window-configuration))))
	3695	;; (wg-pickelable-or-error (ecb-current-window-configuration))
	3696	;;(ecb-current-window-configuration)
	3697	;;)
	3698
	3699	;; Before switching - turn off ECB
	3700	;; https://github.com/pashinin/workgroups2/issues/34
	3701	(if (and (boundp 'ecb-minor-mode)
	3702	(boundp 'ecb-frame)
	3703	(fboundp 'ecb-deactivate)
	3704	ecb-minor-mode
	3705	(equal ecb-frame (selected-frame)))
	3706	(let ((ecb-split-edit-window-after-start 'before-deactivation))
	3707	(ecb-deactivate)))
	3708
	3709	;; Switch
	3710	(wg-restore-workgroup workgroup)
	3711	(wg-set-previous-workgroup current)
	3712	(wg-set-current-workgroup workgroup)
	3713
	3714	;; After switch
	3715	;; Save "last-workgroup" to the session params
	3716	(let (wg-flag-modified)
	3717	(awhen (wg-current-workgroup t)
	3718	(wg-set-session-parameter 'last-workgroup (wg-workgroup-name it)))
	3719	(awhen (wg-previous-workgroup t)
	3720	(wg-set-session-parameter 'prev-workgroup (wg-workgroup-name it))))
	3721
	3722	;; If a workgroup had ECB - turn it on
	3723	(if (and (boundp 'ecb-minor-mode)
	3724	(not ecb-minor-mode)
	3725	(fboundp 'ecb-activate)
	3726	(wg-workgroup-parameter (wg-current-workgroup t) 'ecb nil))
	3727	(let ((ecb-split-edit-window-after-start 'before-deactivation))
	3728	(ecb-activate)))
	3729	;;(ecb-last-window-config-before-deactivation
	3730	;; (wg-workgroup-parameter (wg-current-workgroup t) 'ecb-win-config nil)))
	3731
	3732	;; `sr-speedbar'
	3733	;; if SPEEDBAR buffer is visible - set some variables
	3734	(let* ((buffers (mapcar 'window-buffer (window-list)))
	3735	(buffer-names (mapcar 'buffer-name buffers)))
	3736	(when (and (featurep 'sr-speedbar)
	3737	(member sr-speedbar-buffer-name buffer-names))
	3738	(setq sr-speedbar-window (get-buffer-window sr-speedbar-buffer-name))))
	3739
	3740	;; Finally
	3741	(if wg-mess-with-buffer-list
	3742	(fset 'buffer-list wg-buffer-list-function))
	3743	(wg-fontified-message (:cmd "Switched: ") (wg-workgroup-name (wg-current-workgroup t)))
	3744	(run-hooks 'wg-after-switch-to-workgroup-hook))
	3745	(when current (pop wg-deactivation-list)))))
	3746
	3747	(defun wg-switch-to-workgroup-at-index (index)
	3748	"Switch to the workgroup at INDEX in `wg-workgroup-list'."
	3749	(interactive (list (or current-prefix-arg (wg-read-workgroup-index))))
	3750	(let ((wl (wg-workgroup-list-or-error)))
	3751	(wg-switch-to-workgroup
	3752	(or (nth index wl) (error "There are only %d workgroups" (length wl))))))
	3753
	3754	(cl-macrolet
	3755	((define-range-of-switch-to-workgroup-at-index (num)
	3756	`(progn
	3757	,@(wg-docar (i (wg-range 0 num))
	3758	`(defun ,(intern (format "wg-switch-to-workgroup-at-index-%d" i)) ()
	3759	,(format "Switch to the workgroup at index %d." i)
	3760	(interactive)
	3761	(wg-switch-to-workgroup-at-index ,i))))))
	3762	(define-range-of-switch-to-workgroup-at-index 10))
	3763
	3764	(defun wg-switch-to-cyclic-nth-from-workgroup (workgroup n)
	3765	"Switch N workgroups cyclically from WORKGROUP in `wg-workgroup-list.'"
	3766	(let ((workgroup-list (wg-workgroup-list-or-error))
	3767	(workgroup (wg-get-workgroup workgroup t)))
	3768	(wg-switch-to-workgroup
	3769	(cond ((not workgroup) (car workgroup-list))
	3770	((= 1 (length workgroup-list)) (error "There's only one workgroup"))
	3771	(t (wg-cyclic-nth-from-workgroup workgroup n))))))
	3772
	3773	(defun wg-switch-to-workgroup-left (&optional workgroup n)
	3774	"Switch to WORKGROUP that is (- N) places away from WORKGROUP in `wg-workgroup-list'.
	3775	Use `current-prefix-arg' for N if non-nil. Otherwise N defaults to 1."
	3776	(interactive (list nil current-prefix-arg))
	3777	(wg-switch-to-cyclic-nth-from-workgroup workgroup (- (or n 1))))
	3778
	3779	(defun wg-switch-to-workgroup-right (&optional workgroup n)
	3780	"Switch to the workgroup N places from WORKGROUP in `wg-workgroup-list'.
	3781	Use `current-prefix-arg' for N if non-nil. Otherwise N defaults to 1."
	3782	(interactive (list nil current-prefix-arg))
	3783	(wg-switch-to-cyclic-nth-from-workgroup workgroup (or n 1)))
	3784
	3785	(defun wg-switch-to-previous-workgroup ()
	3786	"Switch to the previous workgroup."
	3787	(interactive)
	3788	(wg-switch-to-workgroup (wg-previous-workgroup)))
	3789
	3790	(defun wg-wconfig-kill-ring ()
	3791	"Return `wg-wconfig-kill-ring', creating it first if necessary."
	3792	(or wg-wconfig-kill-ring
	3793	(setq wg-wconfig-kill-ring (make-ring wg-wconfig-kill-ring-max))))
	3794
	3795	(defun wg-add-to-wconfig-kill-ring (wconfig)
	3796	"Add WCONFIG to `wg-wconfig-kill-ring'."
	3797	(ring-insert (wg-wconfig-kill-ring) wconfig))
	3798
	3799	(defun wg-kill-workgroup (&optional workgroup)
	3800	"Kill WORKGROUP, saving its working-wconfig to the kill ring."
	3801	(interactive)
	3802	(let* ((workgroup (wg-get-workgroup workgroup))
	3803	(to (or (wg-previous-workgroup t)
	3804	(wg-cyclic-nth-from-workgroup workgroup))))
	3805	(wg-add-to-wconfig-kill-ring (wg-workgroup-working-wconfig workgroup))
	3806	(wg-delete-workgroup workgroup)
	3807	(if (eq workgroup to) (wg-restore-wconfig (wg-make-blank-wconfig))
	3808	(wg-switch-to-workgroup to))
	3809	(wg-fontified-message
	3810	(:cmd "Killed: ")
	3811	(:cur (wg-workgroup-name workgroup)) " "
	3812	(wg-workgroup-list-display))))
	3813
	3814	(defun wg-kill-ring-save-base-wconfig (&optional workgroup)
	3815	"Save WORKGROUP's base wconfig to the kill ring."
	3816	(interactive)
	3817	(let ((workgroup (wg-get-workgroup workgroup)))
	3818	(wg-add-to-wconfig-kill-ring (wg-workgroup-base-wconfig workgroup))
	3819	(wg-fontified-message
	3820	(:cmd "Saved: ") (:cur (wg-workgroup-name workgroup))
	3821	(:cur "'s ") (:msg "base wconfig to the kill ring"))))
	3822
	3823	(defun wg-kill-ring-save-working-wconfig (&optional workgroup)
	3824	"Save WORKGROUP's working-wconfig to `wg-wconfig-kill-ring'."
	3825	(interactive)
	3826	(let ((workgroup (wg-get-workgroup workgroup)))
	3827	(wg-add-to-wconfig-kill-ring (wg-workgroup-working-wconfig workgroup))
	3828	(wg-fontified-message
	3829	(:cmd "Saved: ") (:cur (wg-workgroup-name workgroup))
	3830	(:cur "'s ") (:msg "working-wconfig to the kill ring"))))
	3831
	3832	(defun wg-yank-wconfig ()
	3833	"Restore a wconfig from `wg-wconfig-kill-ring'.
	3834	Successive yanks restore wconfigs sequentially from the kill
	3835	ring, starting at the front."
	3836	(interactive)
	3837	(when (zerop (ring-length (wg-wconfig-kill-ring)))
	3838	(error "The kill-ring is empty"))
	3839	(let ((pos (if (not (eq real-last-command 'wg-yank-wconfig)) 0
	3840	(1+ (or (get 'wg-yank-wconfig :position) 0)))))
	3841	(put 'wg-yank-wconfig :position pos)
	3842	(wg-restore-wconfig-undoably (ring-ref (wg-wconfig-kill-ring) pos))
	3843	(wg-fontified-message
	3844	(:cmd "Yanked: ")
	3845	(:msg (format "%S" pos)) " "
	3846	(wg-workgroup-list-display))))
	3847
	3848	(defun wg-kill-workgroup-and-buffers (&optional workgroup)
	3849	"Kill WORKGROUP and the buffers in its working-wconfig."
	3850	(interactive)
	3851	(let* ((workgroup (wg-get-workgroup workgroup))
	3852	(bufs (save-window-excursion
	3853	(wg-restore-workgroup workgroup)
	3854	(mapcar #'window-buffer (window-list)))))
	3855	(wg-kill-workgroup workgroup)
	3856	(mapc #'kill-buffer bufs)
	3857	(wg-fontified-message
	3858	(:cmd "Killed: ")
	3859	(:cur (wg-workgroup-name workgroup))
	3860	(:msg " and its buffers ") "\n"
	3861	(wg-workgroup-list-display))))
	3862
	3863	(defun wg-delete-other-workgroups (&optional workgroup)
	3864	"Delete all workgroups but WORKGROUP."
	3865	(interactive)
	3866	(let ((workgroup (wg-get-workgroup workgroup)))
	3867	(unless (or wg-no-confirm-on-destructive-operation
	3868	(y-or-n-p "Really delete all other workgroups? "))
	3869	(error "Cancelled"))
	3870	(dolist (w (wg-workgroup-list-or-error))
	3871	(unless (eq w workgroup)
	3872	(wg-delete-workgroup w)))
	3873	(unless (wg-current-workgroup-p workgroup)
	3874	(wg-switch-to-workgroup workgroup))
	3875	(wg-fontified-message
	3876	(:cmd "Deleted: ")
	3877	(:msg "All workgroups but ")
	3878	(:cur (wg-workgroup-name workgroup)))))
	3879
	3880	(defun wg-revert-workgroup (&optional workgroup)
	3881	"Restore WORKGROUP's window configuration to its state at the last save."
	3882	(interactive)
	3883	(let* ((workgroup (wg-get-workgroup workgroup))
	3884	(base-wconfig (wg-workgroup-base-wconfig workgroup)))
	3885	(if (wg-current-workgroup-p workgroup)
	3886	(wg-restore-wconfig-undoably base-wconfig)
	3887	(wg-add-wconfig-to-undo-list workgroup base-wconfig))
	3888	(wg-fontified-message
	3889	(:cmd "Reverted: ")
	3890	(:cur (wg-workgroup-name workgroup)))))
	3891
	3892	(defun wg-revert-all-workgroups ()
	3893	"Revert all workgroups to their base wconfigs.
	3894	Only workgroups' working-wconfigs in `selected-frame' are
	3895	reverted."
	3896	(interactive)
	3897	(mapc #'wg-revert-workgroup (wg-workgroup-list-or-error))
	3898	(wg-fontified-message
	3899	(:cmd "Reverted: ")
	3900	(:msg "All")))
	3901
	3902	(defun wg-workgroup-state-table (&optional frame)
	3903	"Return FRAME's workgroup table, creating it first if necessary."
	3904	(or (frame-parameter frame 'wg-workgroup-state-table)
	3905	(let ((wtree (make-hash-table :test 'equal)))
	3906	(set-frame-parameter frame 'wg-workgroup-state-table wtree)
	3907	wtree)))
	3908
	3909	(defun wg-get-workgroup-state (workgroup &optional frame)
	3910	"Return WORKGROUP's state table in a FRAME."
	3911	(let ((uid (wg-workgroup-uid workgroup))
	3912	(state-table (wg-workgroup-state-table frame)))
	3913	(or (gethash uid state-table)
	3914	(let ((wgs (wg-make-workgroup-state
	3915	:undo-pointer 0
	3916	:undo-list
	3917	(list (or (wg-workgroup-selected-frame-wconfig workgroup)
	3918	(wg-workgroup-base-wconfig workgroup))))))
	3919	(puthash uid wgs state-table)
	3920	wgs))))
	3921
	3922	(defmacro wg-with-undo (workgroup spec &rest body)
	3923	"Bind WORKGROUP's undo state to SPEC and eval BODY."
	3924	(declare (indent 2))
	3925	(wg-dbind (state undo-pointer undo-list) spec
	3926	`(let* ((,state (wg-get-workgroup-state ,workgroup))
	3927	(,undo-pointer (wg-workgroup-state-undo-pointer ,state))
	3928	(,undo-list (wg-workgroup-state-undo-list ,state)))
	3929	,@body)))
	3930
	3931	(defun wg-flag-just-exited-minibuffer ()
	3932	"Added to `minibuffer-exit-hook'."
	3933	(setq wg-just-exited-minibuffer t))
	3934
	3935	(defun wg-flag-window-configuration-changed ()
	3936	"Set `wg-window-configuration-changed' to t.
	3937	But only if not the minibuffer was just exited. Added to
	3938	`window-configuration-change-hook'."
	3939	(if wg-just-exited-minibuffer
	3940	(setq wg-just-exited-minibuffer nil)
	3941	(progn
	3942	(wg-flag-workgroup-modified)
	3943	(setq wg-window-configuration-changed t))))
	3944
	3945	(defun wg-unflag-undoify-window-configuration-change ()
	3946	"Set `wg-undoify-window-configuration-change' to nil, exempting
	3947	from undoification any window-configuration changes caused by the
	3948	current command."
	3949	(setq wg-undoify-window-configuration-change nil))
	3950
	3951	(defun wg-set-workgroup-working-wconfig (workgroup wconfig)
	3952	"Set the working-wconfig of WORKGROUP to WCONFIG."
	3953	(wg-flag-workgroup-modified workgroup)
	3954	(setf (wg-workgroup-selected-frame-wconfig workgroup) wconfig)
	3955	(wg-with-undo workgroup (state undo-pointer undo-list)
	3956	(setcar (nthcdr undo-pointer undo-list) wconfig)))
	3957
	3958	(defun wg-add-wconfig-to-undo-list (workgroup wconfig)
	3959	"Add WCONFIG to WORKGROUP's undo list, truncating its future if necessary."
	3960	(wg-with-undo workgroup (state undo-pointer undo-list)
	3961	(let ((undo-list (cons nil (nthcdr undo-pointer undo-list))))
	3962	(awhen (nthcdr wg-wconfig-undo-list-max undo-list) (setcdr it nil))
	3963	(setf (wg-workgroup-state-undo-list state) undo-list))
	3964	(setf (wg-workgroup-state-undo-pointer state) 0))
	3965	(wg-set-workgroup-working-wconfig workgroup wconfig))
	3966
	3967	(defun wg-workgroup-working-wconfig (workgroup &optional noupdate)
	3968	"Return WORKGROUP's working-wconfig.
	3969	If WORKGROUP is the current workgroup in `selected-frame', and
	3970	NOUPDATE is nil, set its working wconfig in `selected-frame' to
	3971	`wg-current-wconfig' and return the updated wconfig. Otherwise
	3972	return WORKGROUP's current undo state."
	3973	(if (and (not noupdate) (wg-current-workgroup-p workgroup))
	3974	(wg-set-workgroup-working-wconfig workgroup (wg-current-wconfig))
	3975	(wg-with-undo workgroup (state undo-pointer undo-list)
	3976	(nth undo-pointer undo-list))))
	3977
	3978	(defun wg-update-current-workgroup-working-wconfig ()
	3979	"Update `selected-frame's current workgroup's working-wconfig with `wg-current-wconfig'."
	3980	(awhen (wg-current-workgroup t)
	3981	(wg-set-workgroup-working-wconfig it (wg-current-wconfig))))
	3982
	3983	(defun wg-restore-wconfig-undoably (wconfig &optional noundo)
	3984	"Restore WCONFIG in `selected-frame', saving undo information.
	3985	Skip undo when NOUNDO."
	3986	(when noundo (wg-unflag-undoify-window-configuration-change))
	3987	(wg-update-current-workgroup-working-wconfig)
	3988	(wg-restore-wconfig wconfig))
	3989
	3990	(defun wg-workgroup-offset-position-in-undo-list (workgroup increment)
	3991	"Increment WORKGROUP's undo-pointer by INCREMENT.
	3992	Also restore the wconfig at the incremented undo-pointer if
	3993	WORKGROUP is current."
	3994	(wg-with-undo workgroup (state undo-pointer undo-list)
	3995	(let ((new-pointer (+ undo-pointer increment)))
	3996	(when (wg-within new-pointer 0 (length undo-list))
	3997	(when (wg-current-workgroup-p workgroup)
	3998	(wg-restore-wconfig-undoably (nth new-pointer undo-list) t))
	3999	(setf (wg-workgroup-state-undo-pointer state) new-pointer)))))
	4000
	4001	(defun wg-undoify-window-configuration-change ()
	4002	"Conditionally `wg-add-wconfig-to-undo-list'.
	4003	Added to `post-command-hook'."
	4004	(when (and wg-window-configuration-changed ;; When the window config has changed,
	4005	wg-undoify-window-configuration-change ;; and undoification is still on for the current command
	4006	(wg-minibuffer-inactive-p)) ;; and the change didn't occur while the minibuffer is active,
	4007	(-when-let (workgroup (wg-current-workgroup t)) ;; and there's a current workgroup,
	4008	;; add the current wconfig to that workgroup's undo list:
	4009	(wg-add-wconfig-to-undo-list workgroup (wg-current-wconfig))))
	4010	;; Reset all flags no matter what:
	4011	(setq wg-window-configuration-changed nil
	4012	wg-undoify-window-configuration-change t
	4013	wg-already-updated-working-wconfig nil))
	4014
	4015	(defun wg-update-working-wconfig-hook ()
	4016	"Used in before advice on all functions that trigger `window-configuration-change-hook'.
	4017	To save up to date undo info before the change."
	4018	(when (and (not wg-already-updated-working-wconfig)
	4019	(wg-minibuffer-inactive-p))
	4020	(wg-update-current-workgroup-working-wconfig)
	4021	(setq wg-already-updated-working-wconfig t)))
	4022
	4023	(defun wg-workgroup-gc-buf-uids (workgroup)
	4024	"Remove buf uids from WORKGROUP that have no referent in `wg-buf-list'."
	4025	(wg-asetf (wg-workgroup-strong-buf-uids workgroup)
	4026	(cl-remove-if-not 'wg-find-buf-by-uid it)
	4027	(wg-workgroup-weak-buf-uids workgroup)
	4028	(cl-remove-if-not 'wg-find-buf-by-uid it)))
	4029
	4030	(defun wg-display-internal (elt-fn list)
	4031	"Return display string built by calling ELT-FN on each element of LIST."
	4032	(let ((div (wg-add-face :div wg-list-display-decor-divider))
	4033	(wwidth (window-width (minibuffer-window)))
	4034	(i -1)
	4035	(str))
	4036	(setq str
	4037	(wg-fontify
	4038	(:brace wg-list-display-decor-left-brace)
	4039	(if (not list) (funcall elt-fn nil nil)
	4040	(wg-doconcat (elt list div) (funcall elt-fn elt (cl-incf i))))
	4041	(:brace wg-list-display-decor-right-brace)))
	4042	;; (subseq str 0 wwidth)
	4043	))
	4044
	4045	(defun wg-workgroup-list-display (&optional workgroup-list)
	4046	"Return the WORKGROUP-LIST display string.
	4047	The string contains the names of all workgroups in `wg-workgroup-list',
	4048	decorated with faces, dividers and strings identifying the
	4049	current and previous workgroups."
	4050	(if (wg-current-session t)
	4051	(wg-display-internal 'wg-workgroup-display
	4052	(or workgroup-list (wg-workgroup-list)))))
	4053
	4054	(defun wg-create-first-wg ()
	4055	"Create a first workgroup if needed."
	4056	(when (and workgroups-mode
	4057	wg-session-load-on-start
	4058	(= (length (wg-workgroup-list)) 0))
	4059	(wg-create-workgroup wg-first-wg-name)
	4060	(wg-mark-everything-unmodified)))
	4061
	4062	(defun wg-pickel-workgroup-parameters (workgroup)
	4063	"Return a copy of WORKGROUP after pickeling its parameters.
	4064	If WORKGROUP's parameters are non-nil, otherwise return
	4065	WORKGROUP."
	4066	(if (not (wg-workgroup-parameters workgroup)) workgroup
	4067	(let ((copy (wg-copy-workgroup workgroup)))
	4068	(wg-asetf (wg-workgroup-parameters copy) (wg-pickel it))
	4069	copy)))
	4070
	4071	(defun wg-unpickel-workgroup-parameters (workgroup)
	4072	"If WORKGROUP's parameters are non-nil, return a copy of
	4073	WORKGROUP after unpickeling its parameters. Otherwise return
	4074	WORKGROUP."
	4075	(if (not (wg-workgroup-parameters workgroup)) workgroup
	4076	(let ((copy (wg-copy-workgroup workgroup)))
	4077	(wg-asetf (wg-workgroup-parameters copy) (wg-unpickel it))
	4078	copy)))
	4079
	4080	(defun wg-delete-workgroup (workgroup)
	4081	"Remove WORKGROUP from `wg-workgroup-list'.
	4082	Also delete all references to it by `wg-workgroup-state-table',
	4083	`wg-current-workgroup' and `wg-previous-workgroup'."
	4084	(dolist (frame (frame-list))
	4085	(remhash (wg-workgroup-uid workgroup) (wg-workgroup-state-table frame))
	4086	(when (wg-current-workgroup-p workgroup frame)
	4087	(wg-set-current-workgroup nil frame))
	4088	(when (wg-previous-workgroup-p workgroup frame)
	4089	(wg-set-previous-workgroup nil frame)))
	4090	(setf (wg-workgroup-list) (remove workgroup (wg-workgroup-list-or-error)))
	4091	(wg-flag-session-modified)
	4092	workgroup)
	4093
	4094	(defun wg-add-workgroup (workgroup &optional index)
	4095	"Add WORKGROUP to `wg-workgroup-list' at INDEX or the end.
	4096	If a workgroup with the same name exists, overwrite it."
	4097	(awhen (wg-find-workgroup-by :name (wg-workgroup-name workgroup) t)
	4098	(unless index (setq index (cl-position it (wg-workgroup-list-or-error))))
	4099	(wg-delete-workgroup it))
	4100	(wg-asetf (wg-workgroup-list)
	4101	(wg-insert-before workgroup it (or index (length it))))
	4102	(wg-flag-session-modified)
	4103	workgroup)
	4104
	4105	(defun wg-check-and-add-workgroup (workgroup)
	4106	"Add WORKGROUP to `wg-workgroup-list'.
	4107	Ask to overwrite if a workgroup with the same name exists."
	4108	(let ((name (wg-workgroup-name workgroup))
	4109	(uid (wg-workgroup-uid workgroup)))
	4110	(when (wg-find-workgroup-by :uid uid t)
	4111	(error "A workgroup with uid %S already exists" uid))
	4112	(when (wg-find-workgroup-by :name name t)
	4113	(unless (or wg-no-confirm-on-destructive-operation
	4114	(y-or-n-p (format "%S exists. Overwrite? " name)))
	4115	(error "Cancelled"))))
	4116	(wg-add-workgroup workgroup))
	4117
	4118	(defun wg-make-and-add-workgroup (name &optional blank)
	4119	"Create a workgroup named NAME with current `window-tree'.
	4120	If BLANK - then just scratch buffer.
	4121	Add it with `wg-check-and-add-workgroup'."
	4122	(wg-check-and-add-workgroup
	4123	(wg-make-workgroup
	4124	:name name
	4125	:base-wconfig (if blank (wg-make-blank-wconfig)
	4126	(wg-current-wconfig)))))
	4127
	4128	(defun wg-get-workgroup-create (workgroup)
	4129	"Return the workgroup specified by WORKGROUP, creating a new one if needed.
	4130	If `wg-get-workgroup' on WORKGROUP returns a workgroup, return it.
	4131	Otherwise, if WORKGROUP is a string, create a new workgroup with
	4132	that name and return it. Otherwise error."
	4133	(or (wg-get-workgroup workgroup t)
	4134	(if (stringp workgroup)
	4135	(wg-make-and-add-workgroup workgroup)
	4136	(wg-get-workgroup workgroup)))) ; Call this again for its error message
	4137
	4138	(defun wg-cyclic-offset-workgroup (workgroup n)
	4139	"Offset WORKGROUP's position in `wg-workgroup-list' by N."
	4140	(let ((workgroup-list (wg-workgroup-list-or-error)))
	4141	(unless (member workgroup workgroup-list)
	4142	(error "Workgroup isn't present in `wg-workgroup-list'."))
	4143	(setf (wg-workgroup-list) (wg-cyclic-offset-elt workgroup workgroup-list n)
	4144	(wg-session-modified (wg-current-session)) t)))
	4145
	4146	(defun wg-swap-workgroups-in-workgroup-list (workgroup1 workgroup2)
	4147	"Swap the positions of WORKGROUP1 and WORKGROUP2 in `wg-workgroup-list'."
	4148	(let ((workgroup-list (wg-workgroup-list-or-error)))
	4149	(when (eq workgroup1 workgroup2)
	4150	(error "Can't swap a workgroup with itself"))
	4151	(unless (and (memq workgroup1 workgroup-list)
	4152	(memq workgroup2 workgroup-list))
	4153	(error "Both workgroups aren't present in `wg-workgroup-list'."))
	4154	(setf (wg-workgroup-list) (wg-util-swap workgroup1 workgroup2 workgroup-list)
	4155	(wg-session-modified (wg-current-session)) t)))
	4156
	4157	(defun wg-session-uids-consistent-p ()
	4158	"Return t if there are no duplicate bufs or buf uids in the wrong places.
	4159	nil otherwise."
	4160	(and (not (wg-dups-p (wg-buf-list) :key 'wg-buf-uid :test 'string=))
	4161	(not (wg-dups-p (wg-workgroup-list) :key 'wg-workgroup-uid :test 'string=))))
	4162
	4163	(defun wg-open-session (filename)
	4164	"Load a session visiting FILENAME, creating one if none already exists."
	4165	(interactive "FFind session file: ")
	4166	(cond ((file-exists-p filename)
	4167	;; TODO: handle errors when reading object
	4168	(let ((session (read (f-read-text filename))))
	4169	(unless (wg-session-p session)
	4170	(error "%S is not a Workgroups session file." filename))
	4171	(setf (wg-session-file-name session) filename)
	4172	(wg-reset-internal (wg-unpickel-session-parameters session)))
	4173
	4174	(if wg-control-frames (wg-restore-frames))
	4175
	4176	(awhen (wg-workgroup-list)
	4177	(if (and wg-open-this-wg
	4178	(member wg-open-this-wg (wg-workgroup-names)))
	4179	(wg-switch-to-workgroup wg-open-this-wg)
	4180	(if (and wg-load-last-workgroup
	4181	(member (wg-session-parameter 'last-workgroup) (wg-workgroup-names)))
	4182	(wg-switch-to-workgroup (wg-session-parameter 'last-workgroup))
	4183	(wg-switch-to-workgroup (car it))))
	4184	(awhen (wg-session-parameter 'prev-workgroup)
	4185	(when (and (member it (wg-workgroup-names))
	4186	(wg-get-workgroup it t))
	4187	(wg-set-previous-workgroup (wg-get-workgroup it t)))))
	4188	(wg-fontified-message (:cmd "Loaded: ") (:file filename))
	4189	(wg-mark-everything-unmodified))
	4190	(t
	4191	(wg-query-and-save-if-modified)
	4192	(wg-reset-internal (wg-make-session :file-name filename))
	4193	(wg-fontified-message (:cmd "(New Workgroups session file)")))))
	4194	(defalias 'wg-find-session-file 'wg-open-session)
	4195
	4196	(defun wg-write-sexp-to-file (sexp file)
	4197	"Write the printable representation of SEXP to FILE."
	4198	(with-temp-buffer
	4199	(let ((print-level nil) (print-length nil))
	4200	(insert (format "%S" sexp)))
	4201	(write-file file)))
	4202
	4203	;; FIXME: Duplicate buf names probably shouldn't be allowed. An unrelated error
	4204	;; causes two scratch buffers to be present, triggering the "uids don't match"
	4205	;; error. Write something to remove bufs with duplicate names.
	4206	(defun wg-perform-session-maintenance ()
	4207	"Perform various maintenance operations on the current Workgroups session."
	4208	(wg-update-current-workgroup-working-wconfig)
	4209
	4210	;; Update every workgroup's base wconfig with `wg-workgroup-update-base-wconfig'
	4211	(dolist (workgroup (wg-workgroup-list))
	4212	(awhen (wg-workgroup-selected-frame-wconfig workgroup)
	4213	(setf (wg-workgroup-base-wconfig workgroup) it
	4214	(wg-workgroup-selected-frame-wconfig workgroup) nil)))
	4215
	4216	;; Garbage collection
	4217
	4218	;; Commenting this will cause a constantly growing session file:
	4219	;; (tried to comment this block to solve https://github.com/pashinin/workgroups2/issues/48)
	4220	(let ((all-buf-uids (wg-all-buf-uids)))
	4221	(wg-asetf (wg-buf-list)
	4222	(cl-remove-if-not (lambda (uid) (member uid all-buf-uids)) it
	4223	:key 'wg-buf-uid)))
	4224
	4225	(mapc 'wg-workgroup-gc-buf-uids (wg-workgroup-list)) ; Remove buf uids that have no referent in `wg-buf-list'
	4226	(mapc 'wg-update-buffer-in-buf-list (wg-buffer-list-emacs)))
	4227
	4228	(defun wg-save-session-as (filename &optional confirm)
	4229	"Write the current session into file FILENAME.
	4230	This makes the session visit that file, and marks it as not modified.
	4231
	4232	If optional second arg CONFIRM is non-nil, this function asks for
	4233	confirmation before overwriting an existing file. Interactively,
	4234	confirmation is required unless you supply a prefix argument."
	4235	(interactive (list (read-file-name "Save session as: ")
	4236	(not current-prefix-arg)))
	4237	(when (and confirm (file-exists-p filename))
	4238	(unless (y-or-n-p (format "File `%s' exists; overwrite? " filename))
	4239	(error "Cancelled")))
	4240	(unless (file-writable-p filename)
	4241	(error "File %s can't be written to" filename))
	4242	(wg-perform-session-maintenance)
	4243	(setf (wg-session-file-name (wg-current-session)) filename)
	4244	(setf (wg-session-version (wg-current-session)) wg-version)
	4245
	4246	;; Save opened frames as a session parameter "frame-list".
	4247	;; Exclude `selected-frame' and daemon one (if any).
	4248	;; http://stackoverflow.com/questions/21151992/why-emacs-as-daemon-gives-1-more-frame-than-is-opened
	4249	(if wg-control-frames
	4250	(let ((fl (frame-list)))
	4251	;; TODO: remove using dash
	4252	(mapc (lambda (frame)
	4253	(if (string-equal "initial_terminal" (terminal-name frame))
	4254	(delete frame fl))) fl)
	4255	(setq fl (delete (selected-frame) fl))
	4256	(let (wg-flag-modified)
	4257	(wg-set-session-parameter 'frame-list (mapcar 'wg-frame-to-wconfig fl)))))
	4258	(wg-write-sexp-to-file (wg-pickel-all-session-parameters) filename)
	4259	(wg-fontified-message (:cmd "Wrote: ") (:file filename))
	4260	(wg-mark-everything-unmodified))
	4261	(defalias 'wg-write-session-file 'wg-save-session-as)
	4262
	4263	(defun wg-get-session-file ()
	4264	"Return the filename in which to save the session."
	4265	(or (aif (wg-current-session t) (wg-session-file-name it))
	4266	wg-session-file))
	4267	;;(read-file-name (format "Save session as [%s]: " wg-session-file))
	4268
	4269	(defun wg-save-session (&optional force)
	4270	"Save the current Workgroups session if it's been modified.
	4271	When FORCE - save session regardless of whether it's been modified."
	4272	(interactive "P")
	4273	;;(if (and (not (wg-modified-p)) (not force))
	4274	;; (wg-message "(The session is unmodified)")
	4275	(wg-save-session-as (wg-get-session-file)))
	4276
	4277	(defun wg-reset-internal (&optional session)
	4278	"Reset Workgroups, setting `wg-current-session' to SESSION.
	4279	Resets all frame parameters, buffer-local vars, current session
	4280	object, etc. SESSION nil defaults to a new, blank session."
	4281	(mapc 'wg-reset-frame (frame-list))
	4282	(mapc 'wg-reset-buffer (wg-buffer-list-emacs))
	4283	(setq wg-wconfig-kill-ring nil)
	4284	(setq wg-current-session (or session (wg-make-session))))
	4285
	4286	(defun wg-all-buf-uids (&optional session buffer-list)
	4287	"Return the union of all SESSION buf-uids and BUFFER-LIST uids."
	4288	(cl-union (cl-reduce 'wg-string-list-union ; (wg-session-all-buf-uids session)
	4289	(wg-session-workgroup-list (or session (wg-current-session)))
	4290	:key 'wg-workgroup-all-buf-uids)
	4291	;; (wg-buffer-list-all-uids buffer-list)
	4292	(delq nil (mapcar 'wg-buffer-uid (or buffer-list (wg-buffer-list-emacs))))
	4293	:test 'string=))
	4294
	4295	(defun wg-modified-p ()
	4296	"Return t when the current session or any of its workgroups are modified."
	4297	(aif (wg-current-session t)
	4298	(or (wg-session-modified it)
	4299	(cl-some 'wg-workgroup-modified (wg-workgroup-list)))))
	4300
	4301	(defun wg-mark-everything-unmodified ()
	4302	"Mark the session and all workgroups as unmodified."
	4303	(let (wg-undoify-window-configuration-change) ; to skip WG's `post-command-hook' that marks "modified" again
	4304	(-when-let (session (wg-current-session t))
	4305	(setf (wg-session-modified session) nil))
	4306	(dolist (workgroup (wg-workgroup-list))
	4307	(setf (wg-workgroup-modified workgroup) nil))))
	4308
	4309	(defun wg-session-parameter (parameter &optional default session)
	4310	"Return session's value for PARAMETER.
	4311	If PARAMETER is not found, return DEFAULT which defaults to nil.
	4312	SESSION nil defaults to the current session."
	4313	(wg-aget (wg-session-parameters (or session (wg-current-session)))
	4314	parameter default))
	4315
	4316	(defun wg-set-session-parameter (parameter value &optional session)
	4317	"Set PARAMETER to VALUE in SESSION.
	4318	SESSION nil means use the current session. Return value."
	4319	(-when-let (session (or session (wg-current-session t)))
	4320	(wg-set-parameter (wg-session-parameters session) parameter value)
	4321	(wg-flag-session-modified session)
	4322	value))
	4323
	4324	(defun wg-remove-session-parameter (parameter &optional session)
	4325	"Remove parameter PARAMETER from SESSION's parameters."
	4326	(let ((session (or session (wg-current-session))))
	4327	(wg-asetf (wg-session-parameters session) (wg-aremove it parameter))
	4328	(wg-flag-session-modified session)))
	4329
	4330	(defun wg-session-local-value (variable &optional session)
	4331	"Return the value of VARIABLE in SESSION.
	4332	SESSION nil defaults to the current session. If VARIABLE does
	4333	not have a session-local binding in SESSION, the value is
	4334	resolved by Emacs."
	4335	(let* ((undefined (cl-gensym))
	4336	(value (wg-session-parameter variable undefined session)))
	4337	(if (not (eq value undefined)) value
	4338	(symbol-value variable))))
	4339
	4340	(defun wg-reset-frame (frame)
	4341	"Reset Workgroups' `frame-parameters' in FRAME to nil."
	4342	(set-frame-parameter frame 'wg-workgroup-state-table nil)
	4343	(set-frame-parameter frame 'wg-current-workgroup-uid nil)
	4344	(set-frame-parameter frame 'wg-previous-workgroup-uid nil))
	4345
	4346	(defun wg-save-session-on-exit (behavior)
	4347	"Perform session-saving operations based on BEHAVIOR."
	4348	(cl-case behavior
	4349	(ask (wg-query-and-save-if-modified))
	4350	(save (wg-save-session))))
	4351
	4352	(defun wg-reload-session ()
	4353	"Reload current workgroups session."
	4354	(interactive)
	4355	(let* ((file (wg-get-session-file))
	4356	(exists (file-exists-p file)))
	4357	(condition-case err
	4358	(wg-open-session file)
	4359	(progn
	4360	(wg-create-first-wg)
	4361	(message "Error loading session-file: %s" err))))
	4362	;; TODO: print what exactly happened
	4363	(wg-create-first-wg))
	4364
	4365	(defun wg-save-session-on-emacs-exit ()
	4366	"Call `wg-save-session-on-exit' with `wg-emacs-exit-save-behavior'.
	4367	Added to `kill-emacs-query-functions'."
	4368	(wg-save-session-on-exit wg-emacs-exit-save-behavior) t)
	4369
	4370	(defun wg-save-session-on-workgroups-mode-exit ()
	4371	"Call `wg-save-session-on-exit' with `wg-workgroups-mode-exit-save-behavior'.
	4372	Called when `workgroups-mode' is turned off."
	4373	(wg-save-session-on-exit wg-workgroups-mode-exit-save-behavior) t)
	4374
	4375	(defun wg-pickel-all-session-parameters (&optional session)
	4376	"Return a copy of SESSION after pickeling its parameters.
	4377	And the parameters of all its workgroups."
	4378	(let ((copy (wg-copy-session (or session (wg-current-session)))))
	4379	(when (wg-session-parameters copy)
	4380	(wg-asetf (wg-session-parameters copy) (wg-pickel it)))
	4381	(wg-asetf (wg-session-workgroup-list copy)
	4382	(cl-mapcar 'wg-pickel-workgroup-parameters it))
	4383	copy))
	4384
	4385	(defun wg-unpickel-session-parameters (session)
	4386	"Return a copy of SESSION after unpickeling its parameters.
	4387	And the parameters of all its workgroups."
	4388	(let ((copy (wg-copy-session session)))
	4389	(when (wg-session-parameters copy)
	4390	(wg-asetf (wg-session-parameters copy) (wg-unpickel it)))
	4391	(wg-asetf (wg-session-workgroup-list copy)
	4392	(cl-mapcar 'wg-unpickel-workgroup-parameters it))
	4393	copy))
	4394
	4395	(defvar wg-buffer-workgroup nil
	4396	"Associating each buffer with the workgroup.
	4397	In which it most recently appeared.")
	4398	(make-variable-buffer-local 'wg-buffer-workgroup)
	4399
	4400	(defun wg-workgroup-associated-buf-uids (&optional workgroup)
	4401	"Return a new list containing all of WORKGROUP's associated buf uids."
	4402	(awhen (or workgroup (wg-current-workgroup t))
	4403	(append (wg-workgroup-strong-buf-uids it)
	4404	(wg-workgroup-weak-buf-uids it))))
	4405
	4406	(defun wg-workgroup-associated-bufs (workgroup)
	4407	"Return a new list containing all of WORKGROUP's associated bufs."
	4408	(delete nil (mapcar 'wg-find-buf-by-uid
	4409	(wg-workgroup-associated-buf-uids workgroup))))
	4410
	4411	(defun wg-workgroup-associated-buffers (workgroup)
	4412	"Return a new list containing all of WORKGROUP's associated buffer objects."
	4413	(delete nil (mapcar 'wg-restore-buffer
	4414	(wg-workgroup-associated-bufs workgroup))))
	4415
	4416	(defun wg-workgroup-strongly-associate-bufobj (workgroup bufobj)
	4417	"Strongly associate BUFOBJ with WORKGROUP."
	4418	(let* ((uid (wg-bufobj-uid-or-add bufobj))
	4419	(remp (wg-removef-p uid (wg-workgroup-weak-buf-uids workgroup)
	4420	:test 'string=))
	4421	(addp (wg-pushnew-p uid (wg-workgroup-strong-buf-uids workgroup)
	4422	:test 'string=)))
	4423	(when (or remp addp)
	4424	(wg-flag-workgroup-modified workgroup)
	4425	bufobj)))
	4426
	4427	(defun wg-workgroup-weakly-associate-bufobj (workgroup bufobj)
	4428	"Weakly associate BUFOBJ with WORKGROUP."
	4429	(let* ((uid (wg-bufobj-uid-or-add bufobj))
	4430	(remp (wg-removef-p uid (wg-workgroup-strong-buf-uids workgroup)
	4431	:test 'string=))
	4432	(addp (wg-pushnew-p uid (wg-workgroup-weak-buf-uids workgroup)
	4433	:test 'string=)))
	4434	(when (or remp addp)
	4435	(wg-flag-workgroup-modified workgroup)
	4436	bufobj)))
	4437
	4438	(defun wg-workgroup-associate-bufobj (workgroup bufobj &optional weak)
	4439	"Associate BUFOBJ with WORKGROUP.
	4440	WEAK non-nil means weakly associate it. Otherwise strongly associate it."
	4441	(if weak (wg-workgroup-weakly-associate-bufobj workgroup bufobj)
	4442	(wg-workgroup-strongly-associate-bufobj workgroup bufobj)))
	4443
	4444	(defun wg-workgroup-dissociate-bufobj (workgroup bufobj)
	4445	"Dissociate BUFOBJ from WORKGROUP."
	4446	(let* ((uid (wg-bufobj-uid-or-add bufobj))
	4447	(rem1p (wg-removef-p uid (wg-workgroup-strong-buf-uids workgroup)
	4448	:test 'string=))
	4449	(rem2p (wg-removef-p uid (wg-workgroup-weak-buf-uids workgroup)
	4450	:test 'string=)))
	4451	(when (or rem1p rem2p)
	4452	(wg-flag-workgroup-modified workgroup)
	4453	bufobj)))
	4454
	4455	(defun wg-workgroup-dissociate-weakly-associated-buffers (workgroup)
	4456	"Dissociate from WORKGROUP all weakly associated buffers."
	4457	(when (wg-workgroup-weak-buf-uids workgroup)
	4458	(wg-flag-workgroup-modified workgroup)
	4459	(setf (wg-workgroup-weak-buf-uids workgroup) nil)))
	4460
	4461	(defun wg-workgroup-dissociate-strongly-associated-buffers (workgroup)
	4462	"Dissociate from WORKGROUP all strongly associated buffers."
	4463	(when (wg-workgroup-strong-buf-uids workgroup)
	4464	(wg-flag-workgroup-modified workgroup)
	4465	(setf (wg-workgroup-strong-buf-uids workgroup) nil)))
	4466
	4467	(defun wg-workgroup-dissociate-all-buffers (workgroup)
	4468	"Dissociate from WORKGROUP all its associated buffers."
	4469	(wg-workgroup-dissociate-weakly-associated-buffers workgroup)
	4470	(wg-workgroup-dissociate-strongly-associated-buffers workgroup))
	4471
	4472	(defun wg-auto-dissociate-buffer-hook ()
	4473	"`kill-buffer-hook' that automatically dissociates buffers from workgroups."
	4474	(when wg-dissociate-buffer-on-kill-buffer
	4475	(awhen (wg-current-workgroup t)
	4476	(wg-workgroup-dissociate-bufobj it (current-buffer)))))
	4477
	4478	(defun wg-associate-buffer-with-workgroup (&optional workgroup buffer weak)
	4479	"Associate BUFFER with WORKGROUP.
	4480	WEAK non-nil means weakly associate BUFFER."
	4481	(interactive (list nil nil current-prefix-arg))
	4482	(let* ((workgroup (wg-get-workgroup workgroup))
	4483	(buffer (or buffer (current-buffer)))
	4484	(bname (buffer-name buffer))
	4485	(wgname (wg-workgroup-name workgroup)))
	4486	(if (wg-workgroup-associate-bufobj workgroup buffer weak)
	4487	(wg-message "%s-associated %S with %s"
	4488	(if weak "Weakly" "Strongly") bname wgname)
	4489	(wg-message "%S is already associated with %s" bname wgname))))
	4490
	4491	(defun wg-associate-visible-buffers-with-workgroup (&optional workgroup weak)
	4492	"Associate all buffers visible in `selected-frame' with WORKGROUP.
	4493	WEAK non-nil means weakly associate them. Otherwise strongly
	4494	associate them."
	4495	(interactive (list nil current-prefix-arg))
	4496	(let ((workgroup (wg-get-workgroup workgroup))
	4497	(buffers (mapcar 'window-buffer (window-list))))
	4498	(dolist (buffer buffers)
	4499	(wg-workgroup-associate-bufobj workgroup buffer weak))
	4500	(wg-fontified-message
	4501	(:cmd (format "%s associated: " (if weak "Weakly" "Strongly")))
	4502	(wg-display-internal 'wg-buffer-display buffers))))
	4503
	4504	(defun wg-dissociate-buffer-from-workgroup (&optional workgroup buffer)
	4505	"Dissociate BUFFER from WORKGROUP."
	4506	(interactive (list nil nil))
	4507	(let ((workgroup (wg-get-workgroup workgroup))
	4508	(buffer (or buffer (current-buffer))))
	4509	(wg-message
	4510	(if (wg-workgroup-dissociate-bufobj workgroup buffer)
	4511	"Dissociated %S from %s" "%S isn't associated with %s")
	4512	(wg-buffer-name buffer)
	4513	(wg-workgroup-name workgroup))))
	4514
	4515	(defun wg-associate-buffers (workgroup window-or-emacs-window-tree)
	4516	"Associate the buffers visible in window elements of
	4517	WINDOW-OR-EMACS-WINDOW-TREE with the given WORKGROUP.
	4518	WINDOW-OR-EMACS-WINDOW-TREE must be either a window or a tree of
	4519	the form produced by `(car (window-tree))'."
	4520	(if (windowp window-or-emacs-window-tree)
	4521	(with-current-buffer (window-buffer window-or-emacs-window-tree)
	4522	(setq wg-buffer-workgroup workgroup))
	4523	(dolist (w (cddr window-or-emacs-window-tree))
	4524	(when w (wg-associate-buffers workgroup w)))))
	4525
	4526	(defun wg-workgroup-bufobj-association-type (workgroup bufobj)
	4527	"Return BUFOBJ's association-type in WORKGROUP, or nil if unassociated."
	4528	(let ((uid (wg-bufobj-uid-or-add bufobj)))
	4529	(or (and (member uid (wg-workgroup-strong-buf-uids workgroup)) 'strong)
	4530	(and (member uid (wg-workgroup-weak-buf-uids workgroup)) 'weak))))
	4531
	4532	(defun wg-associate-frame-buffers ()
	4533	"Associate visible buffers with the current workgroup.
	4534	Unless it is currently being deactivated."
	4535	(awhen (wg-current-workgroup :noerror)
	4536	(unless (member it wg-deactivation-list)
	4537	(wg-associate-buffers it (car (window-tree))))))
	4538
	4539	(defun wg-add-or-remove-workgroups-hooks (remove)
	4540	"Add or remove all of Workgroups' hooks, depending on REMOVE."
	4541	(wg-add-or-remove-hooks
	4542	remove
	4543	'kill-emacs-query-functions 'wg-save-session-on-emacs-exit
	4544	'delete-frame-hook 'wg-update-working-wconfig-on-delete-frame
	4545	'after-make-frame-functions 'wg-update-working-wconfig-on-make-frame
	4546	'wg-pre-window-configuration-change-hook 'wg-update-working-wconfig-hook
	4547	'window-configuration-change-hook 'wg-flag-window-configuration-changed
	4548	'post-command-hook 'wg-undoify-window-configuration-change
	4549	'minibuffer-exit-hook 'wg-flag-just-exited-minibuffer
	4550	'kill-buffer-hook 'wg-update-buffer-in-buf-list
	4551	'kill-buffer-hook 'wg-auto-dissociate-buffer-hook
	4552	;;'window-configuration-change-hook 'wg-associate-frame-buffers
	4553	))
	4554
	4555	;;;###autoload
	4556	(defun workgroups-mode (&optional arg)
	4557	"Turn `workgroups-mode' on and off.
	4558	ARG is nil - toggle
	4559	ARG >= 1 - turn on
	4560	ARG == 0 - turn off
	4561	ARG is anything else, turn on `workgroups-mode'."
	4562	(interactive (list current-prefix-arg))
	4563	(setq workgroups-mode
	4564	(cond ((not arg) (not workgroups-mode))
	4565	((integerp arg) (if (> arg 0) t nil))
	4566	(t)))
	4567	(cond
	4568	(workgroups-mode
	4569	(if (boundp 'desktop-restore-frames)
	4570	(setq desktop-restore-frames nil))
	4571	(wg-reset-internal) ; creates a new `wg-current-session'
	4572	(wg-add-workgroups-mode-minor-mode-entries)
	4573	(wg-enable-all-advice)
	4574	(wg-add-or-remove-workgroups-hooks nil)
	4575	(wg-change-modeline)
	4576
	4577	;; some sr-speedbar hooks can harm
	4578	(when (featurep 'sr-speedbar)
	4579	(ad-disable-advice 'delete-other-windows 'around 'sr-speedbar-delete-other-window-advice)
	4580	(ad-disable-advice 'delete-window 'before 'sr-speedbar-delete-window-advice))
	4581
	4582	;; Load session
	4583	(when (and wg-session-load-on-start
	4584	(file-exists-p wg-session-file))
	4585	(condition-case err
	4586	(wg-open-session wg-session-file)
	4587	(error (message "Error finding `wg-session-file': %s" err))))
	4588	(run-hooks 'workgroups-mode-hook))
	4589	(t
	4590	(wg-save-session-on-workgroups-mode-exit)
	4591	(wg-disable-all-advice)
	4592	(wg-add-or-remove-workgroups-hooks t)
	4593	(wg-remove-mode-line-display)
	4594	(run-hooks 'workgroups-mode-exit-hook)))
	4595	(wg-fontified-message
	4596	(:cmd "Workgroups Mode: ") (:msg (if workgroups-mode "on" "off")))
	4597	(wg-create-first-wg)
	4598	workgroups-mode)
	4599
	4600	;;;###autoload
	4601	(defun wg-help ()
	4602	"Just call `apropos-command' on \"^wg-\".
	4603	There used to be a bunch of help-buffer construction stuff here,
	4604	including a `wg-help' variable that basically duplicated every
	4605	command's docstring; But why, when there's `apropos-command'?"
	4606	(interactive)
	4607	(apropos-command "^wg-"))
	4608
	4609	;; Remove after some time
	4610	(defalias 'wg-switch-to-buffer 'switch-to-buffer)
	4611
	4612	(provide 'workgroups2)
	4613	;;; workgroups2.el ends here