diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/ChangeLog | 105 | ||||
| -rw-r--r-- | lisp/comint.el | 6 | ||||
| -rw-r--r-- | lisp/doc-view.el | 5 | ||||
| -rw-r--r-- | lisp/emacs-lisp/timer.el | 40 | ||||
| -rw-r--r-- | lisp/iswitchb.el | 7 | ||||
| -rw-r--r-- | lisp/net/rcirc.el | 21 | ||||
| -rw-r--r-- | lisp/net/tramp-ftp.el | 8 | ||||
| -rw-r--r-- | lisp/net/tramp-sh.el | 79 | ||||
| -rw-r--r-- | lisp/net/tramp-smb.el | 8 | ||||
| -rw-r--r-- | lisp/net/tramp.el | 9 | ||||
| -rw-r--r-- | lisp/shell.el | 7 | ||||
| -rw-r--r-- | lisp/textmodes/bibtex.el | 227 | ||||
| -rw-r--r-- | lisp/url/ChangeLog | 4 | ||||
| -rw-r--r-- | lisp/url/url-future.el | 6 | ||||
| -rw-r--r-- | lisp/window.el | 437 |
15 files changed, 846 insertions, 123 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 101384cee7d..8cc1c3f1e26 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,108 @@ +2011-06-06 Martin Rudalics <rudalics@gmx.at> + + * window.el (window-right, window-left, window-child) + (window-child-count, window-last-child, window-any-p) + (normalize-live-buffer, normalize-live-frame) + (normalize-any-window, normalize-live-window) + (window-iso-combination-p, window-iso-combined-p) + (window-iso-combinations) + (walk-window-tree-1, walk-window-tree, walk-window-subtree) + (windows-with-parameter, window-with-parameter) + (window-atom-root, make-window-atom, window-atom-check-1) + (window-atom-check, window-side-check, window-check): New + functions. + (ignore-window-parameters, window-sides, window-sides-vertical) + (window-sides-slots): New variables. + (window-size-fixed): Move down in code. Minor doc-string fix. + +2011-06-05 Andreas Schwab <schwab@linux-m68k.org> + + * comint.el (comint-dynamic-complete-as-filename) + (comint-dynamic-complete-filename): Correctly call + completion-in-region. + +2011-06-05 Deniz Dogan <deniz@dogan.se> + + * net/rcirc.el (rcirc-prompt-for-encryption): Fix bug introduced + in last change. + +2011-06-05 Deniz Dogan <deniz@dogan.se> + + * net/rcirc.el (rcirc-prompt-for-encryption): New function. + (rcirc): Use it to prompt for encryption. + +2011-06-05 Roland Winkler <winkler@gnu.org> + + * textmodes/bibtex.el (bibtex-search-buffer): New variable. + (bibtex-search-entries): New command bound to C-c C-a. + (bibtex-display-entries): New function. + +2011-06-05 Roland Winkler <winkler@gnu.org> + + * textmodes/bibtex.el (bibtex-generate-url-list): Fix docstring. + (bibtex-insert-kill): After yanking insert newline if necessary. + (bibtex-initialize): Call bibtex-string-files-init only once. + (bibtex-mode): Do not call easy-menu-add. + (bibtex-validate-globally): Use save-excursion in bibtex buffers. + (bibtex-yank): Set arg properly if nil. + +2011-06-05 Roland Winkler <winkler@gnu.org> + + * textmodes/bibtex.el (bibtex-search-entry-globally): New + variable. + (bibtex-search-entry): Use it. + +2011-06-05 Roland Winkler <winkler@gnu.org> + + * textmodes/bibtex.el (bibtex-entry-format): New option + sort-fields. + (bibtex-format-entry, bibtex-reformat): Honor this option. + (bibtex-parse-entry): Return fields in proper order. + +2011-06-05 Juanma Barranquero <lekktu@gmail.com> + + * doc-view.el (doc-view-remove-if): Move computation of result out + of `dolist' to silence misleading lexical-binding warning. + +2011-06-04 Chong Yidong <cyd@stupidchicken.com> + + * emacs-lisp/timer.el (timer-activate): Remove unused arg. + (timer-activate, timer-activate-when-idle): Doc fix (Bug#8793). + +2011-06-04 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp-sh.el (tramp-find-shell): Apply workaround also for + "SunOS 5.10". + +2011-06-04 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-set-completion-function, tramp-parse-rhosts) + (tramp-parse-shosts, tramp-parse-sconfig, tramp-parse-shostkeys) + (tramp-parse-hosts, tramp-parse-passwd, tramp-parse-netrc) + (tramp-parse-putty): + * net/tramp-sh.el (tramp-completion-function-alist-rsh) + (tramp-completion-function-alist-ssh) + (tramp-completion-function-alist-telnet) + (tramp-completion-function-alist-su) + (tramp-completion-function-alist-putty): Set `tramp-autoload' + cookie. + + * net/tramp-ftp.el: + * net/tramp-sh.el: + * net/tramp-smb.el: Set `tramp-autoload' cookie, and eval after + load "tramp.el" `tramp-set-completion-function'. + +2011-06-04 Stefan Monnier <monnier@iro.umontreal.ca> + + * shell.el: Require and use pcomplete. + (shell-dynamic-complete-functions): Add pcomplete-completions-at-point. + (shell-completion-vars): Set pcomplete-default-completion-function. + +2011-06-04 Deniz Dogan <deniz@dogan.se> + + * iswitchb.el (iswitchb-window-buffer-p): Use `member' instead of + `memq' (Bug#8799). + 2011-06-02 Stefan Monnier <monnier@iro.umontreal.ca> * subr.el (make-progress-reporter): Add "..." by default (bug#8785). diff --git a/lisp/comint.el b/lisp/comint.el index e4bc530f361..5548d19ad30 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -3035,7 +3035,8 @@ Returns t if successful." (when (comint--match-partial-filename) (unless (window-minibuffer-p (selected-window)) (message "Completing file name...")) - (apply #'completion-in-region (comint--complete-file-name-data)))) + (let ((data (comint--complete-file-name-data))) + (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data))))) (defun comint-filename-completion () "Return completion data for filename at point, if any." @@ -3152,7 +3153,8 @@ in the same way as TABLE completes strings of the form (concat S2 S)." (defun comint-dynamic-complete-as-filename () "Dynamically complete at point as a filename. See `comint-dynamic-complete-filename'. Returns t if successful." - (apply #'completion-in-region (comint--complete-file-name-data))) + (let ((data (comint--complete-file-name-data))) + (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data)))) (make-obsolete 'comint-dynamic-complete-as-filename 'comint-filename-completion "24.1") diff --git a/lisp/doc-view.el b/lisp/doc-view.el index 7bd1a55011e..06c3b70a3a6 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -614,9 +614,10 @@ It's a subdirectory of `doc-view-cache-directory'." (defun doc-view-remove-if (predicate list) "Return LIST with all items removed that satisfy PREDICATE." (let (new-list) - (dolist (item list (nreverse new-list)) + (dolist (item list) (when (not (funcall predicate item)) - (setq new-list (cons item new-list)))))) + (setq new-list (cons item new-list)))) + (nreverse new-list))) ;;;###autoload (defun doc-view-mode-p (type) diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el index 5f069226aa9..0a035175041 100644 --- a/lisp/emacs-lisp/timer.el +++ b/lisp/emacs-lisp/timer.el @@ -189,35 +189,35 @@ fire repeatedly that many seconds apart." (setcdr reuse-cell timers)) (setq reuse-cell (cons timer timers))) ;; Insert new timer after last which possibly means in front of queue. - (if last - (setcdr last reuse-cell) - (if idle - (setq timer-idle-list reuse-cell) - (setq timer-list reuse-cell))) + (cond (last (setcdr last reuse-cell)) + (idle (setq timer-idle-list reuse-cell)) + (t (setq timer-list reuse-cell))) (setf (timer--triggered timer) triggered-p) (setf (timer--idle-delay timer) idle) nil) (error "Invalid or uninitialized timer"))) -(defun timer-activate (timer &optional triggered-p reuse-cell idle) - "Put TIMER on the list of active timers. +(defun timer-activate (timer &optional triggered-p reuse-cell) + "Insert TIMER into `timer-list'. +If TRIGGERED-P is t, make TIMER inactive (put it on the list, but +mark it as already triggered). To remove it, use `cancel-timer'. -If TRIGGERED-P is t, that means to make the timer inactive -\(put it on the list, but mark it as already triggered). -To remove from the list, use `cancel-timer'. - -REUSE-CELL, if non-nil, is a cons cell to reuse instead -of allocating a new one." +REUSE-CELL, if non-nil, is a cons cell to reuse when inserting +TIMER into `timer-list' (usually a cell removed from that list by +`cancel-timer-internal'; using this reduces consing for repeat +timers). If nil, allocate a new cell." (timer--activate timer triggered-p reuse-cell nil)) (defun timer-activate-when-idle (timer &optional dont-wait reuse-cell) - "Arrange to activate TIMER whenever Emacs is next idle. -If optional argument DONT-WAIT is non-nil, then enable the -timer to activate immediately, or at the right time, if Emacs -is already idle. - -REUSE-CELL, if non-nil, is a cons cell to reuse instead -of allocating a new one." + "Insert TIMER into `timer-idle-list'. +This arranges to activate TIMER whenever Emacs is next idle. +If optional argument DONT-WAIT is non-nil, set TIMER to activate +immediately, or at the right time, if Emacs is already idle. + +REUSE-CELL, if non-nil, is a cons cell to reuse when inserting +TIMER into `timer-idle-list' (usually a cell removed from that +list by `cancel-timer-internal'; using this reduces consing for +repeat timers). If nil, allocate a new cell." (timer--activate timer (not dont-wait) reuse-cell 'idle)) (defalias 'disable-timeout 'cancel-timer) diff --git a/lisp/iswitchb.el b/lisp/iswitchb.el index e0da2563c1a..70dda5442d5 100644 --- a/lisp/iswitchb.el +++ b/lisp/iswitchb.el @@ -1118,10 +1118,9 @@ Return the modified list with the last element prepended to it." If BUFFER is visible in the current frame, return nil." (interactive) (let ((blist (iswitchb-get-buffers-in-frames 'current))) - ;;If the buffer is visible in current frame, return nil - (if (memq buffer blist) - nil - ;; maybe in other frame or icon + ;; If the buffer is visible in current frame, return nil + (unless (member buffer blist) + ;; maybe in other frame or icon (get-buffer-window buffer 0) ; better than 'visible ))) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index bd9d6846a4b..70190867e89 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -455,15 +455,7 @@ If ARG is non-nil, instead prompt for connection parameters." :channels) " ")) "[, ]+" t)) - (encryption - (intern (completing-read "Encryption (default plain): " - '("plain" "tls") - nil t - (let ((choice (plist-get server-plist - :encryption))) - (when choice - (symbol-name choice))) - nil "plain")))) + (encryption (rcirc-prompt-for-encryption server-plist))) (rcirc-connect server port nick user-name rcirc-default-full-name channels password encryption)) @@ -596,6 +588,17 @@ If ARG is non-nil, instead prompt for connection parameters." (time-to-seconds (current-time)) (float-time))) +(defun rcirc-prompt-for-encryption (server-plist) + "Prompt the user for the encryption method to use. +SERVER-PLIST is the property list for the server." + (let ((msg "Encryption (default %s): ") + (choices '("plain" "tls")) + (default (or (plist-get server-plist :encryption) + 'plain))) + (intern + (completing-read (format msg default) + choices nil t nil nil (symbol-name default))))) + (defun rcirc-keepalive () "Send keep alive pings to active rcirc processes. Kill processes that have not received a server message since the diff --git a/lisp/net/tramp-ftp.el b/lisp/net/tramp-ftp.el index d42a6f57ea9..71b3eacccea 100644 --- a/lisp/net/tramp-ftp.el +++ b/lisp/net/tramp-ftp.el @@ -113,9 +113,11 @@ present for backward compatibility." (list nil "\\`\\(anonymous\\|ftp\\)\\'" tramp-ftp-method))) ;; Add completion function for FTP method. -(tramp-set-completion-function - tramp-ftp-method - '((tramp-parse-netrc "~/.netrc"))) +;;;###tramp-autoload +(eval-after-load 'tramp + '(tramp-set-completion-function + tramp-ftp-method + '((tramp-parse-netrc "~/.netrc")))) ;; If there is URL syntax, `substitute-in-file-name' needs special ;; handling. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index a25877abe90..025b4ab6cf3 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -400,11 +400,13 @@ detected as prompt when being sent on echoing hosts, therefore.") "\\'") nil ,(user-login-name))) +;;;###tramp-autoload (defconst tramp-completion-function-alist-rsh '((tramp-parse-rhosts "/etc/hosts.equiv") (tramp-parse-rhosts "~/.rhosts")) "Default list of (FUNCTION FILE) pairs to be examined for rsh methods.") +;;;###tramp-autoload (defconst tramp-completion-function-alist-ssh '((tramp-parse-rhosts "/etc/hosts.equiv") (tramp-parse-rhosts "/etc/shosts.equiv") @@ -420,47 +422,60 @@ detected as prompt when being sent on echoing hosts, therefore.") (tramp-parse-sknownhosts "~/.ssh2/knownhosts")) "Default list of (FUNCTION FILE) pairs to be examined for ssh methods.") +;;;###tramp-autoload (defconst tramp-completion-function-alist-telnet '((tramp-parse-hosts "/etc/hosts")) "Default list of (FUNCTION FILE) pairs to be examined for telnet methods.") +;;;###tramp-autoload (defconst tramp-completion-function-alist-su '((tramp-parse-passwd "/etc/passwd")) "Default list of (FUNCTION FILE) pairs to be examined for su methods.") +;;;###tramp-autoload (defconst tramp-completion-function-alist-putty '((tramp-parse-putty "HKEY_CURRENT_USER\\Software\\SimonTatham\\PuTTY\\Sessions")) "Default list of (FUNCTION REGISTRY) pairs to be examined for putty methods.") -(tramp-set-completion-function "rcp" tramp-completion-function-alist-rsh) -(tramp-set-completion-function "remcp" tramp-completion-function-alist-rsh) -(tramp-set-completion-function "scp" tramp-completion-function-alist-ssh) -(tramp-set-completion-function "scp1" tramp-completion-function-alist-ssh) -(tramp-set-completion-function "scp2" tramp-completion-function-alist-ssh) -(tramp-set-completion-function "scpc" tramp-completion-function-alist-ssh) -(tramp-set-completion-function "scpx" tramp-completion-function-alist-ssh) -(tramp-set-completion-function "sftp" tramp-completion-function-alist-ssh) -(tramp-set-completion-function "rsync" tramp-completion-function-alist-ssh) -(tramp-set-completion-function "rsyncc" tramp-completion-function-alist-ssh) -(tramp-set-completion-function "rsh" tramp-completion-function-alist-rsh) -(tramp-set-completion-function "remsh" tramp-completion-function-alist-rsh) -(tramp-set-completion-function "ssh" tramp-completion-function-alist-ssh) -(tramp-set-completion-function "ssh1" tramp-completion-function-alist-ssh) -(tramp-set-completion-function "ssh2" tramp-completion-function-alist-ssh) -(tramp-set-completion-function "ssh1_old" tramp-completion-function-alist-ssh) -(tramp-set-completion-function "ssh2_old" tramp-completion-function-alist-ssh) -(tramp-set-completion-function "sshx" tramp-completion-function-alist-ssh) -(tramp-set-completion-function "telnet" tramp-completion-function-alist-telnet) -(tramp-set-completion-function "su" tramp-completion-function-alist-su) -(tramp-set-completion-function "sudo" tramp-completion-function-alist-su) -(tramp-set-completion-function "ksu" tramp-completion-function-alist-su) -(tramp-set-completion-function "krlogin" tramp-completion-function-alist-rsh) -(tramp-set-completion-function "plink" tramp-completion-function-alist-ssh) -(tramp-set-completion-function "plink1" tramp-completion-function-alist-ssh) -(tramp-set-completion-function "plinkx" tramp-completion-function-alist-putty) -(tramp-set-completion-function "pscp" tramp-completion-function-alist-ssh) -(tramp-set-completion-function "fcp" tramp-completion-function-alist-ssh) +;;;###tramp-autoload +(eval-after-load 'tramp + '(progn + (tramp-set-completion-function "rcp" tramp-completion-function-alist-rsh) + (tramp-set-completion-function "remcp" tramp-completion-function-alist-rsh) + (tramp-set-completion-function "scp" tramp-completion-function-alist-ssh) + (tramp-set-completion-function "scp1" tramp-completion-function-alist-ssh) + (tramp-set-completion-function "scp2" tramp-completion-function-alist-ssh) + (tramp-set-completion-function "scpc" tramp-completion-function-alist-ssh) + (tramp-set-completion-function "scpx" tramp-completion-function-alist-ssh) + (tramp-set-completion-function "sftp" tramp-completion-function-alist-ssh) + (tramp-set-completion-function "rsync" tramp-completion-function-alist-ssh) + (tramp-set-completion-function + "rsyncc" tramp-completion-function-alist-ssh) + (tramp-set-completion-function "rsh" tramp-completion-function-alist-rsh) + (tramp-set-completion-function "remsh" tramp-completion-function-alist-rsh) + (tramp-set-completion-function "ssh" tramp-completion-function-alist-ssh) + (tramp-set-completion-function "ssh1" tramp-completion-function-alist-ssh) + (tramp-set-completion-function "ssh2" tramp-completion-function-alist-ssh) + (tramp-set-completion-function + "ssh1_old" tramp-completion-function-alist-ssh) + (tramp-set-completion-function + "ssh2_old" tramp-completion-function-alist-ssh) + (tramp-set-completion-function "sshx" tramp-completion-function-alist-ssh) + (tramp-set-completion-function + "telnet" tramp-completion-function-alist-telnet) + (tramp-set-completion-function "su" tramp-completion-function-alist-su) + (tramp-set-completion-function "sudo" tramp-completion-function-alist-su) + (tramp-set-completion-function "ksu" tramp-completion-function-alist-su) + (tramp-set-completion-function + "krlogin" tramp-completion-function-alist-rsh) + (tramp-set-completion-function "plink" tramp-completion-function-alist-ssh) + (tramp-set-completion-function + "plink1" tramp-completion-function-alist-ssh) + (tramp-set-completion-function + "plinkx" tramp-completion-function-alist-putty) + (tramp-set-completion-function "pscp" tramp-completion-function-alist-ssh) + (tramp-set-completion-function "fcp" tramp-completion-function-alist-ssh))) ;; "getconf PATH" yields: ;; HP-UX: /usr/bin:/usr/ccs/bin:/opt/ansic/bin:/opt/langtools/bin:/opt/fortran/bin @@ -3626,9 +3641,11 @@ file exists and nonzero exit status otherwise." (tramp-send-command vec "echo ~root" t) (cond ((or (string-match "^~root$" (buffer-string)) - ;; The default shell (ksh93) of OpenSolaris is buggy. - (string-equal (tramp-get-connection-property vec "uname" "") - "SunOS 5.11")) + ;; The default shell (ksh93) of OpenSolaris and Solaris + ;; is buggy. We've got reports for "SunOS 5.10" and + ;; "SunOS 5.11" so far. + (string-match (regexp-opt '("SunOS 5.10" "SunOS 5.11")) + (tramp-get-connection-property vec "uname" ""))) (setq shell (or (tramp-find-executable vec "bash" (tramp-get-remote-path vec) t t) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index a43e99c1206..eb456298c1a 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -53,9 +53,11 @@ `(,(concat "\\`" tramp-smb-method "\\'") nil nil)) ;; Add completion function for SMB method. -(tramp-set-completion-function - tramp-smb-method - '((tramp-parse-netrc "~/.netrc"))) +;;;###tramp-autoload +(eval-after-load 'tramp + '(tramp-set-completion-function + tramp-smb-method + '((tramp-parse-netrc "~/.netrc")))) (defcustom tramp-smb-program "smbclient" "*Name of SMB client to run." diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 178f057a66c..8f1095a0486 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1500,6 +1500,7 @@ letter into the file name. This function removes it." ;;; Config Manipulation Functions: +;;;###tramp-autoload (defun tramp-set-completion-function (method function-list) "Sets the list of completion functions for METHOD. FUNCTION-LIST is a list of entries of the form (FUNCTION FILE). @@ -2366,6 +2367,7 @@ PARTIAL-USER must match USER, PARTIAL-HOST must match HOST." (unless (zerop (+ (length user) (length host))) (tramp-completion-make-tramp-file-name method user host nil))) +;;;###tramp-autoload (defun tramp-parse-rhosts (filename) "Return a list of (user host) tuples allowed to access. Either user or host may be nil." @@ -2396,6 +2398,7 @@ Either user or host may be nil." (forward-line 1) result)) +;;;###tramp-autoload (defun tramp-parse-shosts (filename) "Return a list of (user host) tuples allowed to access. User is always nil." @@ -2425,6 +2428,7 @@ User is always nil." (forward-line 1)) result)) +;;;###tramp-autoload (defun tramp-parse-sconfig (filename) "Return a list of (user host) tuples allowed to access. User is always nil." @@ -2454,6 +2458,7 @@ User is always nil." (forward-line 1)) result)) +;;;###tramp-autoload (defun tramp-parse-shostkeys (dirname) "Return a list of (user host) tuples allowed to access. User is always nil." @@ -2485,6 +2490,7 @@ User is always nil." (setq files (cdr files))) result)) +;;;###tramp-autoload (defun tramp-parse-hosts (filename) "Return a list of (user host) tuples allowed to access. User is always nil." @@ -2519,6 +2525,7 @@ User is always nil." ;; as default. Unfortunately, we have no information whether any user name ;; has been typed already. So we use `tramp-current-user' as indication, ;; assuming it is set in `tramp-completion-handle-file-name-all-completions'. +;;;###tramp-autoload (defun tramp-parse-passwd (filename) "Return a list of (user host) tuples allowed to access. Host is always \"localhost\"." @@ -2548,6 +2555,7 @@ Host is always \"localhost\"." (forward-line 1) result)) +;;;###tramp-autoload (defun tramp-parse-netrc (filename) "Return a list of (user host) tuples allowed to access. User may be nil." @@ -2578,6 +2586,7 @@ User may be nil." (forward-line 1) result)) +;;;###tramp-autoload (defun tramp-parse-putty (registry) "Return a list of (user host) tuples allowed to access. User is always nil." diff --git a/lisp/shell.el b/lisp/shell.el index e07f996823e..8a282e94160 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -98,6 +98,7 @@ (eval-when-compile (require 'cl)) (require 'comint) +(require 'pcomplete) ;;; Customization and Buffer Variables @@ -186,7 +187,9 @@ This is a fine thing to set in your `.emacs' file.") shell-environment-variable-completion shell-command-completion shell-c-a-p-replace-by-expanded-directory + pcomplete-completions-at-point shell-filename-completion + ;; Not sure when this one would still be useful. --Stef comint-filename-completion) "List of functions called to perform completion. This variable is used to initialize `comint-dynamic-complete-functions' in the @@ -380,7 +383,6 @@ to `dirtrack-mode'." :group 'shell :type '(choice (const nil) regexp)) -(defvar pcomplete-parse-arguments-function) (defun shell-completion-vars () "Setup completion vars for `shell-mode' and `read-shell-command'." @@ -396,6 +398,9 @@ to `dirtrack-mode'." (set (make-local-variable 'pcomplete-parse-arguments-function) ;; FIXME: This function should be moved to shell.el. #'pcomplete-parse-comint-arguments) + ;; Don't use pcomplete's defaulting mechanism, rely on + ;; shell-dynamic-complete-functions instead. + (set (make-local-variable 'pcomplete-default-completion-function) #'ignore) (setq comint-input-autoexpand shell-input-autoexpand) ;; Not needed in shell-mode because it's inherited from comint-mode, but ;; placed here for read-shell-command. diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index 9d05728ffad..12094887f38 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -126,6 +126,8 @@ braces Enclose parts of field entries by braces according to `bibtex-field-braces-alist'. strings Replace parts of field entries by string constants according to `bibtex-field-strings-alist'. +sort-fields Sort fields to match the field order in + `bibtex-entry-field-alist'. The value t means do all of the above formatting actions. The value nil means do no formatting at all." @@ -144,7 +146,8 @@ The value nil means do no formatting at all." (const delimiters) (const unify-case) (const braces) - (const strings)))) + (const strings) + (const sort-fields)))) (put 'bibtex-entry-format 'safe-local-variable (lambda (x) (or (eq x t) @@ -153,7 +156,8 @@ The value nil means do no formatting at all." (unless (memq (pop x) '(opts-or-alts required-fields numerical-fields page-dashes whitespace inherit-booktitle realign - last-comma delimiters unify-case braces strings)) + last-comma delimiters unify-case braces strings + sort-fields)) (setq OK nil))) (unless (null x) (setq OK nil)) OK)))) @@ -593,7 +597,8 @@ to the directories specified in `bibtex-string-file-path'." List elements can be absolute file names or file names relative to the directories specified in `bibtex-file-path'. If an element is a directory, check all BibTeX files in this directory. If an element is the symbol -`bibtex-file-path', check all BibTeX files in `bibtex-file-path'." +`bibtex-file-path', check all BibTeX files in `bibtex-file-path'. +See also `bibtex-search-entry-globally'." :group 'bibtex :type '(repeat (choice (const :tag "bibtex-file-path" bibtex-file-path) directory file))) @@ -601,6 +606,12 @@ check all BibTeX files in this directory. If an element is the symbol (defvar bibtex-file-path (getenv "BIBINPUTS") "*Colon separated list of paths to search for `bibtex-files'.") +(defcustom bibtex-search-entry-globally nil + "If non-nil, interactive calls of `bibtex-search-entry' search globally. +A global search includes all files in `bibtex-files'." + :group 'bibtex + :type 'boolean) + (defcustom bibtex-help-message t "If non-nil print help messages in the echo area on entering a new field." :group 'bibtex @@ -912,7 +923,7 @@ The following is a complex example, see URL `http://link.aps.org/'. (((\"journal\" . \"\\\\=<\\(PR[ABCDEL]?\\|RMP\\)\\\\=>\") \"http://link.aps.org/abstract/%s/v%s/p%s\" - (\"journal\" \".*\" downcase) + (\"journal\" \".*\" upcase) (\"volume\" \".*\" 0) (\"pages\" \"\\`[A-Z]?[0-9]+\" 0)))" :group 'bibtex @@ -957,6 +968,11 @@ Set this variable before loading BibTeX mode." :group 'bibtex :type 'boolean) +(defcustom bibtex-search-buffer "*BibTeX Search*" + "Buffer for BibTeX search results." + :group 'bibtex + :type 'string) + ;; `bibtex-font-lock-keywords' is a user option, too. But since the ;; patterns used to define this variable are defined in a later ;; section of this file, it is defined later. @@ -1014,6 +1030,7 @@ Set this variable before loading BibTeX mode." (define-key km "\C-c\C-rn" 'bibtex-narrow-to-entry) (define-key km "\C-c\C-rw" 'widen) (define-key km "\C-c\C-l" 'bibtex-url) + (define-key km "\C-c\C-a" 'bibtex-search-entries) (define-key km "\C-c\C-o" 'bibtex-remove-OPT-or-ALT) (define-key km "\C-c\C-e\C-i" 'bibtex-InProceedings) (define-key km "\C-c\C-ei" 'bibtex-InCollection) @@ -1091,6 +1108,8 @@ Set this variable before loading BibTeX mode." ["View Cite Locations (RefTeX)" reftex-view-crossref-from-bibtex (fboundp 'reftex-view-crossref-from-bibtex)]) ("Operating on Buffer or Region" + ["Search Entries" bibtex-search-entries t] + "--" ["Validate Entries" bibtex-validate t] ["Sort Entries" bibtex-sort-buffer t] ["Reformat Entries" bibtex-reformat t] @@ -1881,6 +1900,9 @@ Optional arg COMMA is as in `bibtex-enclosing-field'." (push-mark) (insert (funcall fun 'bibtex-entry-kill-ring-yank-pointer bibtex-entry-kill-ring)) + ;; If we copied an entry from a buffer containing only this one entry, + ;; it can be missing the second "\n". + (unless (looking-back "\n\n") (insert "\n")) (unless (functionp bibtex-reference-keys) ;; update `bibtex-reference-keys' (save-excursion @@ -1906,7 +1928,7 @@ Formats current entry according to variable `bibtex-entry-format'." '(realign opts-or-alts required-fields numerical-fields page-dashes whitespace inherit-booktitle last-comma delimiters unify-case braces - strings) + strings sort-fields) bibtex-entry-format)) (left-delim-re (regexp-quote (bibtex-field-left-delimiter))) bounds crossref-key req-field-list default-field-list field-list @@ -1962,7 +1984,21 @@ Formats current entry according to variable `bibtex-entry-format'." ;; default list of fields that may appear in this entry default-field-list (append (nth 0 (nth 1 entry-list)) (nth 1 (nth 1 entry-list)) - bibtex-user-optional-fields))) + bibtex-user-optional-fields)) + + (when (memq 'sort-fields format) + (goto-char (point-min)) + (let ((beg-fields (save-excursion (bibtex-beginning-first-field))) + (fields-alist (bibtex-parse-entry)) + bibtex-help-message elt) + (delete-region beg-fields (point)) + (dolist (field default-field-list) + (when (setq elt (assoc-string (car field) fields-alist t)) + (setq fields-alist (delete elt fields-alist)) + (bibtex-make-field (list (car elt) "" (cdr elt)) nil nil t))) + (dolist (field fields-alist) + (unless (member (car field) '("=key=" "=type=")) + (bibtex-make-field (list (car field) "" (cdr field)) nil nil t)))))) ;; process all fields (bibtex-beginning-first-field (point-min)) @@ -2698,12 +2734,14 @@ When called interactively, FORCE is t, CURRENT is t if current buffer uses ((and (not current) (memq (current-buffer) buffer-list)) (setq buffer-list (delq (current-buffer) buffer-list)))) ;; parse keys - (dolist (buffer buffer-list) - (with-current-buffer buffer - (if (or force (functionp bibtex-reference-keys)) - (bibtex-parse-keys)) - (unless (functionp bibtex-strings) - (bibtex-parse-strings (bibtex-string-files-init))))) + (let (string-init) + (dolist (buffer buffer-list) + (with-current-buffer buffer + (if (or force (functionp bibtex-reference-keys)) + (bibtex-parse-keys)) + (when (or force (functionp bibtex-strings)) + (unless string-init (setq string-init (bibtex-string-files-init))) + (bibtex-parse-strings string-init))))) ;; select BibTeX buffer (if select (if buffer-list @@ -3018,10 +3056,7 @@ if that value is non-nil. bibtex-font-lock-syntactic-keywords)) (setq imenu-generic-expression (list (list nil bibtex-entry-head bibtex-key-in-head)) - imenu-case-fold-search t) - ;; XEmacs needs `easy-menu-add', Emacs does not care - (easy-menu-add bibtex-edit-menu) - (easy-menu-add bibtex-entry-menu)) + imenu-case-fold-search t)) (defun bibtex-field-list (entry-type) "Return list of allowed fields for entry ENTRY-TYPE. @@ -3139,7 +3174,7 @@ If optional arg CONTENT is non-nil extract content of text fields." (bibtex-text-in-field-bounds bounds content)) alist) (goto-char (bibtex-end-of-field bounds)))) - alist)) + (nreverse alist))) (defun bibtex-autofill-entry () "Try to fill fields of current BibTeX entry based on neighboring entries. @@ -3567,10 +3602,15 @@ is limited to the current buffer. Optional arg START is buffer position where the search starts. If it is nil, start search at beginning of buffer. If DISPLAY is non-nil, display the buffer containing KEY. Otherwise, use `set-buffer'. -When called interactively, GLOBAL is t if there is a prefix arg or the current -mode is not `bibtex-mode', START is nil, and DISPLAY is t." +When called interactively, START is nil, DISPLAY is t. +Also, GLOBAL is t if the current mode is not `bibtex-mode' +or `bibtex-search-entry-globally' is non-nil. +A prefix arg negates the value of `bibtex-search-entry-globally'." (interactive - (let ((global (or current-prefix-arg (not (eq major-mode 'bibtex-mode))))) + (let ((global (or (not (eq major-mode 'bibtex-mode)) + (if bibtex-search-entry-globally + (not current-prefix-arg) + current-prefix-arg)))) (list (bibtex-read-key "Find key: " nil global) global nil t))) (if (and global bibtex-files) (let ((buffer-list (bibtex-initialize t)) @@ -3843,20 +3883,21 @@ Return t if test was successful, nil otherwise." ;; Check for duplicate keys within BibTeX buffer (dolist (buffer buffer-list) (with-current-buffer buffer - (let (entry-type key key-list) - (goto-char (point-min)) - (while (re-search-forward bibtex-entry-head nil t) - (setq entry-type (bibtex-type-in-head) - key (bibtex-key-in-head)) - (if (or (and strings (bibtex-string= entry-type "string")) - (assoc-string entry-type bibtex-entry-field-alist t)) - (if (member key key-list) - (push (format "%s:%d: Duplicate key `%s'\n" - (buffer-file-name) - (bibtex-current-line) key) - error-list) - (push key key-list)))) - (push (cons buffer key-list) buffer-key-list)))) + (save-excursion + (let (entry-type key key-list) + (goto-char (point-min)) + (while (re-search-forward bibtex-entry-head nil t) + (setq entry-type (bibtex-type-in-head) + key (bibtex-key-in-head)) + (if (or (and strings (bibtex-string= entry-type "string")) + (assoc-string entry-type bibtex-entry-field-alist t)) + (if (member key key-list) + (push (format "%s:%d: Duplicate key `%s'\n" + (buffer-file-name) + (bibtex-current-line) key) + error-list) + (push key key-list)))) + (push (cons buffer key-list) buffer-key-list))))) ;; Check for duplicate keys among BibTeX buffers (while (setq current-buf (pop buffer-list)) @@ -4118,6 +4159,7 @@ More precisely, reinsert the field or entry killed or yanked most recently. With argument N, reinsert the Nth most recently killed BibTeX item. See also the command \\[bibtex-yank-pop]." (interactive "*p") + (unless n (setq n 1)) (bibtex-insert-kill (1- n) t) (setq this-command 'bibtex-yank)) @@ -4397,14 +4439,15 @@ If mark is active reformat entries in region, if not in whole buffer." ("Force delimiters? " . 'delimiters) ("Unify case of entry types and field names? " . 'unify-case) ("Enclose parts of field entries by braces? " . 'braces) - ("Replace parts of field entries by string constants? " . 'strings)))))) + ("Replace parts of field entries by string constants? " . 'strings) + ("Sort fields? " . 'sort-fields)))))) ;; Do not include required-fields because `bibtex-reformat' ;; cannot handle the error messages of `bibtex-format-entry'. ;; Use `bibtex-validate' to check for required fields. ((eq t bibtex-entry-format) '(realign opts-or-alts numerical-fields delimiters last-comma page-dashes unify-case inherit-booktitle - whitespace braces strings)) + whitespace braces strings sort-fields)) (t (cons 'realign (remove 'required-fields bibtex-entry-format))))) (reformat-reference-keys @@ -4754,6 +4797,118 @@ Return the URL or nil if none can be generated." (message "No URL known.")) url))) +;; We could combine multiple seach results with set operations +;; AND, OR, MINUS, and NOT. Would this be useful? +;; How complicated are searches in real life? +;; We could also have other searches such as "publication year newer than...". +(defun bibtex-search-entries (field regexp &optional global display) + "Search BibTeX entries for FIELD matching REGEXP. +REGEXP may be a regexp to search for. +If REGEXP is a function, it is called for each entry with two args, +the buffer positions of beginning and end of entry. Then an entry +is accepted if this function returns non-nil. +If FIELD is an empty string perform search for REGEXP in whole entry. +With GLOBAL non-nil, search in `bibtex-files'. Otherwise the search +is limited to the current buffer. +If DISPLAY is non-nil, display search results in `bibtex-search-buffer'. +When called interactively, DISPLAY is t. +Also, GLOBAL is t if `bibtex-search-entry-globally' is non-nil. +A prefix arg negates the value of `bibtex-search-entry-globally'. +Return alist with elements (KEY FILE ENTRY), +where FILE is the BibTeX file of ENTRY." + (interactive + (list (completing-read + "Field: " + (delete-dups + (apply 'append + bibtex-user-optional-fields + (mapcar (lambda (x) + (append (mapcar 'car (nth 0 (nth 1 x))) + (mapcar 'car (nth 1 (nth 1 x))))) + bibtex-entry-field-alist))) nil t) + (read-string "Regexp: ") + (if bibtex-search-entry-globally + (not current-prefix-arg) + current-prefix-arg) + t)) + (let ((funp (functionp regexp)) + entries text file) + ;; If REGEXP is a function, the value of FIELD is ignored anyway. + ;; Yet to ensure the code below does not fail, we make FIELD + ;; a non-empty string. + (if (and funp (string= "" field)) (setq field "unrestricted")) + (dolist (buffer (if (and global bibtex-files) + (bibtex-initialize t) + (list (current-buffer)))) + (with-current-buffer buffer + (setq file (if buffer-file-name + (file-name-nondirectory buffer-file-name) + (buffer-name buffer))) + (save-excursion + (goto-char (point-min)) + (if (string= "" field) + ;; Unrestricted search. + (while (re-search-forward regexp nil t) + (let ((beg (bibtex-beginning-of-entry)) + (end (bibtex-end-of-entry)) + key) + (if (and (<= beg (match-beginning 0)) + (<= (match-end 0) end) + (save-excursion + (goto-char beg) + (and (looking-at bibtex-entry-head) + (setq key (bibtex-key-in-head))))) + (add-to-list 'entries + (list key file + (buffer-substring-no-properties + beg end)))))) + ;; The following is slow. But it works reliably even in more + ;; complicated cases with BibTeX string constants and crossrefed + ;; entries. If you prefer speed over reliability, perform an + ;; unrestricted search. + (bibtex-map-entries + (lambda (key beg end) + (if (cond (funp (funcall regexp beg end)) + ((and (setq text (bibtex-text-in-field field t)) + (string-match regexp text)))) + (add-to-list 'entries + (list key file + (buffer-substring-no-properties + beg end)))))))))) + (if display + (if entries + (bibtex-display-entries entries) + (message "No BibTeX entries %smatching `%s'" + (if (string= "" field) "" + (format "with field `%s' " field)) + regexp))) + entries)) + +(defun bibtex-display-entries (entries &optional append) + "Display BibTeX ENTRIES in `bibtex-search-buffer'. +ENTRIES is an alist with elements (KEY FILE ENTRY), +where FILE is the BibTeX file of ENTRY. +If APPEND is non-nil, append ENTRIES to those already displayed." + (pop-to-buffer (get-buffer-create bibtex-search-buffer)) + ;; It would be nice if this buffer was editable, though editing + ;; can be meaningful only for individual existing entries + ;; (unlike reordering or creating new entries). + ;; Fancy workaround: Editing commands in the virtual buffer could + ;; jump to the real entry in the real buffer. + (let (buffer-read-only) + (if append (goto-char (point-max)) (erase-buffer)) + (dolist (entry (sort entries (lambda (x y) (string< (car x) (car y))))) + (insert "% " (nth 1 entry) "\n" (nth 2 entry) "\n\n"))) + ;; `bibtex-sort-buffer' fails with the file names associated with + ;; each entry. Prior to sorting we could make the file name + ;; a BibTeX field of each entry (using `bibtex-make-field'). + ;; Or we could make it a text property that we unfold afterwards. + ;; (bibtex-sort-buffer) + (bibtex-mode) + (set-buffer-modified-p nil) + (setq buffer-read-only t) + (goto-char (point-min))) + ;; Make BibTeX a Feature diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index e5ab59e828f..9f7ad1c1ca5 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog @@ -1,3 +1,7 @@ +2011-06-04 Andreas Schwab <schwab@linux-m68k.org> + + * url-future.el (url-future-test): Fix scope of `saver'. + 2011-06-01 Glenn Morris <rgm@gnu.org> * url-queue.el (url-queue-parallel-processes, url-queue-timeout): diff --git a/lisp/url/url-future.el b/lisp/url/url-future.el index 334c4fa9126..ac85a3cec47 100644 --- a/lisp/url/url-future.el +++ b/lisp/url/url-future.el @@ -96,7 +96,8 @@ (url-future-finish url-future 'cancel))) (ert-deftest url-future-test () - (let* ((text "running future") + (let* (saver + (text "running future") (good (make-url-future :value (lambda () (format text)) :callback (lambda (f) (set 'saver f)))) (bad (make-url-future :value (lambda () (/ 1 0)) @@ -104,8 +105,7 @@ (tocancel (make-url-future :value (lambda () (/ 1 0)) :callback (lambda (f) (set 'saver f)) :errorback (lambda (&rest d) - (set 'saver d)))) - saver) + (set 'saver d))))) (should (equal good (url-future-call good))) (should (equal good saver)) (should (equal text (url-future-value good))) diff --git a/lisp/window.el b/lisp/window.el index 9ea00442628..0da3f5ae1de 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -30,15 +30,6 @@ (eval-when-compile (require 'cl)) -(defvar window-size-fixed nil - "*Non-nil in a buffer means windows displaying the buffer are fixed-size. -If the value is `height', then only the window's height is fixed. -If the value is `width', then only the window's width is fixed. -Any other non-nil value fixes both the width and the height. -Emacs won't change the size of any window displaying that buffer, -unless you explicitly change the size, or Emacs has no other choice.") -(make-variable-buffer-local 'window-size-fixed) - (defmacro save-selected-window (&rest body) "Execute BODY, then select the previously selected window. The value returned is the value of the last form in BODY. @@ -72,6 +63,434 @@ are not altered by this macro (unless they are altered in BODY)." (when (window-live-p save-selected-window-window) (select-window save-selected-window-window 'norecord)))))) +;; The following two functions are like `window-next' and `window-prev' +;; but the WINDOW argument is _not_ optional (so they don't substitute +;; the selected window for nil), and they return nil when WINDOW doesn't +;; have a parent (like a frame's root window or a minibuffer window). +(defsubst window-right (window) + "Return WINDOW's right sibling. +Return nil if WINDOW is the root window of its frame. WINDOW can +be any window." + (and window (window-parent window) (window-next window))) + +(defsubst window-left (window) + "Return WINDOW's left sibling. +Return nil if WINDOW is the root window of its frame. WINDOW can +be any window." + (and window (window-parent window) (window-prev window))) + +(defsubst window-child (window) + "Return WINDOW's first child window." + (or (window-vchild window) (window-hchild window))) + +(defun window-child-count (window) + "Return number of WINDOW's child windows." + (let ((count 0)) + (when (and (windowp window) (setq window (window-child window))) + (while window + (setq count (1+ count)) + (setq window (window-next window)))) + count)) + +(defun window-last-child (window) + "Return last child window of WINDOW." + (when (and (windowp window) (setq window (window-child window))) + (while (window-next window) + (setq window (window-next window)))) + window) + +(defsubst window-any-p (object) + "Return t if OBJECT denotes a live or internal window." + (and (windowp object) + (or (window-buffer object) (window-child object)) + t)) + +;; The following four functions should probably go to subr.el. +(defsubst normalize-live-buffer (buffer-or-name) + "Return buffer specified by BUFFER-OR-NAME. +BUFFER-OR-NAME must be either a buffer or a string naming a live +buffer and defaults to the current buffer." + (cond + ((not buffer-or-name) + (current-buffer)) + ((bufferp buffer-or-name) + (if (buffer-live-p buffer-or-name) + buffer-or-name + (error "Buffer %s is not a live buffer" buffer-or-name))) + ((get-buffer buffer-or-name)) + (t + (error "No such buffer %s" buffer-or-name)))) + +(defsubst normalize-live-frame (frame) + "Return frame specified by FRAME. +FRAME must be a live frame and defaults to the selected frame." + (if frame + (if (frame-live-p frame) + frame + (error "%s is not a live frame" frame)) + (selected-frame))) + +(defsubst normalize-any-window (window) + "Return window specified by WINDOW. +WINDOW must be a window that has not been deleted and defaults to +the selected window." + (if window + (if (window-any-p window) + window + (error "%s is not a window" window)) + (selected-window))) + +(defsubst normalize-live-window (window) + "Return live window specified by WINDOW. +WINDOW must be a live window and defaults to the selected one." + (if window + (if (and (windowp window) (window-buffer window)) + window + (error "%s is not a live window" window)) + (selected-window))) + +(defvar ignore-window-parameters nil + "If non-nil, standard functions ignore window parameters. +The functions currently affected by this are `split-window', +`delete-window', `delete-other-windows' and `other-window'. + +An application may bind this to a non-nil value around calls to +these functions to inhibit processing of window parameters.") + +(defun window-iso-combination-p (&optional window horizontal) + "If WINDOW is a vertical combination return WINDOW's first child. +WINDOW can be any window and defaults to the selected one. +Optional argument HORIZONTAL non-nil means return WINDOW's first +child if WINDOW is a horizontal combination." + (setq window (normalize-any-window window)) + (if horizontal + (window-hchild window) + (window-vchild window))) + +(defsubst window-iso-combined-p (&optional window horizontal) + "Return non-nil if and only if WINDOW is vertically combined. +WINDOW can be any window and defaults to the selected one. +Optional argument HORIZONTAL non-nil means return non-nil if and +only if WINDOW is horizontally combined." + (setq window (normalize-any-window window)) + (let ((parent (window-parent window))) + (and parent (window-iso-combination-p parent horizontal)))) + +(defun window-iso-combinations (&optional window horizontal) + "Return largest number of vertically arranged subwindows of WINDOW. +WINDOW can be any window and defaults to the selected one. +Optional argument HORIZONTAL non-nil means to return the largest +number of horizontally arranged subwindows of WINDOW." + (setq window (normalize-any-window window)) + (cond + ((window-live-p window) + ;; If WINDOW is live, return 1. + 1) + ((window-iso-combination-p window horizontal) + ;; If WINDOW is iso-combined, return the sum of the values for all + ;; subwindows of WINDOW. + (let ((child (window-child window)) + (count 0)) + (while child + (setq count + (+ (window-iso-combinations child horizontal) + count)) + (setq child (window-right child))) + count)) + (t + ;; If WINDOW is not iso-combined, return the maximum value of any + ;; subwindow of WINDOW. + (let ((child (window-child window)) + (count 1)) + (while child + (setq count + (max (window-iso-combinations child horizontal) + count)) + (setq child (window-right child))) + count)))) + +(defun walk-window-tree-1 (proc walk-window-tree-window any &optional sub-only) + "Helper function for `walk-window-tree' and `walk-window-subtree'." + (let (walk-window-tree-buffer) + (while walk-window-tree-window + (setq walk-window-tree-buffer + (window-buffer walk-window-tree-window)) + (when (or walk-window-tree-buffer any) + (funcall proc walk-window-tree-window)) + (unless walk-window-tree-buffer + (walk-window-tree-1 + proc (window-hchild walk-window-tree-window) any) + (walk-window-tree-1 + proc (window-vchild walk-window-tree-window) any)) + (if sub-only + (setq walk-window-tree-window nil) + (setq walk-window-tree-window + (window-right walk-window-tree-window)))))) + +(defun walk-window-tree (proc &optional frame any) + "Run function PROC on each live window of FRAME. +PROC must be a function with one argument - a window. FRAME must +be a live frame and defaults to the selected one. ANY, if +non-nil means to run PROC on all live and internal windows of +FRAME. + +This function performs a pre-order, depth-first traversal of the +window tree. If PROC changes the window tree, the result is +unpredictable." + (let ((walk-window-tree-frame (normalize-live-frame frame))) + (walk-window-tree-1 + proc (frame-root-window walk-window-tree-frame) any))) + +(defun walk-window-subtree (proc &optional window any) + "Run function PROC on each live subwindow of WINDOW. +WINDOW defaults to the selected window. PROC must be a function +with one argument - a window. ANY, if non-nil means to run PROC +on all live and internal subwindows of WINDOW. + +This function performs a pre-order, depth-first traversal of the +window tree rooted at WINDOW. If PROC changes that window tree, +the result is unpredictable." + (setq window (normalize-any-window window)) + (walk-window-tree-1 proc window any t)) + +(defun windows-with-parameter (parameter &optional value frame any values) + "Return a list of all windows on FRAME with PARAMETER non-nil. +FRAME defaults to the selected frame. Optional argument VALUE +non-nil means only return windows whose window-parameter value of +PARAMETER equals VALUE \(comparison is done using `equal'). +Optional argument ANY non-nil means consider internal windows +too. Optional argument VALUES non-nil means return a list of cons +cells whose car is the value of the parameter and whose cdr is +the window." + (let (this-value windows) + (walk-window-tree + (lambda (window) + (when (and (setq this-value (window-parameter window parameter)) + (or (not value) (or (equal value this-value)))) + (setq windows + (if values + (cons (cons this-value window) windows) + (cons window windows))))) + frame any) + + (nreverse windows))) + +(defun window-with-parameter (parameter &optional value frame any) + "Return first window on FRAME with PARAMETER non-nil. +FRAME defaults to the selected frame. Optional argument VALUE +non-nil means only return a window whose window-parameter value +for PARAMETER equals VALUE \(comparison is done with `equal'). +Optional argument ANY non-nil means consider internal windows +too." + (let (this-value windows) + (catch 'found + (walk-window-tree + (lambda (window) + (when (and (setq this-value (window-parameter window parameter)) + (or (not value) (equal value this-value))) + (throw 'found window))) + frame any)))) + +;;; Atomic windows. +(defun window-atom-root (&optional window) + "Return root of atomic window WINDOW is a part of. +WINDOW can be any window and defaults to the selected one. +Return nil if WINDOW is not part of a atomic window." + (setq window (normalize-any-window window)) + (let (root) + (while (and window (window-parameter window 'window-atom)) + (setq root window) + (setq window (window-parent window))) + root)) + +(defun make-window-atom (window) + "Make WINDOW an atomic window. +WINDOW must be an internal window. Return WINDOW." + (if (not (window-child window)) + (error "Window %s is not an internal window" window) + (walk-window-subtree + (lambda (window) + (set-window-parameter window 'window-atom t)) + window t) + window)) + +(defun window-atom-check-1 (window) + "Subroutine of `window-atom-check'." + (when window + (if (window-parameter window 'window-atom) + (let ((count 0)) + (when (or (catch 'reset + (walk-window-subtree + (lambda (window) + (if (window-parameter window 'window-atom) + (setq count (1+ count)) + (throw 'reset t))) + window t)) + ;; count >= 1 must hold here. If there's no other + ;; window around dissolve this atomic window. + (= count 1)) + ;; Dissolve atomic window. + (walk-window-subtree + (lambda (window) + (set-window-parameter window 'window-atom nil)) + window t))) + ;; Check children. + (unless (window-buffer window) + (window-atom-check-1 (window-hchild window)) + (window-atom-check-1 (window-vchild window)))) + ;; Check right sibling + (window-atom-check-1 (window-right window)))) + +(defun window-atom-check (&optional frame) + "Check atomicity of all windows on FRAME. +FRAME defaults to the selected frame. If an atomic window is +wrongly configured, reset the atomicity of all its subwindows to +nil. An atomic window is wrongly configured if it has no +subwindows or one of its subwindows is not atomic." + (window-atom-check-1 (frame-root-window frame))) + +;; Side windows. +(defvar window-sides '(left top right bottom) + "Window sides.") + +(defcustom window-sides-vertical nil + "If non-nil, left and right side windows are full height. +Otherwise, top and bottom side windows are full width." + :type 'boolean + :group 'windows + :version "24.1") + +(defcustom window-sides-slots '(nil nil nil nil) + "Maximum number of side window slots. +The value is a list of four elements specifying the number of +side window slots on \(in this order) the left, top, right and +bottom side of each frame. If an element is a number, this means +to display at most that many side windows on the corresponding +side. If an element is nil, this means there's no bound on the +number of slots on that side." + :risky t + :type + '(list + :value (nil nil nil nil) + (choice + :tag "Left" + :help-echo "Maximum slots of left side window." + :value nil + :format "%[Left%] %v\n" + (const :tag "Unlimited" :format "%t" nil) + (integer :tag "Number" :value 2 :size 5)) + (choice + :tag "Top" + :help-echo "Maximum slots of top side window." + :value nil + :format "%[Top%] %v\n" + (const :tag "Unlimited" :format "%t" nil) + (integer :tag "Number" :value 3 :size 5)) + (choice + :tag "Right" + :help-echo "Maximum slots of right side window." + :value nil + :format "%[Right%] %v\n" + (const :tag "Unlimited" :format "%t" nil) + (integer :tag "Number" :value 2 :size 5)) + (choice + :tag "Bottom" + :help-echo "Maximum slots of bottom side window." + :value nil + :format "%[Bottom%] %v\n" + (const :tag "Unlimited" :format "%t" nil) + (integer :tag "Number" :value 3 :size 5))) + :group 'windows) + +(defun window-side-check (&optional frame) + "Check the window-side parameter of all windows on FRAME. +FRAME defaults to the selected frame. If the configuration is +invalid, reset all window-side parameters to nil. + +A valid configuration has to preserve the following invariant: + +- If a window has a non-nil window-side parameter, it must have a + parent window and the parent window's window-side parameter + must be either nil or the same as for window. + +- If windows with non-nil window-side parameters exist, there + must be at most one window of each side and non-side with a + parent whose window-side parameter is nil and there must be no + leaf window whose window-side parameter is nil." + (let (normal none left top right bottom + side parent parent-side code) + (when (or (catch 'reset + (walk-window-tree + (lambda (window) + (setq side (window-parameter window 'window-side)) + (setq parent (window-parent window)) + (setq parent-side + (and parent (window-parameter parent 'window-side))) + ;; The following `cond' seems a bit tedious, but I'd + ;; rather stick to using just the stack. + (cond + (parent-side + (when (not (eq parent-side side)) + ;; A parent whose window-side is non-nil must + ;; have a child with the same window-side. + (throw 'reset t))) + ;; Now check that there's more than one main window + ;; for any of none, left, top, right and bottom. + ((eq side 'none) + (if none + (throw 'reset t) + (setq none t))) + ((eq side 'left) + (if left + (throw 'reset t) + (setq left t))) + ((eq side 'top) + (if top + (throw 'reset t) + (setq top t))) + ((eq side 'right) + (if right + (throw 'reset t) + (setq right t))) + ((eq side 'bottom) + (if bottom + (throw 'reset t) + (setq bottom t))) + ((window-buffer window) + ;; A leaf window without window-side parameter, + ;; record its existence. + (setq normal t)))) + frame t)) + (if none + ;; At least one non-side window exists, so there must + ;; be at least one side-window and no normal window. + (or (not (or left top right bottom)) normal) + ;; No non-side window exists, so there must be no side + ;; window either. + (or left top right bottom))) + (walk-window-tree + (lambda (window) + (set-window-parameter window 'window-side nil)) + frame t)))) + +(defun window-check (&optional frame) + "Check atomic and side windows on FRAME. +FRAME defaults to the selected frame." + (window-side-check frame) + (window-atom-check frame)) + +;;; Window sizes. +(defvar window-size-fixed nil + "Non-nil in a buffer means windows displaying the buffer are fixed-size. +If the value is `height', then only the window's height is fixed. +If the value is `width', then only the window's width is fixed. +Any other non-nil value fixes both the width and the height. + +Emacs won't change the size of any window displaying that buffer, +unless it has no other choice \(like when deleting a neighboring +window).") +(make-variable-buffer-local 'window-size-fixed) + (defun window-body-height (&optional window) "Return number of lines in WINDOW available for actual buffer text. WINDOW defaults to the selected window. |