Mercurial > emacs
changeset 90988:492971a3f31f unicode-xft-base
Merge from emacs--devo--0
Patches applied:
* emacs--devo--0 (patch 816-823)
- Update from CVS
- Merge from emacs--rel--22
* emacs--rel--22 (patch 59-69)
- Update from CVS
- Merge from gnus--rel--5.10
* gnus--rel--5.10 (patch 237-238)
- Update from CVS
Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-235
line wrap: on
line diff
--- a/etc/NEWS Mon Jul 23 05:39:31 2007 +0000 +++ b/etc/NEWS Tue Jul 24 01:23:55 2007 +0000 @@ -46,6 +46,8 @@ recenter the visited source file. Its value can be a number (for example, 0 for top line, -1 for bottom line), or nil for no recentering. +** The mode-line display a `@' if the default-directory for the current buffer +is on a remote machine, or a hyphen otherwise. * Startup Changes in Emacs 23.1 @@ -57,6 +59,16 @@ ** New command kill-matching-buffers kills buffers whose name matches a regexp. +** Minibuffer changes: + +*** isearch started in the minibuffer searches in the minibuffer history. +Reverse isearch commands (C-r, C-M-r) search in previous minibuffer +history elements, and forward isearch commands (C-s, C-M-s) search in +next history elements. When the reverse search reaches the first history +element, it wraps to the last history element, and the forward search +wraps to the first history element. When the search is terminated, the +history element containing the search string becomes the current. + * New Modes and Packages in Emacs 23.1
--- a/leim/ChangeLog Mon Jul 23 05:39:31 2007 +0000 +++ b/leim/ChangeLog Tue Jul 24 01:23:55 2007 +0000 @@ -13,7 +13,7 @@ * MISC-DIC/pinyin.map, MISC-DIC/ziranma.cin: Add copyright and license notices. - + 2007-01-24 Kenichi Handa <handa@m17n.org> * MISC-DIC/README: New file.
--- a/lisp/ChangeLog Mon Jul 23 05:39:31 2007 +0000 +++ b/lisp/ChangeLog Tue Jul 24 01:23:55 2007 +0000 @@ -1,3 +1,378 @@ +2007-07-23 Stefan Monnier <monnier@iro.umontreal.ca> + + * ses.el (ses-cleanup): Prevent Emacs from spuriously checking if the + underlying file is uptodate. + +2007-07-23 Christopher J. Madsen <cjm@cjmweb.net> + + * replace.el (perform-replace): Use isearch-no-upper-case-p. + +2007-07-23 Stefan Monnier <monnier@iro.umontreal.ca> + + * vc-hooks.el (vc-mode-line-map): New const. + (vc-mode-line): Use it. + +2007-07-23 Alexandre Julliard <julliard@winehq.org> + + * vc-git.el (vc-git-delete-file, vc-git-rename-file) + (vc-git-unregister): New functions. + (vc-git-find-version): Use the result of ls-files as a parameter + for cat-file + +2007-07-23 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-perl-file-attributes) + (tramp-perl-directory-files-and-attributes) + (tramp-handle-file-attributes-with-stat) + (tramp-handle-directory-files-and-attributes-with-stat) + (tramp-convert-file-attributes): Handle huge file sizes. + +2007-07-23 Juri Linkov <juri@jurta.org> + + * isearch.el (isearch-message-function): New variable. + (isearch-update, isearch-search): Use it. + + * simple.el (goto-history-element): New function created from + next-history-element. + (next-history-element): Most code moved to goto-history-element. + Call goto-history-element with (- minibuffer-history-position n). + (previous-history-element): Call goto-history-element with (+ + minibuffer-history-position n). + (minibuffer-setup-hook): Add minibuffer-history-isearch-setup. + (minibuffer-history-isearch-message-overlay): New buffer-local variable. + (minibuffer-history-isearch-setup, minibuffer-history-isearch-end) + (minibuffer-history-isearch-search, minibuffer-history-isearch-message) + (minibuffer-history-isearch-wrap, minibuffer-history-isearch-push-state) + (minibuffer-history-isearch-pop-state): New functions. + +2007-07-23 Thien-Thi Nguyen <ttn@gnuvola.org> + + * vc-hooks.el (vc-stay-local-p): Fix bug: Avoid remove-if-not. + Also, if FILE is a list, return non-nil if any of its elements + should stay local. Update docstring. + +2007-07-23 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/copyright.el (copyright-update-year): Fix 2007-05-25 + change by reverting a small part. + +2007-07-23 Richard Stallman <rms@gnu.org> + + * progmodes/octave-inf.el (inferior-octave-prompt): Accept .exe. + +2007-07-23 Dan Nicolaescu <dann@ics.uci.edu> + + * vc-git.el (vc-git-checkin): Delete unused parameter and the code + handling it. Use vc-git-command. + (vc-git-find-version, vc-git-diff-tree): New functions. + (vc-git-revert): Use vc-git-command. + (vc-git--run-command): Delete. + +2007-07-23 Alexandre Julliard <julliard@winehq.org> + + * vc-git.el (vc-git-workfile-unchanged-p): Update comment. + +2007-07-20 Kenichi Handa <handa@m17n.org> + + * international/utf-8.el (utf-8-post-read-conversion): + Temporarily bind utf-8-compose-scripts to nil while running + *-compose-region functions. + +2007-07-23 Dan Nicolaescu <dann@ics.uci.edu> + + * vc-git.el: Update status. + (vc-directory-exclusion-list): Use eval-after-load. + +2007-07-22 Nick Roberts <nickrob@snap.net.nz> + + * bindings.el (mode-line-remote): New variable. + (help-echo): Add to default values of mode-line-format. + + * files.el: Mark mode-line-remote as risky. + +2007-07-22 Juri Linkov <juri@jurta.org> + + * isearch.el (isearch-edit-string): Save old point and + isearch-other-end to old-point and old-other-end before reading + the search string from minibuffer. After exiting minibuffer set + point to old-other-end if point and the search direction is the + same as before reading the search string. + (isearch-del-char): Don't set isearch-yank-flag to t. Put point + to isearch-other-end. Instead of isearch-search-and-update call + three functions isearch-search, isearch-push-state and isearch-update. + +2007-07-22 Dan Nicolaescu <dann@ics.uci.edu> + + * vc-git.el (vc-git-register, vc-git-checkin): Use vc-git-command, + deal with multiple file arguments. + (vc-git-print-log): Deal with multiple file arguments. + +2007-07-22 Stefan Monnier <monnier@iro.umontreal.ca> + + * diff-mode.el (diff-refine-ignore-spaces-hunk): Rename from + diff-refine-hunk. Adjust users. + (diff-unified-hunk-p, diff-splittable-p): New functions. + (diff-mode-menu): Use it to disable Split when it doesn't work. + +2007-07-22 Dan Nicolaescu <dann@ics.uci.edu> + + * diff-mode.el (diff-mode-menu): New entries. + +2007-07-22 Stefan Monnier <monnier@iro.umontreal.ca> + + * diff-mode.el (diff-unified->context): Use the new `apply' undo entry + if applicable, so as to save undo-log space. + + * diff-mode.el (diff-find-file-name): Add arg `batch'. + + * diff-mode.el (diff-beginning-of-file-and-junk): New function. + (diff-file-kill): Use it. + (diff-beginning-of-hunk): Add arg `try-harder' using it. + (diff-restrict-view, diff-find-source-location, diff-refine-hunk): + Use it so they find the hunk even when we're in the file header. + +2007-07-22 Dan Nicolaescu <dann@ics.uci.edu> + + * vc-git.el (vc-git-revision-granularity, vc-git-root) + (vc-git-command, vc-git-dir-state, vc-git-dired-state-info) + (vc-git-create-repo): New functions. + (vc-git-registered): New autoloaded function definition. + (vc-git-registered): Use vc-git-root. + (vc-git-responsible-p): New defalias. + (vc-git-annotate-extract-revision-at-line): Uncomment. + (vc-git-print-log): Add the file name to the log. + (vc-git-log-view-mode): New derived mode. + (vc-git-diff, vc-git-annotate-command): Use vc-git-command. + +2007-07-22 Michael Albinus <michael.albinus@gmx.de> + + * progmodes/grep.el (grep-compute-defaults): Keep default values. + +2007-07-22 Ralf Angeli <angeli@caeruleus.net> + + * textmodes/reftex.el (reftex-access-parse-file): Create parse + file in a way that does not interfere with recentf mode. + (reftex-access-parse-file): Do not risk destroying an existing + buffer. + +2007-07-22 Alexandre Julliard <julliard@winehq.org> + + * vc-git.el: New file. + +2007-07-22 Stefan Monnier <monnier@iro.umontreal.ca> + + * textmodes/tex-mode.el (tex-font-script-display): Change default. + +2007-07-22 Dan Nicolaescu <dann@ics.uci.edu> + + * vc-cvs.el (vc-cvs-mode-line-string): Add support for tooltips + for branches and new files. + + * vc-hooks.el (vc-default-mode-line-string): Move mouse-face and + local-map handling ... + (vc-mode-line): ... here. Improve handling of help-echo. + + * vc.el (mode-line-string): Document help-echo usage. + +2007-07-22 Michael Albinus <michael.albinus@gmx.de> + + Sync with Tramp 2.1.10. + + * tramp.el (tramp-get-ls-command): Fyx typo. + + * trampver.el: Update release number. + +2007-07-22 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * startup.el (command-line-x-option-alist): Use x-handle-no-bitmap-icon. + + * term/x-win.el (x-handle-no-bitmap-icon): New function. + +2007-07-22 Martin Rudalics <rudalics@gmx.at> + + * add-log.el (change-log-fill-parenthesized-list): New function. + (change-log-indent): Call change-log-fill-parenthesized-list. + (change-log-fill-paragraph): Bind fill-indent-according-to-mode to + t. Have lines with leading asterisk start a paragraph. + +2007-07-21 Jay Belanger <jay.p.belanger@gmail.com> + + * calc/calc-math.el (math-emacs-precision) + (math-largest-emacs-expt, math-smallest-emacs-expt): + New variables. + (math-use-emacs-fn): New function. + (math-exp-raw): Evaluate with `math-use-emacs-fn', when + appropriate. + +2007-07-21 Thien-Thi Nguyen <ttn@gnuvola.org> + + * image-dired.el (image-dired-sane-db-file): New func. + (image-dired-write-tags, image-dired-remove-tag) + (image-dired-list-tags, image-dired-write-comments) + (image-dired-get-comment, image-dired-mark-tagged-files) + (image-dired-create-gallery-lists): Call new func. + Reported by Dieter Wilhelm <dieter@duenenhof-wilhelm.de>. + +2007-07-21 Dan Nicolaescu <dann@ics.uci.edu> + + * vc-hg.el (vc-hg-dir-state): Fix loop. + (vc-hg-print-log): Fix expected return value for vc-hg-command. + (vc-hg-next-version, vc-hg-delete-file, vc-hg-rename-file) + (vc-hg-register, vc-hg-create-repo, vc-hg-checkin) + (vc-hg-revert): Likewise. + (vc-hg-revision-table, vc-hg-revision-completion-table): New + functions. + +2007-07-20 Stefan Monnier <monnier@iro.umontreal.ca> + + * add-log.el (change-log-resolve-conflict): Don't lose data if the + merge fails. + +2007-07-20 Dan Nicolaescu <dann@ics.uci.edu> + + * progmodes/compile.el (compilation-auto-jump-to-first-error): + Add group and version. + +2007-07-20 Stefan Monnier <monnier@iro.umontreal.ca> + + * add-log.el (add-log-file-name): Use file-relative-name. + (add-change-log-entry): Delay reading + add-log-(full-name|mailing-address) to after we've switched to the + ChangeLog buffer so we get the right value. + (add-change-log-entry, add-log-current-defun, change-log-merge): + Use derived-mode-p rather than checking major-mode directly. + + * pcvs.el (cvs-mode-add-change-log-entry-other-window): Use a directory + name for buffer-file-name if it refers to a directory. + + * vc-arch.el (vc-arch-diff): Fix last change. + + * progmodes/compile.el (compilation-start): Remember the original + directory in a buffer-local compilation-directory. + (compile): Set the global value of compilation-directory. + (recompile): Use compilation-directory even in the compilation buffer. + +2007-07-20 Dan Nicolaescu <dann@ics.uci.edu> + + * vc-hg.el (vc-hg-diff): Use vc-hg-command. + +2007-07-20 Vinicius Jose Latorre <viniciusjl@ig.com.br> + + * ps-print.el: Problem with foreground and background color when + printing a buffer with and without faces. Reported by Christian + Schlauer <cs-muelleimer-rubbish.bin@arcor.de>. + (ps-print-version): New version 6.7.5. + (ps-default-fg): Change default value to nil, so black color is used + when a face does not specify a foreground color. + (ps-default-bg): Change default value to nil, so white color is used + for background color. + (ps-begin-job): Fix code. + +2007-07-20 Eli Zaretskii <eliz@gnu.org> + + * makefile.w32-in (install-lisp-SH): Don't create subdirectories + in $(INSTALL_DIR)/lisp/ if they already exist. + +2007-07-20 Dhruva Krishnamurthy <dhruvakm@gmail.com> (tiny change) + + * makefile.w32-in (install-lisp-CMD): Don't create subdirectories + in $(INSTALL_DIR)/lisp/ if they already exist. + +2007-07-20 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/vera-mode.el (vera-re-search-forward) + (vera-re-search-backward): Remove use of store-match-data. + (vera-mode-map): Move initialization into declaration. + + * progmodes/flymake.el (flymake-buildfile-dirs): Remove. + (flymake-find-buildfile): Use locate-dominating-file. + + * vc.el (vc-delistify): Use mapconcat. + (vc-do-command): Minor simplification. + (vc-expand-dirs): Use push. + + * vc-mcvs.el (vc-mcvs-create-repo): + * vc-cvs.el (vc-cvs-create-repo): Remove. + + * vc-hooks.el (vc-find-root): Fix case where `file' is the current + directory and the root as well. + +2007-07-20 Dan Nicolaescu <dann@ics.uci.edu> + + * vc-hooks.el (vc-default-workfile-unchanged-p): Pass a list + instead of a file. + + * vc-hg.el (vc-hg-print-log): Deal with multiple file arguments. + (vc-hg-registered): Replace if with when. + (vc-hg-state): Deal with nonexistent files and handle removed files. + (vc-hg-dir-state, vc-hg-dired-state-info): New functions. + (vc-hg-checkout): Re-enable. + (vc-hg-create-repo): Fix typos. + (vc-hg-print-log): Fix for multiple files. + (vc-hg-workfile-unchanged-p): New function. + + * vc.el: Fix typo. + (vc-print-log): Fix call to print-log. + (vc-default-comment-history): Likewise. + (vc-directory-exclusion-list): Add .hg and .bzr. + (vc-diff-internal): Pass a list instead of a file. + + * vc-mcvs.el (vc-mcvs-create-repo): Fix typos. + + * vc-bzr.el (vc-bzr-create-repo): New function. + +2007-07-19 Stefan Monnier <monnier@iro.umontreal.ca> + + * vc-hooks.el (vc-find-root): Walk up the tree to find an existing + `file' from which to start the search. + +2007-07-19 Eric S. Raymond <esr@snark.thyrsus.com> + + * vc-cvs.el: vc-cvs-checkin had some reference problems, now fixed. + +2007-07-19 Stefan Monnier <monnier@iro.umontreal.ca> + + * files.el (locate-dominating-file): New function. + +2007-07-18 Michael Albinus <michael.albinus@gmx.de> + + * progmodes/grep.el (grep-host-defaults-alist): New defvar. + (grep-compute-defaults): Use it. + +2007-07-18 Stefan Monnier <monnier@iro.umontreal.ca> + + * uniquify.el: Docstring fixes. + +2007-07-18 Eric S. Raymond <esr@snark.thyrsus.com> + + * vc-hooks.el: Generalize stay-local-p to operate on lists of + files. Change two keybindings to point to new function names. + * vc-arch.el, vc-bzr.el, vc-cvs.el, vc-hg.el, vc-mcvs.el, vc-rcs.el, + vc-sccs.el, vc-svn.el: These now implement the NewVC-fileset. + * vc.el: Adapted for NewVC-fileset, but no functional changes yet. + +2007-07-18 Juanma Barranquero <lekktu@gmail.com> + + * follow.el (follow-mode-hook, follow-mode-off-hook, follow-mode) + (follow-delete-other-windows-and-split, follow-recenter) + (follow-windows-aligned-p, follow-point-visible-all-windows-p) + (follow-redisplay, follow-estimate-first-window-start) + (follow-xemacs-scrollbar-support, follow-intercept-process-output): + Fix typos in docstrings. + +2007-07-18 Martin Rudalics <rudalics@gmx.at> + + * add-log.el (change-log-mode): Use fill-nobreak-predicate to + avoid that filling introduces lines with a single asterisk. + + * kmacro.el (kmacro-end-macro): When ignoring empty macro + avoid incorrect kmacro-ring-empty-p messages. + Reported by Michael Schierl <schierlm@gmx.de>. + +2007-07-17 Dan Nicolaescu <dann@ics.uci.edu> + + * vc.el: Add more info about the vc-registered function. + 2007-07-17 Michael Albinus <michael.albinus@gmx.de> * files.el (file-remote-p): Introduce optional parameter @@ -9,7 +384,7 @@ * progmodes/grep.el (grep-probe): Use `process-file'. (grep-compute-defaults): Handle variables host specific. - * net/ange-ftp.el: (ange-ftp-file-remote-p): Handle optional + * net/ange-ftp.el (ange-ftp-file-remote-p): Handle optional parameter IDENTIFICATION. * net/tramp.el (tramp-handle-file-remote-p): Handle optional @@ -23,8 +398,8 @@ (tramp-convert-file-attributes): Add error handling when inode is extraordinary big. (tramp-get-inode): Change parameter from FILE to VEC. - (tramp-handle-start-file-process ): Use (current-buffer) if BUFFER - is NIL. This is according to the specification. Goto (point-max) + (tramp-handle-start-file-process): Use (current-buffer) if BUFFER + is nil. This is according to the specification. Goto (point-max) when ready. (tramp-handle-shell-command): Rewrite completely, using `process-file' and `start-file-process'. @@ -103,6 +478,17 @@ * bookmark.el (bookmark-show-all-annotations): Make sure each inserted annotation ends with newline. +2007-07-15 Richard Stallman <rms@gnu.org> + + * kmacro.el (kmacro-bind-to-key): Avoid comparisons on function keys. + + * tutorial.el (tutorial--find-changed-keys): + Handle C-x specially like ESC. + +2007-07-15 Aaron Hawley <aaronh@garden.org> + + * tar-mode.el (tar-get-descriptor): No error for zero-length file. + 2007-07-15 Juri Linkov <juri@jurta.org> * delsel.el (delete-selection-pre-hook): @@ -345,7 +731,7 @@ (org-columns-compile-format) (org-fill-paragraph-experimental) (org-string-to-number, org-property-action) - (org-columns-move-left, org-columns-new ) + (org-columns-move-left, org-columns-new) (org-column-number-to-string) (org-property-previous-allowed-value) (org-at-property-p, org-columns-delete)
--- a/lisp/add-log.el Mon Jul 23 05:39:31 2007 +0000 +++ b/lisp/add-log.el Tue Jul 24 01:23:55 2007 +0000 @@ -55,7 +55,7 @@ ;; Many modes set this variable, so avoid warnings. ;;;###autoload (defcustom add-log-current-defun-function nil - "*If non-nil, function to guess name of surrounding function. + "If non-nil, function to guess name of surrounding function. It is used by `add-log-current-defun' in preference to built-in rules. Returns function's name as a string, or nil if outside a function." :type '(choice (const nil) function) @@ -63,7 +63,7 @@ ;;;###autoload (defcustom add-log-full-name nil - "*Full name of user, for inclusion in ChangeLog daily headers. + "Full name of user, for inclusion in ChangeLog daily headers. This defaults to the value returned by the function `user-full-name'." :type '(choice (const :tag "Default" nil) string) @@ -148,7 +148,7 @@ (defcustom change-log-version-info-enabled nil - "*If non-nil, enable recording version numbers with the changes." + "If non-nil, enable recording version numbers with the changes." :version "21.1" :type 'boolean :group 'change-log) @@ -160,7 +160,7 @@ (concat "^(def[^ \t\n]+[ \t]+[^ \t\n][ \t]\"" re) ;; Revision: pcl-cvs.el,v 1.72 1999/09/05 20:21:54 monnier Exp (concat "^;+ *Revision: +[^ \t\n]+[ \t]+" re))) - "*List of regexps to search for version number. + "List of regexps to search for version number. The version number must be in group 1. Note: The search is conducted only within 10%, at the beginning of the file." :version "21.1" @@ -460,11 +460,7 @@ (if add-log-file-name-function (funcall add-log-file-name-function buffer-file) (setq buffer-file - (if (string-match - (concat "^" (regexp-quote (file-name-directory log-file))) - buffer-file) - (substring buffer-file (match-end 0)) - (file-name-nondirectory buffer-file))) + (file-relative-name buffer-file (file-name-directory log-file))) ;; If we have a backup file, it's presumably because we're ;; comparing old and new versions (e.g. for deleted ;; functions) and we'll want to use the original name. @@ -508,112 +504,111 @@ (buffer-file (if buf-file-name (expand-file-name buf-file-name))) (file-name (expand-file-name (find-change-log file-name buffer-file))) ;; Set ITEM to the file name to use in the new item. - (item (add-log-file-name buffer-file file-name)) - bound - (full-name (or add-log-full-name (user-full-name))) - (mailing-address (or add-log-mailing-address user-mail-address))) - - (if whoami - (progn - (setq full-name (read-string "Full name: " full-name)) - ;; Note that some sites have room and phone number fields in - ;; full name which look silly when inserted. Rather than do - ;; anything about that here, let user give prefix argument so that - ;; s/he can edit the full name field in prompter if s/he wants. - (setq mailing-address - (read-string "Mailing address: " mailing-address)))) + (item (add-log-file-name buffer-file file-name))) (unless (equal file-name buffer-file-name) (if (or other-window (window-dedicated-p (selected-window))) (find-file-other-window file-name) (find-file file-name))) - (or (eq major-mode 'change-log-mode) + (or (derived-mode-p 'change-log-mode) (change-log-mode)) (undo-boundary) (goto-char (point-min)) - ;; If file starts with a copyright and permission notice, skip them. - ;; Assume they end at first blank line. - (when (looking-at "Copyright") - (search-forward "\n\n") - (skip-chars-forward "\n")) + (let ((full-name (or add-log-full-name (user-full-name))) + (mailing-address (or add-log-mailing-address user-mail-address))) + + (when whoami + (setq full-name (read-string "Full name: " full-name)) + ;; Note that some sites have room and phone number fields in + ;; full name which look silly when inserted. Rather than do + ;; anything about that here, let user give prefix argument so that + ;; s/he can edit the full name field in prompter if s/he wants. + (setq mailing-address + (read-string "Mailing address: " mailing-address))) + + ;; If file starts with a copyright and permission notice, skip them. + ;; Assume they end at first blank line. + (when (looking-at "Copyright") + (search-forward "\n\n") + (skip-chars-forward "\n")) - ;; Advance into first entry if it is usable; else make new one. - (let ((new-entries - (mapcar (lambda (addr) - (concat - (if (stringp add-log-time-zone-rule) - (let ((tz (getenv "TZ"))) - (unwind-protect - (progn - (set-time-zone-rule add-log-time-zone-rule) - (funcall add-log-time-format)) - (set-time-zone-rule tz))) - (funcall add-log-time-format)) - " " full-name - " <" addr ">")) - (if (consp mailing-address) - mailing-address - (list mailing-address))))) - (if (and (not add-log-always-start-new-record) - (let ((hit nil)) - (dolist (entry new-entries hit) - (when (looking-at (regexp-quote entry)) - (setq hit t))))) - (forward-line 1) - (insert (nth (random (length new-entries)) - new-entries) - (if use-hard-newlines hard-newline "\n") - (if use-hard-newlines hard-newline "\n")) - (forward-line -1))) + ;; Advance into first entry if it is usable; else make new one. + (let ((new-entries + (mapcar (lambda (addr) + (concat + (if (stringp add-log-time-zone-rule) + (let ((tz (getenv "TZ"))) + (unwind-protect + (progn + (set-time-zone-rule add-log-time-zone-rule) + (funcall add-log-time-format)) + (set-time-zone-rule tz))) + (funcall add-log-time-format)) + " " full-name + " <" addr ">")) + (if (consp mailing-address) + mailing-address + (list mailing-address))))) + (if (and (not add-log-always-start-new-record) + (let ((hit nil)) + (dolist (entry new-entries hit) + (when (looking-at (regexp-quote entry)) + (setq hit t))))) + (forward-line 1) + (insert (nth (random (length new-entries)) + new-entries) + (if use-hard-newlines hard-newline "\n") + (if use-hard-newlines hard-newline "\n")) + (forward-line -1)))) ;; Determine where we should stop searching for a usable ;; item to add to, within this entry. - (setq bound - (save-excursion - (if (looking-at "\n*[^\n* \t]") - (skip-chars-forward "\n") - (if add-log-keep-changes-together - (forward-page) ; page delimits entries for date - (forward-paragraph))) ; paragraph delimits entries for file - (point))) + (let ((bound + (save-excursion + (if (looking-at "\n*[^\n* \t]") + (skip-chars-forward "\n") + (if add-log-keep-changes-together + (forward-page) ; page delimits entries for date + (forward-paragraph))) ; paragraph delimits entries for file + (point)))) - ;; Now insert the new line for this item. - (cond ((re-search-forward "^\\s *\\*\\s *$" bound t) - ;; Put this file name into the existing empty item. - (if item - (insert item))) - ((and (not new-entry) - (let (case-fold-search) - (re-search-forward - (concat (regexp-quote (concat "* " item)) - ;; Don't accept `foo.bar' when - ;; looking for `foo': - "\\(\\s \\|[(),:]\\)") - bound t))) - ;; Add to the existing item for the same file. - (re-search-forward "^\\s *$\\|^\\s \\*") - (goto-char (match-beginning 0)) - ;; Delete excess empty lines; make just 2. - (while (and (not (eobp)) (looking-at "^\\s *$")) - (delete-region (point) (line-beginning-position 2))) - (insert (if use-hard-newlines hard-newline "\n") - (if use-hard-newlines hard-newline "\n")) - (forward-line -2) - (indent-relative-maybe)) - (t - ;; Make a new item. - (while (looking-at "\\sW") - (forward-line 1)) - (while (and (not (eobp)) (looking-at "^\\s *$")) - (delete-region (point) (line-beginning-position 2))) - (insert (if use-hard-newlines hard-newline "\n") - (if use-hard-newlines hard-newline "\n") - (if use-hard-newlines hard-newline "\n")) - (forward-line -2) - (indent-to left-margin) - (insert "* ") - (if item (insert item)))) + ;; Now insert the new line for this item. + (cond ((re-search-forward "^\\s *\\*\\s *$" bound t) + ;; Put this file name into the existing empty item. + (if item + (insert item))) + ((and (not new-entry) + (let (case-fold-search) + (re-search-forward + (concat (regexp-quote (concat "* " item)) + ;; Don't accept `foo.bar' when + ;; looking for `foo': + "\\(\\s \\|[(),:]\\)") + bound t))) + ;; Add to the existing item for the same file. + (re-search-forward "^\\s *$\\|^\\s \\*") + (goto-char (match-beginning 0)) + ;; Delete excess empty lines; make just 2. + (while (and (not (eobp)) (looking-at "^\\s *$")) + (delete-region (point) (line-beginning-position 2))) + (insert (if use-hard-newlines hard-newline "\n") + (if use-hard-newlines hard-newline "\n")) + (forward-line -2) + (indent-relative-maybe)) + (t + ;; Make a new item. + (while (looking-at "\\sW") + (forward-line 1)) + (while (and (not (eobp)) (looking-at "^\\s *$")) + (delete-region (point) (line-beginning-position 2))) + (insert (if use-hard-newlines hard-newline "\n") + (if use-hard-newlines hard-newline "\n") + (if use-hard-newlines hard-newline "\n")) + (forward-line -2) + (indent-to left-margin) + (insert "* ") + (if item (insert item))))) ;; Now insert the function name, if we have one. ;; Point is at the item for this file, ;; either at the end of the line or at the first blank line. @@ -662,9 +657,45 @@ (add-change-log-entry whoami file-name t)) ;;;###autoload (define-key ctl-x-4-map "a" 'add-change-log-entry-other-window) + (defvar change-log-indent-text 0) +(defun change-log-fill-parenthesized-list () + ;; Fill parenthesized lists of names according to GNU standards. + ;; * file-name.ext (very-long-foo, very-long-bar, very-long-foobar): + ;; should be filled as + ;; * file-name.ext (very-long-foo, very-long-bar) + ;; (very-long-foobar): + (save-excursion + (end-of-line 0) + (skip-chars-backward " \t") + (when (and (equal (char-before) ?\,) + (> (point) (1+ (point-min)))) + (condition-case nil + (when (save-excursion + (and (prog2 + (up-list -1) + (equal (char-after) ?\() + (skip-chars-backward " \t")) + (or (bolp) + ;; Skip everything but a whitespace or asterisk. + (and (not (zerop (skip-chars-backward "^ \t\n*"))) + (skip-chars-backward " \t") + ;; We want one asterisk here. + (= (skip-chars-backward "*") -1) + (skip-chars-backward " \t") + (bolp))))) + ;; Delete the comma. + (delete-char -1) + ;; Close list on previous line. + (insert ")") + (skip-chars-forward " \t\n") + ;; Start list on new line. + (insert-before-markers "(")) + (error nil))))) + (defun change-log-indent () + (change-log-fill-parenthesized-list) (let* ((indent (save-excursion (beginning-of-line) @@ -699,6 +730,11 @@ show-trailing-whitespace t) (set (make-local-variable 'fill-paragraph-function) 'change-log-fill-paragraph) + ;; Avoid that filling leaves behind a single "*" on a line. + (add-hook 'fill-nobreak-predicate + '(lambda () + (looking-back "^\\s *\\*\\s *" (line-beginning-position))) + nil t) (set (make-local-variable 'indent-line-function) 'change-log-indent) (set (make-local-variable 'tab-always-indent) nil) ;; We really do want "^" in paragraph-start below: it is only the @@ -727,7 +763,11 @@ (interactive "P") (let ((end (progn (forward-paragraph) (point))) (beg (progn (backward-paragraph) (point))) - (paragraph-start (concat paragraph-start "\\|\\s *\\s("))) + ;; Add lines starting with whitespace followed by a left paren or an + ;; asterisk. + (paragraph-start (concat paragraph-start "\\|\\s *\\(?:\\s(\\|\\*\\)")) + ;; Make sure we call `change-log-indent'. + (fill-indent-according-to-mode t)) (fill-region beg end justify) t)) @@ -749,7 +789,7 @@ ;;;###autoload (defvar add-log-tex-like-modes - '(TeX-mode plain-TeX-mode LaTeX-mode plain-tex-mode latex-mode) + '(TeX-mode plain-TeX-mode LaTeX-mode tex-mode) "*Modes that look like TeX to `add-log-current-defun'.") ;;;###autoload @@ -771,7 +811,7 @@ (let ((location (point))) (cond (add-log-current-defun-function (funcall add-log-current-defun-function)) - ((memq major-mode add-log-lisp-like-modes) + ((apply 'derived-mode-p add-log-lisp-like-modes) ;; If we are now precisely at the beginning of a defun, ;; make sure beginning-of-defun finds that one ;; rather than the previous one. @@ -795,7 +835,7 @@ (buffer-substring-no-properties (point) (progn (forward-sexp 1) (point))))) - ((and (memq major-mode add-log-c-like-modes) + ((and (apply 'derived-mode-p add-log-c-like-modes) (save-excursion (beginning-of-line) ;; Use eq instead of = here to avoid @@ -813,7 +853,7 @@ (buffer-substring-no-properties (point) (progn (forward-sexp 1) (point)))) - ((memq major-mode add-log-c-like-modes) + ((apply 'derived-mode-p add-log-c-like-modes) ;; See whether the point is inside a defun. (let (having-previous-defun having-next-defun @@ -955,7 +995,7 @@ (setq end (point))) (buffer-substring-no-properties middle end))))))))) - ((memq major-mode add-log-tex-like-modes) + ((apply 'derived-mode-p add-log-tex-like-modes) (if (re-search-backward "\\\\\\(sub\\)*\\(section\\|paragraph\\|chapter\\)" nil t) @@ -964,17 +1004,17 @@ (buffer-substring-no-properties (1+ (point)) ; without initial backslash (line-end-position))))) - ((eq major-mode 'texinfo-mode) + ((derived-mode-p 'texinfo-mode) (if (re-search-backward "^@node[ \t]+\\([^,\n]+\\)" nil t) (match-string-no-properties 1))) - ((memq major-mode '(perl-mode cperl-mode)) + ((derived-mode-p '(perl-mode cperl-mode)) (if (re-search-backward "^sub[ \t]+\\([^({ \t\n]+\\)" nil t) (match-string-no-properties 1))) ;; Emacs's autoconf-mode installs its own ;; `add-log-current-defun-function'. This applies to ;; a different mode apparently for editing .m4 ;; autoconf source. - ((eq major-mode 'autoconf-mode) + ((derived-mode-p 'autoconf-mode) (if (re-search-backward "^\\(\\(m4_\\)?define\\|A._DEFUN\\)(\\[?\\([A-Za-z0-9_]+\\)" nil t) (match-string-no-properties 3))) @@ -1041,17 +1081,32 @@ (defun change-log-resolve-conflict () "Function to be used in `smerge-resolve-function'." - (let ((buf (current-buffer))) - (with-temp-buffer - (insert-buffer-substring buf (match-beginning 1) (match-end 1)) - (save-match-data (change-log-mode)) - (let ((other-buf (current-buffer))) - (with-current-buffer buf - (save-excursion - (save-restriction - (narrow-to-region (match-beginning 0) (match-end 0)) - (replace-match (match-string 3) t t) - (change-log-merge other-buf)))))))) + (save-excursion + (save-restriction + (narrow-to-region (match-beginning 0) (match-end 0)) + (let ((mb1 (match-beginning 1)) + (me1 (match-end 1)) + (mb3 (match-beginning 3)) + (me3 (match-end 3)) + (tmp1 (generate-new-buffer " *changelog-resolve-1*")) + (tmp2 (generate-new-buffer " *changelog-resolve-2*"))) + (unwind-protect + (let ((buf (current-buffer))) + (with-current-buffer tmp1 + (change-log-mode) + (insert-buffer-substring buf mb1 me1)) + (with-current-buffer tmp2 + (change-log-mode) + (insert-buffer-substring buf mb3 me3) + ;; Do the merge here instead of inside `buf' so as to be + ;; more robust in case change-log-merge fails. + (change-log-merge tmp1)) + (goto-char (point-max)) + (delete-region (point-min) + (prog1 (point) + (insert-buffer-substring tmp2)))) + (kill-buffer tmp1) + (kill-buffer tmp2)))))) ;;;###autoload (defun change-log-merge (other-log) @@ -1063,7 +1118,7 @@ Entries are inserted in chronological order. Both the current and old-style time formats for entries are supported." (interactive "*fLog file name to merge: ") - (if (not (eq major-mode 'change-log-mode)) + (if (not (derived-mode-p 'change-log-mode)) (error "Not in Change Log mode")) (let ((other-buf (if (bufferp other-log) other-log (find-file-noselect other-log))) @@ -1073,7 +1128,7 @@ (goto-char (point-min)) (set-buffer other-buf) (goto-char (point-min)) - (if (not (eq major-mode 'change-log-mode)) + (if (not (derived-mode-p 'change-log-mode)) (error "%s not found in Change Log mode" other-log)) ;; Loop through all the entries in OTHER-LOG. (while (not (eobp))
--- a/lisp/bindings.el Mon Jul 23 05:39:31 2007 +0000 +++ b/lisp/bindings.el Tue Jul 24 01:23:55 2007 +0000 @@ -248,6 +248,22 @@ (make-variable-buffer-local 'mode-line-modified) +(defvar mode-line-remote + (list (propertize + "%1R" + 'help-echo (purecopy (lambda (window object point) + (format "%s" + (save-selected-window + (select-window window) + (concat + (if (file-remote-p default-directory) + "Remote: " + "Local: ") + default-directory))))))) + "Mode-line flag to show if default-directory for current buffer is remote.") + +(make-variable-buffer-local 'mode-line-remote) + ;; Actual initialization is below. (defvar mode-line-position nil "Mode-line control for displaying the position in the buffer. @@ -287,6 +303,7 @@ (propertize "-" 'help-echo help-echo) 'mode-line-mule-info 'mode-line-modified + 'mode-line-remote 'mode-line-frame-identification 'mode-line-buffer-identification (propertize " " 'help-echo help-echo)
--- a/lisp/calc/calc-math.el Mon Jul 23 05:39:31 2007 +0000 +++ b/lisp/calc/calc-math.el Tue Jul 24 01:23:55 2007 +0000 @@ -32,6 +32,71 @@ (require 'calc-ext) (require 'calc-macs) + +;;; Find out how many 9s in 9.9999... will give distinct Emacs floats, +;;; then back off by one. + +(defvar math-emacs-precision + (let* ((n 1) + (x 9) + (xx (+ x (* 9 (expt 10 (- n)))))) + (while (/= x xx) + (progn + (setq n (1+ n)) + (setq x xx) + (setq xx (+ x (* 9 (expt 10 (- n))))))) + (1- n)) + "The number of digits in an Emacs float.") + +;;; Find the largest power of 10 which is an Emacs float, +;;; then back off by one so that any float d.dddd...eN +;;; is an Emacs float, for acceptable d.dddd.... + +(defvar math-largest-emacs-expt + (let ((x 1)) + (while (condition-case nil + (expt 10.0 x) + (error nil)) + (setq x (* 2 x))) + (setq x (/ x 2)) + (while (condition-case nil + (expt 10.0 x) + (error nil)) + (setq x (1+ x))) + (- x 2)) + "The largest exponent which Calc will convert to an Emacs float.") + +(defvar math-smallest-emacs-expt + (let ((x -1)) + (while (condition-case nil + (expt 10.0 x) + (error nil)) + (setq x (* 2 x))) + (setq x (/ x 2)) + (while (condition-case nil + (expt 10.0 x) + (error nil)) + (setq x (1- x))) + (+ x 2)) + "The smallest exponent which Calc will convert to an Emacs float.") + +(defun math-use-emacs-fn (fn x) + "Use the native Emacs function FN to evaluate the Calc number X. +If this can't be done, return NIL." + (and + (<= calc-internal-prec math-emacs-precision) + (math-realp x) + (let* ((fx (math-float x)) + (xpon (+ (nth 2 x) (1- (math-numdigs (nth 1 x)))))) + (and (<= math-smallest-emacs-expt xpon) + (<= xpon math-largest-emacs-expt) + (condition-case nil + (math-read-number + (number-to-string + (funcall fn + (string-to-number (math-format-number (math-float x)))))) + (error nil)))))) + (defun calc-sqrt (arg) (interactive "P") (calc-slow-wrapper @@ -1403,6 +1468,7 @@ (list 'polar (math-exp-raw (nth 1 xc)) (math-from-radians (nth 2 xc))))) + ((math-use-emacs-fn 'exp x)) ((or (math-lessp-float '(float 5 -1) x) (math-lessp-float x '(float -5 -1))) (if (math-lessp-float '(float 921035 1) x)
--- a/lisp/diff-mode.el Mon Jul 23 05:39:31 2007 +0000 +++ b/lisp/diff-mode.el Tue Jul 24 01:23:55 2007 +0000 @@ -155,7 +155,7 @@ ("\C-c\C-u" . diff-context->unified) ;; `d' because it duplicates the context :-( --Stef ("\C-c\C-d" . diff-unified->context) - ("\C-c\C-w" . diff-refine-hunk) + ("\C-c\C-w" . diff-refine-ignore-spaces-hunk) ("\C-c\C-f" . next-error-follow-minor-mode)) "Keymap for `diff-mode'. See also `diff-mode-shared-map'.") @@ -164,12 +164,23 @@ '("Diff" ["Jump to Source" diff-goto-source t] ["Apply hunk" diff-apply-hunk t] + ["Test applying hunk" diff-test-hunk t] ["Apply diff with Ediff" diff-ediff-patch t] - ["-----" nil nil] + "-----" ["Reverse direction" diff-reverse-direction t] ["Context -> Unified" diff-context->unified t] ["Unified -> Context" diff-unified->context t] ;;["Fixup Headers" diff-fixup-modifs (not buffer-read-only)] + "-----" + ["Split hunk" diff-split-hunk (diff-splittable-p)] + ["Refine hunk" diff-refine-ignore-spaces-hunk t] + ["Kill current hunk" diff-hunk-kill t] + ["Kill current file's hunks" diff-file-kill t] + "-----" + ["Previous Hunk" diff-hunk-prev t] + ["Next Hunk" diff-hunk-next t] + ["Previous File" diff-file-prev t] + ["Next File" diff-file-next t] )) (defcustom diff-minor-mode-prefix "\C-c=" @@ -390,13 +401,26 @@ ;; The return value is used by easy-mmode-define-navigation. (goto-char (or end (point-max))))) -(defun diff-beginning-of-hunk () +(defun diff-beginning-of-hunk (&optional try-harder) + "Move back to beginning of hunk. +If TRY-HARDER is non-nil, try to cater to the case where we're not in a hunk +but in the file header instead, in which case move forward to the first hunk." (beginning-of-line) (unless (looking-at diff-hunk-header-re) (forward-line 1) (condition-case () (re-search-backward diff-hunk-header-re) - (error (error "Can't find the beginning of the hunk"))))) + (error + (if (not try-harder) + (error "Can't find the beginning of the hunk") + (diff-beginning-of-file-and-junk) + (diff-hunk-next)))))) + +(defun diff-unified-hunk-p () + (save-excursion + (ignore-errors + (diff-beginning-of-hunk) + (looking-at "^@@")))) (defun diff-beginning-of-file () (beginning-of-line) @@ -425,7 +449,7 @@ If the prefix ARG is given, restrict the view to the current file instead." (interactive "P") (save-excursion - (if arg (diff-beginning-of-file) (diff-beginning-of-hunk)) + (if arg (diff-beginning-of-file) (diff-beginning-of-hunk 'try-harder)) (narrow-to-region (point) (progn (if arg (diff-end-of-file) (diff-end-of-hunk)) (point))) @@ -453,18 +477,37 @@ (diff-end-of-hunk) (kill-region start (point))))) +(defun diff-beginning-of-file-and-junk () + "Go to the beginning of file-related diff-info. +This is like `diff-beginning-of-file' except it tries to skip back over leading +data such as \"Index: ...\" and such." + (let ((start (point)) + (file (condition-case err (progn (diff-beginning-of-file) (point)) + (error err))) + ;; prevhunk is one of the limits. + (prevhunk (save-excursion (ignore-errors (diff-hunk-prev) (point)))) + err) + (when (consp file) + ;; Presumably, we started before the file header, in the leading junk. + (setq err file) + (diff-file-next) + (setq file (point))) + (let ((index (save-excursion + (re-search-backward "^Index: " prevhunk t)))) + (when index (setq file index)) + (if (<= file start) + (goto-char file) + ;; File starts *after* the starting point: we really weren't in + ;; a file diff but elsewhere. + (goto-char start) + (signal (car err) (cdr err)))))) + (defun diff-file-kill () "Kill current file's hunks." (interactive) - (diff-beginning-of-file) + (diff-beginning-of-file-and-junk) (let* ((start (point)) - (prevhunk (save-excursion - (ignore-errors - (diff-hunk-prev) (point)))) - (index (save-excursion - (re-search-backward "^Index: " prevhunk t))) (inhibit-read-only t)) - (when index (setq start index)) (diff-end-of-file) (if (looking-at "^\n") (forward-char 1)) ;`tla' generates such diffs. (kill-region start (point)))) @@ -491,6 +534,13 @@ (while (re-search-forward re end t) (incf n)) n))) +(defun diff-splittable-p () + (save-excursion + (beginning-of-line) + (and (looking-at "^[-+ ]") + (progn (forward-line -1) (looking-at "^[-+ ]")) + (diff-unified-hunk-p)))) + (defun diff-split-hunk () "Split the current (unified diff) hunk at point into two hunks." (interactive) @@ -585,9 +635,11 @@ (list (if old (match-string 2) (match-string 4)) (if old (match-string 4) (match-string 2))))))))) -(defun diff-find-file-name (&optional old prefix) +(defun diff-find-file-name (&optional old batch prefix) "Return the file corresponding to the current patch. Non-nil OLD means that we want the old file. +Non-nil BATCH means to prefer returning an incorrect answer than to prompt +the user. PREFIX is only used internally: don't use it." (save-excursion (unless (looking-at diff-file-header-re) @@ -622,7 +674,10 @@ (boundp 'cvs-pcl-cvs-dirchange-re) (save-excursion (re-search-backward cvs-pcl-cvs-dirchange-re nil t)) - (diff-find-file-name old (match-string 1))) + (diff-find-file-name old batch (match-string 1))) + ;; Invent something, if necessary. + (when batch + (or (car fs) default-directory)) ;; if all else fails, ask the user (let ((file (read-file-name (format "Use file %s: " (or (first fs) "")) nil (first fs) t (first fs)))) @@ -670,7 +725,12 @@ (let ((line1 (match-string 4)) (lines1 (match-string 5)) (line2 (match-string 6)) - (lines2 (match-string 7))) + (lines2 (match-string 7)) + ;; Variables to use the special undo function. + (old-undo buffer-undo-list) + (old-end (marker-position end)) + (start (match-beginning 0)) + (reversible t)) (replace-match (concat "***************\n*** " line1 "," (number-to-string (+ (string-to-number line1) @@ -712,6 +772,14 @@ (if (not (save-excursion (re-search-forward "^+" nil t))) (delete-region (point) (point-max)) (let ((modif nil) (delete nil)) + (if (save-excursion (re-search-forward "^\\+.*\n-" nil t)) + ;; Normally, lines in a substitution come with + ;; first the removals and then the additions, and + ;; the context->unified function follows this + ;; convention, of course. Yet, other alternatives + ;; are valid as well, but they preclude the use of + ;; context->unified as an undo command. + (setq reversible nil)) (while (not (eobp)) (case (char-after) (?\s (insert " ") (setq modif nil) (backward-char 1)) @@ -730,7 +798,15 @@ (forward-line 1) (when delete (delete-region last-pt (point)) - (setq delete nil))))))))))))))) + (setq delete nil))))))) + (unless (or (not reversible) (eq buffer-undo-list t)) + ;; Drop the many undo entries and replace them with + ;; a single entry that uses diff-context->unified to do + ;; the work. + (setq buffer-undo-list + (cons (list 'apply (- old-end end) start (point-max) + 'diff-context->unified start (point-max)) + old-undo))))))))))) (defun diff-context->unified (start end &optional to-context) "Convert context diffs to unified diffs. @@ -1289,7 +1365,8 @@ SWITCHED is non-nil if the patch is already applied." (save-excursion (let* ((other (diff-xor other-file diff-jump-to-old-file)) - (char-offset (- (point) (progn (diff-beginning-of-hunk) (point)))) + (char-offset (- (point) (progn (diff-beginning-of-hunk 'try-harder) + (point)))) ;; Check that the hunk is well-formed. Otherwise diff-mode and ;; the user may disagree on what constitutes the hunk ;; (e.g. because an empty line truncates the hunk mid-course), @@ -1461,10 +1538,11 @@ (goto-char (+ (car pos) (cdr src))) (add-log-current-defun)))))) -(defun diff-refine-hunk () +(defun diff-refine-ignore-spaces-hunk () "Refine the current hunk by ignoring space differences." (interactive) - (let* ((char-offset (- (point) (progn (diff-beginning-of-hunk) (point)))) + (let* ((char-offset (- (point) (progn (diff-beginning-of-hunk 'try-harder) + (point)))) (opts (case (char-after) (?@ "-bu") (?* "-bc") (t "-b"))) (line-nb (and (or (looking-at "[^0-9]+\\([0-9]+\\)") (error "Can't find line number"))
--- a/lisp/emacs-lisp/copyright.el Mon Jul 23 05:39:31 2007 +0000 +++ b/lisp/emacs-lisp/copyright.el Tue Jul 24 01:23:55 2007 +0000 @@ -109,7 +109,7 @@ (save-match-data (forward-line 1) (and (looking-at comment-start-skip) - (goto-char (match-end 1)))) + (goto-char (match-end 0)))) (save-match-data (looking-at copyright-years-regexp)))) (forward-line 1)
--- a/lisp/files.el Mon Jul 23 05:39:31 2007 +0000 +++ b/lisp/files.el Tue Jul 24 01:23:55 2007 +0000 @@ -711,6 +711,28 @@ ((null action) (try-completion string names)) (t (test-completion string names)))))) +(defun locate-dominating-file (file regexp) + "Look up the directory hierarchy from FILE for a file matching REGEXP." + (while (and file (not (file-directory-p file))) + (setq file (file-name-directory (directory-file-name file)))) + (catch 'found + (let ((user (nth 2 (file-attributes file))) + ;; Abbreviate, so as to stop when we cross ~/. + (dir (abbreviate-file-name (file-name-as-directory file))) + files) + ;; As a heuristic, we stop looking up the hierarchy of directories as + ;; soon as we find a directory belonging to another user. This should + ;; save us from looking in things like /net and /afs. This assumes + ;; that all the files inside a project belong to the same user. + (while (and dir (equal user (nth 2 (file-attributes dir)))) + (if (setq files (directory-files dir 'full regexp)) + (throw 'found (car files)) + (if (equal dir + (setq dir (file-name-directory + (directory-file-name dir)))) + (setq dir nil)))) + nil))) + (defun executable-find (command) "Search for COMMAND in `exec-path' and return the absolute file name. Return nil if COMMAND is not found anywhere in `exec-path'." @@ -2464,6 +2486,7 @@ mode-line-mule-info mode-line-position mode-line-process + mode-line-remote mode-name outline-level overriding-local-map
--- a/lisp/follow.el Mon Jul 23 05:39:31 2007 +0000 +++ b/lisp/follow.el Tue Jul 24 01:23:55 2007 +0000 @@ -278,12 +278,12 @@ :group 'convenience) (defcustom follow-mode-hook nil - "Hooks to run when follow-mode is turned on." + "Hooks to run when Follow mode is turned on." :type 'hook :group 'follow) (defcustom follow-mode-off-hook nil - "Hooks to run when follow-mode is turned off." + "Hooks to run when Follow mode is turned off." :type 'hook :group 'follow) @@ -501,9 +501,9 @@ movement commands. Follow mode comes to its prime when used on a large screen and two -side-by-side window are used. The user can, with the help of Follow +side-by-side windows are used. The user can, with the help of Follow mode, use two full-height windows as though they would have been -one. Imagine yourself editing a large function, or section of text, +one. Imagine yourself editing a large function, or section of text, and being able to use 144 lines instead of the normal 72... (your mileage may vary). @@ -511,7 +511,7 @@ `\\[split-window-horizontally]' or \ `M-x follow-delete-other-windows-and-split' can be used. -Only windows displayed in the same frame follow each-other. +Only windows displayed in the same frame follow each other. If the variable `follow-intercept-processes' is non-nil, Follow mode will listen to the output of processes and redisplay accordingly. @@ -645,11 +645,11 @@ Execute this command to display as much as possible of the text in the selected window. All other windows, in the current frame, are deleted and the selected window is split in two -side-by-side windows. Follow Mode is activated, hence the +side-by-side windows. Follow Mode is activated, hence the two windows always will display two successive pages. \(If one window is moved, the other one will follow.) -If ARG is positive, the leftmost window is selected. If it negative, +If ARG is positive, the leftmost window is selected. If negative, the rightmost is selected. If ARG is nil, the leftmost window is selected if the original window is the first one in the frame. @@ -754,8 +754,8 @@ Rearrange all other windows around the middle window. With a positive argument, place the current line ARG lines -from the top. With a negative, place it -ARG lines from the -bottom." +from the top. With a negative argument, place it -ARG lines +from the bottom." (interactive "P") (if arg (let ((p (point)) @@ -985,7 +985,7 @@ ;; should start at a full screen line. (defsubst follow-windows-aligned-p (win-start-end) - "Non-nil if the follower WINDOWS are aligned." + "Non-nil if the follower windows are aligned." (let ((res t)) (save-excursion (goto-char (window-start (car (car win-start-end)))) @@ -1005,7 +1005,7 @@ ;; no one will be recentered.) (defun follow-point-visible-all-windows-p (win-start-end) - "Non-nil when the window-point is visible in all windows." + "Non-nil when the `window-point' is visible in all windows." (let ((res t)) (while (and res win-start-end) (setq res (follow-pos-visible (window-point (car (car win-start-end))) @@ -1133,7 +1133,7 @@ (defun follow-redisplay (&optional windows win) "Reposition the WINDOWS around WIN. Should the point be too close to the roof we redisplay everything -from the top. WINDOWS should contain a list of windows to +from the top. WINDOWS should contain a list of windows to redisplay, it is assumed that WIN is a member of the list. Should WINDOWS be nil, the windows displaying the same buffer as WIN, in the current frame, are used. @@ -1214,8 +1214,8 @@ (defun follow-estimate-first-window-start (windows win start) "Estimate the position of the first window. -Returns (EXACT . POS). If EXACT is non-nil, POS is the starting -position of the first window. Otherwise it is a good guess." +Returns (EXACT . POS). If EXACT is non-nil, POS is the starting +position of the first window. Otherwise it is a good guess." (let ((pred (car (follow-split-followers windows win))) (exact nil)) (save-excursion @@ -1667,7 +1667,7 @@ (defun follow-xemacs-scrollbar-support (window) "Redraw windows showing the same buffer as shown in WINDOW. WINDOW is either the dragged window, or a cons containing the -window as its first element. This is called while the user drags +window as its first element. This is called while the user drags the scrollbar. WINDOW can be an object or a window." @@ -1797,7 +1797,7 @@ "Intercept all active processes. This is needed so that Follow Mode can track all display events in the -system. (See `follow-mode')" +system. (See `follow-mode'.)" (interactive) (let ((list (process-list))) (while list @@ -2075,7 +2075,7 @@ ;;{{{ Tail window handling ;; In Emacs (not XEmacs) windows showing nothing are sometimes -;; recentered. When in Follow Mode, this is not desireable for +;; recentered. When in Follow Mode, this is not desirable for ;; non-first windows in the window chain. This section tries to ;; make the windows stay where they should be. ;;
--- a/lisp/gnus/ChangeLog Mon Jul 23 05:39:31 2007 +0000 +++ b/lisp/gnus/ChangeLog Tue Jul 24 01:23:55 2007 +0000 @@ -1,3 +1,12 @@ +2007-07-21 Reiner Steib <Reiner.Steib@gmx.de> + + * mm-uu.el (mm-uu-type-alist): Refer to mm-uu-configure-list in doc + string. + +2007-07-16 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-srvr.el (gnus-server-font-lock-keywords): Quote faces. + 2007-07-14 David Kastrup <dak@gnu.org> * gnus-art.el (gnus-mime-delete-part): Don't go through article-edit
--- a/lisp/gnus/gnus-srvr.el Mon Jul 23 05:39:31 2007 +0000 +++ b/lisp/gnus/gnus-srvr.el Tue Jul 24 01:23:55 2007 +0000 @@ -215,11 +215,11 @@ (put 'gnus-server-offline-face 'face-alias 'gnus-server-offline) (defvar gnus-server-font-lock-keywords - '(("(\\(agent\\))" 1 gnus-server-agent) - ("(\\(opened\\))" 1 gnus-server-opened) - ("(\\(closed\\))" 1 gnus-server-closed) - ("(\\(offline\\))" 1 gnus-server-offline) - ("(\\(denied\\))" 1 gnus-server-denied))) + '(("(\\(agent\\))" 1 'gnus-server-agent) + ("(\\(opened\\))" 1 'gnus-server-opened) + ("(\\(closed\\))" 1 'gnus-server-closed) + ("(\\(offline\\))" 1 'gnus-server-offline) + ("(\\(denied\\))" 1 'gnus-server-denied))) (defun gnus-server-mode () "Major mode for listing and editing servers.
--- a/lisp/gnus/mm-uu.el Mon Jul 23 05:39:31 2007 +0000 +++ b/lisp/gnus/mm-uu.el Tue Jul 24 01:23:55 2007 +0000 @@ -162,7 +162,10 @@ Each element consist of the following entries: label, start-regexp, end-regexp, extract-function, test-function. -After modifying this list you must run \\[mm-uu-configure].") +After modifying this list you must run \\[mm-uu-configure]. + +You can disable elements from this list by customizing +`mm-uu-configure-list'.") (defcustom mm-uu-configure-list '((shar . disabled)) "A list of mm-uu configuration.
--- a/lisp/image-dired.el Mon Jul 23 05:39:31 2007 +0000 +++ b/lisp/image-dired.el Tue Jul 24 01:23:55 2007 +0000 @@ -869,11 +869,28 @@ ;;;###autoload (defalias 'tumme 'image-dired-show-all-from-dir) +(defun image-dired-sane-db-file () + "Check if `image-dired-db-file' exists. +If not, try to create it (including any parent directories). +Signal error if there are problems creating it." + (or (file-exists-p image-dired-db-file) + (let (dir buf) + (unless (file-directory-p (setq dir (file-name-directory + image-dired-db-file))) + (make-directory dir t)) + (with-current-buffer (setq buf (create-file-buffer + image-dired-db-file)) + (write-file image-dired-db-file)) + (kill-buffer buf) + (file-exists-p image-dired-db-file)) + (error "Could not create %s" image-dired-db-file))) + (defun image-dired-write-tags (file-tags) "Write file tags to database. Write each file and tag in FILE-TAGS to the database. FILE-TAGS is an alist in the following form: ((FILE . TAG) ... )" + (image-dired-sane-db-file) (let (end file tag) (with-temp-file image-dired-db-file (insert-file-contents image-dired-db-file) @@ -893,6 +910,7 @@ (defun image-dired-remove-tag (files tag) "For all FILES, remove TAG from the image database." + (image-dired-sane-db-file) (save-excursion (let (end buf start) (setq buf (find-file image-dired-db-file)) @@ -927,6 +945,7 @@ (defun image-dired-list-tags (file) "Read all tags for image FILE from the image database." + (image-dired-sane-db-file) (save-excursion (let (end buf (tags "")) (setq buf (find-file image-dired-db-file)) @@ -2038,6 +2057,7 @@ Write file comments to one or more files. FILE-COMMENTS is an alist on the following form: ((FILE . COMMENT) ... )" + (image-dired-sane-db-file) (let (end comment-beg-pos comment-end-pos file comment) (with-temp-file image-dired-db-file (insert-file-contents image-dired-db-file) @@ -2108,6 +2128,7 @@ (defun image-dired-get-comment (file) "Get comment for file FILE." + (image-dired-sane-db-file) (save-excursion (let (end buf comment-beg-pos comment-end-pos comment) (setq buf (find-file image-dired-db-file)) @@ -2136,6 +2157,7 @@ on all image files in the database file. The files that have a matching tags will be marked in the dired buffer." (interactive) + (image-dired-sane-db-file) (let ((tag (read-string "Mark tagged files (regexp): ")) (hits 0) files buf) @@ -2300,6 +2322,7 @@ (defun image-dired-create-gallery-lists () "Create temporary lists used by `image-dired-gallery-generate'." + (image-dired-sane-db-file) (let ((buf (find-file image-dired-db-file)) end beg file row-tags) (setq image-dired-tag-file-list nil)
--- a/lisp/isearch.el Mon Jul 23 05:39:31 2007 +0000 +++ b/lisp/isearch.el Tue Jul 24 01:23:55 2007 +0000 @@ -164,6 +164,10 @@ (defvar isearch-mode-end-hook-quit nil "Non-nil while running `isearch-mode-end-hook' if user quit the search.") +(defvar isearch-message-function nil + "Function to call to display the search prompt. +If nil, use `isearch-message'.") + (defvar isearch-wrap-function nil "Function to call to wrap the search when search is failed. If nil, move point to the beginning of the buffer for a forward search, @@ -711,7 +715,9 @@ (null executing-kbd-macro)) (progn (if (not (input-pending-p)) - (isearch-message)) + (if isearch-message-function + (funcall isearch-message-function) + (isearch-message))) (if (and isearch-slow-terminal-mode (not (or isearch-small-window (pos-visible-in-window-p)))) @@ -988,7 +994,7 @@ isearch-original-minibuffer-message-timeout) (isearch-original-minibuffer-message-timeout isearch-original-minibuffer-message-timeout) - ) + old-point old-other-end) ;; Actually terminate isearching until editing is done. ;; This is so that the user can do anything without failure, @@ -997,6 +1003,10 @@ (isearch-done t t) (exit nil)) ; was recursive editing + ;; Save old point and isearch-other-end before reading from minibuffer + ;; that can change their values. + (setq old-point (point) old-other-end isearch-other-end) + (isearch-message) ;; for read-char (unwind-protect (let* (;; Why does following read-char echo? @@ -1032,6 +1042,14 @@ isearch-new-message (mapconcat 'isearch-text-char-description isearch-new-string ""))) + + ;; Set point at the start (end) of old match if forward (backward), + ;; so after exiting minibuffer isearch resumes at the start (end) + ;; of this match and can find it again. + (if (and old-other-end (eq old-point (point)) + (eq isearch-forward isearch-new-forward)) + (goto-char old-other-end)) + ;; Always resume isearching by restarting it. (isearch-mode isearch-forward isearch-regexp @@ -1256,10 +1274,13 @@ (ding) (setq isearch-string (substring isearch-string 0 (- (or arg 1))) isearch-message (mapconcat 'isearch-text-char-description - isearch-string "") - ;; Don't move cursor in reverse search. - isearch-yank-flag t)) - (isearch-search-and-update)) + isearch-string ""))) + ;; Use the isearch-other-end as new starting point to be able + ;; to find the remaining part of the search string again. + (if isearch-other-end (goto-char isearch-other-end)) + (isearch-search) + (isearch-push-state) + (isearch-update)) (defun isearch-yank-string (string) "Pull STRING into search string." @@ -2016,7 +2037,9 @@ (defun isearch-search () ;; Do the search with the current search string. - (isearch-message nil t) + (if isearch-message-function + (funcall isearch-message-function nil t) + (isearch-message nil t)) (if (and (eq isearch-case-fold-search t) search-upper-case) (setq isearch-case-fold-search (isearch-no-upper-case-p isearch-string isearch-regexp)))
--- a/lisp/kmacro.el Mon Jul 23 05:39:31 2007 +0000 +++ b/lisp/kmacro.el Tue Jul 24 01:23:55 2007 +0000 @@ -606,8 +606,11 @@ (unless executing-kbd-macro (end-kbd-macro arg #'kmacro-loop-setup-function) (when (and last-kbd-macro (= (length last-kbd-macro) 0)) + (setq last-kbd-macro nil) (message "Ignore empty macro") - (kmacro-pop-ring)))) + ;; Don't call `kmacro-ring-empty-p' to avoid its messages. + (while (and (null last-kbd-macro) kmacro-ring) + (kmacro-pop-ring1))))) ;;;###autoload @@ -795,8 +798,9 @@ ok cmd) (when (= (length key-seq) 1) (let ((ch (aref key-seq 0))) - (if (or (and (>= ch ?0) (<= ch ?9)) - (and (>= ch ?A) (<= ch ?Z))) + (if (and (integerp ch) + (or (and (>= ch ?0) (<= ch ?9)) + (and (>= ch ?A) (<= ch ?Z)))) (setq key-seq (concat "\C-x\C-k" key-seq) ok t)))) (when (and (not (equal key-seq ""))
--- a/lisp/makefile.w32-in Mon Jul 23 05:39:31 2007 +0000 +++ b/lisp/makefile.w32-in Tue Jul 24 01:23:55 2007 +0000 @@ -432,12 +432,13 @@ # since cp does not preserve time stamps install-lisp-SH: cp -f *.el "$(INSTALL_DIR)/lisp" - for dir in $(WINS); do mkdir "$(INSTALL_DIR)/lisp/$$dir" && cp -f $$dir/*.el "$(INSTALL_DIR)/lisp/$$dir"; done + for dir in $(WINS); do [ -d "$(INSTALL_DIR)/lisp/$$dir" ] || mkdir "$(INSTALL_DIR)/lisp/$$dir"; done + for dir in $(WINS); do cp -f $$dir/*.el "$(INSTALL_DIR)/lisp/$$dir"; done for dir in . $(WINS); do cp $$dir/*.elc "$(INSTALL_DIR)/lisp/$$dir"; done install-lisp-CMD: cp -f *.el "$(INSTALL_DIR)/lisp" - for %%f in ($(WINS)) do mkdir "$(INSTALL_DIR)/lisp/%%f" + for %%f in ($(WINS)) do if not exist "$(INSTALL_DIR)/lisp/%%f" mkdir "$(INSTALL_DIR)/lisp/%%f" for %%f in ($(WINS)) do cp -f %%f/*.el "$(INSTALL_DIR)/lisp/%%f" for %%f in (. $(WINS)) do cp -f %%f/*.elc "$(INSTALL_DIR)/lisp/%%f"
--- a/lisp/net/tramp.el Mon Jul 23 05:39:31 2007 +0000 +++ b/lisp/net/tramp.el Tue Jul 24 01:23:55 2007 +0000 @@ -1528,7 +1528,7 @@ $uid = ($ARGV[1] eq \"integer\") ? $stat[4] : \"\\\"\" . getpwuid($stat[4]) . \"\\\"\"; $gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" . getgrgid($stat[5]) . \"\\\"\"; printf( - \"(%%s %%u %%s %%s (%%u %%u) (%%u %%u) (%%u %%u) %%u %%u t (%%u . %%u) -1)\\n\", + \"(%%s %%u %%s %%s (%%u %%u) (%%u %%u) (%%u %%u) %%u.0 %%u t (%%u . %%u) -1)\\n\", $type, $stat[3], $uid, @@ -1577,7 +1577,7 @@ $uid = ($ARGV[1] eq \"integer\") ? $stat[4] : \"\\\"\" . getpwuid($stat[4]) . \"\\\"\"; $gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" . getgrgid($stat[5]) . \"\\\"\"; printf( - \"(\\\"%%s\\\" %%s %%u %%s %%s (%%u %%u) (%%u %%u) (%%u %%u) %%u %%u t (%%u . %%u) (%%u %%u))\\n\", + \"(\\\"%%s\\\" %%s %%u %%s %%s (%%u %%u) (%%u %%u) (%%u %%u) %%u.0 %%u t (%%u . %%u) (%%u %%u))\\n\", $filename, $type, $stat[3], @@ -2390,7 +2390,7 @@ (tramp-send-command-and-read vec (format - "%s -c '((\"%%N\") %%h %s %s %%X.0 %%Y.0 %%Z.0 %%s \"%%A\" t %%i.0 -1)' %s" + "%s -c '((\"%%N\") %%h %s %s %%X.0 %%Y.0 %%Z.0 %%s.0 \"%%A\" t %%i.0 -1)' %s" (tramp-get-remote-stat vec) (if (eq id-format 'integer) "%u" "\"%U\"") (if (eq id-format 'integer) "%g" "\"%G\"") @@ -2740,7 +2740,7 @@ (format (concat "cd %s; echo \"(\"; (%s -ab | xargs " - "%s -c '(\"%%n\" (\"%%N\") %%h %s %s %%X.0 %%Y.0 %%Z.0 %%s \"%%A\" t %%i.0 -1)'); " + "%s -c '(\"%%n\" (\"%%N\") %%h %s %s %%X.0 %%Y.0 %%Z.0 %%s.0 \"%%A\" t %%i.0 -1)'); " "echo \")\"") (tramp-shell-quote-argument localname) (tramp-get-ls-command vec) @@ -6253,6 +6253,11 @@ (setcar (nthcdr 6 attr) (list (floor (nth 6 attr) 65536) (floor (mod (nth 6 attr) 65536))))) + ;; Convert file size. + (when (< (nth 7 attr) 0) + (setcar (nthcdr 7 attr) -1)) + (when (and (floatp (nth 7 attr)) (<= (nth 7 attr) most-positive-fixnum)) + (setcar (nthcdr 7 attr) (round (nth 7 attr)))) ;; Convert file mode bits to string. (unless (stringp (nth 8 attr)) (setcar (nthcdr 8 attr) (tramp-file-mode-from-int (nth 8 attr)))) @@ -6551,8 +6556,7 @@ (and dl (not - (string-equal - result (expand-file-name-as-directory cmd (car dl))))) + (string-equal result (expand-file-name cmd (car dl))))) (setq dl (cdr dl))) (setq dl (cdr dl)))))) (tramp-error vec 'file-error "Couldn't find a proper `ls' command")))))
--- a/lisp/net/trampver.el Mon Jul 23 05:39:31 2007 +0000 +++ b/lisp/net/trampver.el Tue Jul 24 01:23:55 2007 +0000 @@ -30,14 +30,14 @@ ;; "autoconf && ./configure" to change them. (X)Emacs version check is defined ;; in macro AC_EMACS_INFO of aclocal.m4; should be changed only there. -(defconst tramp-version "2.1.10-pre" +(defconst tramp-version "2.1.10" "This version of Tramp.") (defconst tramp-bug-report-address "tramp-devel@gnu.org" "Email address to send bug reports to.") ;; Check for (X)Emacs version. -(let ((x (if (or (< emacs-major-version 21) (and (featurep 'xemacs) (< emacs-minor-version 4))) (format "Tramp 2.1.10-pre is not fit for %s" (when (string-match "^.*$" (emacs-version)) (match-string 0 (emacs-version)))) "ok"))) +(let ((x (if (or (< emacs-major-version 21) (and (featurep 'xemacs) (< emacs-minor-version 4))) (format "Tramp 2.1.10 is not fit for %s" (when (string-match "^.*$" (emacs-version)) (match-string 0 (emacs-version)))) "ok"))) (unless (string-match "\\`ok\\'" x) (error x))) (provide 'trampver)
--- a/lisp/pcvs.el Mon Jul 23 05:39:31 2007 +0000 +++ b/lisp/pcvs.el Tue Jul 24 01:23:55 2007 +0000 @@ -2207,6 +2207,10 @@ (dolist (fi (cvs-mode-marked nil nil)) (let* ((default-directory (cvs-expand-dir-name (cvs-fileinfo->dir fi))) (buffer-file-name (expand-file-name (cvs-fileinfo->file fi)))) + (if (file-directory-p buffer-file-name) + ;; Be careful to use a directory name, otherwise add-log starts + ;; looking for a ChangeLog file in the parent dir. + (setq buffer-file-name (file-name-as-directory buffer-file-name))) (kill-local-variable 'change-log-default-name) (save-excursion (add-change-log-entry-other-window)))))
--- a/lisp/progmodes/compile.el Mon Jul 23 05:39:31 2007 +0000 +++ b/lisp/progmodes/compile.el Tue Jul 24 01:23:55 2007 +0000 @@ -607,7 +607,9 @@ (defcustom compilation-auto-jump-to-first-error nil "If non-nil, automatically jump to the first error after `compile'." - :type 'boolean) + :type 'boolean + :group 'compilation + :version "23.1") (defvar compilation-auto-jump-to-next nil "If non-nil, automatically jump to the next error encountered.") @@ -934,7 +936,7 @@ (unless (equal command (eval compile-command)) (setq compile-command command)) (save-some-buffers (not compilation-ask-about-save) nil) - (setq compilation-directory default-directory) + (setq-default compilation-directory default-directory) (compilation-start command comint)) ;; run compile with the default command line @@ -944,10 +946,7 @@ original use. Otherwise, recompile using `compile-command'." (interactive) (save-some-buffers (not compilation-ask-about-save) nil) - (let ((default-directory - (or (and (not (eq major-mode (nth 1 compilation-arguments))) - compilation-directory) - default-directory))) + (let ((default-directory (or compilation-directory default-directory))) (apply 'compilation-start (or compilation-arguments `(,(eval compile-command)))))) @@ -1042,6 +1041,10 @@ (buffer-disable-undo (current-buffer)) ;; first transfer directory from where M-x compile was called (setq default-directory thisdir) + ;; Remember the original dir, so we can use it when we recompile. + ;; default-directory' can't be used reliably for that because it may be + ;; affected by the special handling of "cd ...;". + (set (make-local-variable 'compilation-directory) thisdir) ;; Make compilation buffer read-only. The filter can still write it. ;; Clear out the compilation buffer. (let ((inhibit-read-only t)
--- a/lisp/progmodes/flymake.el Mon Jul 23 05:39:31 2007 +0000 +++ b/lisp/progmodes/flymake.el Tue Jul 24 01:23:55 2007 +0000 @@ -325,11 +325,6 @@ (or (nth 2 (flymake-get-file-name-mode-and-masks file-name)) 'flymake-get-real-file-name)) -(defcustom flymake-buildfile-dirs '("." ".." "../.." "../../.." "../../../.." "../../../../.." "../../../../../.." "../../../../../../.." "../../../../../../../.." "../../../../../../../../.." "../../../../../../../../../.." "../../../../../../../../../../..") - "Dirs to look for buildfile." - :group 'flymake - :type '(repeat (string))) - (defvar flymake-find-buildfile-cache (flymake-makehash 'equal)) (defun flymake-get-buildfile-from-cache (dir-name) @@ -346,19 +341,15 @@ Buildfile includes Makefile, build.xml etc. Return its file name if found, or nil if not found." (or (flymake-get-buildfile-from-cache source-dir-name) - (let* ((dirs flymake-buildfile-dirs) - (buildfile-dir nil) - (found nil)) - (while (and (not found) dirs) - (setq buildfile-dir (concat source-dir-name (car dirs))) - (when (file-exists-p (expand-file-name buildfile-name buildfile-dir)) - (setq found t)) - (setq dirs (cdr dirs))) - (if found + (let* ((file (locate-dominating-file + source-dir-name + (concat "\\`" (regexp-quote buildfile-name) "\\'")))) + (if file (progn - (flymake-log 3 "found buildfile at %s/%s" buildfile-dir buildfile-name) - (flymake-add-buildfile-to-cache source-dir-name buildfile-dir) - buildfile-dir) + (flymake-log 3 "found buildfile at %s" file) + (setq file (file-name-directory file)) + (flymake-add-buildfile-to-cache source-dir-name file) + file) (progn (flymake-log 3 "buildfile for %s not found" source-dir-name) nil)))))
--- a/lisp/progmodes/grep.el Mon Jul 23 05:39:31 2007 +0000 +++ b/lisp/progmodes/grep.el Tue Jul 24 01:23:55 2007 +0000 @@ -343,6 +343,12 @@ (defvar grep-regexp-history nil) (defvar grep-files-history '("ch" "el")) +(defvar grep-host-defaults-alist nil + "Default values depending on target host. +`grep-compute-defaults' returns default values for every local or +remote host `grep' runs. These values can differ from host to +host. Once computed, the default values are kept here in order +to avoid computing them again.") ;;;###autoload (defun grep-process-setup () @@ -377,38 +383,51 @@ ;;;###autoload (defun grep-compute-defaults () - (let ((host-id - (intern (or (file-remote-p default-directory 'host) "localhost")))) + ;; Keep default values. + (unless grep-host-defaults-alist + (add-to-list + 'grep-host-defaults-alist + (cons nil + `((grep-command ,grep-command) + (grep-template ,grep-template) + (grep-use-null-device ,grep-use-null-device) + (grep-find-command ,grep-find-command) + (grep-find-template ,grep-find-template) + (grep-find-use-xargs ,grep-find-use-xargs) + (grep-highlight-matches ,grep-highlight-matches))))) + (let* ((host-id + (intern (or (file-remote-p default-directory 'host) "localhost"))) + (host-defaults (assq host-id grep-host-defaults-alist)) + (defaults (assq nil grep-host-defaults-alist))) ;; There are different defaults on different hosts. They must be - ;; computed for every host once, then they are kept in the - ;; variables' property host-id for reuse. + ;; computed for every host once. (setq grep-command - (or (get 'grep-command host-id) - (eval (car (get 'grep-command 'standard-value)))) + (or (cadr (assq 'grep-command host-defaults)) + (cadr (assq 'grep-command defaults))) grep-template - (or (get 'grep-template host-id) - (eval (car (get 'grep-template 'standard-value)))) + (or (cadr (assq 'grep-template host-defaults)) + (cadr (assq 'grep-template defaults))) grep-use-null-device - (or (get 'grep-use-null-device host-id) - (eval (car (get 'grep-use-null-device 'standard-value)))) + (or (cadr (assq 'grep-use-null-device host-defaults)) + (cadr (assq 'grep-use-null-device defaults))) grep-find-command - (or (get 'grep-find-command host-id) - (eval (car (get 'grep-find-command 'standard-value)))) + (or (cadr (assq 'grep-find-command host-defaults)) + (cadr (assq 'grep-find-command defaults))) grep-find-template - (or (get 'grep-find-template host-id) - (eval (car (get 'grep-find-template 'standard-value)))) + (or (cadr (assq 'grep-find-template host-defaults)) + (cadr (assq 'grep-find-template defaults))) grep-find-use-xargs - (or (get 'grep-find-use-xargs host-id) - (eval (car (get 'grep-find-use-xargs 'standard-value)))) + (or (cadr (assq 'grep-find-use-xargs host-defaults)) + (cadr (assq 'grep-find-use-xargs defaults))) grep-highlight-matches - (or (get 'grep-highlight-matches host-id) - (eval (car (get 'grep-highlight-matches 'standard-value))))) + (or (cadr (assq 'grep-highlight-matches host-defaults)) + (cadr (assq 'grep-highlight-matches defaults)))) (unless (or (not grep-use-null-device) (eq grep-use-null-device t)) (setq grep-use-null-device @@ -492,13 +511,19 @@ t)))) ;; Save defaults for this host. - (put 'grep-command host-id grep-command) - (put 'grep-template host-id grep-template) - (put 'grep-use-null-device host-id grep-use-null-device) - (put 'grep-find-command host-id grep-find-command) - (put 'grep-find-template host-id grep-find-template) - (put 'grep-find-use-xargs host-id grep-find-use-xargs) - (put 'grep-highlight-matches host-id grep-highlight-matches))) + (setq grep-host-defaults-alist + (delete (assq host-id grep-host-defaults-alist) + grep-host-defaults-alist)) + (add-to-list + 'grep-host-defaults-alist + (cons host-id + `((grep-command ,grep-command) + (grep-template ,grep-template) + (grep-use-null-device ,grep-use-null-device) + (grep-find-command ,grep-find-command) + (grep-find-template ,grep-find-template) + (grep-find-use-xargs ,grep-find-use-xargs) + (grep-highlight-matches ,grep-highlight-matches)))))) (defun grep-tag-default () (or (and transient-mark-mode mark-active
--- a/lisp/progmodes/octave-inf.el Mon Jul 23 05:39:31 2007 +0000 +++ b/lisp/progmodes/octave-inf.el Tue Jul 24 01:23:55 2007 +0000 @@ -42,7 +42,7 @@ :group 'octave-inferior) (defcustom inferior-octave-prompt - "\\(^octave\\(\\|.bin\\)\\(-[.0-9]+\\)?\\(:[0-9]+\\)?\\|^debug\\|^\\)>+ " + "\\(^octave\\(\\|.bin\\|.exe\\)\\(-[.0-9]+\\)?\\(:[0-9]+\\)?\\|^debug\\|^\\)>+ " "Regexp to match prompts for the inferior Octave process." :type 'regexp :group 'octave-inferior)
--- a/lisp/progmodes/vera-mode.el Mon Jul 23 05:39:31 2007 +0000 +++ b/lisp/progmodes/vera-mode.el Tue Jul 24 01:23:55 2007 +0000 @@ -48,7 +48,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Documentation -;; See comment string of function `vera-mode' or type `C-c C-h' in Emacs. +;; See comment string of function `vera-mode' or type `C-h m' in Emacs. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Installation @@ -122,37 +122,37 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Key bindings -(defvar vera-mode-map () +(defvar vera-mode-map + (let ((map (make-sparse-keymap))) + ;; Backspace/delete key bindings. + (define-key map [backspace] 'backward-delete-char-untabify) + (unless (boundp 'delete-key-deletes-forward) ; XEmacs variable + (define-key map [delete] 'delete-char) + (define-key map [(meta delete)] 'kill-word)) + ;; Standard key bindings. + (define-key map "\M-e" 'vera-forward-statement) + (define-key map "\M-a" 'vera-backward-statement) + (define-key map "\M-\C-e" 'vera-forward-same-indent) + (define-key map "\M-\C-a" 'vera-backward-same-indent) + ;; Mode specific key bindings. + (define-key map "\C-c\t" 'indent-according-to-mode) + (define-key map "\M-\C-\\" 'vera-indent-region) + (define-key map "\C-c\C-c" 'vera-comment-uncomment-region) + (define-key map "\C-c\C-f" 'vera-fontify-buffer) + (define-key map "\C-c\C-v" 'vera-version) + (define-key map "\M-\t" 'tab-to-tab-stop) + ;; Electric key bindings. + (define-key map "\t" 'vera-electric-tab) + (define-key map "\r" 'vera-electric-return) + (define-key map " " 'vera-electric-space) + (define-key map "{" 'vera-electric-opening-brace) + (define-key map "}" 'vera-electric-closing-brace) + (define-key map "#" 'vera-electric-pound) + (define-key map "*" 'vera-electric-star) + (define-key map "/" 'vera-electric-slash) + map) "Keymap for Vera Mode.") -(setq vera-mode-map (make-sparse-keymap)) -;; backspace/delete key bindings -(define-key vera-mode-map [backspace] 'backward-delete-char-untabify) -(unless (boundp 'delete-key-deletes-forward) ; XEmacs variable - (define-key vera-mode-map [delete] 'delete-char) - (define-key vera-mode-map [(meta delete)] 'kill-word)) -;; standard key bindings -(define-key vera-mode-map "\M-e" 'vera-forward-statement) -(define-key vera-mode-map "\M-a" 'vera-backward-statement) -(define-key vera-mode-map "\M-\C-e" 'vera-forward-same-indent) -(define-key vera-mode-map "\M-\C-a" 'vera-backward-same-indent) -;; mode specific key bindings -(define-key vera-mode-map "\C-c\t" 'indent-according-to-mode) -(define-key vera-mode-map "\M-\C-\\" 'vera-indent-region) -(define-key vera-mode-map "\C-c\C-c" 'vera-comment-uncomment-region) -(define-key vera-mode-map "\C-c\C-f" 'vera-fontify-buffer) -(define-key vera-mode-map "\C-c\C-v" 'vera-version) -(define-key vera-mode-map "\M-\t" 'tab-to-tab-stop) -;; electric key bindings -(define-key vera-mode-map "\t" 'vera-electric-tab) -(define-key vera-mode-map "\r" 'vera-electric-return) -(define-key vera-mode-map " " 'vera-electric-space) -(define-key vera-mode-map "{" 'vera-electric-opening-brace) -(define-key vera-mode-map "}" 'vera-electric-closing-brace) -(define-key vera-mode-map "#" 'vera-electric-pound) -(define-key vera-mode-map "*" 'vera-electric-star) -(define-key vera-mode-map "/" 'vera-electric-slash) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Menu @@ -844,21 +844,19 @@ (defsubst vera-re-search-forward (regexp &optional bound noerror) "Like `re-search-forward', but skips over matches in literals." - (store-match-data '(nil nil)) - (while (and (re-search-forward regexp bound noerror) - (vera-skip-forward-literal) - (progn (store-match-data '(nil nil)) - (if bound (< (point) bound) t)))) - (match-end 0)) + (let (ret) + (while (and (setq ret (re-search-forward regexp bound noerror)) + (vera-skip-forward-literal) + (if bound (< (point) bound) t))) + ret)) (defsubst vera-re-search-backward (regexp &optional bound noerror) "Like `re-search-backward', but skips over matches in literals." - (store-match-data '(nil nil)) - (while (and (re-search-backward regexp bound noerror) - (vera-skip-backward-literal) - (progn (store-match-data '(nil nil)) - (if bound (> (point) bound) t)))) - (match-end 0)) + (let (ret) + (while (and (setq ret (re-search-backward regexp bound noerror)) + (vera-skip-backward-literal) + (if bound (> (point) bound) t))) + ret)) (defun vera-forward-syntactic-ws (&optional lim skip-directive) "Forward skip of syntactic whitespace."
--- a/lisp/ps-print.el Mon Jul 23 05:39:31 2007 +0000 +++ b/lisp/ps-print.el Tue Jul 24 01:23:55 2007 +0000 @@ -5408,9 +5408,11 @@ ps-zebra-stripe-height) "/ZebraColor " (ps-format-color ps-zebra-color 0.95) - "def\n/BackgroundColor " + "def\n") + (ps-output "/BackgroundColor " (ps-format-color ps-default-background 1.0) - "def\n/UseSetpagedevice " + "def\n") + (ps-output "/UseSetpagedevice " (if (eq ps-spool-config 'setpagedevice) "/setpagedevice where{pop languagelevel 2 eq}{false}ifelse" "false")
--- a/lisp/replace.el Mon Jul 23 05:39:31 2007 +0000 +++ b/lisp/replace.el Tue Jul 24 01:23:55 2007 +0000 @@ -1408,38 +1408,36 @@ (or map (setq map query-replace-map)) (and query-flag minibuffer-auto-raise (raise-frame (window-frame (minibuffer-window)))) - (let ((nocasify (not (and case-fold-search case-replace - (string-equal from-string - (downcase from-string))))) - (case-fold-search (and case-fold-search - (string-equal from-string - (downcase from-string)))) - (literal (or (not regexp-flag) (eq regexp-flag 'literal))) - (search-function (if regexp-flag 're-search-forward 'search-forward)) - (search-string from-string) - (real-match-data nil) ; the match data for the current match - (next-replacement nil) - ;; This is non-nil if we know there is nothing for the user - ;; to edit in the replacement. - (noedit nil) - (keep-going t) - (stack nil) - (replace-count 0) - (nonempty-match nil) + (let* ((case-fold-search + (and case-fold-search + (isearch-no-upper-case-p from-string regexp-flag))) + (nocasify (not (and case-replace case-fold-search))) + (literal (or (not regexp-flag) (eq regexp-flag 'literal))) + (search-function (if regexp-flag 're-search-forward 'search-forward)) + (search-string from-string) + (real-match-data nil) ; The match data for the current match. + (next-replacement nil) + ;; This is non-nil if we know there is nothing for the user + ;; to edit in the replacement. + (noedit nil) + (keep-going t) + (stack nil) + (replace-count 0) + (nonempty-match nil) - ;; If non-nil, it is marker saying where in the buffer to stop. - (limit nil) + ;; If non-nil, it is marker saying where in the buffer to stop. + (limit nil) - ;; Data for the next match. If a cons, it has the same format as - ;; (match-data); otherwise it is t if a match is possible at point. - (match-again t) + ;; Data for the next match. If a cons, it has the same format as + ;; (match-data); otherwise it is t if a match is possible at point. + (match-again t) - (message - (if query-flag - (apply 'propertize - (substitute-command-keys - "Query replacing %s with %s: (\\<query-replace-map>\\[help] for help) ") - minibuffer-prompt-properties)))) + (message + (if query-flag + (apply 'propertize + (substitute-command-keys + "Query replacing %s with %s: (\\<query-replace-map>\\[help] for help) ") + minibuffer-prompt-properties)))) ;; If region is active, in Transient Mark mode, operate on region. (when start
--- a/lisp/ses.el Mon Jul 23 05:39:31 2007 +0000 +++ b/lisp/ses.el Tue Jul 24 01:23:55 2007 +0000 @@ -1470,17 +1470,22 @@ (overlay-put ses--curcell-overlay 'face 'underline)) (defun ses-cleanup () - "Cleanup when changing a buffer from SES mode to something else. Delete -overlay, remove special text properties." + "Cleanup when changing a buffer from SES mode to something else. +Delete overlays, remove special text properties." (widen) (let ((inhibit-read-only t) + ;; When reverting, hide the buffer name, otherwise Emacs will ask + ;; the user "the file is modified, do you really want to make + ;; modifications to this buffer", where the "modifications" refer to + ;; the irrelevant set-text-properties below. + (buffer-file-name nil) (was-modified (buffer-modified-p))) ;;Delete read-only, keymap, and intangible properties (set-text-properties (point-min) (point-max) nil) ;;Delete overlay (mapc 'delete-overlay (overlays-in (point-min) (point-max))) (unless was-modified - (set-buffer-modified-p nil)))) + (restore-buffer-modified-p nil)))) ;;;###autoload (defun ses-mode ()
--- a/lisp/simple.el Mon Jul 23 05:39:31 2007 +0000 +++ b/lisp/simple.el Tue Jul 24 01:23:55 2007 +0000 @@ -1300,55 +1300,61 @@ (defvar minibuffer-temporary-goal-position nil) +(defun goto-history-element (nabs) + "Puts element of the minibuffer history in the minibuffer. +The argument NABS specifies the absolute history position." + (interactive "p") + (let ((minimum (if minibuffer-default -1 0)) + elt minibuffer-returned-to-present) + (if (and (zerop minibuffer-history-position) + (null minibuffer-text-before-history)) + (setq minibuffer-text-before-history + (minibuffer-contents-no-properties))) + (if (< nabs minimum) + (if minibuffer-default + (error "End of history; no next item") + (error "End of history; no default available"))) + (if (> nabs (length (symbol-value minibuffer-history-variable))) + (error "Beginning of history; no preceding item")) + (unless (memq last-command '(next-history-element + previous-history-element)) + (let ((prompt-end (minibuffer-prompt-end))) + (set (make-local-variable 'minibuffer-temporary-goal-position) + (cond ((<= (point) prompt-end) prompt-end) + ((eobp) nil) + (t (point)))))) + (goto-char (point-max)) + (delete-minibuffer-contents) + (setq minibuffer-history-position nabs) + (cond ((= nabs -1) + (setq elt minibuffer-default)) + ((= nabs 0) + (setq elt (or minibuffer-text-before-history "")) + (setq minibuffer-returned-to-present t) + (setq minibuffer-text-before-history nil)) + (t (setq elt (nth (1- minibuffer-history-position) + (symbol-value minibuffer-history-variable))))) + (insert + (if (and (eq minibuffer-history-sexp-flag (minibuffer-depth)) + (not minibuffer-returned-to-present)) + (let ((print-level nil)) + (prin1-to-string elt)) + elt)) + (goto-char (or minibuffer-temporary-goal-position (point-max))))) + (defun next-history-element (n) "Puts next element of the minibuffer history in the minibuffer. With argument N, it uses the Nth following element." (interactive "p") (or (zerop n) - (let ((narg (- minibuffer-history-position n)) - (minimum (if minibuffer-default -1 0)) - elt minibuffer-returned-to-present) - (if (and (zerop minibuffer-history-position) - (null minibuffer-text-before-history)) - (setq minibuffer-text-before-history - (minibuffer-contents-no-properties))) - (if (< narg minimum) - (if minibuffer-default - (error "End of history; no next item") - (error "End of history; no default available"))) - (if (> narg (length (symbol-value minibuffer-history-variable))) - (error "Beginning of history; no preceding item")) - (unless (memq last-command '(next-history-element - previous-history-element)) - (let ((prompt-end (minibuffer-prompt-end))) - (set (make-local-variable 'minibuffer-temporary-goal-position) - (cond ((<= (point) prompt-end) prompt-end) - ((eobp) nil) - (t (point)))))) - (goto-char (point-max)) - (delete-minibuffer-contents) - (setq minibuffer-history-position narg) - (cond ((= narg -1) - (setq elt minibuffer-default)) - ((= narg 0) - (setq elt (or minibuffer-text-before-history "")) - (setq minibuffer-returned-to-present t) - (setq minibuffer-text-before-history nil)) - (t (setq elt (nth (1- minibuffer-history-position) - (symbol-value minibuffer-history-variable))))) - (insert - (if (and (eq minibuffer-history-sexp-flag (minibuffer-depth)) - (not minibuffer-returned-to-present)) - (let ((print-level nil)) - (prin1-to-string elt)) - elt)) - (goto-char (or minibuffer-temporary-goal-position (point-max)))))) + (goto-history-element (- minibuffer-history-position n)))) (defun previous-history-element (n) "Puts previous element of the minibuffer history in the minibuffer. With argument N, it uses the Nth previous element." (interactive "p") - (next-history-element (- n))) + (or (zerop n) + (goto-history-element (+ minibuffer-history-position n)))) (defun next-complete-history-element (n) "Get next history element which completes the minibuffer before the point. @@ -1381,6 +1387,137 @@ ;; the buffer; this should be 0 for normal buffers. (1- (minibuffer-prompt-end))) +;; isearch minibuffer history +(add-hook 'minibuffer-setup-hook 'minibuffer-history-isearch-setup) + +(defvar minibuffer-history-isearch-message-overlay) +(make-variable-buffer-local 'minibuffer-history-isearch-message-overlay) + +(defun minibuffer-history-isearch-setup () + "Set up a minibuffer for using isearch to search the minibuffer history. +Intended to be added to `minibuffer-setup-hook'." + (set (make-local-variable 'isearch-search-fun-function) + 'minibuffer-history-isearch-search) + (set (make-local-variable 'isearch-message-function) + 'minibuffer-history-isearch-message) + (set (make-local-variable 'isearch-wrap-function) + 'minibuffer-history-isearch-wrap) + (set (make-local-variable 'isearch-push-state-function) + 'minibuffer-history-isearch-push-state) + (add-hook 'isearch-mode-end-hook 'minibuffer-history-isearch-end nil t)) + +(defun minibuffer-history-isearch-end () + "Clean up the minibuffer after terminating isearch in the minibuffer." + (if minibuffer-history-isearch-message-overlay + (delete-overlay minibuffer-history-isearch-message-overlay))) + +(defun minibuffer-history-isearch-search () + "Return the proper search function, for isearch in minibuffer history." + (cond + (isearch-word + (if isearch-forward 'word-search-forward 'word-search-backward)) + (t + (lambda (string bound noerror) + (let ((search-fun + ;; Use standard functions to search within minibuffer text + (cond + (isearch-regexp + (if isearch-forward 're-search-forward 're-search-backward)) + (t + (if isearch-forward 'search-forward 'search-backward)))) + found) + ;; Avoid lazy-highlighting matches in the minibuffer prompt when + ;; searching forward. Lazy-highlight calls this lambda with the + ;; bound arg, so skip the minibuffer prompt. + (if (and bound isearch-forward (< (point) (minibuffer-prompt-end))) + (goto-char (minibuffer-prompt-end))) + (or + ;; 1. First try searching in the initial minibuffer text + (funcall search-fun string + (if isearch-forward bound (minibuffer-prompt-end)) + noerror) + ;; 2. If the above search fails, start putting next/prev history + ;; elements in the minibuffer successively, and search the string + ;; in them. Do this only when bound is nil (i.e. not while + ;; lazy-highlighting search strings in the current minibuffer text). + (unless bound + (condition-case nil + (progn + (while (not found) + (cond (isearch-forward + (next-history-element 1) + (goto-char (minibuffer-prompt-end))) + (t + (previous-history-element 1) + (goto-char (point-max)))) + (setq isearch-barrier (point) isearch-opoint (point)) + ;; After putting the next/prev history element, search + ;; the string in them again, until next-history-element + ;; or previous-history-element raises an error at the + ;; beginning/end of history. + (setq found (funcall search-fun string + (unless isearch-forward + ;; For backward search, don't search + ;; in the minibuffer prompt + (minibuffer-prompt-end)) + noerror))) + ;; Return point of the new search result + (point)) + ;; Return nil when next(prev)-history-element fails + (error nil))))))))) + +(defun minibuffer-history-isearch-message (&optional c-q-hack ellipsis) + "Display the minibuffer history search prompt. +If there are no search errors, this function displays an overlay with +the isearch prompt which replaces the original minibuffer prompt. +Otherwise, it displays the standard isearch message returned from +`isearch-message'." + (if (not (and (minibufferp) isearch-success (not isearch-error))) + ;; Use standard function `isearch-message' when not in the minibuffer, + ;; or search fails, or has an error (like incomplete regexp). + ;; This function overwrites minibuffer text with isearch message, + ;; so it's possible to see what is wrong in the search string. + (isearch-message c-q-hack ellipsis) + ;; Otherwise, put the overlay with the standard isearch prompt over + ;; the initial minibuffer prompt. + (if (overlayp minibuffer-history-isearch-message-overlay) + (move-overlay minibuffer-history-isearch-message-overlay + (point-min) (minibuffer-prompt-end)) + (setq minibuffer-history-isearch-message-overlay + (make-overlay (point-min) (minibuffer-prompt-end))) + (overlay-put minibuffer-history-isearch-message-overlay 'evaporate t)) + (overlay-put minibuffer-history-isearch-message-overlay + 'display (isearch-message-prefix c-q-hack ellipsis)) + ;; And clear any previous isearch message. + (message ""))) + +(defun minibuffer-history-isearch-wrap () + "Wrap the minibuffer history search when search is failed. +Move point to the first history element for a forward search, +or to the last history element for a backward search." + (unless isearch-word + ;; When `minibuffer-history-isearch-search' fails on reaching the + ;; beginning/end of the history, wrap the search to the first/last + ;; minibuffer history element. + (if isearch-forward + (goto-history-element (length (symbol-value minibuffer-history-variable))) + (goto-history-element 0)) + (setq isearch-success t)) + (goto-char (if isearch-forward (minibuffer-prompt-end) (point-max)))) + +(defun minibuffer-history-isearch-push-state () + "Save a function restoring the state of minibuffer history search. +Save `minibuffer-history-position' to the additional state parameter +in the search status stack." + `(lambda (cmd) + (minibuffer-history-isearch-pop-state cmd ,minibuffer-history-position))) + +(defun minibuffer-history-isearch-pop-state (cmd hist-pos) + "Restore the minibuffer history search state. +Go to the history element by the absolute history position `hist-pos'." + (goto-history-element hist-pos)) + + ;Put this on C-x u, so we can force that rather than C-_ into startup msg (defalias 'advertised-undo 'undo)
--- a/lisp/startup.el Mon Jul 23 05:39:31 2007 +0000 +++ b/lisp/startup.el Tue Jul 24 01:23:55 2007 +0000 @@ -144,7 +144,7 @@ ("--foreground-color" 1 x-handle-switch foreground-color) ("--background-color" 1 x-handle-switch background-color) ("--mouse-color" 1 x-handle-switch mouse-color) - ("--no-bitmap-icon" 0 x-handle-switch icon-type nil) + ("--no-bitmap-icon" 0 x-handle-no-bitmap-icon) ("--iconic" 0 x-handle-iconic) ("--xrm" 1 x-handle-xrm-switch) ("--cursor-color" 1 x-handle-switch cursor-color)
--- a/lisp/tar-mode.el Mon Jul 23 05:39:31 2007 +0000 +++ b/lisp/tar-mode.el Tue Jul 24 01:23:55 2007 +0000 @@ -672,7 +672,7 @@ ((eq link-p 38) "a volume header") ((eq link-p 55) "an extended pax header") (t "a link")))) - (if (zerop size) (error "This is a zero-length file")) + (if (zerop size) (message "This is a zero-length file")) descriptor)) (defun tar-mouse-extract (event)
--- a/lisp/term/x-win.el Mon Jul 23 05:39:31 2007 +0000 +++ b/lisp/term/x-win.el Tue Jul 24 01:23:55 2007 +0000 @@ -129,6 +129,9 @@ initial-frame-alist) x-invocation-args (cdr x-invocation-args))))))) +(defun x-handle-no-bitmap-icon (switch) + (setq default-frame-alist (cons '(icon-type) default-frame-alist))) + ;; Make -iconic apply only to the initial frame! (defun x-handle-iconic (switch) (setq initial-frame-alist
--- a/lisp/textmodes/reftex.el Mon Jul 23 05:39:31 2007 +0000 +++ b/lisp/textmodes/reftex.el Tue Jul 24 01:23:55 2007 +0000 @@ -1331,10 +1331,8 @@ (put docstruct-symbol 'modified nil) (save-excursion (if (file-writable-p file) - (progn + (with-temp-file file (message "Writing parse file %s" (abbreviate-file-name file)) - (find-file file) - (erase-buffer) (insert (format ";; RefTeX parse info file\n")) (insert (format ";; File: %s\n" master)) (insert (format ";; User: %s (%s)\n\n" @@ -1357,9 +1355,7 @@ ) (t (print x)))) list)) - (insert "))\n\n") - (save-buffer 0) - (kill-buffer (current-buffer))) + (insert "))\n\n")) (error "Cannot write to file %s" file))) t))))
--- a/lisp/textmodes/tex-mode.el Mon Jul 23 05:39:31 2007 +0000 +++ b/lisp/textmodes/tex-mode.el Tue Jul 24 01:23:55 2007 +0000 @@ -249,7 +249,7 @@ :group 'tex) (put 'tex-fontify-script 'safe-local-variable 'booleanp) -(defcustom tex-font-script-display '(-0.3 . 0.3) +(defcustom tex-font-script-display '(-0.2 . 0.2) "Display specification for subscript and superscript content. The car is used for subscript, the cdr is used for superscripts." :group 'tex @@ -675,11 +675,11 @@ (setq beg next)))) (defface superscript - '((t :height 0.8)) ;; :raise 0.3 + '((t :height 0.8)) ;; :raise 0.2 "Face used for superscripts." :group 'tex) (defface subscript - '((t :height 0.8)) ;; :raise -0.3 + '((t :height 0.8)) ;; :raise -0.2 "Face used for subscripts." :group 'tex)
--- a/lisp/tutorial.el Mon Jul 23 05:39:31 2007 +0000 +++ b/lisp/tutorial.el Tue Jul 24 01:23:55 2007 +0000 @@ -431,11 +431,17 @@ (def-fun (nth 0 kdf)) (def-fun-txt (format "%s" def-fun)) (rem-fun (command-remapping def-fun)) + ;; Handle prefix definitions specially + ;; so that a mode that rebinds some subcommands + ;; won't make it appear that the whole prefix is gone. (key-fun (if (eq def-fun 'ESC-prefix) (lookup-key global-map [27]) - (key-binding key))) + (if (eq def-fun 'Control-X-prefix) + (lookup-key global-map [24]) + (key-binding key)))) (where (where-is-internal (if rem-fun rem-fun def-fun))) cwhere) + (if where (progn (setq cwhere (car where)
--- a/lisp/uniquify.el Mon Jul 23 05:39:31 2007 +0000 +++ b/lisp/uniquify.el Tue Jul 24 01:23:55 2007 +0000 @@ -28,7 +28,7 @@ ;;; Commentary: ;; Emacs's standard method for making buffer names unique adds <2>, <3>, -;; etc. to the end of (all but one of) the buffers. This file replaces +;; etc.. to the end of (all but one of) the buffers. This file replaces ;; that behavior, for buffers visiting files and dired buffers, with a ;; uniquification that adds parts of the file name until the buffer names ;; are unique. For instance, buffers visiting /u/mernst/tmp/Makefile and @@ -95,7 +95,7 @@ (defcustom uniquify-buffer-name-style nil - "*If non-nil, buffer names are uniquified with parts of directory name. + "If non-nil, buffer names are uniquified with parts of directory name. The value determines the buffer name style and is one of `forward', `reverse', `post-forward', or `post-forward-angle-brackets'. For example, files `/foo/bar/mumble/name' and `/baz/quux/mumble/name' @@ -104,7 +104,9 @@ reverse name\\mumble\\bar name\\mumble\\quux post-forward name|bar/mumble name|quux/mumble post-forward-angle-brackets name<bar/mumble> name<quux/mumble> - nil name name<2>" + nil name name<2> +Of course, the \"mumble\" part may be stripped as well, depending on the setting +of `uniquify-strip-common-suffix'." :type '(radio (const forward) (const reverse) (const post-forward) @@ -119,7 +121,7 @@ :group 'uniquify) (defcustom uniquify-ask-about-buffer-names-p nil - "*If non-nil, permit user to choose names for buffers with same base file. + "If non-nil, permit user to choose names for buffers with same base file. If the user chooses to name a buffer, uniquification is preempted and no other buffer names are changed." :type 'boolean @@ -127,7 +129,7 @@ ;; The default value matches certain Gnus buffers. (defcustom uniquify-ignore-buffers-re nil - "*Regular expression matching buffer names that should not be uniquified. + "Regular expression matching buffer names that should not be uniquified. For instance, set this to \"^draft-[0-9]+$\" to avoid having uniquify rename draft buffers even if `uniquify-after-kill-buffer-p' is non-nil and the visited file name isn't the same as that of the buffer." @@ -135,12 +137,12 @@ :group 'uniquify) (defcustom uniquify-min-dir-content 0 - "*Minimum number of directory name components included in buffer name." + "Minimum number of directory name components included in buffer name." :type 'integer :group 'uniquify) (defcustom uniquify-separator nil - "*String separator for buffer name components. + "String separator for buffer name components. When `uniquify-buffer-name-style' is `post-forward', separates base file name from directory part in buffer names (default \"|\"). When `uniquify-buffer-name-style' is `reverse', separates all @@ -149,7 +151,7 @@ :group 'uniquify) (defcustom uniquify-trailing-separator-p nil - "*If non-nil, add a file name separator to dired buffer names. + "If non-nil, add a file name separator to dired buffer names. If `uniquify-buffer-name-style' is `forward', add the separator at the end; if it is `reverse', add the separator at the beginning; otherwise, this variable is ignored." @@ -255,7 +257,7 @@ (directory-file-name filename)))))))) (defun uniquify-rerationalize-w/o-cb (fix-list) - "Re-rationalize the buffers in FIX-LIST, but ignoring current-buffer." + "Re-rationalize the buffers in FIX-LIST, but ignoring `current-buffer'." (let ((new-fix-list nil)) (dolist (item fix-list) (let ((buf (uniquify-item-buffer item)))
--- a/lisp/vc-arch.el Mon Jul 23 05:39:31 2007 +0000 +++ b/lisp/vc-arch.el Tue Jul 24 01:23:55 2007 +0000 @@ -198,16 +198,17 @@ ;; creates a {arch} directory somewhere. file 'arch-root (vc-find-root file "{arch}/=tagging-method")))) -(defun vc-arch-register (file &optional rev comment) +(defun vc-arch-register (files &optional rev comment) (if rev (error "Explicit initial revision not supported for Arch")) - (let ((tagmet (vc-arch-tagging-method file))) - (if (and (memq tagmet '(tagline implicit)) comment-start) - (with-current-buffer (find-file-noselect file) - (if (buffer-modified-p) - (error "Save %s first" (buffer-name))) - (vc-arch-add-tagline) - (save-buffer)) - (vc-arch-command nil 0 file "add")))) + (dolist (file files) + (let ((tagmet (vc-arch-tagging-method file))) + (if (and (memq tagmet '(tagline implicit)) comment-start) + (with-current-buffer (find-file-noselect file) + (if (buffer-modified-p) + (error "Save %s first" (buffer-name))) + (vc-arch-add-tagline) + (save-buffer))))) + (vc-arch-command nil 0 files "add")) (defun vc-arch-registered (file) ;; Don't seriously check whether it's source or not. Checking would @@ -371,42 +372,49 @@ (defun vc-arch-checkout-model (file) 'implicit) -(defun vc-arch-checkin (file rev comment) +(defun vc-arch-checkin (files rev comment) (if rev (error "Committing to a specific revision is unsupported")) - (let ((summary (file-relative-name file (vc-arch-root file)))) + ;; FIXME: This implementation probably only works for singleton filesets + (let ((summary (file-relative-name (car file) (vc-arch-root (car files))))) ;; Extract a summary from the comment. (when (or (string-match "\\`Summary:[ \t]*\\(.*[^ \t\n]\\)\\([ \t]*\n\\)*" comment) (string-match "\\`[ \t]*\\(.*[^ \t\n]\\)[ \t]*\\(\n?\\'\\|\n\\([ \t]*\n\\)+\\)" comment)) (setq summary (match-string 1 comment)) (setq comment (substring comment (match-end 0)))) - (vc-arch-command nil 0 file "commit" "-s" summary "-L" comment "--" + (vc-arch-command nil 0 files "commit" "-s" summary "-L" comment "--" (vc-switches 'Arch 'checkin)))) -(defun vc-arch-diff (file &optional oldvers newvers buffer) - "Get a difference report using Arch between two versions of FILE." - (if (and newvers - (vc-up-to-date-p file) - (equal newvers (vc-workfile-version file))) - ;; Newvers is the base revision and the current file is unchanged, - ;; so we can diff with the current file. - (setq newvers nil)) - (if newvers - (error "Diffing specific revisions not implemented") - (let* ((async (and (not vc-disable-async-diff) (fboundp 'start-process))) - ;; Run the command from the root dir. - (default-directory (vc-arch-root file)) - (status - (vc-arch-command - (or buffer "*vc-diff*") - (if async 'async 1) - nil "file-diffs" - ;; Arch does not support the typical flags. - ;; (vc-switches 'Arch 'diff) - (file-relative-name file) - (if (equal oldvers (vc-workfile-version file)) - nil - oldvers)))) - (if async 1 status)))) ; async diff, pessimistic assumption. +(defun vc-arch-diff (files &optional oldvers newvers buffer) + "Get a difference report using Arch between two versions of FILES." + ;; FIXME: This implementation only works for singleton filesets. To make + ;; it work for more cases, we have to either call `file-diffs' manually on + ;; each and every `file' in the fileset, or use `changes --diffs' (and + ;; variants) and maybe filter the output with `filterdiff' to only include + ;; the files in which we're interested. + (let ((file (car files))) + (if (and newvers + (vc-up-to-date-p file) + (equal newvers (vc-workfile-version file))) + ;; Newvers is the base revision and the current file is unchanged, + ;; so we can diff with the current file. + (setq newvers nil)) + (if newvers + (error "Diffing specific revisions not implemented") + (let* ((async (and (not vc-disable-async-diff) (fboundp 'start-process))) + ;; Run the command from the root dir. + (default-directory (vc-arch-root file)) + (status + (vc-arch-command + (or buffer "*vc-diff*") + (if async 'async 1) + nil "file-diffs" + ;; Arch does not support the typical flags. + ;; (vc-switches 'Arch 'diff) + (file-relative-name file) + (if (equal oldvers (vc-workfile-version file)) + nil + oldvers)))) + (if async 1 status))))) ; async diff, pessimistic assumption. (defun vc-arch-delete-file (file) (vc-arch-command nil 0 file "rm"))
--- a/lisp/vc-bzr.el Mon Jul 23 05:39:31 2007 +0000 +++ b/lisp/vc-bzr.el Tue Jul 24 01:23:55 2007 +0000 @@ -90,7 +90,7 @@ ;; since v0.9, bzr supports removing the progress indicators ;; by setting environment variable BZR_PROGRESS_BAR to "none". -(defun vc-bzr-command (bzr-command buffer okstatus file &rest args) +(defun vc-bzr-command (bzr-command buffer okstatus file-or-list &rest args) "Wrapper round `vc-do-command' using `vc-bzr-program' as COMMAND. Invoke the bzr command adding `BZR_PROGRESS_BAR=none' to the environment." (let ((process-environment @@ -103,7 +103,7 @@ ;; This is redundant because vc-do-command does it already. --Stef (process-connection-type nil)) (apply 'vc-do-command buffer okstatus vc-bzr-program - file bzr-command (append vc-bzr-program-args args)))) + file-or-list bzr-command (append vc-bzr-program-args args)))) ;;;###autoload @@ -196,12 +196,16 @@ (defun vc-bzr-checkout-model (file) 'implicit) -(defun vc-bzr-register (file &optional rev comment) +(defun vc-bzr-create-repo () + "Create a new BZR repository." + (vc-bzr-command "init" nil 0 nil)) + +(defun vc-bzr-register (files &optional rev comment) "Register FILE under bzr. Signal an error unless REV is nil. COMMENT is ignored." (if rev (error "Can't register explicit version with bzr")) - (vc-bzr-command "add" nil 0 file)) + (vc-bzr-command "add" nil 0 files)) ;; Could run `bzr status' in the directory and see if it succeeds, but ;; that's relatively expensive. @@ -226,11 +230,11 @@ "Unregister FILE from bzr." (vc-bzr-command "remove" nil 0 file)) -(defun vc-bzr-checkin (file rev comment) +(defun vc-bzr-checkin (files rev comment) "Check FILE in to bzr with log message COMMENT. REV non-nil gets an error." (if rev (error "Can't check in a specific version with bzr")) - (vc-bzr-command "commit" nil 0 file "-m" comment)) + (vc-bzr-command "commit" nil 0 files "-m" comment)) (defun vc-bzr-checkout (file &optional editable rev destfile) "Checkout revision REV of FILE from bzr to DESTFILE. @@ -271,12 +275,12 @@ (2 'change-log-email)) ("^ *timestamp: \\(.*\\)" (1 'change-log-date-face)))))) -(defun vc-bzr-print-log (file &optional buffer) ; get buffer arg in Emacs 22 - "Get bzr change log for FILE into specified BUFFER." +(defun vc-bzr-print-log (files &optional buffer) ; get buffer arg in Emacs 22 + "Get bzr change log for FILES into specified BUFFER." ;; Fixme: This might need the locale fixing up if things like `revno' ;; got localized, but certainly it shouldn't use LC_ALL=C. ;; NB. Can't be async -- see `vc-bzr-post-command-function'. - (vc-bzr-command "log" buffer 0 file) + (vc-bzr-command "log" buffer 0 files) ;; FIXME: Until Emacs-23, VC was missing a hook to sort out the mode for ;; the buffer, or at least set the regexps right. (unless (fboundp 'vc-default-log-view-mode) @@ -294,16 +298,16 @@ (autoload 'vc-diff-switches-list "vc" nil nil t) -(defun vc-bzr-diff (file &optional rev1 rev2 buffer) +(defun vc-bzr-diff (files &optional rev1 rev2 buffer) "VC bzr backend for diff." - (let ((working (vc-workfile-version file))) + (let ((working (vc-workfile-version (car files)))) (if (and (equal rev1 working) (not rev2)) (setq rev1 nil)) (if (and (not rev1) rev2) (setq rev1 working)) ;; NB. Can't be async -- see `vc-bzr-post-command-function'. ;; bzr diff produces condition code 1 for some reason. - (apply #'vc-bzr-command "diff" (or buffer "*vc-diff*") 1 file + (apply #'vc-bzr-command "diff" (or buffer "*vc-diff*") 1 files "--diff-options" (mapconcat 'identity (vc-diff-switches-list bzr) " ") (when rev1
--- a/lisp/vc-cvs.el Mon Jul 23 05:39:31 2007 +0000 +++ b/lisp/vc-cvs.el Tue Jul 24 01:23:55 2007 +0000 @@ -258,14 +258,25 @@ Compared to the default implementation, this function does two things: Handle the special case of a CVS file that is added but not yet committed and support display of sticky tags." - (let ((sticky-tag (vc-file-getprop file 'vc-cvs-sticky-tag)) - (string (if (string= (vc-workfile-version file) "0") - ;; A file that is added but not yet committed. - "CVS @@" - (vc-default-mode-line-string 'CVS file)))) - (if (zerop (length sticky-tag)) - string - (concat string "[" sticky-tag "]")))) + (let* ((sticky-tag (vc-file-getprop file 'vc-cvs-sticky-tag)) + help-echo + (string + (if (string= (vc-workfile-version file) "0") + ;; A file that is added but not yet committed. + (progn + (setq help-echo "Added file (needs commit) under CVS") + "CVS @@") + (let ((def-ml (vc-default-mode-line-string 'CVS file))) + (setq help-echo + (get-text-property 0 'help-echo def-ml)) + def-ml)))) + (propertize + (if (zerop (length sticky-tag)) + string + (setq help-echo (format "%s on the '%s' branch" + help-echo sticky-tag)) + (concat string "[" sticky-tag "]")) + 'help-echo help-echo))) (defun vc-cvs-dired-state-info (file) "CVS-specific version of `vc-dired-state-info'." @@ -281,21 +292,21 @@ ;;; State-changing functions ;;; -(defun vc-cvs-register (file &optional rev comment) - "Register FILE into the CVS version-control system. -COMMENT can be used to provide an initial description of FILE. +(defun vc-cvs-register (files &optional rev comment) + "Register FILES into the CVS version-control system. +COMMENT can be used to provide an initial description of FILES. `vc-register-switches' and `vc-cvs-register-switches' are passed to the CVS command (in that order)." (when (and (not (vc-cvs-responsible-p file)) - (vc-cvs-could-register file)) - ;; Register the directory if needed. - (vc-cvs-register (directory-file-name (file-name-directory file)))) - (apply 'vc-cvs-command nil 0 file - "add" - (and comment (string-match "[^\t\n ]" comment) - (concat "-m" comment)) - (vc-switches 'CVS 'register))) + (vc-cvs-could-register file)) + ;; Register the directory if needed. + (vc-cvs-register (directory-file-name (file-name-directory file)))) + (apply 'vc-cvs-command nil 0 files + "add" + (and comment (string-match "[^\t\n ]" comment) + (concat "-m" comment)) + (vc-switches 'CVS 'register))) (defun vc-cvs-responsible-p (file) "Return non-nil if CVS thinks it is responsible for FILE." @@ -317,17 +328,18 @@ t (directory-file-name dir)))) (eq dir t))) -(defun vc-cvs-checkin (file rev comment) +(defun vc-cvs-checkin (files rev comment) "CVS-specific version of `vc-backend-checkin'." (unless (or (not rev) (vc-cvs-valid-version-number-p rev)) (if (not (vc-cvs-valid-symbolic-tag-name-p rev)) (error "%s is not a valid symbolic tag name" rev) ;; If the input revison is a valid symbolic tag name, we create it ;; as a branch, commit and switch to it. - (apply 'vc-cvs-command nil 0 file "tag" "-b" (list rev)) - (apply 'vc-cvs-command nil 0 file "update" "-r" (list rev)) - (vc-file-setprop file 'vc-cvs-sticky-tag rev))) - (let ((status (apply 'vc-cvs-command nil 1 file + (apply 'vc-cvs-command nil 0 files "tag" "-b" (list rev)) + (apply 'vc-cvs-command nil 0 files "update" "-r" (list rev)) + (mapc (lambda (file) (vc-file-setprop file 'vc-cvs-sticky-tag rev)) + files))) + (let ((status (apply 'vc-cvs-command nil 1 files "ci" (if rev (concat "-r" rev)) (concat "-m" comment) (vc-switches 'CVS 'checkin)))) @@ -337,7 +349,8 @@ ;; Check checkin problem. (cond ((re-search-forward "Up-to-date check failed" nil t) - (vc-file-setprop file 'vc-state 'needs-merge) + (mapc (lambda (file) (vc-file-setprop file 'vc-state 'needs-merge)) + files) (error (substitute-command-keys (concat "Up-to-date check failed: " "type \\[vc-next-action] to merge in changes")))) @@ -346,20 +359,25 @@ (goto-char (point-min)) (shrink-window-if-larger-than-buffer) (error "Check-in failed")))) - ;; Update file properties - (vc-file-setprop - file 'vc-workfile-version - (vc-parse-buffer "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" 2)) - ;; Forget the checkout model of the file, because we might have + ;; Single-file commit? Then update the version by parsing the buffer. + ;; Otherwise we can't necessarily tell what goes with what; clear + ;; its properties so they have to be refetched. + (if (= (length files) 1) + (vc-file-setprop + (car files) 'vc-workfile-version + (vc-parse-buffer "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" 2)) + (mapc (lambda (file) (vc-file-clearprops file)) files)) + ;; Anyway, forget the checkout model of the file, because we might have ;; guessed wrong when we found the file. After commit, we can ;; tell it from the permissions of the file (see ;; vc-cvs-checkout-model). - (vc-file-setprop file 'vc-checkout-model nil) + (mapc (lambda (file) (vc-file-setprop file 'vc-checkout-model nil)) + files) ;; if this was an explicit check-in (does not include creation of ;; a branch), remove the sticky tag. (if (and rev (not (vc-cvs-valid-symbolic-tag-name-p rev))) - (vc-cvs-command nil 0 file "update" "-A")))) + (vc-cvs-command nil 0 files "update" "-A")))) (defun vc-cvs-find-version (file rev buffer) (apply 'vc-cvs-command @@ -481,37 +499,30 @@ ;;; History functions ;;; -(defun vc-cvs-print-log (file &optional buffer) +(defun vc-cvs-print-log (files &optional buffer) "Get change log associated with FILE." (vc-cvs-command buffer - (if (and (vc-stay-local-p file) (fboundp 'start-process)) 'async 0) - file "log")) + (if (and (vc-stay-local-p files) (fboundp 'start-process)) 'async 0) + files "log")) -(defun vc-cvs-diff (file &optional oldvers newvers buffer) +(defun vc-cvs-wash-log () + "Remove all non-comment information from log output." + (vc-call-backend 'RCS 'wash-log) + nil) + +(defun vc-cvs-diff (files &optional oldvers newvers buffer) "Get a difference report using CVS between two versions of FILE." - (if (string= (vc-workfile-version file) "0") - ;; This file is added but not yet committed; there is no master file. - (if (or oldvers newvers) - (error "No revisions of %s exist" file) - ;; We regard this as "changed". - ;; Diff it against /dev/null. - ;; Note: this is NOT a "cvs diff". - (apply 'vc-do-command (or buffer "*vc-diff*") - 1 "diff" file - (append (vc-switches nil 'diff) '("/dev/null"))) - ;; Even if it's empty, it's locally modified. - 1) - (let* ((async (and (not vc-disable-async-diff) - (vc-stay-local-p file) - (fboundp 'start-process))) + (let* ((async (and (not vc-disable-async-diff) + (vc-stay-local-p files) + (fboundp 'start-process))) (status (apply 'vc-cvs-command (or buffer "*vc-diff*") (if async 'async 1) - file "diff" + files "diff" (and oldvers (concat "-r" oldvers)) (and newvers (concat "-r" newvers)) (vc-switches 'CVS 'diff)))) - (if async 1 status)))) ; async diff, pessimistic assumption + (if async 1 status))) ; async diff, pessimistic assumption (defun vc-cvs-diff-tree (dir &optional rev1 rev2) "Diff all files at and below DIR." @@ -683,11 +694,11 @@ ;;; Internal functions ;;; -(defun vc-cvs-command (buffer okstatus file &rest flags) +(defun vc-cvs-command (buffer okstatus files &rest flags) "A wrapper around `vc-do-command' for use in vc-cvs.el. The difference to vc-do-command is that this function always invokes `cvs', and that it passes `vc-cvs-global-switches' to it before FLAGS." - (apply 'vc-do-command buffer okstatus "cvs" file + (apply 'vc-do-command buffer okstatus "cvs" files (if (stringp vc-cvs-global-switches) (cons vc-cvs-global-switches flags) (append vc-cvs-global-switches
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/vc-git.el Tue Jul 24 01:23:55 2007 +0000 @@ -0,0 +1,439 @@ +;;; vc-git.el --- VC backend for the git version control system + +;; Copyright (C) 2006, 2007 Free Software Foundation, Inc. + +;; Author: Alexandre Julliard <julliard@winehq.org> +;; Keywords: tools + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; This file contains a VC backend for the git version control +;; system. +;; + +;;; Installation: + +;; To install: put this file on the load-path and add GIT to the list +;; of supported backends in `vc-handled-backends'; the following line, +;; placed in your ~/.emacs, will accomplish this: +;; +;; (add-to-list 'vc-handled-backends 'GIT) + +;;; Todo: +;; - check if more functions could use vc-git-command instead +;; of start-process. +;; - changelog generation +;; - working with revisions other than HEAD + +;; Implement the rest of the vc interface. See the comment at the +;; beginning of vc.el. The current status is: +;; +;; FUNCTION NAME STATUS +;; BACKEND PROPERTIES +;; * revision-granularity OK +;; STATE-QUERYING FUNCTIONS +;; * registered (file) OK +;; * state (file) OK +;; - state-heuristic (file) ?? PROBABLY NOT NEEDED +;; - dir-state (dir) OK +;; * workfile-version (file) OK +;; - latest-on-branch-p (file) ?? +;; * checkout-model (file) OK +;; - workfile-unchanged-p (file) MAYBE CAN BE SIMPLIFIED +;; - mode-line-string (file) NOT NEEDED +;; - dired-state-info (file) OK +;; STATE-CHANGING FUNCTIONS +;; * create-repo () OK +;; * register (files &optional rev comment) OK +;; - init-version (file) ?? +;; - responsible-p (file) OK +;; - could-register (file) NEEDED +;; - receive-file (file rev) ?? +;; - unregister (file) OK +;; * checkin (files rev comment) OK +;; * find-version (file rev buffer) OK +;; * checkout (file &optional editable rev) OK +;; * revert (file &optional contents-done) OK +;; - rollback (files) ?? PROBABLY NOT NEEDED +;; - merge (file rev1 rev2) NEEDED +;; - merge-news (file) NEEDED +;; - steal-lock (file &optional version) NOT NEEDED +;; HISTORY FUNCTIONS +;; * print-log (files &optional buffer) OK +;; - log-view-mode () OK +;; - show-log-entry (version) NOT NEEDED, DEFAULT IS GOOD +;; - wash-log (file) ?? +;; - logentry-check () ?? +;; - comment-history (file) ?? +;; - update-changelog (files) ?? +;; * diff (file &optional rev1 rev2 buffer) PORT TO NEW VC INTERFACE +;; - revision-completion-table (file) NEEDED? +;; - diff-tree (dir &optional rev1 rev2) OK +;; - annotate-command (file buf &optional rev) OK +;; - annotate-time () OK +;; - annotate-current-time () ?? NOT NEEDED +;; - annotate-extract-revision-at-line () OK +;; SNAPSHOT SYSTEM +;; - create-snapshot (dir name branchp) NEEDED +;; - assign-name (file name) NOT NEEDED +;; - retrieve-snapshot (dir name update) NEEDED +;; MISCELLANEOUS +;; - make-version-backups-p (file) ?? +;; - repository-hostname (dirname) ?? +;; - previous-version (file rev) ?? +;; - next-version (file rev) ?? +;; - check-headers () ?? +;; - clear-headers () ?? +;; - delete-file (file) OK +;; - rename-file (old new) OK +;; - find-file-hook () PROBABLY NOT NEEDED +;; - find-file-not-found-hook () PROBABLY NOT NEEDED + +(eval-when-compile (require 'cl) (require 'vc)) + +(defvar git-commits-coding-system 'utf-8 + "Default coding system for git commits.") + +;; XXX when this backend is considered sufficiently reliable this +;; should be moved to vc-hooks.el +(add-to-list 'vc-handled-backends 'GIT) +(eval-after-load "vc" + '(add-to-list 'vc-directory-exclusion-list ".bzr" t)) + +;;; BACKEND PROPERTIES + +(defun vc-git-revision-granularity () + 'repository) + +;;; STATE-QUERYING FUNCTIONS + +;;;###autoload (defun vc-git-registered (file) +;;;###autoload "Return non-nil if FILE is registered with git." +;;;###autoload (if (vc-find-root file ".git") ; short cut +;;;###autoload (progn +;;;###autoload (load "vc-git") +;;;###autoload (vc-git-registered file)))) + +(defun vc-git-registered (file) + "Check whether FILE is registered with git." + (when (vc-git-root file) + (with-temp-buffer + (let* ((dir (file-name-directory file)) + (name (file-relative-name file dir))) + (and (ignore-errors + (when dir (cd dir)) + (eq 0 (call-process "git" nil '(t nil) nil "ls-files" "-c" "-z" "--" name))) + (let ((str (buffer-string))) + (and (> (length str) (length name)) + (string= (substring str 0 (1+ (length name))) (concat name "\0"))))))))) + +(defun vc-git-state (file) + "Git-specific version of `vc-state'." + (let ((diff (vc-git--run-command-string file "diff-index" "-z" "HEAD" "--"))) + (if (and diff (string-match ":[0-7]\\{6\\} [0-7]\\{6\\} [0-9a-f]\\{40\\} [0-9a-f]\\{40\\} [ADMU]\0[^\0]+\0" diff)) + 'edited + 'up-to-date))) + +(defun vc-git-dir-state (dir) + (with-temp-buffer + (vc-git-command (current-buffer) nil nil "ls-files" "-t") + (goto-char (point-min)) + (let ((status-char nil) + (file nil)) + (while (not (eobp)) + (setq status-char (char-after)) + (setq file + (expand-file-name + (buffer-substring-no-properties (+ (point) 2) (line-end-position)))) + (cond + ;; The rest of the possible states in "git ls-files -t" output: + ;; R removed/deleted + ;; K to be killed + ;; should not show up in vc-dired, so don't deal with them + ;; here. + ((eq status-char ?H) + (vc-file-setprop file 'vc-state 'up-to-date)) + ((eq status-char ?M) + (vc-file-setprop file 'vc-state 'edited)) + ((eq status-char ?C) + (vc-file-setprop file 'vc-state 'edited)) + ((eq status-char ??) + (vc-file-setprop file 'vc-backend 'none) + (vc-file-setprop file 'vc-state 'nil))) + (forward-line))))) + +(defun vc-git-workfile-version (file) + "Git-specific version of `vc-workfile-version'." + (let ((str (with-output-to-string + (with-current-buffer standard-output + (call-process "git" nil '(t nil) nil "symbolic-ref" "HEAD"))))) + (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str) + (match-string 2 str) + str))) + +(defun vc-git-checkout-model (file) + 'implicit) + +(defun vc-git-workfile-unchanged-p (file) + ;; The reason this does not use the result of vc-git-state is that + ;; git-diff-index (used by vc-git-state) doesn't refresh the cached + ;; stat info, so if the file has been modified it will always show + ;; up as modified in vc-git-state, even if the change has been + ;; undone, until git-update-index --refresh is run. + + ;; OTOH the vc-git-workfile-unchanged-p implementation checks the + ;; actual content, so it will detect the case of a file reverted + ;; back to its original state. + + ;; The ideal implementation would be to refresh the stat cache and + ;; then call vc-git-state, but at the moment there's no git command + ;; to refresh a single file, so this will have to be added first. + (let ((sha1 (vc-git--run-command-string file "hash-object" "--")) + (head (vc-git--run-command-string file "ls-tree" "-z" "HEAD" "--"))) + (and head + (string-match "[0-7]\\{6\\} blob \\([0-9a-f]\\{40\\}\\)\t[^\0]+\0" head) + (string= (car (split-string sha1 "\n")) (match-string 1 head))))) + +(defun vc-git-dired-state-info (file) + "Git-specific version of `vc-dired-state-info'." + (let ((git-state (vc-state file))) + (if (eq git-state 'edited) + "(modified)" + ;; fall back to the default VC representation + (vc-default-dired-state-info 'GIT file)))) + +;;; STATE-CHANGING FUNCTIONS + +(defun vc-git-create-repo () + "Create a new GIT repository." + (vc-git-command "init" nil 0 nil)) + +(defun vc-git-register (files &optional rev comment) + "Register FILE into the git version-control system." + (vc-git-command nil 0 files "update-index" "--add" "--")) + +(defalias 'vc-git-responsible-p 'vc-git-root) + +(defun vc-git-unregister (file) + (vc-git-command nil 0 file "rm" "-f" "--cached" "--")) + + +(defun vc-git-checkin (files rev comment) + (let ((coding-system-for-write git-commits-coding-system)) + (vc-git-command nil 0 files "commit" "-m" comment "--only" "--"))) + +(defun vc-git-find-version (file rev buffer) + (let ((coding-system-for-read 'binary) + (coding-system-for-write 'binary) + (fullname (substring + (vc-git--run-command-string + file "ls-files" "-z" "--full-name" "--") + 0 -1))) + (vc-git-command + buffer 0 + (concat (if rev rev "HEAD") ":" fullname) "cat-file" "blob"))) + +(defun vc-git-checkout (file &optional editable rev) + (vc-git-command nil0 file "checkout" (or rev "HEAD"))) + +(defun vc-git-revert (file &optional contents-done) + "Revert FILE to the version stored in the git repository." + (if contents-done + (vc-git-command nil 0 file "update-index" "--") + (vc-git-command nil 0 file "checkout" "HEAD"))) + +;;; HISTORY FUNCTIONS + +(defun vc-git-print-log (files &optional buffer) + "Get change log associated with FILES." + (let ((name (file-relative-name file)) + (coding-system-for-read git-commits-coding-system)) + ;; `log-view-mode' needs to have the file name in order to function + ;; correctly. "git log" does not print it, so we insert it here by + ;; hand. + + ;; `vc-do-command' creates the buffer, but we need it before running + ;; the command. + (vc-setup-buffer buffer) + ;; If the buffer exists from a previous invocation it might be + ;; read-only. + (let ((inhibit-read-only t)) + ;; XXX Here loop and call "git rev-list" on each file separately + ;; to make sure that each file gets a "File:" header before the + ;; corresponding log. Maybe there is a way to do this with one + ;; command... + (dolist (file files) + (with-current-buffer + buffer + (insert "File: " (file-name-nondirectory file) "\n"))) + (vc-git-command buffer 'async name "rev-list" "--pretty" "HEAD" "--")))) + +(defvar log-view-message-re) +(defvar log-view-file-re) +(defvar log-view-font-lock-keywords) + +(define-derived-mode vc-git-log-view-mode log-view-mode "GIT-Log-View" + (require 'add-log) ;; we need the faces add-log + ;; Don't have file markers, so use impossible regexp. + (set (make-local-variable 'log-view-file-re) "^File:[ \t]+\\(.+\\)") + (set (make-local-variable 'log-view-message-re) + "^commit *\\([0-9a-z]+\\)") + (set (make-local-variable 'log-view-font-lock-keywords) + (append + `((,log-view-message-re (1 'change-log-acknowledgement)) + (,log-view-file-re (1 'change-log-file-face))) + ;; Handle the case: + ;; user: foo@bar + '(("^Author:[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)" + (1 'change-log-email)) + ;; Handle the case: + ;; user: FirstName LastName <foo@bar> + ("^Author:[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]" + (1 'change-log-name) + (2 'change-log-email)) + ("^Date: \\(.+\\)" (1 'change-log-date)) + ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message)))))) + +(defun vc-git-diff (file &optional rev1 rev2 buffer) + (let ((name (file-relative-name file)) + (buf (or buffer "*vc-diff*"))) + (if (and rev1 rev2) + (vc-git-command buf 0 name "diff-tree" "-p" rev1 rev2 "--") + (vc-git-command buf 0 name "diff-index" "-p" (or rev1 "HEAD") "--")) + ;; git-diff-index doesn't set exit status like diff does + (if (vc-git-workfile-unchanged-p file) 0 1))) + +(defun vc-git-diff-tree (dir &optional rev1 rev2) + (vc-git-diff dir rev1 rev2)) + +(defun vc-git-annotate-command (file buf &optional rev) + ;; FIXME: rev is ignored + (let ((name (file-relative-name file))) + (vc-git-command buf 0 name "blame" (if rev (concat "-r" rev))))) + +(defun vc-git-annotate-time () + (and (re-search-forward "[0-9a-f]+ (.* \\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\) \\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\) \\([-+0-9]+\\) +[0-9]+)" nil t) + (vc-annotate-convert-time + (apply #'encode-time (mapcar (lambda (match) (string-to-number (match-string match))) '(6 5 4 3 2 1 7)))))) + +(defun vc-git-annotate-extract-revision-at-line () + (save-excursion + (move-beginning-of-line 1) + (and (looking-at "[0-9a-f]+") + (buffer-substring-no-properties (match-beginning 0) (match-end 0))))) + +;;; MISCELLANEOUS + +(defun vc-git-previous-version (file rev) + "Git-specific version of `vc-previous-version'." + (let ((default-directory (file-name-directory (expand-file-name file))) + (file (file-name-nondirectory file))) + (vc-git-symbolic-commit + (with-temp-buffer + (and + (zerop + (call-process "git" nil '(t nil) nil "rev-list" + "-2" rev "--" file)) + (goto-char (point-max)) + (bolp) + (zerop (forward-line -1)) + (not (bobp)) + (buffer-substring-no-properties + (point) + (1- (point-max)))))))) + +(defun vc-git-next-version (file rev) + "Git-specific version of `vc-next-version'." + (let* ((default-directory (file-name-directory + (expand-file-name file))) + (file (file-name-nondirectory file)) + (current-rev + (with-temp-buffer + (and + (zerop + (call-process "git" nil '(t nil) nil "rev-list" + "-1" rev "--" file)) + (goto-char (point-max)) + (bolp) + (zerop (forward-line -1)) + (bobp) + (buffer-substring-no-properties + (point) + (1- (point-max))))))) + (and current-rev + (vc-git-symbolic-commit + (with-temp-buffer + (and + (zerop + (call-process "git" nil '(t nil) nil "rev-list" + "HEAD" "--" file)) + (goto-char (point-min)) + (search-forward current-rev nil t) + (zerop (forward-line -1)) + (buffer-substring-no-properties + (point) + (progn (forward-line 1) (1- (point)))))))))) + +(defun vc-git-delete-file (file) + (vc-git-command nil 0 file "rm" "-f" "--")) + +(defun vc-git-rename-file (old new) + (vc-git-command nil 0 (list old new) "mv" "-f" "--")) + + +;; Internal commands + +(defun vc-git-root (file) + (vc-find-root file ".git")) + +(defun vc-git-command (buffer okstatus file-or-list &rest flags) + "A wrapper around `vc-do-command' for use in vc-git.el. +The difference to vc-do-command is that this function always invokes `git'." + (apply 'vc-do-command buffer okstatus "git" file-or-list flags)) + +(defun vc-git--run-command-string (file &rest args) + "Run a git command on FILE and return its output as string." + (let* ((ok t) + (str (with-output-to-string + (with-current-buffer standard-output + (unless (eq 0 (apply #'call-process "git" nil '(t nil) nil + (append args (list (file-relative-name file))))) + (setq ok nil)))))) + (and ok str))) + +(defun vc-git-symbolic-commit (commit) + "Translate COMMIT string into symbolic form. +Returns nil if not possible." + (and commit + (with-temp-buffer + (and + (zerop + (call-process "git" nil '(t nil) nil "name-rev" + "--name-only" "--tags" + commit)) + (goto-char (point-min)) + (= (forward-line 2) 1) + (bolp) + (buffer-substring-no-properties (point-min) (1- (point-max))))))) + +(provide 'vc-git) + +;; arch-tag: bd10664a-0e5b-48f5-a877-6c17b135be12 +;;; vc-git.el ends here
--- a/lisp/vc-hg.el Mon Jul 23 05:39:31 2007 +0000 +++ b/lisp/vc-hg.el Tue Jul 24 01:23:55 2007 +0000 @@ -4,7 +4,6 @@ ;; Author: Ivan Kanis ;; Keywords: tools -;; Version: 1889 ;; This file is part of GNU Emacs. @@ -39,41 +38,45 @@ ;; beginning of vc.el. The current status is: ;; FUNCTION NAME STATUS +;; BACKEND PROPERTIES +;; * revision-granularity OK +;; STATE-QUERYING FUNCTIONS ;; * registered (file) OK ;; * state (file) OK ;; - state-heuristic (file) ?? PROBABLY NOT NEEDED -;; - dir-state (dir) NEEDED +;; - dir-state (dir) OK ;; * workfile-version (file) OK ;; - latest-on-branch-p (file) ?? ;; * checkout-model (file) OK -;; - workfile-unchanged-p (file) ?? +;; - workfile-unchanged-p (file) OK ;; - mode-line-string (file) NOT NEEDED -;; - dired-state-info (file) NEEDED +;; - dired-state-info (file) OK ;; STATE-CHANGING FUNCTIONS -;; * register (file &optional rev comment) OK +;; * register (files &optional rev comment) OK +;; * create-repo () OK ;; - init-version () NOT NEEDED ;; - responsible-p (file) OK ;; - could-register (file) OK ;; - receive-file (file rev) ?? PROBABLY NOT NEEDED ;; - unregister (file) COMMENTED OUT, MAY BE INCORRECT -;; * checkin (file rev comment) OK +;; * checkin (files rev comment) OK ;; * find-version (file rev buffer) OK -;; * checkout (file &optional editable rev) NOT NEEDED, COMMENTED OUT +;; * checkout (file &optional editable rev) OK ;; * revert (file &optional contents-done) OK -;; - cancel-version (file editable) ?? PROBABLY NOT NEEDED +;; - rollback (files) ?? PROBABLY NOT NEEDED ;; - merge (file rev1 rev2) NEEDED ;; - merge-news (file) NEEDED ;; - steal-lock (file &optional version) NOT NEEDED ;; HISTORY FUNCTIONS -;; * print-log (file &optional buffer) OK +;; * print-log (files &optional buffer) OK ;; - log-view-mode () OK ;; - show-log-entry (version) NOT NEEDED, DEFAULT IS GOOD ;; - wash-log (file) ?? ;; - logentry-check () NOT NEEDED ;; - comment-history (file) NOT NEEDED ;; - update-changelog (files) NOT NEEDED -;; * diff (file &optional rev1 rev2 buffer) OK -;; - revision-completion-table (file) ?? +;; * diff (files &optional rev1 rev2 buffer) OK +;; - revision-completion-table (file) OK ;; - diff-tree (dir &optional rev1 rev2) TEST IT ;; - annotate-command (file buf &optional rev) OK ;; - annotate-time () OK @@ -111,6 +114,7 @@ ;;; Code: (eval-when-compile + (require 'cl) (require 'vc)) ;;; Customization options @@ -125,6 +129,12 @@ :version "22.2" :group 'vc) + +;;; Properties of the backend + +(defun vc-hg-revision-granularity () + 'repository) + ;;; State querying functions ;;;###autoload (defun vc-hg-registered (file) @@ -137,8 +147,8 @@ ;; Modelled after the similar function in vc-bzr.el (defun vc-hg-registered (file) "Return non-nil if FILE is registered with hg." - (if (vc-hg-root file) ; short cut - (vc-hg-state file))) ; expensive + (when (vc-hg-root file) ; short cut + (vc-hg-state file))) ; expensive (defun vc-hg-state (file) "Hg-specific version of `vc-state'." @@ -159,13 +169,43 @@ (error nil))))))) (when (eq 0 status) (if (eq 0 (length out)) 'up-to-date - (let ((state (aref out 0))) - (cond - ((eq state ?M) 'edited) - ((eq state ?A) 'edited) - ((eq state ?P) 'needs-patch) - ((eq state ??) nil) - (t 'up-to-date))))))) + (when (null (string-match ".*: No such file or directory$" out)) + (let ((state (aref out 0))) + (cond + ((eq state ?A) 'edited) + ((eq state ?M) 'edited) + ((eq state ?R) nil) + ((eq state ??) nil) + (t 'up-to-date)))))))) + +(defun vc-hg-dir-state (dir) + (with-temp-buffer + (vc-hg-command (current-buffer) nil nil "status") + (goto-char (point-min)) + (let ((status-char nil) + (file nil)) + (while (not (eobp)) + (setq status-char (char-after)) + (setq file + (expand-file-name + (buffer-substring-no-properties (+ (point) 2) + (line-end-position)))) + (cond + ;; The rest of the possible states in "hg status" output: + ;; R = removed + ;; ! = deleted, but still tracked + ;; ? = not tracked + ;; should not show up in vc-dired, so don't deal with them + ;; here. + ((eq status-char ?A) + (vc-file-setprop file 'vc-workfile-version "0") + (vc-file-setprop file 'vc-state 'edited)) + ((eq status-char ?M) + (vc-file-setprop file 'vc-state 'edited)) + ((eq status-char ??) + (vc-file-setprop file 'vc-backend 'none) + (vc-file-setprop file 'vc-state 'nil))) + (forward-line))))) (defun vc-hg-workfile-version (file) "Hg-specific version of `vc-workfile-version'." @@ -191,8 +231,8 @@ ;;; History functions -(defun vc-hg-print-log(file &optional buffer) - "Get change log associated with FILE." +(defun vc-hg-print-log(files &optional buffer) + "Get change log associated with FILES." ;; `log-view-mode' needs to have the file name in order to function ;; correctly. "hg log" does not print it, so we insert it here by ;; hand. @@ -203,13 +243,14 @@ ;; If the buffer exists from a previous invocation it might be ;; read-only. (let ((inhibit-read-only t)) - (with-current-buffer - buffer - (insert "File: " (file-name-nondirectory file) "\n"))) - (vc-hg-command - buffer - (if (and (vc-stay-local-p file) (fboundp 'start-process)) 'async 0) - file "log")) + ;; We need to loop and call "hg log" on each file separately. + ;; "hg log" with multiple file arguments mashes all the logs + ;; together. + (dolist (file files) + (with-current-buffer + buffer + (insert "File: " (file-name-nondirectory file) "\n")) + (vc-hg-command buffer 0 file "log")))) (defvar log-view-message-re) (defvar log-view-file-re) @@ -236,24 +277,41 @@ ("^date: \\(.+\\)" (1 'change-log-date)) ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message)))))) -(defun vc-hg-diff (file &optional oldvers newvers buffer) - "Get a difference report using hg between two versions of FILE." - (let ((working (vc-workfile-version file))) +(defun vc-hg-diff (files &optional oldvers newvers buffer) + "Get a difference report using hg between two versions of FILES." + (let ((working (vc-workfile-version (car files)))) (if (and (equal oldvers working) (not newvers)) (setq oldvers nil)) (if (and (not oldvers) newvers) (setq oldvers working)) - (apply 'call-process "hg" nil (or buffer "*vc-diff*") nil - "--cwd" (file-name-directory file) "diff" + (apply #'vc-hg-command (or buffer "*vc-diff*") nil + (mapcar (lambda (file) (file-name-nondirectory file)) files) + "--cwd" (file-name-directory (car files)) + "diff" (append (if oldvers (if newvers (list "-r" oldvers "-r" newvers) (list "-r" oldvers)) - (list "")) - (list (file-name-nondirectory file)))))) + (list "")))))) + +(defun vc-hg-revision-table (file) + (let ((default-directory (file-name-directory file))) + (with-temp-buffer + (vc-hg-command t nil file "log" "--template" "{rev} ") + (split-string + (buffer-substring-no-properties (point-min) (point-max)))))) -(defalias 'vc-hg-diff-tree 'vc-hg-diff) +;; Modelled after the similar function in vc-cvs.el +(defun vc-hg-revision-completion-table (file) + (lexical-let ((file file) + table) + (setq table (lazy-completion-table + table (lambda () (vc-hg-revision-table file)))) + table)) + +(defun vc-hg-diff-tree (file &optional oldvers newvers buffer) + (vc-hg-diff (list file) oldvers newvers buffer)) (defun vc-hg-annotate-command (file buffer &optional version) "Execute \"hg annotate\" on FILE, inserting the contents in BUFFER. @@ -290,7 +348,7 @@ (let ((newrev (1+ (string-to-number rev))) (tip-version (with-temp-buffer - (vc-hg-command t nil nil "tip") + (vc-hg-command t 0 nil "tip") (goto-char (point-min)) (re-search-forward "^changeset:[ \t]*\\([0-9]+\\):") (string-to-number (match-string-no-properties 1))))) @@ -305,18 +363,22 @@ (condition-case () (delete-file file) (file-error nil)) - (vc-hg-command nil nil file "remove" "--after" "--force")) + (vc-hg-command nil 0 file "remove" "--after" "--force")) ;; Modelled after the similar function in vc-bzr.el (defun vc-hg-rename-file (old new) "Rename file from OLD to NEW using `hg mv'." - (vc-hg-command nil nil new old "mv")) + (vc-hg-command nil 0 new old "mv")) -(defun vc-hg-register (file &optional rev comment) - "Register FILE under hg. +(defun vc-hg-register (files &optional rev comment) + "Register FILES under hg. REV is ignored. COMMENT is ignored." - (vc-hg-command nil nil file "add")) + (vc-hg-command nil 0 files "add")) + +(defun vc-hg-create-repo () + "Create a new Mercurial repository." + (vc-hg-command nil 0 nil "init")) (defalias 'vc-hg-responsible-p 'vc-hg-root) @@ -336,49 +398,58 @@ ;; "Unregister FILE from hg." ;; (vc-hg-command nil nil file "remove")) -(defun vc-hg-checkin (file rev comment) +(defun vc-hg-checkin (files rev comment) "HG-specific version of `vc-backend-checkin'. REV is ignored." - (vc-hg-command nil nil file "commit" "-m" comment)) + (vc-hg-command nil 0 files "commit" "-m" comment)) (defun vc-hg-find-version (file rev buffer) (let ((coding-system-for-read 'binary) (coding-system-for-write 'binary)) (if rev - (vc-hg-command buffer nil file "cat" "-r" rev) - (vc-hg-command buffer nil file "cat")))) + (vc-hg-command buffer 0 file "cat" "-r" rev) + (vc-hg-command buffer 0 file "cat")))) ;; Modelled after the similar function in vc-bzr.el -;; This should not be needed, `vc-hg-find-version' provides the same -;; functionality. -;; (defun vc-hg-checkout (file &optional editable rev workfile) -;; "Retrieve a revision of FILE into a WORKFILE. -;; EDITABLE is ignored. -;; REV is the revision to check out into WORKFILE." -;; (unless workfile -;; (setq workfile (vc-version-backup-file-name file rev))) -;; (let ((coding-system-for-read 'binary) -;; (coding-system-for-write 'binary)) -;; (with-temp-file workfile -;; (if rev -;; (vc-hg-command t nil file "cat" "-r" rev) -;; (vc-hg-command t nil file "cat"))))) +(defun vc-hg-checkout (file &optional editable rev) + "Retrieve a revision of FILE. +EDITABLE is ignored. +REV is the revision to check out into WORKFILE." + (let ((coding-system-for-read 'binary) + (coding-system-for-write 'binary)) + (with-current-buffer (or (get-file-buffer file) (current-buffer)) + (if rev + (vc-hg-command t 0 file "cat" "-r" rev) + (vc-hg-command t 0 file "cat"))))) (defun vc-hg-checkout-model (file) 'implicit) ;; Modelled after the similar function in vc-bzr.el +(defun vc-hg-workfile-unchanged-p (file) + (eq 'up-to-date (vc-hg-state file))) + +(defun vc-hg-dired-state-info (file) + "Hg-specific version of `vc-dired-state-info'." + (let ((hg-state (vc-state file))) + (if (eq hg-state 'edited) + (if (equal (vc-workfile-version file) "0") + "(added)" "(modified)") + ;; fall back to the default VC representation + (vc-default-dired-state-info 'HG file)))) + +;; Modelled after the similar function in vc-bzr.el (defun vc-hg-revert (file &optional contents-done) (unless contents-done - (with-temp-buffer (vc-hg-command t nil file "revert")))) + (with-temp-buffer (vc-hg-command t 0 file "revert")))) ;;; Internal functions -(defun vc-hg-command (buffer okstatus file &rest flags) +(defun vc-hg-command (buffer okstatus file-or-list &rest flags) "A wrapper around `vc-do-command' for use in vc-hg.el. The difference to vc-do-command is that this function always invokes `hg', and that it passes `vc-hg-global-switches' to it before FLAGS." - (apply 'vc-do-command buffer okstatus "hg" file + (apply 'vc-do-command buffer okstatus "hg" file-or-list (if (stringp vc-hg-global-switches) (cons vc-hg-global-switches flags) (append vc-hg-global-switches
--- a/lisp/vc-hooks.el Mon Jul 23 05:39:31 2007 +0000 +++ b/lisp/vc-hooks.el Tue Jul 24 01:23:55 2007 +0000 @@ -159,32 +159,36 @@ (defun vc-stay-local-p (file) "Return non-nil if VC should stay local when handling FILE. -This uses the `repository-hostname' backend operation." - (let* ((backend (vc-backend file)) - (sym (vc-make-backend-sym backend 'stay-local)) - (stay-local (if (boundp sym) (symbol-value sym) t))) - (if (eq stay-local t) (setq stay-local vc-stay-local)) - (if (symbolp stay-local) stay-local - (let ((dirname (if (file-directory-p file) - (directory-file-name file) - (file-name-directory file)))) - (eq 'yes - (or (vc-file-getprop dirname 'vc-stay-local-p) - (vc-file-setprop - dirname 'vc-stay-local-p - (let ((hostname (vc-call-backend - backend 'repository-hostname dirname))) - (if (not hostname) - 'no - (let ((default t)) - (if (eq (car-safe stay-local) 'except) - (setq default nil stay-local (cdr stay-local))) - (when (consp stay-local) - (setq stay-local - (mapconcat 'identity stay-local "\\|"))) - (if (if (string-match stay-local hostname) - default (not default)) - 'yes 'no))))))))))) +This uses the `repository-hostname' backend operation. +If FILE is a list of files, return non-nil if any of them +individually should stay local." + (if (listp file) + (delq nil (mapcar 'vc-stay-local-p file)) + (let* ((backend (vc-backend file)) + (sym (vc-make-backend-sym backend 'stay-local)) + (stay-local (if (boundp sym) (symbol-value sym) t))) + (if (eq stay-local t) (setq stay-local vc-stay-local)) + (if (symbolp stay-local) stay-local + (let ((dirname (if (file-directory-p file) + (directory-file-name file) + (file-name-directory file)))) + (eq 'yes + (or (vc-file-getprop dirname 'vc-stay-local-p) + (vc-file-setprop + dirname 'vc-stay-local-p + (let ((hostname (vc-call-backend + backend 'repository-hostname dirname))) + (if (not hostname) + 'no + (let ((default t)) + (if (eq (car-safe stay-local) 'except) + (setq default nil stay-local (cdr stay-local))) + (when (consp stay-local) + (setq stay-local + (mapconcat 'identity stay-local "\\|"))) + (if (if (string-match stay-local hostname) + default (not default)) + 'yes 'no)))))))))))) ;;; This is handled specially now. ;; Tell Emacs about this new kind of minor mode @@ -315,22 +319,25 @@ If WITNESS if not found, return nil, otherwise return the root." ;; Represent /home/luser/foo as ~/foo so that we don't try to look for ;; witnesses in /home or in /. + (while (not (file-directory-p file)) + (setq file (file-name-directory (directory-file-name file)))) (setq file (abbreviate-file-name file)) (let ((root nil) (user (nth 2 (file-attributes file)))) (while (not (or root - (equal file (setq file (file-name-directory file))) - (null file) - ;; As a heuristic, we stop looking up the hierarchy of - ;; directories as soon as we find a directory belonging - ;; to another user. This should save us from looking in - ;; things like /net and /afs. This assumes that all the - ;; files inside a project belong to the same user. - (not (equal user (nth 2 (file-attributes file)))) - (string-match vc-ignore-dir-regexp file))) + (null file) + ;; As a heuristic, we stop looking up the hierarchy of + ;; directories as soon as we find a directory belonging + ;; to another user. This should save us from looking in + ;; things like /net and /afs. This assumes that all the + ;; files inside a project belong to the same user. + (not (equal user (nth 2 (file-attributes file)))) + (string-match vc-ignore-dir-regexp file))) (if (file-exists-p (expand-file-name witness file)) - (setq root file) - (setq file (directory-file-name file)))) + (setq root file) + (if (equal file + (setq file (file-name-directory (directory-file-name file)))) + (setq file nil)))) root)) ;; Access functions to file properties @@ -373,20 +380,26 @@ (vc-file-setprop file 'vc-backend 'none) nil))))) -(defun vc-backend (file) - "Return the version control type of FILE, nil if it is not registered." +(defun vc-backend (file-or-list) + "Return the version control type of FILE-OR-LIST, nil if it's not registered. +If the argument is a list, the files must all have the same back end." ;; `file' can be nil in several places (typically due to the use of ;; code like (vc-backend buffer-file-name)). - (when (stringp file) - (let ((property (vc-file-getprop file 'vc-backend))) - ;; Note that internally, Emacs remembers unregistered - ;; files by setting the property to `none'. - (cond ((eq property 'none) nil) - (property) - ;; vc-registered sets the vc-backend property - (t (if (vc-registered file) - (vc-file-getprop file 'vc-backend) - nil)))))) + (cond ((stringp file-or-list) + (let ((property (vc-file-getprop file-or-list 'vc-backend))) + ;; Note that internally, Emacs remembers unregistered + ;; files by setting the property to `none'. + (cond ((eq property 'none) nil) + (property) + ;; vc-registered sets the vc-backend property + (t (if (vc-registered file-or-list) + (vc-file-getprop file-or-list 'vc-backend) + nil))))) + ((and file-or-list (listp file-or-list)) + (vc-backend (car file-or-list))) + (t + nil))) + (defun vc-backend-subdirectory-name (file) "Return where the master and lock FILEs for the current directory are kept." @@ -480,7 +493,7 @@ ;; - `removed' ;; - `copied' and `moved' (might be handled by `removed' and `added') (or (vc-file-getprop file 'vc-state) - (if (vc-backend file) + (if (and (> (length file) 0) (vc-backend file)) (vc-file-setprop file 'vc-state (vc-call state-heuristic file))))) @@ -518,7 +531,7 @@ (zerop (condition-case err ;; If the implementation supports it, let the output ;; go to *vc*, not *vc-diff*, since this is an internal call. - (vc-call diff file nil nil "*vc*") + (vc-call diff (list file) nil nil "*vc*") (wrong-number-of-arguments ;; If this error came from the above call to vc-BACKEND-diff, ;; try again without the optional buffer argument (for @@ -529,10 +542,10 @@ 'diff)))) (not (eq (caddr err) 4))) (signal (car err) (cdr err)) - (vc-call diff file)))))) + (vc-call diff (list file))))))) (defun vc-workfile-version (file) - "Return the version level of the current workfile FILE. + "Return the repository version from which FILE was checked out. If FILE is not registered, this function always returns nil." (or (vc-file-getprop file 'vc-workfile-version) (if (vc-backend file) @@ -703,6 +716,11 @@ ;; any VC Dired buffer to synchronize. (vc-dired-resynch-file file))))) +(defconst vc-mode-line-map + (let ((map (make-sparse-keymap))) + (define-key map [mode-line down-mouse-1] 'vc-menu-map) + map)) + (defun vc-mode-line (file) "Set `vc-mode' to display type of version control for FILE. The value is set in the current buffer, which should be the buffer @@ -711,9 +729,22 @@ (let ((backend (vc-backend file))) (if (not backend) (setq vc-mode nil) - (setq vc-mode (concat " " (if vc-display-status - (vc-call mode-line-string file) - (symbol-name backend)))) + (let* ((ml-string (vc-call mode-line-string file)) + (ml-echo (get-text-property 0 'help-echo ml-string))) + (setq vc-mode + (concat + " " + (if (null vc-display-status) + (symbol-name backend) + (propertize + ml-string + 'mouse-face 'mode-line-highlight + 'help-echo + (concat (or ml-echo + (format "File under the %s version control system" + backend)) + "\nmouse-1: Version Control menu") + 'local-map vc-mode-line-map))))) ;; If the file is locked by some other user, make ;; the buffer read-only. Like this, even root ;; cannot modify a file that someone else has locked. @@ -757,13 +788,10 @@ ;; Not just for the 'edited state, but also a fallback ;; for all other states. Think about different symbols ;; for 'needs-patch and 'needs-merge. - (setq state-echo "Edited file") + (setq state-echo "Locally modified file") (concat backend ":" rev))) - 'mouse-face 'mode-line-highlight - 'local-map (let ((map (make-sparse-keymap))) - (define-key map [mode-line down-mouse-1] 'vc-menu-map) map) - 'help-echo (concat state-echo " under the " backend - " version control system\nmouse-1: VC Menu")))) + 'help-echo (concat state-echo " under the " backend + " version control system")))) (defun vc-follow-link () "If current buffer visits a symbolic link, visit the real file. @@ -873,7 +901,7 @@ (let ((map (make-sparse-keymap))) (define-key map "a" 'vc-update-change-log) (define-key map "b" 'vc-switch-backend) - (define-key map "c" 'vc-cancel-version) + (define-key map "c" 'vc-rollback) (define-key map "d" 'vc-directory) (define-key map "g" 'vc-annotate) (define-key map "h" 'vc-insert-headers) @@ -882,8 +910,9 @@ (define-key map "m" 'vc-merge) (define-key map "r" 'vc-retrieve-snapshot) (define-key map "s" 'vc-create-snapshot) - (define-key map "u" 'vc-revert-buffer) + (define-key map "u" 'vc-revert) (define-key map "v" 'vc-next-action) + (define-key map "+" 'vc-update) (define-key map "=" 'vc-diff) (define-key map "~" 'vc-version-other-window) map)) @@ -913,9 +942,9 @@ (define-key vc-menu-map [separator2] '("----")) (define-key vc-menu-map [vc-insert-header] '("Insert Header" . vc-insert-headers)) - (define-key vc-menu-map [undo] '("Undo Last Check-In" . vc-cancel-version)) - (define-key vc-menu-map [vc-revert-buffer] - '("Revert to Base Version" . vc-revert-buffer)) + (define-key vc-menu-map [undo] '("Undo Last Check-In" . vc-rollback)) + (define-key vc-menu-map [vc-revert] + '("Revert to Base Version" . vc-revert)) (define-key vc-menu-map [vc-update] '("Update to Latest Version" . vc-update)) (define-key vc-menu-map [vc-next-action] '("Check In/Out" . vc-next-action)) @@ -932,8 +961,8 @@ ;;(put 'vc-update-change-log 'menu-enable ;; '(member (vc-buffer-backend) '(RCS CVS))) ;;(put 'vc-print-log 'menu-enable 'vc-mode) -;;(put 'vc-cancel-version 'menu-enable 'vc-mode) -;;(put 'vc-revert-buffer 'menu-enable 'vc-mode) +;;(put 'vc-rollback 'menu-enable 'vc-mode) +;;(put 'vc-revert 'menu-enable 'vc-mode) ;;(put 'vc-insert-headers 'menu-enable 'vc-mode) ;;(put 'vc-next-action 'menu-enable 'vc-mode) ;;(put 'vc-register 'menu-enable '(and buffer-file-name (not vc-mode)))
--- a/lisp/vc-mcvs.el Mon Jul 23 05:39:31 2007 +0000 +++ b/lisp/vc-mcvs.el Tue Jul 24 01:23:55 2007 +0000 @@ -109,6 +109,11 @@ :version "22.1" :group 'vc) +;;; Properties of the backend + +(defun vc-mcvs-revision-granularity () + 'file) + ;;; ;;; State-querying functions ;;; @@ -202,13 +207,16 @@ ;;; State-changing functions ;;; -(defun vc-mcvs-register (file &optional rev comment) - "Register FILE into the Meta-CVS version-control system. +(defun vc-mcvs-register (files &optional rev comment) + "Register FILES into the Meta-CVS version-control system. COMMENT can be used to provide an initial description of FILE. `vc-register-switches' and `vc-mcvs-register-switches' are passed to the Meta-CVS command (in that order)." - (let* ((filename (file-name-nondirectory file)) + ;; FIXME: multiple-file case should be made to work + (if (> (length files) 1) (error "Registering filesets is not yet supported.")) + (let* ((file (car files)) + (filename (file-name-nondirectory file)) (extpos (string-match "\\." filename)) (ext (if extpos (substring filename (1+ extpos)))) (root (vc-mcvs-root file)) @@ -257,7 +265,7 @@ "Return non-nil if FILE could be registered in Meta-CVS. This is only possible if Meta-CVS is responsible for FILE's directory.") -(defun vc-mcvs-checkin (file rev comment) +(defun vc-mcvs-checkin (files rev comment) "Meta-CVS-specific version of `vc-backend-checkin'." (unless (or (not rev) (vc-mcvs-valid-version-number-p rev)) (if (not (vc-mcvs-valid-symbolic-tag-name-p rev)) @@ -267,14 +275,15 @@ ;; This file-specific form of branching is deprecated. ;; We can't use `mcvs branch' and `mcvs switch' because they cannot ;; be applied just to this one file. - (apply 'vc-mcvs-command nil 0 file "tag" "-b" (list rev)) - (apply 'vc-mcvs-command nil 0 file "update" "-r" (list rev)) - (vc-file-setprop file 'vc-mcvs-sticky-tag rev) + (apply 'vc-mcvs-command nil 0 files "tag" "-b" (list rev)) + (apply 'vc-mcvs-command nil 0 files "update" "-r" (list rev)) + (mapcar (lambda (file) (vc-file-setprop file 'vc-mcvs-sticky-tag rev)) + files) (setq rev nil))) ;; This commit might cvs-commit several files (e.g. MAP and TYPES) ;; so using numbered revs here is dangerous and somewhat meaningless. (when rev (error "Cannot commit to a specific revision number")) - (let ((status (apply 'vc-mcvs-command nil 1 file + (let ((status (apply 'vc-mcvs-command nil 1 files "ci" "-m" comment (vc-switches 'MCVS 'checkin)))) (set-buffer "*vc*") @@ -283,7 +292,8 @@ ;; Check checkin problem. (cond ((re-search-forward "Up-to-date check failed" nil t) - (vc-file-setprop file 'vc-state 'needs-merge) + (mapcar (lambda (file) (vc-file-setprop file 'vc-state 'needs-merge)) + files) (error (substitute-command-keys (concat "Up-to-date check failed: " "type \\[vc-next-action] to merge in changes")))) @@ -292,20 +302,25 @@ (goto-char (point-min)) (shrink-window-if-larger-than-buffer) (error "Check-in failed")))) - ;; Update file properties - (vc-file-setprop - file 'vc-workfile-version - (vc-parse-buffer "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" 2)) - ;; Forget the checkout model of the file, because we might have + ;; Single-file commit? Then update the version by parsing the buffer. + ;; Otherwise we can't necessarily tell what goes with what; clear + ;; its properties so they have to be refetched. + (if (= (length files) 1) + (vc-file-setprop + (car files) 'vc-workfile-version + (vc-parse-buffer "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" 2)) + (mapc (lambda (file) (vc-file-clearprops file)) files)) + ;; Anyway, forget the checkout model of the file, because we might have ;; guessed wrong when we found the file. After commit, we can ;; tell it from the permissions of the file (see ;; vc-mcvs-checkout-model). - (vc-file-setprop file 'vc-checkout-model nil) + (mapc (lambda (file) (vc-file-setprop file 'vc-checkout-model nil)) + files) ;; if this was an explicit check-in (does not include creation of ;; a branch), remove the sticky tag. (if (and rev (not (vc-mcvs-valid-symbolic-tag-name-p rev))) - (vc-mcvs-command nil 0 file "update" "-A")))) + (vc-mcvs-command nil 0 files "update" "-A")))) (defun vc-mcvs-find-version (file rev buffer) (apply 'vc-mcvs-command @@ -421,44 +436,32 @@ ;;; History functions ;;; -(defun vc-mcvs-print-log (file &optional buffer) - "Get change log associated with FILE." - (let ((default-directory (vc-mcvs-root file))) +(defun vc-mcvs-print-log (files &optional buffer) + "Get change log associated with FILES." + (let ((default-directory (vc-mcvs-root (car files)))) ;; Run the command from the root dir so that `mcvs filt' returns ;; valid relative names. (vc-mcvs-command buffer - (if (and (vc-stay-local-p file) (fboundp 'start-process)) 'async 0) - file "log"))) + (if (and (vc-stay-local-p files) (fboundp 'start-process)) 'async 0) + files "log"))) -(defun vc-mcvs-diff (file &optional oldvers newvers buffer) - "Get a difference report using Meta-CVS between two versions of FILE." - (if (string= (vc-workfile-version file) "0") - ;; This file is added but not yet committed; there is no master file. - (if (or oldvers newvers) - (error "No revisions of %s exist" file) - ;; We regard this as "changed". - ;; Diff it against /dev/null. - ;; Note: this is NOT a "mcvs diff". - (apply 'vc-do-command (or buffer "*vc-diff*") - 1 "diff" file - (append (vc-switches nil 'diff) '("/dev/null"))) - ;; Even if it's empty, it's locally modified. - 1) +(defun vc-mcvs-diff (files &optional oldvers newvers buffer) + "Get a difference report using Meta-CVS between two versions of FILES." (let* ((async (and (not vc-disable-async-diff) - (vc-stay-local-p file) + (vc-stay-local-p files) (fboundp 'start-process))) ;; Run the command from the root dir so that `mcvs filt' returns ;; valid relative names. - (default-directory (vc-mcvs-root file)) + (default-directory (vc-mcvs-root (car files))) (status (apply 'vc-mcvs-command (or buffer "*vc-diff*") (if async 'async 1) - file "diff" + files "diff" (and oldvers (concat "-r" oldvers)) (and newvers (concat "-r" newvers)) (vc-switches 'MCVS 'diff)))) - (if async 1 status)))) ; async diff, pessimistic assumption. + (if async 1 status))) ; async diff, pessimistic assumption. (defun vc-mcvs-diff-tree (dir &optional rev1 rev2) "Diff all files at and below DIR."
--- a/lisp/vc-rcs.el Mon Jul 23 05:39:31 2007 +0000 +++ b/lisp/vc-rcs.el Tue Jul 24 01:23:55 2007 +0000 @@ -29,6 +29,10 @@ ;; See vc.el +;; TODO: +;; - remove call to vc-expand-dirs by implementing our own (which can just +;; list the RCS subdir instead). + ;;; Code: ;;; @@ -96,6 +100,11 @@ :group 'vc) +;;; Properties of the backend + +(defun vc-rcs-revision-granularity () + 'file) + ;;; ;;; State-querying functions ;;; @@ -230,17 +239,23 @@ ;;; State-changing functions ;;; -(defun vc-rcs-register (file &optional rev comment) - "Register FILE into the RCS version-control system. -REV is the optional revision number for the file. COMMENT can be used -to provide an initial description of FILE. +(defun vc-rcs-create-repo () + "Create a new RCS repository." + ;; RCS is totally file-oriented, so all we have to do is make the directory + (make-directory "RCS")) + +(defun vc-rcs-register (files &optional rev comment) + "Register FILES into the RCS version-control system. +REV is the optional revision number for the files. COMMENT can be used +to provide an initial description for each FILES. `vc-register-switches' and `vc-rcs-register-switches' are passed to the RCS command (in that order). Automatically retrieve a read-only version of the file with keywords expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile." - (let ((subdir (expand-file-name "RCS" (file-name-directory file)))) + (let ((subdir (expand-file-name "RCS" (file-name-directory file)))) + (dolist (file files) (and (not (file-exists-p subdir)) (not (directory-files (file-name-directory file) nil ".*,v$" t)) @@ -273,7 +288,7 @@ (if (re-search-forward "^initial revision: \\([0-9.]+\\).*\n" nil t) - (match-string 1)))))) + (match-string 1))))))) (defun vc-rcs-responsible-p (file) "Return non-nil if RCS thinks it would be responsible for registering FILE." @@ -307,55 +322,57 @@ (yes-or-no-p (format "Directory %s is empty; remove it? " dir)) (delete-directory dir)))) -(defun vc-rcs-checkin (file rev comment) +(defun vc-rcs-checkin (files rev comment) "RCS-specific version of `vc-backend-checkin'." (let ((switches (vc-switches 'RCS 'checkin))) - (let ((old-version (vc-workfile-version file)) new-version - (default-branch (vc-file-getprop file 'vc-rcs-default-branch))) - ;; Force branch creation if an appropriate - ;; default branch has been set. - (and (not rev) - default-branch - (string-match (concat "^" (regexp-quote old-version) "\\.") - default-branch) - (setq rev default-branch) - (setq switches (cons "-f" switches))) - (if (and (not rev) old-version) - (setq rev (vc-branch-part old-version))) - (apply 'vc-do-command nil 0 "ci" (vc-name file) - ;; if available, use the secure check-in option - (and (vc-rcs-release-p "5.6.4") "-j") - (concat (if vc-keep-workfiles "-u" "-r") rev) - (concat "-m" comment) - switches) - (vc-file-setprop file 'vc-workfile-version nil) + ;; Now operate on the files + (dolist (file files) + (let ((old-version (vc-workfile-version file)) new-version + (default-branch (vc-file-getprop file 'vc-rcs-default-branch))) + ;; Force branch creation if an appropriate + ;; default branch has been set. + (and (not rev) + default-branch + (string-match (concat "^" (regexp-quote old-version) "\\.") + default-branch) + (setq rev default-branch) + (setq switches (cons "-f" switches))) + (if (and (not rev) old-version) + (setq rev (vc-branch-part old-version))) + (apply 'vc-do-command nil 0 "ci" (vc-name file) + ;; if available, use the secure check-in option + (and (vc-rcs-release-p "5.6.4") "-j") + (concat (if vc-keep-workfiles "-u" "-r") rev) + (concat "-m" comment) + switches) + (vc-file-setprop file 'vc-workfile-version nil) - ;; determine the new workfile version - (set-buffer "*vc*") - (goto-char (point-min)) - (when (or (re-search-forward - "new revision: \\([0-9.]+\\);" nil t) - (re-search-forward - "reverting to previous revision \\([0-9.]+\\)" nil t)) - (setq new-version (match-string 1)) - (vc-file-setprop file 'vc-workfile-version new-version)) + ;; determine the new workfile version + (set-buffer "*vc*") + (goto-char (point-min)) + (when (or (re-search-forward + "new revision: \\([0-9.]+\\);" nil t) + (re-search-forward + "reverting to previous revision \\([0-9.]+\\)" nil t)) + (setq new-version (match-string 1)) + (vc-file-setprop file 'vc-workfile-version new-version)) - ;; if we got to a different branch, adjust the default - ;; branch accordingly - (cond - ((and old-version new-version - (not (string= (vc-branch-part old-version) - (vc-branch-part new-version)))) - (vc-rcs-set-default-branch file - (if (vc-trunk-p new-version) nil - (vc-branch-part new-version))) - ;; If this is an old RCS release, we might have - ;; to remove a remaining lock. - (if (not (vc-rcs-release-p "5.6.2")) - ;; exit status of 1 is also accepted. - ;; It means that the lock was removed before. - (vc-do-command nil 1 "rcs" (vc-name file) - (concat "-u" old-version)))))))) + ;; if we got to a different branch, adjust the default + ;; branch accordingly + (cond + ((and old-version new-version + (not (string= (vc-branch-part old-version) + (vc-branch-part new-version)))) + (vc-rcs-set-default-branch file + (if (vc-trunk-p new-version) nil + (vc-branch-part new-version))) + ;; If this is an old RCS release, we might have + ;; to remove a remaining lock. + (if (not (vc-rcs-release-p "5.6.2")) + ;; exit status of 1 is also accepted. + ;; It means that the lock was removed before. + (vc-do-command nil 1 "rcs" (vc-name file) + (concat "-u" old-version))))))))) (defun vc-rcs-find-version (file rev buffer) (apply 'vc-do-command @@ -427,41 +444,48 @@ new-version))))) (message "Checking out %s...done" file))))) +(defun vc-rcs-rollback (files) + "Roll back, undoing the most recent checkins of FILES." + (if (not files) + (error "RCS backend doesn't support directory-level rollback.")) + (dolist (file files) + (let* ((discard (vc-workfile-version file)) + (previous (if (vc-trunk-p discard) "" (vc-branch-part discard))) + (config (current-window-configuration)) + (done nil)) + (if (null (yes-or-no-p (format "Remove version %s from %s history? " + discard file))) + (error "Aborted")) + (message "Removing revision %s from %s." discard file) + (vc-do-command nil 0 "rcs" (vc-name file) (concat "-o" discard)) + ;; Check out the most recent remaining version. If it + ;; fails, because the whole branch got deleted, do a + ;; double-take and check out the version where the branch + ;; started. + (while (not done) + (condition-case err + (progn + (vc-do-command nil 0 "co" (vc-name file) "-f" + (concat "-u" previous)) + (setq done t)) + (error (set-buffer "*vc*") + (goto-char (point-min)) + (if (search-forward "no side branches present for" nil t) + (progn (setq previous (vc-branch-part previous)) + (vc-rcs-set-default-branch file previous) + ;; vc-do-command popped up a window with + ;; the error message. Get rid of it, by + ;; restoring the old window configuration. + (set-window-configuration config)) + ;; No, it was some other error: re-signal it. + (signal (car err) (cdr err))))))))) + (defun vc-rcs-revert (file &optional contents-done) "Revert FILE to the version it was based on." (vc-do-command nil 0 "co" (vc-name file) "-f" (concat (if (eq (vc-state file) 'edited) "-u" "-r") (vc-workfile-version file)))) -(defun vc-rcs-cancel-version (file editable) - "Undo the most recent checkin of FILE. -EDITABLE non-nil means previous version should be locked." - (let* ((target (vc-workfile-version file)) - (previous (if (vc-trunk-p target) "" (vc-branch-part target))) - (config (current-window-configuration)) - (done nil)) - (vc-do-command nil 0 "rcs" (vc-name file) (concat "-o" target)) - ;; Check out the most recent remaining version. If it fails, because - ;; the whole branch got deleted, do a double-take and check out the - ;; version where the branch started. - (while (not done) - (condition-case err - (progn - (vc-do-command nil 0 "co" (vc-name file) "-f" - (concat (if editable "-l" "-u") previous)) - (setq done t)) - (error (set-buffer "*vc*") - (goto-char (point-min)) - (if (search-forward "no side branches present for" nil t) - (progn (setq previous (vc-branch-part previous)) - (vc-rcs-set-default-branch file previous) - ;; vc-do-command popped up a window with - ;; the error message. Get rid of it, by - ;; restoring the old window configuration. - (set-window-configuration config)) - ;; No, it was some other error: re-signal it. - (signal (car err) (cdr err)))))))) - (defun vc-rcs-merge (file first-version &optional second-version) "Merge changes into current working copy of FILE. The changes are between FIRST-VERSION and SECOND-VERSION." @@ -484,19 +508,38 @@ ;;; History functions ;;; -(defun vc-rcs-print-log (file &optional buffer) +(defun vc-rcs-print-log (files &optional buffer) "Get change log associated with FILE." - (vc-do-command buffer 0 "rlog" (vc-name file))) + (vc-do-command buffer 0 "rlog" (mapcar 'vc-name files))) -(defun vc-rcs-diff (file &optional oldvers newvers buffer) - "Get a difference report using RCS between two versions of FILE." - (if (not oldvers) (setq oldvers (vc-workfile-version file))) - (apply 'vc-do-command (or buffer "*vc-diff*") 1 "rcsdiff" file +(defun vc-rcs-diff (files &optional oldvers newvers buffer) + "Get a difference report using RCS between two sets of files." + (apply 'vc-do-command (or buffer "*vc-diff*") + 1 ;; Always go synchronous, the repo is local + "rcsdiff" (vc-expand-dirs files) (append (list "-q" - (concat "-r" oldvers) + (and oldvers (concat "-r" oldvers)) (and newvers (concat "-r" newvers))) (vc-switches 'RCS 'diff)))) +(defun vc-rcs-wash-log () + "Remove all non-comment information from log output." + (let ((separator (concat "^-+\nrevision [0-9.]+\ndate: .*\n" + "\\(branches: .*;\n\\)?" + "\\(\\*\\*\\* empty log message \\*\\*\\*\n\\)?"))) + (goto-char (point-max)) (forward-line -1) + (while (looking-at "=*\n") + (delete-char (- (match-end 0) (match-beginning 0))) + (forward-line -1)) + (goto-char (point-min)) + (if (looking-at "[\b\t\n\v\f\r ]+") + (delete-char (- (match-end 0) (match-beginning 0)))) + (goto-char (point-min)) + (re-search-forward separator nil t) + (delete-region (point-min) (point)) + (while (re-search-forward separator nil t) + (delete-region (match-beginning 0) (match-end 0))))) + (defun vc-rcs-annotate-command (file buffer &optional revision) "Annotate FILE, inserting the results in BUFFER. Optional arg REVISION is a revision to annotate from." @@ -666,7 +709,6 @@ " " (aref rda 0) ls) - :vc-annotate-prefix t :vc-rcs-r/d/a rda))) (maphash (if all-me
--- a/lisp/vc-sccs.el Mon Jul 23 05:39:31 2007 +0000 +++ b/lisp/vc-sccs.el Tue Jul 24 01:23:55 2007 +0000 @@ -27,6 +27,10 @@ ;;; Commentary: +;; TODO: +;; - remove call to vc-expand-dirs by implementing our own (which can just +;; list the SCCS subdir instead). + ;;; Code: (eval-when-compile @@ -85,6 +89,11 @@ (defconst vc-sccs-name-assoc-file "VC-names") +;;; Properties of the backend + +(defun vc-sccs-revision-granularity () + 'file) + ;;; ;;; State-querying functions ;;; @@ -161,16 +170,22 @@ ;;; State-changing functions ;;; -(defun vc-sccs-register (file &optional rev comment) - "Register FILE into the SCCS version-control system. +(defun vc-sccs-create-repo () + "Create a new SCCS repository." + ;; SCCS is totally file-oriented, so all we have to do is make the directory + (make-directory "SCCS")) + +(defun vc-sccs-register (files &optional rev comment) + "Register FILES into the SCCS version-control system. REV is the optional revision number for the file. COMMENT can be used -to provide an initial description of FILE. +to provide an initial description of FILES. `vc-register-switches' and `vc-sccs-register-switches' are passed to the SCCS command (in that order). -Automatically retrieve a read-only version of the file with keywords +Automatically retrieve a read-only version of the files with keywords expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile." + (dolist (file files) (let* ((dirname (or (file-name-directory file) "")) (basename (file-name-nondirectory file)) (project-file (vc-sccs-search-project-dir dirname basename))) @@ -178,14 +193,14 @@ (or project-file (format (car vc-sccs-master-templates) dirname basename)))) (apply 'vc-do-command nil 0 "admin" vc-name - (and rev (concat "-r" rev)) + (and rev (not (string= rev "")) (concat "-r" rev)) "-fb" (concat "-i" (file-relative-name file)) (and comment (concat "-y" comment)) (vc-switches 'SCCS 'register))) (delete-file file) (if vc-keep-workfiles - (vc-do-command nil 0 "get" (vc-name file))))) + (vc-do-command nil 0 "get" (vc-name file)))))) (defun vc-sccs-responsible-p (file) "Return non-nil if SCCS thinks it would be responsible for registering FILE." @@ -194,14 +209,15 @@ (stringp (vc-sccs-search-project-dir (or (file-name-directory file) "") (file-name-nondirectory file))))) -(defun vc-sccs-checkin (file rev comment) +(defun vc-sccs-checkin (files rev comment) "SCCS-specific version of `vc-backend-checkin'." - (apply 'vc-do-command nil 0 "delta" (vc-name file) - (if rev (concat "-r" rev)) - (concat "-y" comment) - (vc-switches 'SCCS 'checkin)) - (if vc-keep-workfiles - (vc-do-command nil 0 "get" (vc-name file)))) + (dolist (file files) + (apply 'vc-do-command nil 0 "delta" (vc-name file) + (if rev (concat "-r" rev)) + (concat "-y" comment) + (vc-switches 'SCCS 'checkin)) + (if vc-keep-workfiles + (vc-do-command nil 0 "get" (vc-name file))))) (defun vc-sccs-find-version (file rev buffer) (apply 'vc-do-command @@ -242,6 +258,19 @@ switches)))) (message "Checking out %s...done" file))) +(defun vc-sccs-cancel-version (files) + "Roll back, undoing the most recent checkins of FILES." + (if (not files) + (error "SCCS backend doesn't support directory-level rollback.")) + (dolist (file files) + (let ((discard (vc-workfile-version file))) + (if (null (yes-or-no-p (format "Remove version %s from %s history? " + discard file))) + (error "Aborted")) + (message "Removing revision %s from %s..." discard file) + (vc-do-command nil 0 "rmdel" (vc-name file) (concat "-r" discard)) + (vc-do-command nil 0 "get" (vc-name file) nil)))) + (defun vc-sccs-revert (file &optional contents-done) "Revert FILE to the version it was based on." (vc-do-command nil 0 "unget" (vc-name file)) @@ -251,16 +280,6 @@ ;; vc-workfile-version is cleared here so that it gets recomputed. (vc-file-setprop file 'vc-workfile-version nil)) -(defun vc-sccs-cancel-version (file editable) - "Undo the most recent checkin of FILE. -EDITABLE non-nil means previous version should be locked." - (vc-do-command nil 0 "rmdel" - (vc-name file) - (concat "-r" (vc-workfile-version file))) - (vc-do-command nil 0 "get" - (vc-name file) - (if editable "-e"))) - (defun vc-sccs-steal-lock (file &optional rev) "Steal the lock on the current workfile for FILE and revision REV." (vc-do-command nil 0 "unget" (vc-name file) "-n" (if rev (concat "-r" rev))) @@ -271,9 +290,14 @@ ;;; History functions ;;; -(defun vc-sccs-print-log (file &optional buffer) - "Get change log associated with FILE." - (vc-do-command buffer 0 "prs" (vc-name file))) +(defun vc-sccs-print-log (files &optional buffer) + "Get change log associated with FILES." + (vc-do-command buffer 0 "prs" (mapcar 'vc-name files))) + +(defun vc-sccs-wash-log () + "Remove all non-comment information from log output." + ;; FIXME: not implemented for SCCS + nil) (defun vc-sccs-logentry-check () "Check that the log entry in the current buffer is acceptable for SCCS." @@ -281,11 +305,12 @@ (goto-char 512) (error "Log must be less than 512 characters; point is now at pos 512"))) -(defun vc-sccs-diff (file &optional oldvers newvers buffer) - "Get a difference report using SCCS between two versions of FILE." +(defun vc-sccs-diff (files &optional oldvers newvers buffer) + "Get a difference report using SCCS between two filesets." (setq oldvers (vc-sccs-lookup-triple file oldvers)) (setq newvers (vc-sccs-lookup-triple file newvers)) - (apply 'vc-do-command (or buffer "*vc-diff*") 1 "vcdiff" (vc-name file) + (apply 'vc-do-command (or buffer "*vc-diff*") + 1 "vcdiff" (mapcar 'vc-name (vc-expand-dirs files)) (append (list "-q" (and oldvers (concat "-r" oldvers)) (and newvers (concat "-r" newvers)))
--- a/lisp/vc-svn.el Mon Jul 23 05:39:31 2007 +0000 +++ b/lisp/vc-svn.el Tue Jul 24 01:23:55 2007 +0000 @@ -96,6 +96,10 @@ (t ".svn")) "The name of the \".svn\" subdirectory or its equivalent.") +;;; Properties of the backend + +(defun vc-svn-revision-granularity () + 'repository) ;;; ;;; State-querying functions ;;; @@ -206,13 +210,19 @@ ;;; State-changing functions ;;; -(defun vc-svn-register (file &optional rev comment) - "Register FILE into the SVN version-control system. -COMMENT can be used to provide an initial description of FILE. +(defun vc-svn-create-repo () + "Create a new SVN repository." + (vc-do-command nil 0 "svnadmin" '("create" "SVN")) + (vc-do-command nil 0 "svn" '(".") + "checkout" (concat "file://" default-directory "SVN"))) + +(defun vc-svn-register (files &optional rev comment) + "Register FILES into the SVN version-control system. +The COMMENT argument is ignored This does an add but not a commit. `vc-register-switches' and `vc-svn-register-switches' are passed to the SVN command (in that order)." - (apply 'vc-svn-command nil 0 file "add" (vc-switches 'SVN 'register))) + (apply 'vc-svn-command nil 0 files "add" (vc-switches 'SVN 'register))) (defun vc-svn-responsible-p (file) "Return non-nil if SVN thinks it is responsible for FILE." @@ -225,10 +235,11 @@ "Return non-nil if FILE could be registered in SVN. This is only possible if SVN is responsible for FILE's directory.") -(defun vc-svn-checkin (file rev comment) +(defun vc-svn-checkin (files rev comment) "SVN-specific version of `vc-backend-checkin'." + (if rev (error "Committing to a specific revision is unsupported in SVN.")) (let ((status (apply - 'vc-svn-command nil 1 file "ci" + 'vc-svn-command nil 1 files "ci" (nconc (list "-m" comment) (vc-switches 'SVN 'checkin))))) (set-buffer "*vc*") (goto-char (point-min)) @@ -236,7 +247,8 @@ ;; Check checkin problem. (cond ((search-forward "Transaction is out of date" nil t) - (vc-file-setprop file 'vc-state 'needs-merge) + (mapc (lambda (file) (vc-file-setprop file 'vc-state 'needs-merge)) + files) (error (substitute-command-keys (concat "Up-to-date check failed: " "type \\[vc-next-action] to merge in changes")))) @@ -252,6 +264,7 @@ )) (defun vc-svn-find-version (file rev buffer) + "SVN-specific retrieval of a specified version into a buffer." (apply 'vc-svn-command buffer 0 file "cat" @@ -362,53 +375,41 @@ ;;; History functions ;;; -(defun vc-svn-print-log (file &optional buffer) - "Get change log associated with FILE." +(defun vc-svn-print-log (files &optional buffer) + "Get change log(s) associated with FILES." (save-current-buffer (vc-setup-buffer buffer) (let ((inhibit-read-only t)) (goto-char (point-min)) ;; Add a line to tell log-view-mode what file this is. - (insert "Working file: " (file-relative-name file) "\n")) + (insert "Working file(s): " (vc-delistify (mapcar 'file-relative-name files)) "\n")) (vc-svn-command buffer - (if (and (vc-stay-local-p file) (fboundp 'start-process)) 'async 0) - file "log" + (if (and (= (length files) 1) (vc-stay-local-p (car files)) (fboundp 'start-process)) 'async 0) + files "log" ;; By default Subversion only shows the log upto the working version, ;; whereas we also want the log of the subsequent commits. At least ;; that's what the vc-cvs.el code does. "-rHEAD:0"))) -(defun vc-svn-diff (file &optional oldvers newvers buffer) - "Get a difference report using SVN between two versions of FILE." - (unless buffer (setq buffer "*vc-diff*")) - (if (and oldvers (equal oldvers (vc-workfile-version file))) - ;; Use nil rather than the current revision because svn handles it - ;; better (i.e. locally). - (setq oldvers nil)) - (if (string= (vc-workfile-version file) "0") - ;; This file is added but not yet committed; there is no master file. - (if (or oldvers newvers) - (error "No revisions of %s exist" file) - ;; We regard this as "changed". - ;; Diff it against /dev/null. - ;; Note: this is NOT a "svn diff". - (apply 'vc-do-command buffer - 1 "diff" file - (append (vc-switches nil 'diff) '("/dev/null"))) - ;; Even if it's empty, it's locally modified. - 1) - (let* ((switches +(defun vc-svn-wash-log () + "Remove all non-comment information from log output." + ;; FIXME: not implemented for SVN + nil) + +(defun vc-svn-diff (files &optional oldvers newvers buffer) + "Get a difference report using SVN between two versions of fileset FILES." + (let* ((switches (if vc-svn-diff-switches (vc-switches 'SVN 'diff) (list "-x" (mapconcat 'identity (vc-switches nil 'diff) " ")))) (async (and (not vc-disable-async-diff) - (vc-stay-local-p file) + (vc-stay-local-p files) (or oldvers newvers) ; Svn diffs those locally. (fboundp 'start-process)))) (apply 'vc-svn-command buffer (if async 'async 0) - file "diff" + files "diff" (append switches (when oldvers @@ -417,7 +418,7 @@ (if async 1 ; async diff => pessimistic assumption ;; For some reason `svn diff' does not return a useful ;; status w.r.t whether the diff was empty or not. - (buffer-size (get-buffer buffer)))))) + (buffer-size (get-buffer buffer))))) (defun vc-svn-diff-tree (dir &optional rev1 rev2) "Diff all files at and below DIR." @@ -469,11 +470,11 @@ :type 'string :group 'vc) -(defun vc-svn-command (buffer okstatus file &rest flags) +(defun vc-svn-command (buffer okstatus file-or-list &rest flags) "A wrapper around `vc-do-command' for use in vc-svn.el. The difference to vc-do-command is that this function always invokes `svn', and that it passes `vc-svn-global-switches' to it before FLAGS." - (apply 'vc-do-command buffer okstatus vc-svn-program file + (apply 'vc-do-command buffer okstatus vc-svn-program file-or-list (if (stringp vc-svn-global-switches) (cons vc-svn-global-switches flags) (append vc-svn-global-switches
--- a/lisp/vc.el Mon Jul 23 05:39:31 2007 +0000 +++ b/lisp/vc.el Tue Jul 24 01:23:55 2007 +0000 @@ -46,8 +46,9 @@ ;; This mode is fully documented in the Emacs user's manual. ;; -;; Supported version-control systems presently include CVS, RCS, GNU Arch, -;; Subversion, Meta-CVS, and SCCS (or its free replacement, CSSC). +;; Supported version-control systems presently include CVS, RCS, GNU +;; Arch, Subversion, Bzr, Mercurial, Meta-CVS, and SCCS (or its free +;; replacement, CSSC). ;; ;; Some features will not work with old RCS versions. Where ;; appropriate, VC finds out which version you have, and allows or @@ -101,13 +102,23 @@ ;; with `vc-sys-'. Some of the functions are mandatory (marked with a ;; `*'), others are optional (`-'). ;; +;; BACKEND PROPERTIES +;; +;; * revision-granularity +;; +;; Takes no arguments. Returns either 'file or 'repository. +;; ;; STATE-QUERYING FUNCTIONS ;; ;; * registered (file) ;; ;; Return non-nil if FILE is registered in this backend. Both this -;; function as well as `state' should be careful to fail gracefully in the -;; event that the backend executable is absent. +;; function as well as `state' should be careful to fail gracefully +;; in the event that the backend executable is absent. It is +;; preferable that this function's body is autoloaded, that way only +;; calling vc-registered does not cause the backend to be loaded +;; (all the vc-FOO-registered functions are called to try to find +;; the controlling backend for FILE. ;; ;; * state (file) ;; @@ -159,9 +170,12 @@ ;; ;; - mode-line-string (file) ;; -;; If provided, this function should return the VC-specific mode line -;; string for FILE. The default implementation deals well with all -;; states that `vc-state' can return. +;; If provided, this function should return the VC-specific mode +;; line string for FILE. The returned string should have a +;; `help-echo' property which is the text to be displayed as a +;; tooltip when the mouse hovers over the VC entry on the mode-line. +;; The default implementation deals well with all states that +;; `vc-state' can return. ;; ;; - dired-state-info (file) ;; @@ -171,12 +185,20 @@ ;; ;; STATE-CHANGING FUNCTIONS ;; -;; * register (file &optional rev comment) +;; * create-repo () +;; +;; Create an empty repository in the current directory and initialize +;; it so VC mode can add files to it. For file-oriented systems, this +;; need do no more than create a subdirectory with the right name. ;; -;; Register FILE in this backend. Optionally, an initial revision REV -;; and an initial description of the file, COMMENT, may be specified. +;; * register (files &optional rev comment) +;; +;; Register FILES in this backend. Optionally, an initial revision REV +;; and an initial description of the file, COMMENT, may be specified, +;; but it is not guaranteed that the backend will do anything with this. ;; The implementation should pass the value of vc-register-switches -;; to the backend command. +;; to the backend command. (Note: in older versions of VC, this +;; command took a single file argument and not a list.) ;; ;; - init-version (file) ;; @@ -210,12 +232,14 @@ ;; Unregister FILE from this backend. This is only needed if this ;; backend may be used as a "more local" backend for temporary editing. ;; -;; * checkin (file rev comment) +;; * checkin (files rev comment) ;; -;; Commit changes in FILE to this backend. If REV is non-nil, that -;; should become the new revision number. COMMENT is used as a -;; check-in comment. The implementation should pass the value of -;; vc-checkin-switches to the backend command. +;; Commit changes in FILES to this backend. If REV is non-nil, that +;; should become the new revision number (not all backends do +;; anything with it). COMMENT is used as a check-in comment. The +;; implementation should pass the value of vc-checkin-switches to +;; the backend command. (Note: in older versions of VC, this +;; command took a single file argument and not a list.) ;; ;; * find-version (file rev buffer) ;; @@ -242,13 +266,14 @@ ;; already been reverted from a version backup, and this function ;; only needs to update the status of FILE within the backend. ;; -;; - cancel-version (file editable) +;; - rollback (files) ;; -;; Cancel the current workfile version of FILE, i.e. remove it from the -;; master. EDITABLE non-nil means that FILE should be writable -;; afterwards, and if locking is used for FILE, then a lock should also -;; be set. If this function is not provided, trying to cancel a -;; version is caught as an error. +;; Remove the tip version of each of FILES from the repository. If +;; this function is not provided, trying to cancel a version is +;; caught as an error. (Most backends don't provide it.) (Also +;; note that older versions of this backend command were called +;; 'cancel-version' and took a single file arg, not a list of +;; files.) ;; ;; - merge (file rev1 rev2) ;; @@ -267,10 +292,11 @@ ;; ;; HISTORY FUNCTIONS ;; -;; * print-log (file &optional buffer) +;; * print-log (files &optional buffer) ;; -;; Insert the revision log of FILE into BUFFER, or the *vc* buffer -;; if BUFFER is nil. +;; Insert the revision log for FILES into BUFFER, or the *vc* buffer +;; if BUFFER is nil. (Note: older versions of this function expected +;; only a single file argument.) ;; ;; - log-view-mode () ;; @@ -560,7 +586,8 @@ :group 'vc :version "20.3") -(defcustom vc-directory-exclusion-list '("SCCS" "RCS" "CVS" "MCVS" ".svn" "{arch}") +(defcustom vc-directory-exclusion-list '("SCCS" "RCS" "CVS" "MCVS" ".svn" + ".hg" ".bzr" "{arch}") "List of directory names to be ignored when walking directory trees." :type '(repeat string) :group 'vc) @@ -588,7 +615,7 @@ :group 'vc) (defcustom vc-allow-async-revert nil - "Specifies whether the diff during \\[vc-revert-buffer] may be asynchronous. + "Specifies whether the diff during \\[vc-revert] may be asynchronous. Enabling this option means that you can confirm a revert operation even if the local changes in the file have not been found and displayed yet." :type '(choice (const :tag "No" nil) @@ -976,9 +1003,13 @@ Each function is called inside the buffer in which the command was run and is passed 3 arguments: the COMMAND, the FILE and the FLAGS.") +(defun vc-delistify (filelist) + "Smash a FILELIST into a file list string suitable for info messages." + (if (not filelist) "." (mapconcat 'identity filelist " "))) + (defvar w32-quote-process-args) ;;;###autoload -(defun vc-do-command (buffer okstatus command file &rest flags) +(defun vc-do-command (buffer okstatus command file-or-list &rest flags) "Execute a VC command, notifying user and checking for errors. Output from COMMAND goes to BUFFER, or *vc* if BUFFER is nil or the current buffer if BUFFER is t. If the destination buffer is not @@ -986,65 +1017,69 @@ considered successful if its exit status does not exceed OKSTATUS (if OKSTATUS is nil, that means to ignore error status, if it is `async', that means not to wait for termination of the subprocess; if it is t it means to -ignore all execution errors). FILE is the -name of the working file (may also be nil, to execute commands that -don't expect a file name). If an optional list of FLAGS is present, +ignore all execution errors). FILE-OR-LIST is the name of a working file; +it may be a list of files or be nil (to execute commands that don't expect +a file name or set of files). If an optional list of FLAGS is present, that is inserted into the command line before the filename." - (and file (setq file (expand-file-name file))) - (if vc-command-messages - (message "Running %s on %s..." command file)) - (save-current-buffer - (unless (or (eq buffer t) - (and (stringp buffer) - (string= (buffer-name) buffer)) - (eq buffer (current-buffer))) - (vc-setup-buffer buffer)) - (let ((squeezed (remq nil flags)) - (inhibit-read-only t) - (status 0)) - (when file - ;; FIXME: file-relative-name can return a bogus result because - ;; it doesn't look at the actual file-system to see if symlinks - ;; come into play. - (setq squeezed (append squeezed (list (file-relative-name file))))) - (let ((exec-path (append vc-path exec-path)) - ;; Add vc-path to PATH for the execution of this command. - (process-environment - (cons (concat "PATH=" (getenv "PATH") - path-separator - (mapconcat 'identity vc-path path-separator)) - process-environment)) - (w32-quote-process-args t)) - (if (and (eq okstatus 'async) (file-remote-p default-directory)) - ;; start-process does not support remote execution - (setq okstatus nil)) - (if (eq okstatus 'async) - (let ((proc - (let ((process-connection-type nil)) - (apply 'start-process command (current-buffer) command - squeezed)))) - (unless (active-minibuffer-window) - (message "Running %s in the background..." command)) - ;;(set-process-sentinel proc (lambda (p msg) (delete-process p))) - (set-process-filter proc 'vc-process-filter) - (vc-exec-after - `(unless (active-minibuffer-window) - (message "Running %s in the background... done" ',command)))) - (let ((buffer-undo-list t)) - (setq status (apply 'process-file command nil t nil squeezed))) - (when (and (not (eq t okstatus)) - (or (not (integerp status)) - (and okstatus (< okstatus status)))) - (pop-to-buffer (current-buffer)) - (goto-char (point-min)) - (shrink-window-if-larger-than-buffer) - (error "Running %s...FAILED (%s)" command - (if (integerp status) (format "status %d" status) status)))) - (if vc-command-messages - (message "Running %s...OK" command))) - (vc-exec-after - `(run-hook-with-args 'vc-post-command-functions ',command ',file ',flags)) - status))) + ;; FIXME: file-relative-name can return a bogus result because + ;; it doesn't look at the actual file-system to see if symlinks + ;; come into play. + (let* ((files + (mapcar (lambda (f) (file-relative-name (expand-file-name f))) + (if (listp file-or-list) file-or-list (list file-or-list)))) + (full-command + (concat command " " (vc-delistify flags) " " (vc-delistify files)))) + (if vc-command-messages + (message "Running %s..." full-command)) + (save-current-buffer + (unless (or (eq buffer t) + (and (stringp buffer) + (string= (buffer-name) buffer)) + (eq buffer (current-buffer))) + (vc-setup-buffer buffer)) + (let ((squeezed (remq nil flags)) + (inhibit-read-only t) + (status 0)) + (when files + (setq squeezed (nconc squeezed files))) + (let ((exec-path (append vc-path exec-path)) + ;; Add vc-path to PATH for the execution of this command. + (process-environment + (cons (concat "PATH=" (getenv "PATH") + path-separator + (mapconcat 'identity vc-path path-separator)) + process-environment)) + (w32-quote-process-args t)) + (if (and (eq okstatus 'async) (file-remote-p default-directory)) + ;; start-process does not support remote execution + (setq okstatus nil)) + (if (eq okstatus 'async) + (let ((proc + (let ((process-connection-type nil)) + (apply 'start-process command (current-buffer) command + squeezed)))) + (unless (active-minibuffer-window) + (message "Running %s in the background..." full-command)) + ;;(set-process-sentinel proc (lambda (p msg) (delete-process p))) + (set-process-filter proc 'vc-process-filter) + (vc-exec-after + `(unless (active-minibuffer-window) + (message "Running %s in the background... done" ',full-command)))) + (let ((buffer-undo-list t)) + (setq status (apply 'process-file command nil t nil squeezed))) + (when (and (not (eq t okstatus)) + (or (not (integerp status)) + (and okstatus (< okstatus status)))) + (pop-to-buffer (current-buffer)) + (goto-char (point-min)) + (shrink-window-if-larger-than-buffer) + (error "Running %s...FAILED (%s)" full-command + (if (integerp status) (format "status %d" status) status)))) + (if vc-command-messages + (message "Running %s...OK" full-command))) + (vc-exec-after + `(run-hook-with-args 'vc-post-command-functions ',command ',file-or-list ',flags)) + status)))) (defun vc-position-context (posn) "Save a bit of the text around POSN in the current buffer. @@ -1274,7 +1309,7 @@ ;; DO NOT revert the file without asking the user! (if (not visited) (find-file-other-window file)) (if (yes-or-no-p "Revert to master version? ") - (vc-revert-buffer))) + (vc-revert))) (t ;; normal action (if (not verbose) (vc-checkin file nil comment) @@ -1464,7 +1499,7 @@ (message "Registering %s... " file) (let ((backend (vc-responsible-backend file t))) (vc-file-clearprops file) - (vc-call-backend backend 'register file rev comment) + (vc-call-backend backend 'register (list file) rev comment) (vc-file-setprop file 'vc-backend backend) (unless vc-make-backup-files (make-local-variable 'backup-inhibited) @@ -1520,6 +1555,16 @@ The default implementation returns t for all files." t) +(defun vc-expand-dirs (file-or-dir-list) + "Expands directories in a file list specification. +Only files already under version control are noticed." + ;; FIXME: Kill this function. + (let ((flattened '())) + (dolist (node file-or-dir-list) + (vc-file-tree-walk + node (lambda (f) (if (vc-backend f) (push f flattened))))) + (nreverse flattened))) + (defun vc-resynch-window (file &optional keep noquery) "If FILE is in the current buffer, either revert or unvisit it. The choice between revert (to see expanded keywords) and unvisit depends on @@ -1676,7 +1721,7 @@ ;; Change buffers to get local value of vc-checkin-switches. (with-current-buffer (or (get-file-buffer file) (current-buffer)) (progn - (vc-call checkin file rev comment) + (vc-call checkin (list file) rev comment) (vc-delete-automatic-version-backups file))) `((vc-state . up-to-date) (vc-checkout-time . ,(nth 5 (file-attributes file))) @@ -1896,7 +1941,7 @@ (error "diff failed")) (if (not vc-diff-knows-L) (setq vc-diff-knows-L 'yes))) status) - (vc-call diff file rev1 rev2)))) + (vc-call diff (list file) rev1 rev2 "*vc-diff*")))) (defun vc-switches (backend op) (let ((switches @@ -2467,7 +2512,7 @@ ;; buffer can be accessed by the command. (condition-case err (progn - (vc-call print-log file "*vc-change-log*") + (vc-call print-log (list file) "*vc-change-log*") (set-buffer "*vc-change-log*")) (wrong-number-of-arguments ;; If this error came from the above call to print-log, try again @@ -2480,7 +2525,7 @@ (not (eq (caddr err) 2))) (signal (car err) (cdr err)) ;; for backward compatibility - (vc-call print-log file) + (vc-call print-log (list file)) (set-buffer "*vc*")))) (pop-to-buffer (current-buffer)) (vc-exec-after @@ -2509,7 +2554,7 @@ "Return a string with all log entries stored in BACKEND for FILE." (if (vc-find-backend-function backend 'print-log) (with-current-buffer "*vc*" - (vc-call print-log file) + (vc-call print-log (list file)) (vc-call wash-log file) (buffer-string)))) @@ -2534,7 +2579,7 @@ (delete-region (match-beginning 0) (match-end 0))))) ;;;###autoload -(defun vc-revert-buffer () +(defun vc-revert () "Revert the current buffer's file to the version it was based on. This asks for confirmation if the buffer contents are not identical to that version. This function does not automatically pick up newer @@ -2593,7 +2638,7 @@ (if (eq (vc-state file) 'edited) (error (substitute-command-keys - "File is locked--type \\[vc-revert-buffer] to discard changes")) + "File is locked--type \\[vc-revert] to discard changes")) (error (substitute-command-keys "Unexpected file state (%s)--type \\[vc-next-action] to correct") @@ -2659,21 +2704,20 @@ (vc-resynch-buffer file t t)) ;;;###autoload -(defun vc-cancel-version (norevert) - "Get rid of most recently checked in version of this file. -A prefix argument NOREVERT means do not revert the buffer afterwards." +(defun vc-rollback () + "Get rid of most recently checked in version of this file." (interactive "P") (vc-ensure-vc-buffer) (let* ((file buffer-file-name) (backend (vc-backend file)) (target (vc-workfile-version file))) (cond - ((not (vc-find-backend-function backend 'cancel-version)) + ((not (vc-find-backend-function backend 'rollback)) (error "Sorry, canceling versions is not supported under %s" backend)) ((not (vc-call latest-on-branch-p file)) (error "This is not the latest version; VC cannot cancel it")) ((not (vc-up-to-date-p file)) - (error "%s" (substitute-command-keys "File is not up to date; use \\[vc-revert-buffer] to discard changes")))) + (error "%s" (substitute-command-keys "File is not up to date; use \\[vc-revert] to discard changes")))) (if (null (yes-or-no-p (format "Remove version %s from master? " target))) (error "Aborted") (setq norevert (or norevert (not @@ -2682,7 +2726,7 @@ (message "Removing last change from %s..." file) (with-vc-properties file - (vc-call cancel-version file norevert) + (vc-call rollback (list file)) `((vc-state . ,(if norevert 'edited 'up-to-date)) (vc-checkout-time . ,(if norevert 0 @@ -3453,6 +3497,7 @@ (defun vc-file-tree-walk (dirname func &rest args) "Walk recursively through DIRNAME. Invoke FUNC f ARGS on each VC-managed file f underneath it." + ;; FIXME: Kill this function. (vc-file-tree-walk-internal (expand-file-name dirname) func args) (message "Traversing directory %s...done" dirname)) @@ -3463,13 +3508,13 @@ (let ((dir (file-name-as-directory file))) (mapcar (lambda (f) (or - (string-equal f ".") - (string-equal f "..") - (member f vc-directory-exclusion-list) - (let ((dirf (expand-file-name f dir))) - (or - (file-symlink-p dirf);; Avoid possible loops - (vc-file-tree-walk-internal dirf func args))))) + (string-equal f ".") + (string-equal f "..") + (member f vc-directory-exclusion-list) + (let ((dirf (expand-file-name f dir))) + (or + (file-symlink-p dirf) ;; Avoid possible loops. + (vc-file-tree-walk-internal dirf func args))))) (directory-files dir))))) (provide 'vc)
--- a/lispref/ChangeLog Mon Jul 23 05:39:31 2007 +0000 +++ b/lispref/ChangeLog Tue Jul 24 01:23:55 2007 +0000 @@ -3,6 +3,10 @@ * files.texi (Magic File Names): Introduce optional parameter IDENTIFICATION for `file-remote-p'. +2007-07-16 Richard Stallman <rms@gnu.org> + + * display.texi (Defining Faces): Fix previous change. + 2007-07-14 Richard Stallman <rms@gnu.org> * control.texi (Handling Errors): Document `debug' in handler list.
--- a/lispref/display.texi Mon Jul 23 05:39:31 2007 +0000 +++ b/lispref/display.texi Tue Jul 24 01:23:55 2007 +0000 @@ -1760,10 +1760,10 @@ @var{spec}, then uses any customizations that were read from the init file (@pxref{Init File}) to override that specification. -When you evaluate a @code{defcustom} form with @kbd{C-M-x} in Emacs +When you evaluate a @code{defface} form with @kbd{C-M-x} in Emacs Lisp mode (@code{eval-defun}), a special feature of @code{eval-defun} overrides any customizations of the face. This way, the face reflects -exactly what the @code{defcustom} says. +exactly what the @code{defface} says. The purpose of @var{spec} is to specify how the face should appear on different kinds of terminals. It should be an alist whose elements
--- a/man/ChangeLog Mon Jul 23 05:39:31 2007 +0000 +++ b/man/ChangeLog Tue Jul 24 01:23:55 2007 +0000 @@ -1,3 +1,35 @@ +2007-07-23 Nick Roberts <nickrob@snap.net.nz> + + * screen.texi (Mode Line): Describe new mode-line flag that shows if + default-directory for the current buffer is on a remote machine. + +2007-07-22 Michael Albinus <michael.albinus@gmx.de> + + Sync with Tramp 2.1.10. + + * tramp.texi (trampfn): Expand macro implementation in order to handle + empty arguments. + (trampfnmhl, trampfnuhl, trampfnhl): Remove macros. Replace all + occurencies by trampfn. + (Frequently Asked Questions): Extend example code for host + identification in the modeline. Add bbdb to approaches shortening Tramp + file names to be typed. + + * trampver.texi: Update release number. + +2007-07-21 Eli Zaretskii <eliz@gnu.org> + + * vc2-xtra.texi (Customizing VC) <vc-handled-backends>: Update the + default value. + +2007-07-21 Richard Stallman <rms@gnu.org> + + * files.texi (Why Version Control?): Improve previous change. + +2007-07-18 Eric S. Raymond <esr@snark.thyrsus.com> + + * files.texi (Why Version Control?): New node. + 2007-07-17 Michael Albinus <michael.albinus@gmx.de> * tramp.texi: Move @setfilename ../info/tramp up, outside the header
--- a/man/files.texi Mon Jul 23 05:39:31 2007 +0000 +++ b/man/files.texi Tue Jul 24 01:23:55 2007 +0000 @@ -1258,11 +1258,32 @@ you want to use. @menu +* Why Version Control?:: Understanding the problems it addresses * Version Systems:: Supported version control back-end systems. * VC Concepts:: Words and concepts related to version control. * Types of Log File:: The per-file VC log in contrast to the ChangeLog. @end menu +@node Why Version Control? +@subsubsection Understanding the problems it addresses + + Version control systems provide you with three important capabilities: +reversibility, concurrency, and history. + + The most basic capability you get from a version-control system is +reversibility, the ability to back up to a saved, known-good state when +you discover that some modification you did was a mistake or a bad idea. + + Version-control systems also support concurrency, the ability to +have many people modifying the same collection of code or documents +knowing that conflicting modifications can be detected and resolved. + + Version-control systems give you the capability to attach a history +to your data, explanatory comments about the intention behind each +change to it. Even for a programmer working solo change histories +are an important aid to memory; for a multi-person project they +become a vitally important form of communication among developers. + @node Version Systems @subsubsection Supported Version Control Systems @@ -1351,34 +1372,97 @@ which records the changes in the master file, along with a log entry for them. - With CVS, there are usually multiple work files corresponding to a -single master file---often each user has his own copy. It is also -possible to use RCS in this way, but this is not the usual way to use -RCS. - -@cindex locking and version control + To go beyond these basic concepts, you will need to understand three +ways in which version-control systems can differ from each other. They +can be locking or merging; they can be file-based or changeset-based; +and they can be centralized or decentralized. VC handles all these +choices, but they lead to differing behaviors which you will need +to understand as you use it. + +@cindex locking versus merging A version control system typically has some mechanism to coordinate between users who want to change the same file. One method is @dfn{locking} (analogous to the locking that Emacs uses to detect -simultaneous editing of a file, but distinct from it). The other method -is to merge your changes with other people's changes when you check them -in. +simultaneous editing of a file, but distinct from it). In a locking +system, such as SCCS, you must @dfn{lock} a file before you start to +edit it. The other method is @dfn{merging}; the system tries to +merge your changes with other people's changes when you check them in. With version control locking, work files are normally read-only so that you cannot change them. You ask the version control system to make a work file writable for you by locking it; only one user can do this at any given time. When you check in your changes, that unlocks the file, making the work file read-only again. This allows other users -to lock the file to make further changes. SCCS always uses locking, and -RCS normally does. - - The other alternative for RCS is to let each user modify the work file -at any time. In this mode, locking is not required, but it is -permitted; check-in is still the way to record a new version. - - CVS normally allows each user to modify his own copy of the work file -at any time, but requires merging with changes from other users at -check-in time. However, CVS can also be set up to require locking. +to lock the file to make further changes. + + By contrast, a merging system lets each user check out and modify a +work file at any time. When you check in a a file, the system will +attempt to merge your changes with any others checked into the +repository since you checked out the file. + + Both locking and merging systems can have problems when multiple users +try to modify the same file at the same time. Locking systems have +@dfn{lock conflicts}; a user may try to check a file out and be unable +to because it is locked. In merging systems, @dfn{merge conflicts} +happen when you check in a change to a file that conflicts with a change +checked in by someone else after your checkout. Both kinds of conflict +have to be resolved by human judgment and communication. + + SCCS always uses locking. RCS is lock-based by default but can be told +to operate in a merging style. CVS is merge-based by default but can +be told to operate in a locking mode. Most later version-control +systems, such as Subversion and GNU Arch, have been fundamentally +merging-based rather than locking-based. This is because experience +has shown that the merging-based approach is generally superior to +the locking one, both in convenience to developers and in minimizing +the number and severity of conflicts that actually occur. + + While it is rather unlikely that anyone will ever again build a +fundamentally locking-based rather than merging-based version-control +system in the future, merging-based version-systems sometimes have locks +retrofitted onto them for reasons having nothing to do with technology. +@footnote{Usually the control-freak instincts of managers.} For this +reason, and to support older systems still in use, VC mode supports +both locking and merging version control and tries to hide the differences +between them as much as possible. + +@cindex files versus changesets. + On SCCS, RCS, CVS, and other early version-control systems, checkins +and other operations are @dfn{file-based}; each file has its own +@dfn{master file} with its own comment- and revision history separate +from that of all other files in the system. Later systems, beginning +with Subversion, are @dfn{changeset-based}; a checkin may include +changes to several files and that change set is treated as a unit by the +system. Any comment associated with the change doesn't belong to any +one file, but is attached to the changeset itself. + + Changeset-based version control is in general both more flexible and +more powerful than file-based version control; usually, when a change to +multiple files has to be backed out, it's good to be able to easily +identify and remove all of it. + +@cindex centralized vs. decentralized + Early version-control systems were designed around a @dfn{centralized} +model in which each project has only one repository used by all +developers. SCCS, RCS, CVS, and Subversion share this kind of model. +It has two important problems. One is that a single repository is a +single point of failure---if the repository server is down all work +stops. The other is that you need to be connected live to the server to +do checkins and checkouts; if you're offline, you can't work. + + Newer version-control systems like GNU Arch are @dfn{decentralized}. +A project may have several different repositories, and these systems +support a sort of super-merge between repositories that tries to +reconcile their change histories. At the limit, each developer has +his/her own repository, and repository merges replace checkin/commit +operations. + + VC's job is to help you manage the traffic between your personal +workfiles and a repository. Whether that repository is a single master +or one of a network of peer repositories is not something VC has to care +about. Thus, the difference between a centralized and a decentralized +version-control system is invisible to VC mode. + @iftex (@pxref{CVS Options,,,emacs-xtra, Specialized Emacs Features}). @end iftex
--- a/man/screen.texi Mon Jul 23 05:39:31 2007 +0000 +++ b/man/screen.texi Tue Jul 24 01:23:55 2007 +0000 @@ -197,7 +197,7 @@ Normally, the mode line looks like this: @example --@var{cs}:@var{ch}-@var{fr} @var{buf} @var{pos} @var{line} (@var{major} @var{minor})------ +-@var{cs}:@var{ch}@var{R}-@var{fr} @var{buf} @var{pos} @var{line} (@var{major} @var{minor})------ @end example @noindent @@ -211,6 +211,9 @@ not been edited. For a read-only buffer, it is @samp{%*} if the buffer is modified, and @samp{%%} otherwise. + @var{R} is @samp{@@} if the default-directory for the current buffer +is on a remote machine, or a hyphen otherwise. + @var{fr} gives the selected frame name (@pxref{Frames}). It appears only on text-only terminals. The initial frame's name is @samp{F1}.
--- a/man/tramp.texi Mon Jul 23 05:39:31 2007 +0000 +++ b/man/tramp.texi Tue Jul 24 01:23:55 2007 +0000 @@ -17,23 +17,24 @@ @include trampver.texi -@c Macros for formatting a filename. -@c trampfn is for a full filename, trampfnmhl means method, host, localname -@c were given, and so on. -@macro trampfn {method, user, host, localname} -@value{prefix}\method\@value{postfixhop}\user\@@\host\@value{postfix}\localname\ +@c Macro for formatting a filename according to the repective syntax. +@c xxx and yyy are auxiliary macros in order to omit leading and +@c trailing whitespace. Not very elegant, but I don't know it better. + +@macro xxx {one}@c +@set \one\@c @end macro -@macro trampfnmhl {method, host, localname} -@value{prefix}\method\@value{postfixhop}\host\@value{postfix}\localname\ +@macro yyy {one, two}@c +@xxx{x\one\}@c +@ifclear x@c +\one\@w{}\two\@c +@end ifclear +@clear x\one\@c @end macro -@macro trampfnuhl {user, host, localname} -@value{prefix}\user\@@\host\@value{postfix}\localname\ -@end macro - -@macro trampfnhl {host, localname} -@value{prefix}\host\@value{postfix}\localname\ +@macro trampfn {method, user, host, localname}@c +@value{prefix}@yyy{\method\,@value{postfixhop}}@yyy{\user\,@@}\host\@value{postfix}\localname\@c @end macro @copying @@ -497,7 +498,7 @@ installed. It is initially configured to use the @command{scp} program to connect to the remote host. So in the easiest case, you just type @kbd{C-x C-f} and then enter the filename -@file{@trampfnuhl{user, machine, /path/to.file}}. +@file{@trampfn{, user, machine, /path/to.file}}. On some hosts, there are problems with opening a connection. These are related to the behavior of the remote shell. See @xref{Remote shell @@ -1180,7 +1181,7 @@ For the special case of editing files on the local host as another user, see the @option{su} or @option{sudo} methods. They offer shortened syntax for the @samp{root} account, like -@file{@trampfnmhl{su, , /etc/motd}}. +@file{@trampfn{su, , , /etc/motd}}. People who edit large files may want to consider @option{scpc} instead of @option{ssh}, or @option{pscp} instead of @option{plink}. These @@ -1273,11 +1274,11 @@ tramp-default-host "target") @end lisp -Then the simple file name @samp{@trampfnmhl{ssh,,}} will connect you +Then the simple file name @samp{@trampfn{ssh, , ,}} will connect you to John's home directory on target. @ifset emacs -Note, however, that the most simplification @samp{@trampfnmhl{,,}} -won't work, because @samp{/:} is the prefix for quoted file names. +Note, however, that the most simplification @samp{/::} won't work, +because @samp{/:} is the prefix for quoted file names. @end ifset @@ -1339,7 +1340,7 @@ (add-to-list 'tramp-default-proxies-alist '("\\`bastion\\.your\\.domain\\'" "\\`bird\\'" - "@trampfnmhl{ssh, jump.your.domain,}")) + "@trampfn{ssh, , jump.your.domain,}")) @end lisp @var{proxy} can contain the patterns @code{%h} or @code{%u}. These @@ -1352,15 +1353,15 @@ @lisp (add-to-list 'tramp-default-proxies-alist - '("\\.your\\.domain\\'" "\\`root\\'" "@trampfnmhl{ssh, %h,}")) + '("\\.your\\.domain\\'" "\\`root\\'" "@trampfn{ssh, , %h,}")) @end lisp -Opening @file{@trampfnmhl{sudo, randomhost.your.domain,}} would -connect first @samp{randomhost.your.domain} via @code{ssh} under your -account name, and perform @code{sudo -u root} on that host afterwards. -It is important to know that the given method is applied on the host -which has been reached so far. @code{sudo -u root}, applied on your -local host, wouldn't be useful here. +Opening @file{@trampfn{sudo, , randomhost.your.domain,}} would connect +first @samp{randomhost.your.domain} via @code{ssh} under your account +name, and perform @code{sudo -u root} on that host afterwards. It is +important to know that the given method is applied on the host which +has been reached so far. @code{sudo -u root}, applied on your local +host, wouldn't be useful here. This is the recommended configuration to work as @samp{root} on remote Ubuntu hosts. @@ -1382,7 +1383,7 @@ @lisp (add-to-list 'tramp-default-proxies-alist '("\\`host\\.other\\.domain\\'" nil - "@trampfnmhl{tunnel, proxy.your.domain#3128,}")) + "@trampfn{tunnel, , proxy.your.domain#3128,}")) @end lisp Gateway methods can be declared as first hop only in a multiple hop @@ -2029,32 +2030,32 @@ @cindex filename examples To access the file @var{localname} on the remote machine @var{machine} -you would specify the filename @file{@trampfnhl{@var{machine}, +you would specify the filename @file{@trampfn{, , @var{machine}, @var{localname}}}. This will connect to @var{machine} and transfer the file using the default method. @xref{Default Method}. Some examples of @value{tramp} filenames are shown below. @table @file -@item @trampfnhl{melancholia, .emacs} +@item @trampfn{, , melancholia, .emacs} Edit the file @file{.emacs} in your home directory on the machine @code{melancholia}. -@item @trampfnhl{melancholia.danann.net, .emacs} +@item @trampfn{, , melancholia.danann.net, .emacs} This edits the same file, using the fully qualified domain name of the machine. -@item @trampfnhl{melancholia, ~/.emacs} +@item @trampfn{, , melancholia, ~/.emacs} This also edits the same file --- the @file{~} is expanded to your home directory on the remote machine, just like it is locally. -@item @trampfnhl{melancholia, ~daniel/.emacs} +@item @trampfn{, , melancholia, ~daniel/.emacs} This edits the file @file{.emacs} in the home directory of the user @code{daniel} on the machine @code{melancholia}. The @file{~<user>} construct is expanded to the home directory of that user on the remote machine. -@item @trampfnhl{melancholia, /etc/squid.conf} +@item @trampfn{, , melancholia, /etc/squid.conf} This edits the file @file{/etc/squid.conf} on the machine @code{melancholia}. @@ -2066,10 +2067,10 @@ part of the filename. To log in to the remote machine as a specific user, you use the syntax -@file{@trampfnuhl{@var{user}, @var{machine}, @var{path/to.file}}}. +@file{@trampfn{, @var{user}, @var{machine}, @var{path/to.file}}}. That means that connecting to @code{melancholia} as @code{daniel} and editing @file{.emacs} in your home directory you would specify -@file{@trampfnuhl{daniel, melancholia, .emacs}}. +@file{@trampfn{, daniel, melancholia, .emacs}}. It is also possible to specify other file transfer methods (@pxref{Default Method}) as part of the filename. @@ -2160,11 +2161,11 @@ @example @ifset emacs -@value{prefixhop}telnet@value{postfixhop} tmp/ +@value{prefixhop}telnet@value{postfixhop} tmp/ @value{prefixhop}toto@value{postfix} @end ifset @ifset xemacs -@value{prefixhop}telnet@value{postfixhop} @value{prefixhop}toto@value{postfix} +@value{prefixhop}telnet@value{postfixhop} @value{prefixhop}toto@value{postfix} @end ifset @end example @@ -2184,9 +2185,9 @@ your @file{/etc/hosts} file, let's say @example -@trampfnmhl{telnet,127.0.0.1,} @trampfnmhl{telnet,192.168.0.1,} -@trampfnmhl{telnet,localhost,} @trampfnmhl{telnet,melancholia.danann.net,} -@trampfnmhl{telnet,melancholia,} +@trampfn{telnet, , 127.0.0.1,} @trampfn{telnet, , 192.168.0.1,} +@trampfn{telnet, , localhost,} @trampfn{telnet, , melancholia.danann.net,} +@trampfn{telnet, , melancholia,} @end example Now you can choose the desired machine, and you can continue to @@ -2209,20 +2210,20 @@ @end ifinfo @ifset emacs -As example, @kbd{@trampfnmhl{telnet,melancholia,/usr/local/bin//etc} +As example, @kbd{@trampfn{telnet, , melancholia, /usr/local/bin//etc} @key{TAB}} would result in -@file{@trampfnmhl{telnet,melancholia,/etc}}, whereas -@kbd{@trampfnmhl{telnet,melancholia,//etc} @key{TAB}} reduces the +@file{@trampfn{telnet, , melancholia, /etc}}, whereas +@kbd{@trampfn{telnet, , melancholia, //etc} @key{TAB}} reduces the minibuffer contents to @file{/etc}. A triple-slash stands for the default behaviour, -i.e. @kbd{@trampfnmhl{telnet,melancholia,/usr/local/bin///etc} +i.e. @kbd{@trampfn{telnet, , melancholia, /usr/local/bin///etc} @key{TAB}} expands directly to @file{/etc}. @end ifset @ifset xemacs -As example, @kbd{@trampfnmhl{telnet,melancholia,/usr/local/bin//}} -would result in @file{@trampfnmhl{telnet,melancholia,/}}, whereas -@kbd{@trampfnmhl{telnet,melancholia,//}} expands the minibuffer +As example, @kbd{@trampfn{telnet, , melancholia, /usr/local/bin//}} +would result in @file{@trampfn{telnet, , melancholia, /}}, whereas +@kbd{@trampfn{telnet, , melancholia, //}} expands the minibuffer contents to @file{/}. @end ifset @@ -2295,7 +2296,7 @@ this: @example -@b{~ $} cd @trampfnmhl{sudo, , /etc} @key{RET} +@b{~ $} cd @trampfn{sudo, , , /etc} @key{RET} @b{@trampfn{sudo, root, host, /etc} $} hostname @key{RET} host @b{@trampfn{sudo, root, host, /etc} $} id @key{RET} @@ -2324,12 +2325,12 @@ @example @kbd{M-x gdb @key{RET}} -@b{Run gdb (like this):} gdb --annotate=3 @trampfnmhl{ssh, host, ~/myprog} @key{RET} +@b{Run gdb (like this):} gdb --annotate=3 @trampfn{ssh, , host, ~/myprog} @key{RET} @end example The file name can also be relative to a remote default directory. Given you are in a buffer that belongs to the remote directory -@trampfnmhl{ssh, host, /home/user}, you could call +@trampfn{ssh, , host, /home/user}, you could call @example @kbd{M-x perldb @key{RET}} @@ -2602,7 +2603,7 @@ @item I'ld like to see a host indication in the mode line when I'm remote -The following code has been tested with @value{emacsname} 22. You +The following code has been tested with @value{emacsname} 22.1. You should put it into your @file{~/.emacs}: @lisp @@ -2610,13 +2611,13 @@ (list '(:eval (let ((host-name - (if (file-remote-p default-directory) - (tramp-file-name-host - (tramp-dissect-file-name default-directory)) - (system-name)))) + (if (file-remote-p default-directory) + (tramp-file-name-host + (tramp-dissect-file-name default-directory)) + (system-name)))) (if (string-match "^[^0-9][^.]*\\(\\..*\\)" host-name) - (substring host-name 0 (match-beginning 1)) - host-name))) + (substring host-name 0 (match-beginning 1)) + host-name))) ": %12b")) (setq-default @@ -2630,6 +2631,18 @@ mode-line-buffer-identification my-mode-line-buffer-identification))) @end lisp + +Since @value{emacsname} 23, the @code{:eval} clause can be simplified: + +@lisp + '(:eval + (let ((host-name + (or (file-remote-p default-directory 'host) + (system-name)))) + (if (string-match "^[^0-9][^.]*\\(\\..*\\)" host-name) + (substring host-name 0 (match-beginning 1)) + host-name))) +@end lisp @end ifset @@ -2693,11 +2706,11 @@ @end lisp The file name left to type would be -@kbd{C-x C-f @trampfnhl{news.my.domain, /opt/news/etc}}. +@kbd{C-x C-f @trampfn{, , news.my.domain, /opt/news/etc}}. Note, that there are some useful settings already. Accessing your local host as @samp{root} user, is possible just by @kbd{C-x C-f -@trampfnmhl{su,,}}. +@trampfn{su, , ,}}. @item Use configuration possibilities of your method: @@ -2711,7 +2724,7 @@ User news @end example -The file name left to type would be @kbd{C-x C-f @trampfnmhl{ssh, xy, +The file name left to type would be @kbd{C-x C-f @trampfn{ssh, , xy, /opt/news/etc}}. Depending on files in your directories, it is even possible to complete the hostname with @kbd{C-x C-f @value{prefix}ssh@value{postfixhop}x @key{TAB}}. @@ -2881,8 +2894,44 @@ directory. @end ifset +@ifset emacs +@item Use bbdb: + +@file{bbdb} has a built-in feature for @value{ftppackagename} files, +which works also for @value{tramp}. +@ifinfo +@pxref{bbdb-ftp, Storing FTP sites in the BBDB, , bbdb} +@end ifinfo + +You need to load @file{bbdb}: + +@lisp +(require 'bbdb) +(bbdb-initialize) +@end lisp + +Then you can create a BBDB entry via @kbd{M-x bbdb-create-ftp-site}. +Because BBDB is not prepared for @value{tramp} syntax, you must +specify a method together with the user name, when needed. Example: + +@example +@kbd{M-x bbdb-create-ftp-site @key{RET}} +@b{Ftp Site:} news.my.domain @key{RET} +@b{Ftp Directory:} /opt/news/etc/ @key{RET} +@b{Ftp Username:} ssh@value{postfixhop}news @key{RET} +@b{Company:} @key{RET} +@b{Additional Comments:} @key{RET} +@end example + +When you have opened your BBDB buffer, you can access such an entry by +pressing the key @key{F}. +@end ifset + @end enumerate +I would like to thank all @value{tramp} users, who have contributed to +the different recipes! + @item How can I disable @value{tramp}?
--- a/man/trampver.texi Mon Jul 23 05:39:31 2007 +0000 +++ b/man/trampver.texi Tue Jul 24 01:23:55 2007 +0000 @@ -4,12 +4,12 @@ @c In the Tramp CVS, the version number is auto-frobbed from @c configure.ac, so you should edit that file and run @c "autoconf && ./configure" to change the version number. -@set trampver 2.1.10-pre +@set trampver 2.1.10 @c Other flags from configuration @set instprefix /usr/local @set lispdir /usr/local/share/emacs/site-lisp -@set infodir /usr/local/info +@set infodir /usr/local/share/info @c Formatting of the tramp program name consistent. @set tramp @sc{tramp}
--- a/man/vc2-xtra.texi Mon Jul 23 05:39:31 2007 +0000 +++ b/man/vc2-xtra.texi Tue Jul 24 01:23:55 2007 +0000 @@ -590,10 +590,10 @@ @vindex vc-handled-backends The variable @code{vc-handled-backends} determines which version control systems VC should handle. The default value is @code{(RCS CVS -SVN SCCS Arch MCVS)}, so it contains all six version systems that are -currently supported. If you want VC to ignore one or more of these -systems, exclude its name from the list. To disable VC entirely, set -this variable to @code{nil}. +SVN SCCS BZR HG Arch MCVS)}, so it contains all the version systems +that are currently supported. If you want VC to ignore one or more of +these systems, exclude its name from the list. To disable VC entirely, +set this variable to @code{nil}. The order of systems in the list is significant: when you visit a file registered in more than one system (@pxref{Local Version Control}), VC
--- a/src/ChangeLog Mon Jul 23 05:39:31 2007 +0000 +++ b/src/ChangeLog Tue Jul 24 01:23:55 2007 +0000 @@ -1,3 +1,40 @@ +2007-07-22 Nick Roberts <nickrob@snap.net.nz> + + * xdisp.c (decode_mode_spec): Add case 'R' for to test for + remote default-directory. + + * buffer.c (mode-line-format): Describe above case in doc string. + +2007-07-20 Eli Zaretskii <eliz@gnu.org> + + * w32proc.c (IMAGE_NT_OPTIONAL_HDR32_MAGIC, IMAGE_OPTIONAL_HEADER32): + Define if not defined. + +2007-07-18 Jason Rumney <jasonr@gnu.org> + + * w32proc.c (w32_executable_type): Handle 64 bit executables. + +2007-07-18 Richard Stallman <rms@gnu.org> + + * data.c (Fsetq_default): Doc fix. + + * eval.c (Fsetq): Doc fix. + +2007-07-18 Juanma Barranquero <lekktu@gmail.com> + + * coding.c (Ffind_operation_coding_system): + * eval.c (For, Fand): Doc fixes. + Reported by Johan Bockg,Ae(Brd. + +2007-07-18 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * xfns.c (Fx_focus_frame): Call x_ewmh_activate_frame. + + * xterm.h: Declare x_ewmh_activate_frame. + + * xterm.c (x_ewmh_activate_frame): New function. + (XTframe_raise_lower): Move code to x_ewmh_activate_frame. + 2007-07-17 Martin Rudalics <rudalics@gmx.at> * window.c (Fdisplay_buffer): If largest or LRU window is the @@ -8097,7 +8134,7 @@ 2005-09-19 Kim F. Storm <storm@cua.dk> * editfns.c (Fformat): Don't scan past end of format string that - ends in %. Reported by: Johan Bockg,Ae(Brd. + ends in %. Reported by Johan Bockg,Ae(Brd. 2005-09-18 Andreas Schwab <schwab@suse.de>
--- a/src/buffer.c Mon Jul 23 05:39:31 2007 +0000 +++ b/src/buffer.c Tue Jul 24 01:23:55 2007 +0000 @@ -5517,6 +5517,8 @@ %P -- print percent of buffer above bottom of window, perhaps plus Top, or print Bottom or All. %n -- print Narrow if appropriate. + %R -- print R or hyphen. R means that default-directory is on a + remote machine. %t -- visited file is text or binary (if OS supports this distinction). %z -- print mnemonics of keyboard, terminal, and buffer coding systems. %Z -- like %z, but including the end-of-line format.
--- a/src/coding.c Mon Jul 23 05:39:31 2007 +0000 +++ b/src/coding.c Tue Jul 24 01:23:55 2007 +0000 @@ -8400,7 +8400,7 @@ function to call for FILENAME, that function should examine the contents of BUFFER instead of reading the file. -usage: (find-operation-coding-system OPERATION ARGUMENTS ...) */) +usage: (find-operation-coding-system OPERATION ARGUMENTS...) */) (nargs, args) int nargs; Lisp_Object *args;
--- a/src/data.c Mon Jul 23 05:39:31 2007 +0000 +++ b/src/data.c Tue Jul 24 01:23:55 2007 +0000 @@ -1440,7 +1440,7 @@ This sets each VAR's default value to the corresponding VALUE. The VALUE for the Nth VAR can refer to the new default values of previous VARs. -usage: (setq-default [VAR VALUE...]) */) +usage: (setq-default [VAR VALUE]...) */) (args) Lisp_Object args; { @@ -2195,7 +2195,9 @@ return Qnil; } -/* Convert between long values and pairs of Lisp integers. */ +/* Convert between long values and pairs of Lisp integers. + Note that long_to_cons returns a single Lisp integer + when the value fits in one. */ Lisp_Object long_to_cons (i)
--- a/src/eval.c Mon Jul 23 05:39:31 2007 +0000 +++ b/src/eval.c Tue Jul 24 01:23:55 2007 +0000 @@ -330,7 +330,7 @@ doc: /* Eval args until one of them yields non-nil, then return that value. The remaining args are not evalled at all. If all args return nil, return nil. -usage: (or CONDITIONS ...) */) +usage: (or CONDITIONS...) */) (args) Lisp_Object args; { @@ -355,7 +355,7 @@ doc: /* Eval args until one of them yields nil, then return nil. The remaining args are not evalled at all. If no arg yields nil, return the last arg's value. -usage: (and CONDITIONS ...) */) +usage: (and CONDITIONS...) */) (args) Lisp_Object args; { @@ -531,7 +531,7 @@ The second VAL is not computed until after the first SYM is set, and so on; each VAL can use the new value of variables set earlier in the `setq'. The return value of the `setq' form is the value of the last VAL. -usage: (setq SYM VAL SYM VAL ...) */) +usage: (setq [SYM VAL]...) */) (args) Lisp_Object args; {
--- a/src/w32proc.c Mon Jul 23 05:39:31 2007 +0000 +++ b/src/w32proc.c Tue Jul 24 01:23:55 2007 +0000 @@ -591,6 +591,13 @@ return pid; } +/* Old versions of w32api headers don't have separate 32-bit and + 64-bit defines, but the one they have matches the 32-bit variety. */ +#ifndef IMAGE_NT_OPTIONAL_HDR32_MAGIC +# define IMAGE_NT_OPTIONAL_HDR32_MAGIC IMAGE_NT_OPTIONAL_HDR_MAGIC +# define IMAGE_OPTIONAL_HEADER32 IMAGE_OPTIONAL_HEADER +#endif + void w32_executable_type (char * filename, int * is_dos_app, int * is_cygnus_app, int * is_gui_app) { @@ -651,33 +658,54 @@ } else if (nt_header->Signature == IMAGE_NT_SIGNATURE) { - /* Look for cygwin.dll in DLL import list. */ - IMAGE_DATA_DIRECTORY import_dir = - nt_header->OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT]; - IMAGE_IMPORT_DESCRIPTOR * imports; - IMAGE_SECTION_HEADER * section; - - section = rva_to_section (import_dir.VirtualAddress, nt_header); - imports = RVA_TO_PTR (import_dir.VirtualAddress, section, executable); - - for ( ; imports->Name; imports++) - { - char * dllname = RVA_TO_PTR (imports->Name, section, executable); + IMAGE_DATA_DIRECTORY *data_dir = NULL; + if (nt_header->OptionalHeader.Magic == IMAGE_NT_OPTIONAL_HDR32_MAGIC) + { + /* Ensure we are using the 32 bit structure. */ + IMAGE_OPTIONAL_HEADER32 *opt + = (IMAGE_OPTIONAL_HEADER32*) &(nt_header->OptionalHeader); + data_dir = opt->DataDirectory; + *is_gui_app = (opt->Subsystem == IMAGE_SUBSYSTEM_WINDOWS_GUI); + } + /* MingW 3.12 has the required 64 bit structs, but in case older + versions don't, only check 64 bit exes if we know how. */ +#ifdef IMAGE_NT_OPTIONAL_HDR64_MAGIC + else if (nt_header->OptionalHeader.Magic + == IMAGE_NT_OPTIONAL_HDR64_MAGIC) + { + IMAGE_OPTIONAL_HEADER64 *opt + = (IMAGE_OPTIONAL_HEADER64*) &(nt_header->OptionalHeader); + data_dir = opt->DataDirectory; + *is_gui_app = (opt->Subsystem == IMAGE_SUBSYSTEM_WINDOWS_GUI); + } +#endif + if (data_dir) + { + /* Look for cygwin.dll in DLL import list. */ + IMAGE_DATA_DIRECTORY import_dir = + data_dir[IMAGE_DIRECTORY_ENTRY_IMPORT]; + IMAGE_IMPORT_DESCRIPTOR * imports; + IMAGE_SECTION_HEADER * section; - /* The exact name of the cygwin dll has changed with - various releases, but hopefully this will be reasonably - future proof. */ - if (strncmp (dllname, "cygwin", 6) == 0) - { - *is_cygnus_app = TRUE; - break; - } - } + section = rva_to_section (import_dir.VirtualAddress, nt_header); + imports = RVA_TO_PTR (import_dir.VirtualAddress, section, + executable); - /* Check whether app is marked as a console or windowed (aka - GUI) app. Accept Posix and OS2 subsytem apps as console - apps. */ - *is_gui_app = (nt_header->OptionalHeader.Subsystem == IMAGE_SUBSYSTEM_WINDOWS_GUI); + for ( ; imports->Name; imports++) + { + char * dllname = RVA_TO_PTR (imports->Name, section, + executable); + + /* The exact name of the cygwin dll has changed with + various releases, but hopefully this will be reasonably + future proof. */ + if (strncmp (dllname, "cygwin", 6) == 0) + { + *is_cygnus_app = TRUE; + break; + } + } + } } }
--- a/src/window.c Mon Jul 23 05:39:31 2007 +0000 +++ b/src/window.c Tue Jul 24 01:23:55 2007 +0000 @@ -7602,4 +7602,4 @@ } /* arch-tag: 90a9c576-0590-48f1-a5f1-6c96a0452d9f - (do not change thisc omment) */ + (do not change this comment) */
--- a/src/xdisp.c Mon Jul 23 05:39:31 2007 +0000 +++ b/src/xdisp.c Tue Jul 24 01:23:55 2007 +0000 @@ -18144,6 +18144,16 @@ #endif break; + case 'R': + { + Lisp_Object val; + val = call1 (intern ("file-remote-p"), current_buffer->directory); + if (NILP (val)) + return "-"; + else + return "@"; + } + case 't': /* indicate TEXT or BINARY */ #ifdef MODE_LINE_BINARY_TEXT return MODE_LINE_BINARY_TEXT (b);
--- a/src/xfns.c Mon Jul 23 05:39:31 2007 +0000 +++ b/src/xfns.c Tue Jul 24 01:23:55 2007 +0000 @@ -3717,6 +3717,7 @@ x_catch_errors (dpy); XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), RevertToParent, CurrentTime); + x_ewmh_activate_frame (f); x_uncatch_errors (); UNBLOCK_INPUT;
--- a/src/xterm.c Mon Jul 23 05:39:31 2007 +0000 +++ b/src/xterm.c Tue Jul 24 01:23:55 2007 +0000 @@ -9144,38 +9144,36 @@ } } +/* Activate frame with Extended Window Manager Hints */ + +void +x_ewmh_activate_frame (f) + FRAME_PTR f; +{ + /* See Window Manager Specification/Extended Window Manager Hints at + http://freedesktop.org/wiki/Standards_2fwm_2dspec */ + + const char *atom = "_NET_ACTIVE_WINDOW"; + if (f->async_visible && wm_supports (f, atom)) + { + Lisp_Object frame; + XSETFRAME (frame, f); + Fx_send_client_event (frame, make_number (0), frame, + make_unibyte_string (atom, strlen (atom)), + make_number (32), + Fcons (make_number (1), + Fcons (make_number (last_user_time), + Qnil))); + } +} + static void XTframe_raise_lower (f, raise_flag) FRAME_PTR f; int raise_flag; { if (raise_flag) - { - /* The following code is needed for `raise-frame' to work on - some versions of metacity; see Window Manager - Specification/Extended Window Manager Hints at - http://freedesktop.org/wiki/Standards_2fwm_2dspec */ - -#if 0 - /* However, on other versions (metacity 2.17.2-1.fc7), it - reportedly causes hangs when resizing frames. */ - - const char *atom = "_NET_ACTIVE_WINDOW"; - if (f->async_visible && wm_supports (f, atom)) - { - Lisp_Object frame; - XSETFRAME (frame, f); - Fx_send_client_event (frame, make_number (0), frame, - make_unibyte_string (atom, strlen (atom)), - make_number (32), - Fcons (make_number (1), - Fcons (make_number (last_user_time), - Qnil))); - } - else -#endif - x_raise_frame (f); - } + x_raise_frame (f); else x_lower_frame (f); }
--- a/src/xterm.h Mon Jul 23 05:39:31 2007 +0000 +++ b/src/xterm.h Tue Jul 24 01:23:55 2007 +0000 @@ -999,6 +999,7 @@ extern void x_set_window_size P_ ((struct frame *, int, int, int)); extern void x_set_mouse_position P_ ((struct frame *, int, int)); extern void x_set_mouse_pixel_position P_ ((struct frame *, int, int)); +extern void x_ewmh_activate_frame P_ ((struct frame *)); extern void x_raise_frame P_ ((struct frame *)); extern void x_lower_frame P_ ((struct frame *)); extern void x_make_frame_visible P_ ((struct frame *));