Mercurial > emacs
view lisp/winner.el @ 110523:a5ad4f188e19
Synch Semantic to CEDET 1.0.
Move CEDET ChangeLog entries to new file lisp/cedet/ChangeLog.
* semantic.el (semantic-version): Update to 2.0.
(semantic-mode-map): Add "," and "m" bindings.
(navigate-menu): Update.
* semantic/symref.el (semantic-symref-calculate-rootdir):
New function.
(semantic-symref-detect-symref-tool): Use it.
* semantic/symref/grep.el (semantic-symref-grep-shell): New var.
(semantic-symref-perform-search): Use it. Calculate root dir with
semantic-symref-calculate-rootdir.
(semantic-symref-derive-find-filepatterns): Improve error message.
* semantic/symref/list.el
(semantic-symref-results-mode-map): New bindings.
(semantic-symref-auto-expand-results): New option.
(semantic-symref-results-dump): Obey auto-expand.
(semantic-symref-list-expand-all, semantic-symref-regexp)
(semantic-symref-list-contract-all)
(semantic-symref-list-map-open-hits)
(semantic-symref-list-update-open-hits)
(semantic-symref-list-create-macro-on-open-hit)
(semantic-symref-list-call-macro-on-open-hits): New functions.
(semantic-symref-list-menu-entries)
(semantic-symref-list-menu): New vars.
(semantic-symref-list-map-open-hits): Move cursor to beginning of
match before calling the mapped function.
* semantic/doc.el
(semantic-documentation-comment-preceeding-tag): Do nothing if the
mode doesn't provide comment-start-skip.
* semantic/scope.el
(semantic-analyze-scope-nested-tags-default): Strip duplicates.
(semantic-analyze-scoped-inherited-tag-map): Take the tag we are
looking for as part of the scoped tags list.
* semantic/html.el (semantic-default-html-setup): Add
senator-step-at-tag-classes.
* semantic/decorate/include.el
(semantic-decoration-on-unknown-includes): Change light bgcolor.
(semantic-decoration-on-includes-highlight-default): Check that
the include tag has a postion.
* semantic/complete.el (semantic-collector-local-members):
(semantic-complete-read-tag-local-members)
(semantic-complete-jump-local-members): New class and functions.
(semantic-complete-self-insert): Save excursion before completing.
* semantic/analyze/complete.el
(semantic-analyze-possible-completions-default): If no completions
are found, return the raw by-name-only completion list. Add FLAGS
arguments. Add support for 'no-tc (type constraint) and
'no-unique, or no stripping duplicates.
(semantic-analyze-possible-completions-default): Add FLAGS arg.
* semantic/util-modes.el
(semantic-stickyfunc-show-only-functions-p): New option.
(semantic-stickyfunc-fetch-stickyline): Don't show stickytext for
the very first line in a buffer.
* semantic/util.el (semantic-hack-search)
(semantic-recursive-find-nonterminal-by-name)
(semantic-current-tag-interactive): Deleted.
(semantic-describe-buffer): Fix expand-nonterminal. Add
lex-syntax-mods, type relation separator char, and command
separation char.
(semantic-sanity-check): Only message if called interactively.
* semantic/tag.el (semantic-tag-deep-copy-one-tag): Copy the
:filename property and the tag position.
* semantic/lex-spp.el (semantic-lex-spp-lex-text-string):
Add recursion limit.
* semantic/imenu.el (semantic-imenu-bucketize-type-members):
Make this buffer local, not the obsoleted variable.
* semantic/idle.el: Add breadcrumbs support.
(semantic-idle-summary-current-symbol-info-default)
(semantic-idle-tag-highlight)
(semantic-idle-completion-list-default): Use
semanticdb-without-unloaded-file-searches for speed, and to
conform to the controls that specify if the idle timer is supposed
to be parsing unparsed includes.
(semantic-idle-symbol-highlight-face)
(semantic-idle-symbol-maybe-highlight): Rename from *-summary-*.
Callers changed.
(semantic-idle-work-parse-neighboring-files-flag): Default to nil.
(semantic-idle-work-update-headers-flag): New var.
(semantic-idle-work-for-one-buffer): Use it.
(semantic-idle-local-symbol-highlight): Rename from
semantic-idle-tag-highlight.
(semantic-idle-truncate-long-summaries): New option.
* semantic/ia.el (semantic-ia-cache)
(semantic-ia-get-completions): Deleted. Callers changed.
(semantic-ia-show-variants): New command.
(semantic-ia-show-doc): If doc is empty, don't make a temp buffer.
(semantic-ia-show-summary): If there isn't anything to show, say so.
* semantic/grammar.el (semantic-grammar-create-package):
Save the buffer even in batch mode.
* semantic/fw.el
(semanticdb-without-unloaded-file-searches): New macro.
* semantic/dep.el (semantic-dependency-find-file-on-path):
Fix case dereferencing ede-object when it is a list.
* semantic/db-typecache.el (semanticdb-expand-nested-tag)
(semanticdb-typecache-faux-namespace): New functions.
(semanticdb-typecache-file-tags)
(semanticdb-typecache-merge-streams): Use them.
(semanticdb-typecache-file-tags): When deriving tags from a file,
give the mode a chance to monkey with the tag copy.
(semanticdb-typecache-find-default): Wrap find in save-excursion.
(semanticdb-typecache-find-by-name-helper): Merge found names down.
* semantic/db-global.el
(semanticdb-enable-gnu-global-in-buffer): Don't show messages if
GNU Global is not available and we don't want to throw an error.
* semantic/db-find.el (semanticdb-find-result-nth-in-buffer):
When trying to normalize the tag to a buffer, don't error if
set-buffer method doesn't exist.
* semantic/db-file.el (semanticdb-save-db): Simplify msg.
* semantic/db.el (semanticdb-refresh-table): If forcing a
refresh on a file not in a buffer, use semantic-find-file-noselect
and delete the buffer after use.
(semanticdb-current-database-list): When calculating root via
hooks, force it through true-filename and skip the list of
possible roots.
* semantic/ctxt.el (semantic-ctxt-imported-packages): New.
* semantic/analyze/debug.el
(semantic-analyzer-debug-insert-tag): Reset standard output to
current buffer.
(semantic-analyzer-debug-global-symbol)
(semantic-analyzer-debug-missing-innertype): Change "prefix" to
"symbol" in messages.
* semantic/analyze/refs.el: (semantic-analyze-refs-impl)
(semantic-analyze-refs-proto): When calculating value, make sure
the found tag is 'similar' to the originating tag.
(semantic--analyze-refs-find-tags-with-parent): Attempt to
identify matches via imported symbols of parents.
(semantic--analyze-refs-full-lookup-with-parents): Do a deep
search during the brute search.
* semantic/analyze.el
(semantic-analyze-find-tag-sequence-default): Be robust to
calculated scopes being nil.
* semantic/bovine/c.el (semantic-c-describe-environment): Add
project macro symbol array.
(semantic-c-parse-lexical-token): Add recursion limit.
(semantic-ctxt-imported-packages, semanticdb-expand-nested-tag):
New overrides.
(semantic-expand-c-tag-namelist): Split a full type from a typedef
out to its own tag.
(semantic-expand-c-tag-namelist): Do not split out a typedef'd
inline type if it is an anonymous type.
(semantic-c-reconstitute-token): Use the optional initializers as
a clue that some function is probably a constructor. When
defining the type of these constructors, split the parent name,
and use only the class part, if applicable.
* semantic/bovine/c-by.el:
* semantic/wisent/python-wy.el: Regenerate.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Sat, 18 Sep 2010 22:49:54 -0400 |
parents | 1d1d5d9bd884 |
children | 376148b31b5e |
line wrap: on
line source
;;; winner.el --- Restore old window configurations ;; Copyright (C) 1997, 1998, 2001, 2002, 2003, 2004, ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation. Inc. ;; Author: Ivar Rummelhoff <ivarru@math.uio.no> ;; Created: 27 Feb 1997 ;; Keywords: convenience frames ;; This file is part of GNU Emacs. ;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. ;;; Commentary: ;; Winner mode is a global minor mode that records the changes in the ;; window configuration (i.e. how the frames are partitioned into ;; windows) so that the changes can be "undone" using the command ;; `winner-undo'. By default this one is bound to the key sequence ;; ctrl-c left. If you change your mind (while undoing), you can ;; press ctrl-c right (calling `winner-redo'). Even though it uses ;; some features of Emacs20.3, winner.el should also work with ;; Emacs19.34 and XEmacs20, provided that the installed version of ;; custom is not obsolete. ;; Winner mode was improved August 1998. ;; Further improvements February 2002. ;;; Code: (eval-when-compile (require 'cl)) (defmacro winner-active-region () (if (boundp 'mark-active) 'mark-active '(region-active-p))) (defsetf winner-active-region () (store) (if (featurep 'xemacs) `(if ,store (zmacs-activate-region) (zmacs-deactivate-region)) `(setq mark-active ,store))) (defalias 'winner-edges (if (featurep 'xemacs) 'window-pixel-edges 'window-edges)) (defalias 'winner-window-list (if (featurep 'xemacs) (lambda () (delq (minibuffer-window) (window-list nil 0))) (lambda () (window-list nil 0)))) (require 'ring) (defgroup winner nil "Restoring window configurations." :group 'windows) ;;;###autoload (defcustom winner-mode nil "Toggle Winner mode. Setting this variable directly does not take effect; use either \\[customize] or the function `winner-mode'." :set #'(lambda (symbol value) (funcall symbol (or value 0))) :initialize 'custom-initialize-default :type 'boolean :group 'winner :require 'winner) (defcustom winner-dont-bind-my-keys nil "If non-nil: Do not use `winner-mode-map' in Winner mode." :type 'boolean :group 'winner) (defcustom winner-ring-size 200 "Maximum number of stored window configurations per frame." :type 'integer :group 'winner) (defcustom winner-boring-buffers '("*Completions*") "`winner-undo' will not restore windows displaying any of these buffers. You may want to include buffer names such as *Help*, *Apropos*, *Buffer List*, *info* and *Compile-Log*." :type '(repeat string) :group 'winner) ;;;; Saving old configurations (internal variables and subroutines) ;;; Current configuration ;; List the windows according to their edges. (defun winner-sorted-window-list () (sort (winner-window-list) (lambda (x y) (loop for a in (winner-edges x) for b in (winner-edges y) while (= a b) finally return (< a b))))) (defun winner-win-data () ;; Essential properties of the windows in the selected frame. (loop for win in (winner-sorted-window-list) collect (cons (winner-edges win) (window-buffer win)))) ;; This variable is updated with the current window configuration ;; every time it changes. (defvar winner-currents nil) ;; The current configuration (+ the buffers involved). (defsubst winner-conf () (cons (current-window-configuration) (winner-win-data))) ;; Save current configuration. ;; (Called below by `winner-save-old-configurations'). (defun winner-remember () (let ((entry (assq (selected-frame) winner-currents))) (if entry (setcdr entry (winner-conf)) (push (cons (selected-frame) (winner-conf)) winner-currents)))) ;; Consult `winner-currents'. (defun winner-configuration (&optional frame) (or (cdr (assq (or frame (selected-frame)) winner-currents)) (letf (((selected-frame) frame)) (winner-conf)))) ;;; Saved configurations ;; This variable contains the window cofiguration rings. ;; The key in this alist is the frame. (defvar winner-ring-alist nil) ;; Find the right ring. If it does not exist, create one. (defsubst winner-ring (frame) (or (cdr (assq frame winner-ring-alist)) (let ((ring (make-ring winner-ring-size))) (ring-insert ring (winner-configuration frame)) (push (cons frame ring) winner-ring-alist) ring))) ;; If the same command is called several times in a row, ;; we only save one window configuration. (defvar winner-last-command nil) ;; Frames affected by the previous command. (defvar winner-last-frames nil) (defsubst winner-equal (a b) "Check whether two Winner configurations (as produced by `winner-conf') are equal." (equal (cdr a) (cdr b))) ;; Save the current window configuration, if it has changed. ;; If so return frame, otherwise return nil. (defun winner-insert-if-new (frame) (unless (or (memq frame winner-last-frames) (eq this-command 'winner-redo)) (let ((conf (winner-configuration frame)) (ring (winner-ring frame))) (when (and (not (ring-empty-p ring)) (winner-equal conf (ring-ref ring 0))) ;; When the previous configuration was very similar, ;; keep only the latest. (ring-remove ring 0)) (ring-insert ring conf) (push frame winner-last-frames) frame))) ;;; Hooks ;; Frames affected by the current command. (defvar winner-modified-list nil) ;; Called whenever the window configuration changes ;; (a `window-configuration-change-hook'). (defun winner-change-fun () (unless (or (memq (selected-frame) winner-modified-list) (/= 0 (minibuffer-depth))) (push (selected-frame) winner-modified-list))) ;; A `post-command-hook' for emacsen with ;; `window-configuration-change-hook'. (defun winner-save-old-configurations () (when (zerop (minibuffer-depth)) (unless (eq this-command winner-last-command) (setq winner-last-frames nil) (setq winner-last-command this-command)) (dolist (frame winner-modified-list) (winner-insert-if-new frame)) (setq winner-modified-list nil) (winner-remember))) ;; A `minibuffer-setup-hook'. (defun winner-save-unconditionally () (unless (eq this-command winner-last-command) (setq winner-last-frames nil) (setq winner-last-command this-command)) (winner-insert-if-new (selected-frame)) (winner-remember)) ;; A `post-command-hook' for other emacsen. ;; Also called by `winner-undo' before "undoing". (defun winner-save-conditionally () (when (zerop (minibuffer-depth)) (winner-save-unconditionally))) ;;;; Restoring configurations ;; Works almost as `set-window-configuration', ;; but does not change the contents or the size of the minibuffer, ;; and tries to preserve the selected window. (defun winner-set-conf (winconf) (let* ((miniwin (minibuffer-window)) (chosen (selected-window)) (minisize (window-height miniwin))) (letf (((window-buffer miniwin)) ((window-point miniwin))) (set-window-configuration winconf)) (cond ((window-live-p chosen) (select-window chosen)) ((window-minibuffer-p (selected-window)) (other-window 1))) (when (/= minisize (window-height miniwin)) (letf (((selected-window) miniwin) ) (setf (window-height) minisize))))) (defvar winner-point-alist nil) ;; `set-window-configuration' restores old points and marks. This is ;; not what we want, so we make a list of the "real" (i.e. new) points ;; and marks before undoing window configurations. ;; ;; Format of entries: (buffer (mark . mark-active) (window . point) ..) (defun winner-make-point-alist () (letf (((current-buffer))) (loop with alist for win in (winner-window-list) for entry = (or (assq (window-buffer win) alist) (car (push (list (set-buffer (window-buffer win)) (cons (mark t) (winner-active-region))) alist))) do (push (cons win (window-point win)) (cddr entry)) finally return alist))) (defun winner-get-point (buf win) ;; Consult (and possibly extend) `winner-point-alist'. ;; Returns nil if buf no longer exists. (when (buffer-name buf) (let ((entry (assq buf winner-point-alist))) (cond (entry (or (cdr (assq win (cddr entry))) (cdr (assq nil (cddr entry))) (letf (((current-buffer) buf)) (push (cons nil (point)) (cddr entry)) (point)))) (t (letf (((current-buffer) buf)) (push (list buf (cons (mark t) (winner-active-region)) (cons nil (point))) winner-point-alist) (point))))))) ;; Make sure point does not end up in the minibuffer and delete ;; windows displaying dead or boring buffers ;; (c.f. `winner-boring-buffers'). Return nil if all the windows ;; should be deleted. Preserve correct points and marks. (defun winner-set (conf) ;; For the format of `conf', see `winner-conf'. (let* ((buffers nil) (alive ;; Possibly update `winner-point-alist' (loop for buf in (mapcar 'cdr (cdr conf)) for pos = (winner-get-point buf nil) if (and pos (not (memq buf buffers))) do (push buf buffers) collect pos))) (winner-set-conf (car conf)) (let (xwins) ; to be deleted ;; Restore points (dolist (win (winner-sorted-window-list)) (unless (and (pop alive) (setf (window-point win) (winner-get-point (window-buffer win) win)) (not (member (buffer-name (window-buffer win)) winner-boring-buffers))) (push win xwins))) ; delete this window ;; Restore marks (letf (((current-buffer))) (loop for buf in buffers for entry = (cadr (assq buf winner-point-alist)) do (progn (set-buffer buf) (set-mark (car entry)) (setf (winner-active-region) (cdr entry))))) ;; Delete windows, whose buffers are dead or boring. ;; Return t if this is still a possible configuration. (or (null xwins) (progn (mapc 'delete-window (cdr xwins)) ; delete all but one (unless (one-window-p t) (delete-window (car xwins)) t)))))) ;;;; Winner mode (a minor mode) (defcustom winner-mode-hook nil "Functions to run whenever Winner mode is turned on." :type 'hook :group 'winner) (defcustom winner-mode-leave-hook nil "Functions to run whenever Winner mode is turned off." :type 'hook :group 'winner) (defvar winner-mode-map (let ((map (make-sparse-keymap))) (define-key map [(control c) left] 'winner-undo) (define-key map [(control c) right] 'winner-redo) map) "Keymap for Winner mode.") ;; Check if `window-configuration-change-hook' is working. (defun winner-hook-installed-p () (save-window-excursion (let ((winner-var nil) (window-configuration-change-hook '((lambda () (setq winner-var t))))) (split-window) winner-var))) ;;;###autoload (defun winner-mode (&optional arg) "Toggle Winner mode. With arg, turn Winner mode on if and only if arg is positive." (interactive "P") (let ((on-p (if arg (> (prefix-numeric-value arg) 0) (not winner-mode)))) (cond ;; Turn mode on (on-p (setq winner-mode t) (cond ((winner-hook-installed-p) (add-hook 'window-configuration-change-hook 'winner-change-fun) (add-hook 'post-command-hook 'winner-save-old-configurations)) (t (add-hook 'post-command-hook 'winner-save-conditionally))) (add-hook 'minibuffer-setup-hook 'winner-save-unconditionally) (setq winner-modified-list (frame-list)) (winner-save-old-configurations) (run-hooks 'winner-mode-hook) (when (called-interactively-p 'interactive) (message "Winner mode enabled"))) ;; Turn mode off (winner-mode (setq winner-mode nil) (remove-hook 'window-configuration-change-hook 'winner-change-fun) (remove-hook 'post-command-hook 'winner-save-old-configurations) (remove-hook 'post-command-hook 'winner-save-conditionally) (remove-hook 'minibuffer-setup-hook 'winner-save-unconditionally) (run-hooks 'winner-mode-leave-hook) (when (called-interactively-p 'interactive) (message "Winner mode disabled")))))) ;; Inspired by undo (simple.el) (defvar winner-undo-frame nil) (defvar winner-pending-undo-ring nil "The ring currently used by `winner-undo'.") (defvar winner-undo-counter nil) (defvar winner-undone-data nil) ; There confs have been passed. (defun winner-undo () "Switch back to an earlier window configuration saved by Winner mode. In other words, \"undo\" changes in window configuration." (interactive) (cond ((not winner-mode) (error "Winner mode is turned off")) (t (unless (and (eq last-command 'winner-undo) (eq winner-undo-frame (selected-frame))) (winner-save-conditionally) ; current configuration->stack (setq winner-undo-frame (selected-frame)) (setq winner-point-alist (winner-make-point-alist)) (setq winner-pending-undo-ring (winner-ring (selected-frame))) (setq winner-undo-counter 0) (setq winner-undone-data (list (winner-win-data)))) (incf winner-undo-counter) ; starting at 1 (when (and (winner-undo-this) (not (window-minibuffer-p (selected-window)))) (message "Winner undo (%d / %d)" winner-undo-counter (1- (ring-length winner-pending-undo-ring))))))) (defun winner-undo-this () ; The heart of winner undo. (loop (cond ((>= winner-undo-counter (ring-length winner-pending-undo-ring)) (message "No further window configuration undo information") (return nil)) ((and ; If possible configuration (winner-set (ring-ref winner-pending-undo-ring winner-undo-counter)) ; .. and new configuration (let ((data (winner-win-data))) (and (not (member data winner-undone-data)) (push data winner-undone-data)))) (return t)) ; .. then everything is fine. (t ;; Otherwise, discharge it (and try the next one). (ring-remove winner-pending-undo-ring winner-undo-counter))))) (defun winner-redo () ; If you change your mind. "Restore a more recent window configuration saved by Winner mode." (interactive) (cond ((eq last-command 'winner-undo) (winner-set (if (zerop (minibuffer-depth)) (ring-remove winner-pending-undo-ring 0) (ring-ref winner-pending-undo-ring 0))) (unless (eq (selected-window) (minibuffer-window)) (message "Winner undid undo"))) (t (error "Previous command was not a `winner-undo'")))) ;;; To be evaluated when the package is loaded: (unless (or (assq 'winner-mode minor-mode-map-alist) winner-dont-bind-my-keys) (push (cons 'winner-mode winner-mode-map) minor-mode-map-alist)) (provide 'winner) ;; arch-tag: 686d1c1b-010e-42ca-a192-b5685112418f ;;; winner.el ends here