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
This commit is contained in:
commit
d918f936d5
66 changed files with 2861 additions and 1058 deletions
12
etc/NEWS
12
etc/NEWS
|
@ -46,6 +46,8 @@ highlighting, and help echoing in the minibuffer.
|
|||
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 @@ recenter the visited source file. Its value can be a number (for example,
|
|||
|
||||
** 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
|
||||
|
||||
|
|
|
@ -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.
|
||||
|
|
394
lisp/ChangeLog
394
lisp/ChangeLog
|
@ -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)
|
||||
|
|
301
lisp/add-log.el
301
lisp/add-log.el
|
@ -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 @@ Returns function's name as a string, or nil if outside a function."
|
|||
|
||||
;;;###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 @@ use the file's name relative to the directory of the change log file."
|
|||
|
||||
|
||||
(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 @@ use the file's name relative to the directory of the change log file."
|
|||
(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 @@ Optional arg BUFFER-FILE overrides `buffer-file-name'."
|
|||
(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 @@ non-nil, otherwise in local time."
|
|||
(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)))
|
||||
|
||||
;; 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)))
|
||||
(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))))
|
||||
|
||||
;; 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 @@ the change log file in another window."
|
|||
(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 @@ Runs `change-log-mode-hook'.
|
|||
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 @@ Prefix arg means justify as well."
|
|||
(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 @@ Prefix arg means justify as well."
|
|||
|
||||
;;;###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 @@ Has a preference of looking backwards."
|
|||
(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 @@ Has a preference of looking backwards."
|
|||
(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 @@ Has a preference of looking backwards."
|
|||
(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 @@ Has a preference of looking backwards."
|
|||
(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 @@ Has a preference of looking backwards."
|
|||
(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 @@ Point is assumed to be at the start of the entry."
|
|||
|
||||
(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 @@ or a buffer.
|
|||
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 @@ old-style time formats for entries are supported."
|
|||
(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))
|
||||
|
|
|
@ -248,6 +248,22 @@ Normally nil in most modes, since there is no process to display.")
|
|||
|
||||
(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 @@ Keymap to display on minor modes.")
|
|||
(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)
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -155,7 +155,7 @@ when editing big diffs)."
|
|||
("\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 @@ when editing big diffs)."
|
|||
'("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 @@ when editing big diffs)."
|
|||
;; 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 @@ when editing big diffs)."
|
|||
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 @@ If the prefix ARG is given, restrict the view to the current file instead."
|
|||
(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 @@ If the prefix ARG is given, restrict the view to the current file instead."
|
|||
(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 @@ If the OLD prefix arg is passed, tell the file NAME of the old file."
|
|||
(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 @@ PREFIX is only used internally: don't use it."
|
|||
(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 @@ else cover the whole bufer."
|
|||
(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 @@ else cover the whole bufer."
|
|||
(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 @@ else cover the whole bufer."
|
|||
(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 @@ SRC and DST are the two variants of text as returned by `diff-hunk-text'.
|
|||
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 @@ For use in `add-log-current-defun-function'."
|
|||
(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"))
|
||||
|
|
|
@ -109,7 +109,7 @@ When this is `function', only ask when called non-interactively."
|
|||
(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)
|
||||
|
|
|
@ -711,6 +711,28 @@ PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)."
|
|||
((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 @@ asking you for confirmation."
|
|||
mode-line-mule-info
|
||||
mode-line-position
|
||||
mode-line-process
|
||||
mode-line-remote
|
||||
mode-name
|
||||
outline-level
|
||||
overriding-local-map
|
||||
|
|
|
@ -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 @@ of two major techniques:
|
|||
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 @@ To split one large window into two side-by-side windows, the commands
|
|||
`\\[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 @@ Works like `scroll-up' when not in Follow Mode."
|
|||
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 @@ in your `~/.emacs' file:
|
|||
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 @@ Note that this handles the case when the cache has been set to nil."
|
|||
;; 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 @@ Note that this handles the case when the cache has been set to nil."
|
|||
;; 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 @@ Return the selected window."
|
|||
(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 @@ START."
|
|||
(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 @@ non-first windows in Follow Mode."
|
|||
(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 @@ magic stuff before the real process filter is called."
|
|||
"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 @@ report this using the `report-emacs-bug' function."
|
|||
;;{{{ 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.
|
||||
;;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -215,11 +215,11 @@ If nil, a faster, but more primitive, buffer is used instead."
|
|||
(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.
|
||||
|
|
|
@ -162,7 +162,10 @@ This can be either \"inline\" or \"attachment\".")
|
|||
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.
|
||||
|
|
|
@ -869,11 +869,28 @@ displayed."
|
|||
;;;###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 @@ is an alist in the following form:
|
|||
|
||||
(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 @@ is an alist in the following form:
|
|||
|
||||
(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 @@ function. The result is a couple of new files in
|
|||
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 @@ as initial value."
|
|||
|
||||
(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 @@ lets you input a regexp and this will be matched against all tags
|
|||
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 @@ image-dired-file-comment-list:
|
|||
|
||||
(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)
|
||||
|
|
|
@ -164,6 +164,10 @@ is non-nil if the user quit the search.")
|
|||
(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 @@ is treated as a regexp. See \\[isearch-forward] for more info."
|
|||
(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 @@ If first char entered is \\[isearch-yank-word-or-char], then do word search inst
|
|||
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 @@ If first char entered is \\[isearch-yank-word-or-char], then do word search inst
|
|||
(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 @@ If first char entered is \\[isearch-yank-word-or-char], then do word search inst
|
|||
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 @@ If search string is empty, just beep."
|
|||
(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 @@ Can be changed via `isearch-search-fun-function' for special needs."
|
|||
|
||||
(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)))
|
||||
|
|
|
@ -606,8 +606,11 @@ An argument of zero means repeat until error."
|
|||
(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 @@ may be shaded by a local key binding."
|
|||
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 ""))
|
||||
|
|
|
@ -432,12 +432,13 @@ install:
|
|||
# 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"
|
||||
|
||||
|
|
|
@ -1528,7 +1528,7 @@ else
|
|||
$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 @@ for($i = 0; $i < $n; $i++)
|
|||
$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 @@ target of the symlink differ."
|
|||
(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 @@ of."
|
|||
(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 @@ Return ATTR."
|
|||
(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 @@ necessary only. This function will be used in file name completion."
|
|||
(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")))))
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -2207,6 +2207,10 @@ With prefix argument, prompt for cvs flags."
|
|||
(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)))))
|
||||
|
||||
|
|
|
@ -607,7 +607,9 @@ Faces `compilation-error-face', `compilation-warning-face',
|
|||
|
||||
(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 @@ to a function that generates a unique name."
|
|||
(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 @@ If this is run in a Compilation mode buffer, re-use the arguments from the
|
|||
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 @@ Returns the compilation buffer created."
|
|||
(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)
|
||||
|
|
|
@ -325,11 +325,6 @@ Return nil if we cannot, non-nil if we can."
|
|||
(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 @@ Return nil if we cannot, non-nil if we can."
|
|||
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)))))
|
||||
|
|
|
@ -343,6 +343,12 @@ This variable's value takes effect when `grep-compute-defaults' is called.")
|
|||
(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 @@ Set up `compilation-exit-message-function' and run `grep-setup-hook'."
|
|||
|
||||
;;;###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 @@ Set up `compilation-exit-message-function' and run `grep-setup-hook'."
|
|||
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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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 @@ If nil, TAB always indents current line."
|
|||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; 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 @@ This function does not modify point or mark."
|
|||
|
||||
(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."
|
||||
|
|
|
@ -5408,9 +5408,11 @@ XSTART YSTART are the relative position for the first page in a sheet.")
|
|||
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")
|
||||
|
|
|
@ -1408,38 +1408,36 @@ make, or the user didn't cancel the call."
|
|||
(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
|
||||
|
|
11
lisp/ses.el
11
lisp/ses.el
|
@ -1470,17 +1470,22 @@ Narrows the buffer to show only the print area. Gives it `read-only' and
|
|||
(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 ()
|
||||
|
|
215
lisp/simple.el
215
lisp/simple.el
|
@ -1300,55 +1300,61 @@ makes the search case-sensitive."
|
|||
|
||||
(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 @@ Return 0 if current buffer is not a minibuffer."
|
|||
;; 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)
|
||||
|
||||
|
|
|
@ -144,7 +144,7 @@ This is normally copied from `default-directory' when Emacs starts.")
|
|||
("--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)
|
||||
|
|
|
@ -672,7 +672,7 @@ appear on disk when you save the tar-file's buffer."
|
|||
((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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -1331,10 +1331,8 @@ Valid actions are: readable, restore, read, kill, write."
|
|||
(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 @@ Valid actions are: readable, restore, read, kill, write."
|
|||
)
|
||||
(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))))
|
||||
|
||||
|
|
|
@ -249,7 +249,7 @@ Normally set to either `plain-tex-mode' or `latex-mode'."
|
|||
: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 @@ An alternative value is \" . \", if you use a font with a narrow period."
|
|||
(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)
|
||||
|
||||
|
|
|
@ -431,11 +431,17 @@ where
|
|||
(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)
|
||||
|
|
|
@ -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 @@ would have the following buffer names in the various styles:
|
|||
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 @@ would have the following buffer names in the various styles:
|
|||
: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 @@ other buffer names are changed."
|
|||
|
||||
;; 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 @@ visited file name isn't the same as that of the buffer."
|
|||
: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 @@ file name components (default \"\\\")."
|
|||
: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 @@ in `uniquify-list-buffers-directory-modes', otherwise returns nil."
|
|||
(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)))
|
||||
|
|
|
@ -198,16 +198,17 @@ Only the value `maybe' can be trusted :-(."
|
|||
;; 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 @@ Return non-nil if FILE is unchanged."
|
|||
|
||||
(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"))
|
||||
|
|
|
@ -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 @@ Invoke the bzr command adding `BZR_PROGRESS_BAR=none' to the environment."
|
|||
;; 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 @@ Return nil if there isn't one."
|
|||
(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 @@ or a superior directory.")
|
|||
"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 @@ EDITABLE is ignored."
|
|||
(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 @@ EDITABLE is ignored."
|
|||
|
||||
(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
|
||||
|
|
121
lisp/vc-cvs.el
121
lisp/vc-cvs.el
|
@ -258,14 +258,25 @@ See also variable `vc-cvs-sticky-date-format-string'."
|
|||
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 @@ committed and support display of sticky tags."
|
|||
;;; 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 @@ its parents."
|
|||
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 @@ its parents."
|
|||
;; 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 @@ its parents."
|
|||
(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 @@ The changes are between FIRST-VERSION and SECOND-VERSION."
|
|||
;;; 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 @@ If UPDATE is non-nil, then update (resynch) any affected buffers."
|
|||
;;; 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
|
||||
|
|
439
lisp/vc-git.el
Normal file
439
lisp/vc-git.el
Normal file
|
@ -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
|
199
lisp/vc-hg.el
199
lisp/vc-hg.el
|
@ -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 ""))))))
|
||||
|
||||
(defalias 'vc-hg-diff-tree 'vc-hg-diff)
|
||||
(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))))))
|
||||
|
||||
;; 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 @@ Optional arg VERSION is a version to annotate from."
|
|||
(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 @@ Optional arg VERSION is a version to annotate from."
|
|||
(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 @@ COMMENT is ignored."
|
|||
;; "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
|
||||
|
|
167
lisp/vc-hooks.el
167
lisp/vc-hooks.el
|
@ -159,32 +159,36 @@ by these regular expressions."
|
|||
|
||||
(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 @@ The function walks up the directory tree from FILE looking for WITNESS.
|
|||
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 @@ backend is tried first."
|
|||
(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 @@ For registered files, the value returned is one of:
|
|||
;; - `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 @@ Return non-nil if FILE is unchanged."
|
|||
(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 @@ Return non-nil if FILE is unchanged."
|
|||
'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 @@ Before doing that, check if there are any old backups and get rid of them."
|
|||
;; 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 @@ visiting FILE."
|
|||
(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 @@ This function assumes that the file is registered."
|
|||
;; 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 @@ Used in `find-file-not-found-functions'."
|
|||
(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 @@ Used in `find-file-not-found-functions'."
|
|||
(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 @@ Used in `find-file-not-found-functions'."
|
|||
(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 @@ Used in `find-file-not-found-functions'."
|
|||
;;(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)))
|
||||
|
|
|
@ -109,6 +109,11 @@ This is only meaningful if you don't use the implicit checkout model
|
|||
:version "22.1"
|
||||
:group 'vc)
|
||||
|
||||
;;; Properties of the backend
|
||||
|
||||
(defun vc-mcvs-revision-granularity ()
|
||||
'file)
|
||||
|
||||
;;;
|
||||
;;; State-querying functions
|
||||
;;;
|
||||
|
@ -202,13 +207,16 @@ This is only meaningful if you don't use the implicit checkout model
|
|||
;;; 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 @@ the Meta-CVS command (in that order)."
|
|||
"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 is only possible if Meta-CVS is responsible for FILE's directory.")
|
|||
;; 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 @@ This is only possible if Meta-CVS is responsible for FILE's directory.")
|
|||
;; 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 @@ This is only possible if Meta-CVS is responsible for FILE's directory.")
|
|||
(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 @@ The changes are between FIRST-VERSION and SECOND-VERSION."
|
|||
;;; 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."
|
||||
|
|
218
lisp/vc-rcs.el
218
lisp/vc-rcs.el
|
@ -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 @@ For a description of possible values, see `vc-check-master-templates'."
|
|||
:group 'vc)
|
||||
|
||||
|
||||
;;; Properties of the backend
|
||||
|
||||
(defun vc-rcs-revision-granularity ()
|
||||
'file)
|
||||
|
||||
;;;
|
||||
;;; State-querying functions
|
||||
;;;
|
||||
|
@ -230,17 +239,23 @@ When VERSION is given, perform check for that version."
|
|||
;;; 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 @@ expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile."
|
|||
(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 @@ whether to remove it."
|
|||
(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 @@ whether to remove it."
|
|||
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 @@ Needs RCS 5.6.2 or later for -M."
|
|||
;;; 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 @@ Optional arg REVISION is a revision to annotate from."
|
|||
" "
|
||||
(aref rda 0)
|
||||
ls)
|
||||
:vc-annotate-prefix t
|
||||
:vc-rcs-r/d/a rda)))
|
||||
(maphash
|
||||
(if all-me
|
||||
|
|
|
@ -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 @@ For a description of possible values, see `vc-check-master-templates'."
|
|||
(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 @@ For a description of possible values, see `vc-check-master-templates'."
|
|||
;;; 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 @@ expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile."
|
|||
(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 @@ expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile."
|
|||
(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 @@ locked. REV is the revision to check out."
|
|||
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 @@ locked. REV is the revision to check out."
|
|||
;; 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 @@ EDITABLE non-nil means previous version should be locked."
|
|||
;;; 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 @@ EDITABLE non-nil means previous version should be locked."
|
|||
(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)))
|
||||
|
|
|
@ -96,6 +96,10 @@ If you want to force an empty list of arguments, use t."
|
|||
(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 @@ If you want to force an empty list of arguments, use t."
|
|||
;;; 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 @@ the SVN command (in that order)."
|
|||
"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 @@ This is only possible if SVN is responsible for FILE's directory.")
|
|||
;; 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 @@ This is only possible if SVN is responsible for FILE's directory.")
|
|||
))
|
||||
|
||||
(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 @@ The changes are between FIRST-VERSION and SECOND-VERSION."
|
|||
;;; 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 @@ The changes are between FIRST-VERSION and SECOND-VERSION."
|
|||
(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 @@ NAME is assumed to be a URL."
|
|||
: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
|
||||
|
|
261
lisp/vc.el
261
lisp/vc.el
|
@ -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 ()
|
||||
;;
|
||||
;; Register FILE in this backend. Optionally, an initial revision REV
|
||||
;; and an initial description of the file, COMMENT, may be specified.
|
||||
;; 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 (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 @@ These are passed to the checkin program by \\[vc-register]."
|
|||
: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 @@ to use -L and sets this variable to remember whether it worked."
|
|||
: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 @@ Else, add CODE to the process' sentinel."
|
|||
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 @@ already current, set it up properly and erase it. The command is
|
|||
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 @@ If VERBOSE is non-nil, query the user rather than using default parameters."
|
|||
;; 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 @@ first backend that could register the file is used."
|
|||
(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 is to return nil always."
|
|||
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 @@ Runs the normal hook `vc-checkin-hook'."
|
|||
;; 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 @@ actually call the backend, but performs a local diff."
|
|||
(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 @@ If FOCUS-REV is non-nil, leave the point at that revision."
|
|||
;; 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 @@ If FOCUS-REV is non-nil, leave the point at that revision."
|
|||
(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 @@ If FOCUS-REV is non-nil, leave the point at that revision."
|
|||
"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 @@ it if their logs are not in RCS format."
|
|||
(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 @@ the current branch are merged into the working file."
|
|||
(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 @@ return its name; otherwise return nil."
|
|||
(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 @@ A prefix argument NOREVERT means do not revert the buffer afterwards."
|
|||
(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 @@ The annotations are relative to the current time, unless overridden by OFFSET."
|
|||
(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 @@ Invoke FUNC f ARGS on each VC-managed file f underneath it."
|
|||
(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)
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -1760,10 +1760,10 @@ When @code{defface} executes, it defines the face according to
|
|||
@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
|
||||
|
|
|
@ -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
|
||||
|
|
116
man/files.texi
116
man/files.texi
|
@ -1258,11 +1258,32 @@ this section if you are already familiar with the version control system
|
|||
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 @@ After you are done with a set of changes, you @dfn{check the file in},
|
|||
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.
|
||||
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 and version control
|
||||
@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.
|
||||
to lock the file to make further changes.
|
||||
|
||||
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.
|
||||
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.
|
||||
|
||||
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.
|
||||
@iftex
|
||||
(@pxref{CVS Options,,,emacs-xtra, Specialized Emacs Features}).
|
||||
@end iftex
|
||||
|
|
|
@ -197,7 +197,7 @@ more information.
|
|||
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 @@ been edited (the buffer is ``modified''), or @samp{--} if the buffer has
|
|||
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}.
|
||||
|
||||
|
|
169
man/tramp.texi
169
man/tramp.texi
|
@ -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 @@ repository. Being part of the GNU Emacs repository happened in June
|
|||
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 @@ implementation of @command{ssh}. Or you use Kerberos and thus like
|
|||
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 @@ If you, for example, use @value{tramp} mainly to contact the host
|
|||
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 @@ rule:
|
|||
(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 @@ non-local access, you might add the following rule:
|
|||
|
||||
@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 @@ following rule:
|
|||
@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 @@ minute you have already forgotten that you hit that key!
|
|||
@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 @@ need to log in as a different user, you can specify the user name as
|
|||
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 @@ If you, for example, type @kbd{C-x C-f @value{prefix}t
|
|||
|
||||
@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 @@ Next @kbd{@key{TAB}} brings you all machine names @value{tramp} detects in
|
|||
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 @@ that filename part starts with @file{//}.
|
|||
@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 @@ After you have started @code{eshell}, you could perform commands like
|
|||
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 @@ remote hosts. You can call @code{gdb} with a remote file name:
|
|||
|
||||
@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 @@ remote host.
|
|||
@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 @@ should put it into your @file{~/.emacs}:
|
|||
(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 @@ should put it into your @file{~/.emacs}:
|
|||
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 @@ You can define default methods and user names for hosts,
|
|||
@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 @@ Host xy
|
|||
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 @@ C-@key{TAB}} in the minibuffer. The completion is done for the given
|
|||
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}?
|
||||
|
|
|
@ -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}
|
||||
|
|
|
@ -590,10 +590,10 @@ headers.
|
|||
@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
|
||||
|
|
|
@ -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>
|
||||
|
||||
|
|
|
@ -5517,6 +5517,8 @@ A string is printed verbatim in the mode line except for %-constructs:
|
|||
%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.
|
||||
|
|
|
@ -8400,7 +8400,7 @@ contents (not yet decoded). If `file-coding-system-alist' specifies a
|
|||
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;
|
||||
|
|
|
@ -1440,7 +1440,7 @@ More generally, you can use multiple variables and values, as in
|
|||
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 @@ DEFUN ("zerop", Fzerop, Szerop, 1, 1, 0,
|
|||
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)
|
||||
|
|
|
@ -330,7 +330,7 @@ DEFUN ("or", For, Sor, 0, UNEVALLED, 0,
|
|||
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 @@ DEFUN ("and", Fand, Sand, 0, UNEVALLED, 0,
|
|||
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 @@ Thus, (setq x (1+ y)) sets `x' to the value of `(1+ y)'.
|
|||
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;
|
||||
{
|
||||
|
|
|
@ -591,6 +591,13 @@ sys_wait (int *status)
|
|||
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 @@ w32_executable_type (char * filename, int * is_dos_app, int * is_cygnus_app, int
|
|||
}
|
||||
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;
|
||||
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;
|
||||
|
||||
section = rva_to_section (import_dir.VirtualAddress, nt_header);
|
||||
imports = RVA_TO_PTR (import_dir.VirtualAddress, section, executable);
|
||||
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);
|
||||
|
||||
/* 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;
|
||||
}
|
||||
}
|
||||
|
||||
/* 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;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
@ -7602,4 +7602,4 @@ keys_of_window ()
|
|||
}
|
||||
|
||||
/* arch-tag: 90a9c576-0590-48f1-a5f1-6c96a0452d9f
|
||||
(do not change thisc omment) */
|
||||
(do not change this comment) */
|
||||
|
|
10
src/xdisp.c
10
src/xdisp.c
|
@ -18144,6 +18144,16 @@ decode_mode_spec (w, c, field_width, precision, multibyte)
|
|||
#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);
|
||||
|
|
|
@ -3717,6 +3717,7 @@ FRAME nil means use the selected frame. */)
|
|||
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;
|
||||
|
||||
|
|
50
src/xterm.c
50
src/xterm.c
|
@ -9144,38 +9144,36 @@ x_lower_frame (f)
|
|||
}
|
||||
}
|
||||
|
||||
/* 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);
|
||||
}
|
||||
|
|
|
@ -999,6 +999,7 @@ extern void x_fully_uncatch_errors P_ ((void));
|
|||
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 *));
|
||||
|
|
Loading…
Add table
Reference in a new issue