summaryrefslogtreecommitdiff
path: root/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog113
-rw-r--r--lisp/bindings.el20
-rw-r--r--lisp/bs.el3
-rw-r--r--lisp/diff-mode.el89
-rw-r--r--lisp/doc-view.el22
-rw-r--r--lisp/emacs-lisp/easy-mmode.el62
-rw-r--r--lisp/emulation/edt.el6
-rw-r--r--lisp/emulation/vi.el6
-rw-r--r--lisp/follow.el39
-rw-r--r--lisp/font-core.el13
-rw-r--r--lisp/gnus/ChangeLog5
-rw-r--r--lisp/gnus/nnmail.el6
-rw-r--r--lisp/help-fns.el11
-rw-r--r--lisp/loadhist.el156
-rw-r--r--lisp/mouse.el20
-rw-r--r--lisp/obsolete/mlsupport.el4
-rw-r--r--lisp/progmodes/ada-xref.el6
-rw-r--r--lisp/progmodes/etags.el8
-rw-r--r--lisp/progmodes/idlw-shell.el2
-rw-r--r--lisp/progmodes/prolog.el14
-rw-r--r--lisp/smerge-mode.el173
-rw-r--r--lisp/textmodes/bib-mode.el4
-rw-r--r--lisp/textmodes/two-column.el4
-rw-r--r--lisp/vc-arch.el6
-rw-r--r--lisp/vc-bzr.el1
-rw-r--r--lisp/vc-cvs.el6
-rw-r--r--lisp/vc-git.el15
-rw-r--r--lisp/vc-hg.el16
-rw-r--r--lisp/vc-mcvs.el13
-rw-r--r--lisp/vc-mtn.el6
-rw-r--r--lisp/vc-svn.el4
-rw-r--r--lisp/vc.el380
32 files changed, 720 insertions, 513 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 4fe538b3bd4..ab50949e639 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,108 @@
+2007-10-19 Juanma Barranquero <lekktu@gmail.com>
+
+ * bs.el (bs--track-window-changes): Don't refresh the whole list.
+ (bs-mode): Set mode-class property to special.
+
+2007-10-20 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * emacs-lisp/easy-mmode.el (easy-mmode-define-navigation):
+ Add `body' arg. Cleanup the check-narrow-maybe/re-narrow-maybe mess.
+
+ * vc-bzr.el (vc-bzr-diff-tree):
+ * vc-git.el (vc-git-diff-tree):
+ * vc-hg.el (vc-hg-diff-tree):
+ * vc-mcvs.el (vc-mcvs-diff-tree):
+ * vc-mtn.el (vc-mtn-diff-tree):
+ * vc-svn.el (vc-svn-diff-tree): Remove.
+
+ * vc-mtn.el (vc-mtn-revision-completion-table):
+ * vc-cvs.el (vc-cvs-revision-completion-table):
+ * vc-arch.el (vc-arch-revision-completion-table):
+ * vc-hg.el (vc-hg-revision-completion-table, vc-hg-revision-table):
+ * vc-git.el (vc-git-revision-completion-table, vc-git-revision-table):
+ Make it work when the arg is a list of files.
+
+2007-10-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * vc.el: Remove `diff-tree' operation, now subsumed by `diff'.
+ Also `revision-completion-table' now takes a list of files.
+ (vc-deduce-fileset): Remove unused var `regexp'.
+ Only obey allow-directory-wildcard in dired buffers.
+ (vc-default-diff-tree): Remove.
+ (vc-diff-added-files): New var.
+ (vc-diff-internal): Use it. Remove arg `backend'. Update callers.
+ (vc-version-diff): Revert from `vc-history-diff' to the original name.
+ Remove the `backend' arg.
+ (vc-contains-version-controlled-file): Remove.
+ (vc-diff): Bring it closer to the version in Emacs-22.
+ (vc-revert): Fix typo in let-binding.
+ (vc-default-unregister): Remove.
+ (vc-dired-buffers-for-dir): Remove N^2 behavior.
+
+2007-10-19 Dan Nicolaescu <dann@ics.uci.edu>
+
+ * textmodes/two-column.el (2C-split, 2C-merge):
+ * textmodes/bib-mode.el (bib-find-key, mark-bib):
+ * progmodes/idlw-shell.el (idlwave-shell-move-or-history):
+ * progmodes/etags.el (find-tag-in-order, etags-tags-apropos)
+ * progmodes/ada-xref.el (ada-get-all-references):
+ * obsolete/mlsupport.el (ml-next-line, ml-previous-line):
+ * emulation/vi.el (vi-previous-line-first-nonwhite)
+ (vi-effective-range, vi-put-before):
+ * emulation/edt.el (edt-next-line, edt-previous-line)
+ (edt-paragraph-forward): Use forward-line.
+
+ * progmodes/etags.el (tags-apropos): Require apropos at compile
+ time too.
+
+ * progmodes/prolog.el: Require comint when compiling.
+ (inferior-prolog-flavor): Move defvar before use.
+
+2007-10-19 Richard Stallman <rms@gnu.org>
+
+ * font-core.el (turn-on-font-lock-if-desired):
+ Rename from `turn-on-font-lock-if-enabled'.
+ Fully obey `font-lock-global-modes'.
+
+2007-10-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * diff-mode.el (diff-fine-highlight-preproc): Stick to minimal changes
+ which will not affect the behavior of things like forward-word.
+ (diff-fine-highlight): Preserve point.
+
+ * doc-view.el (doc-view-mode-map): Use remapping.
+ Don't rebind C-v, M-v to their default value.
+ Don't bind mouse-4 and mouse-5: it's mwheel.el's job.
+
+ * smerge-mode.el: Add word-granularity refinement.
+ (smerge-refine-forward-function, smerge-refine-ignore-whitespace)
+ (smerge-refine-weight-hack): New vars.
+ (smerge-refine-forward): New fun.
+ (smerge-refine-chopup-region, smerge-refine-highlight-change): Use them.
+ (smerge-refine-subst): Use them as well. Preserve point.
+
+2007-10-19 Juanma Barranquero <lekktu@gmail.com>
+
+ * follow.el (follow-unload-function): New function.
+
+ * loadhist.el (unload-function-features-list):
+ Rename from `unload-hook-features-list'.
+ (unload-hook-features-list): Add as obsolete alias.
+ (unload-feature): Use `unload-function-features-list'
+ and new FEATURE-unload-function.
+
+2007-10-19 Glenn Morris <rgm@gnu.org>
+
+ * bindings.el (mouse-minor-mode-menu)
+ (minor-mode-menu-from-indicator): Move to mouse.el.
+ * mouse.el (mouse-minor-mode-menu, minor-mode-menu-from-indicator):
+ Move here from bindings.el.
+
+2007-10-19 Richard Stallman <rms@gnu.org>
+
+ * help-fns.el (describe-function-1): Don't use the advice origname
+ if it has no function definition.
+
2007-10-18 Johan Bockg,Ae(Brd <bojohan@gnu.org>
* net/tramp.el (tramp-rfn-eshadow-update-overlay): Save excursion.
@@ -23,10 +128,10 @@
* doc-view.el (doc-view-dvi->pdf-sentinel, doc-view-dvi->pdf)
(doc-view-pdf/ps->png-sentinel, doc-view-pdf/ps->png)
(doc-view-pdf->txt-sentinel, doc-view-pdf->txt)
- (doc-view-ps->pdf-sentinel, doc-view-ps->pdf): Remove superfluous
- messages.
- (doc-view-mode-map): Use the image-mode scrolling commands. Don't
- rebind C-x k.
+ (doc-view-ps->pdf-sentinel, doc-view-ps->pdf):
+ Remove superfluous messages.
+ (doc-view-mode-map): Use the image-mode scrolling commands.
+ Don't rebind C-x k.
2007-10-18 Reiner Steib <Reiner.Steib@gmx.de>
diff --git a/lisp/bindings.el b/lisp/bindings.el
index 19819c15d60..1bc31e04bb9 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -493,26 +493,6 @@ Menu of mode operations in the mode line.")
(interactive "@e")
(x-popup-menu event mode-line-mode-menu))
-(defun mouse-minor-mode-menu (event)
- "Show minor-mode menu for EVENT on minor modes area of the mode line."
- (interactive "@e")
- (let ((indicator (car (nth 4 (car (cdr event))))))
- (minor-mode-menu-from-indicator indicator)))
-
-(defun minor-mode-menu-from-indicator (indicator)
- "Show menu, if any, for minor mode specified by INDICATOR.
-Interactively, INDICATOR is read using completion."
- (interactive (list (completing-read "Minor mode indicator: "
- (describe-minor-mode-completion-table-for-indicator))))
- (let ((minor-mode (lookup-minor-mode-from-indicator indicator)))
- (if minor-mode
- (let* ((map (cdr-safe (assq minor-mode minor-mode-map-alist)))
- (menu (and (keymapp map) (lookup-key map [menu-bar]))))
- (if menu
- (popup-menu menu)
- (message "No menu for minor mode `%s'" minor-mode)))
- (error "Cannot find minor mode for `%s'" indicator))))
-
(defun mode-line-minor-mode-help (event)
"Describe minor mode for EVENT on minor modes area of the mode line."
(interactive "@e")
diff --git a/lisp/bs.el b/lisp/bs.el
index bb2dbae83c0..105e5702bcc 100644
--- a/lisp/bs.el
+++ b/lisp/bs.el
@@ -612,7 +612,6 @@ Used from `window-size-change-functions'."
(let ((win (get-buffer-window "*buffer-selection*" frame)))
(when win
(with-selected-window win
- (bs-refresh)
(bs--set-window-height)))))
(defun bs--remove-hooks ()
@@ -622,6 +621,8 @@ Used from `window-size-change-functions'."
(remove-hook 'kill-buffer-hook 'bs--remove-hooks t)
(remove-hook 'change-major-mode-hook 'bs--remove-hooks t))
+(put 'bs-mode 'mode-class 'special)
+
(define-derived-mode bs-mode nil "Buffer-Selection-Menu"
"Major mode for editing a subset of Emacs' buffers.
\\<bs-mode-map>
diff --git a/lisp/diff-mode.el b/lisp/diff-mode.el
index 894a12b1193..972e7972e75 100644
--- a/lisp/diff-mode.el
+++ b/lisp/diff-mode.el
@@ -1657,54 +1657,57 @@ For use in `add-log-current-defun-function'."
:group 'diff-mode)
(defun diff-fine-highlight-preproc ()
- (while (re-search-forward "^." nil t)
- ;; Replace the hunk's leading prefix (+, -, !, <, or >) on each line
- ;; with something constant, otherwise it'll be flagged as changes
- ;; (since it's typically "-" on one side and "+" on the other).
- ;; Note that we keep the same number of chars: we treat the prefix
- ;; as part of the texts-to-diff, so that finding the right char
- ;; afterwards will be easier. This only makes sense because we make
- ;; diffs at char-granularity.
- (replace-match " ")))
+ (while (re-search-forward "^[+>]" nil t)
+ ;; Remove spurious changes due to the fact that one side of the hunk is
+ ;; marked with leading + or > and the other with leading - or <.
+ ;; We used to replace all the prefix chars with " " but this only worked
+ ;; when we did char-based refinement (or when using
+ ;; smerge-refine-weight-hack) since otherwise, the `forward' motion done
+ ;; in chopup do not necessarily do the same as the ones in highlight
+ ;; since the "_" is not treated the same as " ".
+ (replace-match (cdr (assq (char-before) '((?+ . "-") (?> . "<"))))))
+ )
(defun diff-fine-highlight ()
"Highlight changes of hunk at point at a finer granularity."
(interactive)
(require 'smerge-mode)
- (diff-beginning-of-hunk 'try-harder)
- (let* ((style (diff-hunk-style)) ;Skips the hunk header as well.
- (beg (point))
- (props '((diff-mode . fine) (face diff-fine-change)))
- (end (progn (diff-end-of-hunk) (point))))
-
- (remove-overlays beg end 'diff-mode 'fine)
-
- (goto-char beg)
- (case style
- (unified
- (while (re-search-forward "^\\(?:-.*\n\\)+\\(\\)\\(?:\\+.*\n\\)+" end t)
- (smerge-refine-subst (match-beginning 0) (match-end 1)
- (match-end 1) (match-end 0)
- props 'diff-fine-highlight-preproc)))
- (context
- (let* ((middle (save-excursion (re-search-forward "^---")))
- (other middle))
- (while (re-search-forward "^\\(?:!.*\n\\)+" middle t)
- (smerge-refine-subst (match-beginning 0) (match-end 0)
- (save-excursion
- (goto-char other)
- (re-search-forward "^\\(?:!.*\n\\)+" end)
- (setq other (match-end 0))
- (match-beginning 0))
- other
- props 'diff-fine-highlight-preproc))))
- (t ;; Normal diffs.
- (let ((beg1 (1+ (point))))
- (when (re-search-forward "^---.*\n" end t)
- ;; It's a combined add&remove, so there's something to do.
- (smerge-refine-subst beg1 (match-beginning 0)
- (match-end 0) end
- props 'diff-fine-highlight-preproc)))))))
+ (save-excursion
+ (diff-beginning-of-hunk 'try-harder)
+ (let* ((style (diff-hunk-style)) ;Skips the hunk header as well.
+ (beg (point))
+ (props '((diff-mode . fine) (face diff-fine-change)))
+ (end (progn (diff-end-of-hunk) (point))))
+
+ (remove-overlays beg end 'diff-mode 'fine)
+
+ (goto-char beg)
+ (case style
+ (unified
+ (while (re-search-forward "^\\(?:-.*\n\\)+\\(\\)\\(?:\\+.*\n\\)+"
+ end t)
+ (smerge-refine-subst (match-beginning 0) (match-end 1)
+ (match-end 1) (match-end 0)
+ props 'diff-fine-highlight-preproc)))
+ (context
+ (let* ((middle (save-excursion (re-search-forward "^---")))
+ (other middle))
+ (while (re-search-forward "^\\(?:!.*\n\\)+" middle t)
+ (smerge-refine-subst (match-beginning 0) (match-end 0)
+ (save-excursion
+ (goto-char other)
+ (re-search-forward "^\\(?:!.*\n\\)+" end)
+ (setq other (match-end 0))
+ (match-beginning 0))
+ other
+ props 'diff-fine-highlight-preproc))))
+ (t ;; Normal diffs.
+ (let ((beg1 (1+ (point))))
+ (when (re-search-forward "^---.*\n" end t)
+ ;; It's a combined add&remove, so there's something to do.
+ (smerge-refine-subst beg1 (match-beginning 0)
+ (match-end 0) end
+ props 'diff-fine-highlight-preproc))))))))
;; provide the package
diff --git a/lisp/doc-view.el b/lisp/doc-view.el
index d93a8ca316d..b6d8235a02b 100644
--- a/lisp/doc-view.el
+++ b/lisp/doc-view.el
@@ -212,8 +212,10 @@ has finished."
;; Navigation in the document
(define-key map (kbd "n") 'doc-view-next-page)
(define-key map (kbd "p") 'doc-view-previous-page)
- (define-key map (kbd "<next>") 'doc-view-next-page)
- (define-key map (kbd "<prior>") 'doc-view-previous-page)
+ (define-key map (kbd "<next>") 'forward-page)
+ (define-key map (kbd "<prior>") 'backward-page)
+ (define-key map [remap forward-page] 'doc-view-next-page)
+ (define-key map [remap backward-page] 'doc-view-previous-page)
(define-key map (kbd "SPC") 'doc-view-scroll-up-or-next-page)
(define-key map (kbd "DEL") 'doc-view-scroll-down-or-previous-page)
(define-key map (kbd "M-<") 'doc-view-first-page)
@@ -232,18 +234,10 @@ has finished."
(define-key map (kbd "C-S-n") 'doc-view-search-next-match)
(define-key map (kbd "C-S-p") 'doc-view-search-previous-match)
;; Scrolling
- (define-key map (kbd "<right>") 'image-forward-hscroll)
- (define-key map (kbd "<left>") 'image-backward-hscroll)
- (define-key map (kbd "<down>") 'image-next-line)
- (define-key map (kbd "<up>") 'image-previous-line)
- (define-key map (kbd "C-f") 'image-forward-hscroll)
- (define-key map (kbd "C-b") 'image-backward-hscroll)
- (define-key map (kbd "C-n") 'image-next-line)
- (define-key map (kbd "C-p") 'image-previous-line)
- (define-key map (kbd "C-v") 'scroll-up)
- (define-key map (kbd "<mouse-4>") 'mwheel-scroll)
- (define-key map (kbd "<mouse-5>") 'mwheel-scroll)
- (define-key map (kbd "M-v") 'scroll-down)
+ (define-key map [remap forward-char] 'image-forward-hscroll)
+ (define-key map [remap backward-char] 'image-backward-hscroll)
+ (define-key map [remap next-line] 'image-next-line)
+ (define-key map [remap previous-line] 'image-previous-line)
;; Show the tooltip
(define-key map (kbd "C-t") 'doc-view-show-tooltip)
;; Toggle between text and image display or editing
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index da0b76808d5..d3d9e5fdca0 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -478,7 +478,8 @@ CSS contains a list of syntax specifications of the form (CHAR . SYNTAX)."
;;; easy-mmode-define-navigation
;;;
-(defmacro easy-mmode-define-navigation (base re &optional name endfun narrowfun)
+(defmacro easy-mmode-define-navigation (base re &optional name endfun narrowfun
+ &rest body)
"Define BASE-next and BASE-prev to navigate in the buffer.
RE determines the places the commands should move point to.
NAME should describe the entities matched by RE. It is used to build
@@ -488,17 +489,20 @@ BASE-next also tries to make sure that the whole entry is visible by
the next entry) and recentering if necessary.
ENDFUN should return the end position (with or without moving point).
NARROWFUN non-nil means to check for narrowing before moving, and if
-found, do `widen' first and then call NARROWFUN with no args after moving."
+found, do `widen' first and then call NARROWFUN with no args after moving.
+BODY is executed after moving to the destination location."
+ (declare (indent 5) (debug (exp exp exp def-form def-form &rest def-body)))
(let* ((base-name (symbol-name base))
(prev-sym (intern (concat base-name "-prev")))
(next-sym (intern (concat base-name "-next")))
- (check-narrow-maybe
- (when narrowfun
- '(setq was-narrowed
- (prog1 (or (< (- (point-max) (point-min)) (buffer-size)))
- (widen)))))
- (re-narrow-maybe (when narrowfun
- `(when was-narrowed (,narrowfun)))))
+ (when-narrowed
+ (lambda (body)
+ (if (null narrowfun) body
+ `(let ((was-narrowed
+ (prog1 (or (< (- (point-max) (point-min)) (buffer-size)))
+ (widen))))
+ ,body
+ (when was-narrowed (,narrowfun)))))))
(unless name (setq name base-name))
`(progn
(add-to-list 'debug-ignored-errors
@@ -509,33 +513,31 @@ found, do `widen' first and then call NARROWFUN with no args after moving."
(unless count (setq count 1))
(if (< count 0) (,prev-sym (- count))
(if (looking-at ,re) (setq count (1+ count)))
- (let (was-narrowed)
- ,check-narrow-maybe
- (if (not (re-search-forward ,re nil t count))
- (if (looking-at ,re)
- (goto-char (or ,(if endfun `(,endfun)) (point-max)))
- (error "No next %s" ,name))
- (goto-char (match-beginning 0))
- (when (and (eq (current-buffer) (window-buffer (selected-window)))
- (interactive-p))
- (let ((endpt (or (save-excursion
- ,(if endfun `(,endfun)
- `(re-search-forward ,re nil t 2)))
- (point-max))))
- (unless (pos-visible-in-window-p endpt nil t)
- (recenter '(0))))))
- ,re-narrow-maybe)))
+ ,(funcall when-narrowed
+ `(if (not (re-search-forward ,re nil t count))
+ (if (looking-at ,re)
+ (goto-char (or ,(if endfun `(,endfun)) (point-max)))
+ (error "No next %s" ,name))
+ (goto-char (match-beginning 0))
+ (when (and (eq (current-buffer) (window-buffer (selected-window)))
+ (interactive-p))
+ (let ((endpt (or (save-excursion
+ ,(if endfun `(,endfun)
+ `(re-search-forward ,re nil t 2)))
+ (point-max))))
+ (unless (pos-visible-in-window-p endpt nil t)
+ (recenter '(0)))))))
+ ,@body))
(put ',next-sym 'definition-name ',base)
(defun ,prev-sym (&optional count)
,(format "Go to the previous COUNT'th %s" (or name base-name))
(interactive "p")
(unless count (setq count 1))
(if (< count 0) (,next-sym (- count))
- (let (was-narrowed)
- ,check-narrow-maybe
- (unless (re-search-backward ,re nil t count)
- (error "No previous %s" ,name))
- ,re-narrow-maybe)))
+ ,(funcall when-narrowed
+ `(unless (re-search-backward ,re nil t count)
+ (error "No previous %s" ,name)))
+ ,@body))
(put ',prev-sym 'definition-name ',base))))
diff --git a/lisp/emulation/edt.el b/lisp/emulation/edt.el
index 44067dba1f2..bff1a583586 100644
--- a/lisp/emulation/edt.el
+++ b/lisp/emulation/edt.el
@@ -649,7 +649,7 @@ Argument NUM is the number of lines to move."
(interactive "p")
(edt-check-prefix num)
(let ((beg (edt-current-line)))
- (next-line num)
+ (forward-line num)
(edt-bottom-check beg num))
(if edt-x-emacs19-p (setq zmacs-region-stays t)))
@@ -659,7 +659,7 @@ Argument NUM is the number of lines to move."
(interactive "p")
(edt-check-prefix num)
(let ((beg (edt-current-line)))
- (previous-line num)
+ (forward-line (- num))
(edt-top-check beg num))
(if edt-x-emacs19-p (setq zmacs-region-stays t)))
@@ -1426,7 +1426,7 @@ Argument NUM is the positive number of paragraphs to move."
(forward-paragraph (+ num 1))
(start-of-paragraph-text)
(if (eolp)
- (next-line 1))
+ (forward-line 1))
(setq num (1- num)))
(cond((> (point) far)
(setq left (save-excursion (forward-line height)))
diff --git a/lisp/emulation/vi.el b/lisp/emulation/vi.el
index 977a7980803..81ad04b60d9 100644
--- a/lisp/emulation/vi.el
+++ b/lisp/emulation/vi.el
@@ -801,7 +801,7 @@ The given COUNT is remembered for future scrollings."
(defun vi-previous-line-first-nonwhite (count)
"Go up COUNT lines. Stop at first non-white."
(interactive "p")
- (previous-line count)
+ (forward-line (- count))
(back-to-indentation))
(defun vi-scroll-up-window (count)
@@ -1062,7 +1062,7 @@ MOTION-COMMAND with ARG.
(setq end (1+ end)))
((eq moving-unit 'line)
(goto-char begin) (beginning-of-line) (setq begin (point))
- (goto-char end) (next-line 1) (beginning-of-line) (setq end (point))))
+ (goto-char end) (forward-line 1) (beginning-of-line) (setq end (point))))
(if (> end (point-max)) (setq end (point-max))) ; force in buffer region
(cons begin end)))))
@@ -1124,7 +1124,7 @@ text as lines. If the optional after-p is given, put after/below the cursor."
(t (error "Register %c is not containing text string" reg))))
(if (vi-string-end-with-nl-p put-text) ; put back text as lines
(if after-p
- (progn (next-line 1) (beginning-of-line))
+ (progn (forward-line 1) (beginning-of-line))
(beginning-of-line))
(if after-p (forward-char 1)))
(push-mark (point))
diff --git a/lisp/follow.el b/lisp/follow.el
index 55a331a22d3..50760cd9909 100644
--- a/lisp/follow.el
+++ b/lisp/follow.el
@@ -712,7 +712,7 @@ in your `~/.emacs' file:
;;}}}
;;{{{ Movement
-;; Note, these functions are not very useful, atleast not unless you
+;; Note, these functions are not very useful, at least not unless you
;; rebind the rather cumbersome key sequence `C-c . p'.
(defun follow-next-window ()
@@ -1267,7 +1267,7 @@ position of the first window. Otherwise it is a good guess."
(let ((done nil)
win-start
res)
- ;; Always calculate what happend when no line is displayed in the first
+ ;; Always calculate what happens when no line is displayed in the first
;; window. (The `previous' res is needed below!)
(goto-char guess)
(vertical-motion 0 (car windows))
@@ -1508,9 +1508,9 @@ non-first windows in Follow mode."
(setq win-start-end (follow-windows-start-end windows))
(follow-invalidate-cache)
;; When the point ends up in another window. This
- ;; happends when dest is in the beginning of the
+ ;; happens when dest is in the beginning of the
;; file and the selected window is not the first.
- ;; It can also, in rare situations happend when
+ ;; It can also, in rare situations happen when
;; long lines are used and there is a big
;; difference between the width of the windows.
;; (When scrolling one line in a wide window which
@@ -2162,6 +2162,37 @@ This prevents `mouse-drag-region' from messing things up."
;;{{{ The end
+(defun follow-unload-function ()
+ (easy-menu-remove-item nil '("Tools") "Follow")
+ (follow-stop-intercept-process-output)
+ (dolist (group '((before
+ ;; XEmacs
+ isearch-done
+ ;; both
+ set-process-filter sit-for move-overlay)
+ (after
+ ;; Emacs
+ scroll-bar-drag scroll-bar-drag-1 scroll-bar-scroll-down
+ scroll-bar-scroll-up scroll-bar-set-window-start
+ ;; XEmacs
+ scrollbar-line-down scrollbar-line-up scrollbar-page-down
+ scrollbar-page-up scrollbar-to-bottom scrollbar-to-top
+ scrollbar-vertical-drag
+ ;; both
+ process-filter)))
+ (let ((class (car group)))
+ (dolist (fun (cdr group))
+ (when (functionp fun)
+ (condition-case nil
+ (progn
+ (ad-remove-advice fun class
+ (intern (concat "follow-" (symbol-name fun))))
+ (ad-update fun))
+ (error nil))))))
+ nil)
+
+(defvar follow-unload-function 'follow-unload-function)
+
;;
;; We're done!
;;
diff --git a/lisp/font-core.el b/lisp/font-core.el
index 7d7a65e83cc..b97550d2693 100644
--- a/lisp/font-core.el
+++ b/lisp/font-core.el
@@ -234,7 +234,7 @@ this function onto `change-major-mode-hook'."
;; hook is run, the major mode is in the process of being changed and we do not
;; know what the final major mode will be. So, `font-lock-change-major-mode'
;; only (a) notes the name of the current buffer, and (b) adds our function
-;; `turn-on-font-lock-if-enabled' to the hook variables
+;; `turn-on-font-lock-if-desired' to the hook variables
;; `after-change-major-mode-hook' and `post-command-hook' (for modes
;; that do not yet run `after-change-major-mode-hook'). By the time
;; the functions on the first of these hooks to be run are run, the new major
@@ -281,14 +281,17 @@ means that Font Lock mode is turned on for buffers in C and C++ modes only."
(repeat :inline t (symbol :tag "mode"))))
:group 'font-lock)
-(defun turn-on-font-lock-if-enabled ()
- (unless (and (eq (car-safe font-lock-global-modes) 'not)
- (memq major-mode (cdr font-lock-global-modes)))
+(defun turn-on-font-lock-if-desired ()
+ (when (cond ((eq font-lock-global-modes t)
+ t)
+ ((eq (car-safe font-lock-global-modes) 'not)
+ (not (memq major-mode (cdr font-lock-global-modes))))
+ (t (memq major-mode (cdr font-lock-global-modes))))
(let (inhibit-quit)
(turn-on-font-lock))))
(define-globalized-minor-mode global-font-lock-mode
- font-lock-mode turn-on-font-lock-if-enabled
+ font-lock-mode turn-on-font-lock-if-desired
:extra-args (dummy)
:initialize 'custom-initialize-safe-default
:init-value (not (or noninteractive emacs-basic-display))
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 59a32921dc5..5f49f2dc81a 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,8 @@
+2007-10-18 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * nnmail.el (nnmail-fancy-expiry-target): Use rmail-dont-reply-to to
+ exclude address matching message-dont-reply-to-names.
+
2007-10-15 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-util.el (gnus-string<): New function.
diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el
index 71a528c0f0b..35f5476f9b4 100644
--- a/lisp/gnus/nnmail.el
+++ b/lisp/gnus/nnmail.el
@@ -1900,8 +1900,10 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
;; To or From header
((and (equal header 'to-from)
(or (string-match (cadr regexp-target-pair) from)
- (and (string-match message-dont-reply-to-names from)
- (string-match (cadr regexp-target-pair) to))))
+ (and (string-match (cadr regexp-target-pair) to)
+ (let ((rmail-dont-reply-to-names
+ message-dont-reply-to-names))
+ (equal (rmail-dont-reply-to from) "")))))
(setq target (format-time-string (caddr regexp-target-pair) date)))
((and (not (equal header 'to-from))
(string-match (cadr regexp-target-pair)
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index befd83c76ef..f62fadc22b5 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -252,11 +252,14 @@ face (according to `face-differs-from-default-p')."
;;;###autoload
(defun describe-function-1 (function)
(let* ((advised (and (featurep 'advice) (ad-get-advice-info function)))
- ;; If the function is advised, get the symbol that has the
- ;; real definition.
+ ;; If the function is advised, use the symbol that has the
+ ;; real definition, if that symbol is already set up.
(real-function
- (if advised (cdr (assq 'origname advised))
- function))
+ (or (and advised
+ (cdr (assq 'origname advised))
+ (fboundp (cdr (assq 'origname advised)))
+ (cdr (assq 'origname advised)))
+ function))
;; Get the real definition.
(def (if (symbolp real-function)
(symbol-function real-function)
diff --git a/lisp/loadhist.el b/lisp/loadhist.el
index 95de0d822a3..cd8c8ef099b 100644
--- a/lisp/loadhist.el
+++ b/lisp/loadhist.el
@@ -137,11 +137,13 @@ These are symbols with hook-type values whose names don't end in
`-hook' or `-hooks', from which `unload-feature' tries to remove
pertinent symbols.")
-(defvar unload-hook-features-list nil
+(defvar unload-function-features-list nil
"List of features of the package being unloaded.
-This is meant to be used by FEATURE-unload-hook hooks, see the
+This is meant to be used by FEATURE-unload-function, see the
documentation of `unload-feature' for details.")
+(define-obsolete-variable-alias 'unload-hook-features-list
+ 'unload-function-features-list "22.2")
;;;###autoload
(defun unload-feature (feature &optional force)
@@ -172,82 +174,88 @@ such as redefining an Emacs function."
(when dependents
(error "Loaded libraries %s depend on %s"
(prin1-to-string dependents) file))))
- (let* ((unload-hook-features-list (feature-symbols feature))
- (file (pop unload-hook-features-list))
+ (let* ((unload-function-features-list (feature-symbols feature))
+ (file (pop unload-function-features-list))
;; If non-nil, this is a symbol for which we should
;; restore a previous autoload if possible.
restore-autoload
- (unload-hook (intern-soft (concat (symbol-name feature)
- "-unload-hook"))))
- ;; Try to avoid losing badly when hooks installed in critical
- ;; places go away. (Some packages install things on
- ;; `kill-buffer-hook', `activate-menubar-hook' and the like.)
- ;; First off, provide a clean way for package FOO to arrange
- ;; this by adding hooks on the variable `FOO-unload-hook'.
- (if unload-hook
- (run-hooks unload-hook)
- ;; Otherwise, do our best. Look through the obarray for symbols
- ;; which seem to be hook variables or special hook functions and
- ;; remove anything from them which matches the feature-symbols
- ;; about to get zapped. Obviously this won't get anonymous
- ;; functions which the package might just have installed, and
- ;; there might be other important state, but this tactic
- ;; normally works.
- (mapatoms
- (lambda (x)
- (when (and (boundp x)
- (or (and (consp (symbol-value x)) ; Random hooks.
- (string-match "-hooks?\\'" (symbol-name x)))
- (memq x unload-feature-special-hooks))) ; Known abnormal hooks etc.
- (dolist (y unload-hook-features-list)
- (when (and (eq (car-safe y) 'defun)
- (not (get (cdr y) 'autoload)))
- (remove-hook x (cdr y)))))))
- ;; Remove any feature-symbols from auto-mode-alist as well.
- (dolist (y unload-hook-features-list)
- (when (and (eq (car-safe y) 'defun)
- (not (get (cdr y) 'autoload)))
- (setq auto-mode-alist
- (rassq-delete-all (cdr y) auto-mode-alist)))))
- (when (fboundp 'elp-restore-function) ; remove ELP stuff first
- (dolist (elt unload-hook-features-list)
- (when (symbolp elt)
- (elp-restore-function elt))))
+ (name (symbol-name feature))
+ (unload-hook (intern-soft (concat name "-unload-hook")))
+ (unload-func (intern-soft (concat name "-unload-function"))))
+ ;; If FEATURE-unload-function is defined and returns non-nil,
+ ;; don't try to do anything more; otherwise proceed normally.
+ (unless (and (bound-and-true-p unload-func)
+ (funcall unload-func))
+ ;; Try to avoid losing badly when hooks installed in critical
+ ;; places go away. (Some packages install things on
+ ;; `kill-buffer-hook', `activate-menubar-hook' and the like.)
+ (if unload-hook
+ ;; First off, provide a clean way for package FOO to arrange
+ ;; this by adding hooks on the variable `FOO-unload-hook'.
+ ;; This is obsolete; FEATURE-unload-function should be used now.
+ (run-hooks unload-hook)
+ ;; Otherwise, do our best. Look through the obarray for symbols
+ ;; which seem to be hook variables or special hook functions and
+ ;; remove anything from them which matches the feature-symbols
+ ;; about to get zapped. Obviously this won't get anonymous
+ ;; functions which the package might just have installed, and
+ ;; there might be other important state, but this tactic
+ ;; normally works.
+ (mapatoms
+ (lambda (x)
+ (when (and (boundp x)
+ (or (and (consp (symbol-value x)) ; Random hooks.
+ (string-match "-hooks?\\'" (symbol-name x)))
+ (memq x unload-feature-special-hooks))) ; Known abnormal hooks etc.
+ (dolist (y unload-function-features-list)
+ (when (and (eq (car-safe y) 'defun)
+ (not (get (cdr y) 'autoload)))
+ (remove-hook x (cdr y)))))))
+ ;; Remove any feature-symbols from auto-mode-alist as well.
+ (dolist (y unload-function-features-list)
+ (when (and (eq (car-safe y) 'defun)
+ (not (get (cdr y) 'autoload)))
+ (setq auto-mode-alist
+ (rassq-delete-all (cdr y) auto-mode-alist)))))
+ (when (fboundp 'elp-restore-function) ; remove ELP stuff first
+ (dolist (elt unload-function-features-list)
+ (when (symbolp elt)
+ (elp-restore-function elt))))
- (dolist (x unload-hook-features-list)
- (if (consp x)
- (case (car x)
- ;; Remove any feature names that this file provided.
- (provide
- (setq features (delq (cdr x) features)))
- ((defun autoload)
- (let ((fun (cdr x)))
- (when (fboundp fun)
- (when (fboundp 'ad-unadvise)
- (ad-unadvise fun))
- (let ((aload (get fun 'autoload)))
- (if (and aload (eq fun restore-autoload))
- (fset fun (cons 'autoload aload))
- (fmakunbound fun))))))
- ;; (t . SYMBOL) comes before (defun . SYMBOL)
- ;; and says we should restore SYMBOL's autoload
- ;; when we undefine it.
- ((t) (setq restore-autoload (cdr x)))
- ((require defface) nil)
- (t (message "Unexpected element %s in load-history" x)))
- ;; Kill local values as much as possible.
- (dolist (buf (buffer-list))
- (with-current-buffer buf
- (if (and (boundp x) (timerp (symbol-value x)))
- (cancel-timer (symbol-value x)))
- (kill-local-variable x)))
- (if (and (boundp x) (timerp (symbol-value x)))
- (cancel-timer (symbol-value x)))
- ;; Get rid of the default binding if we can.
- (unless (local-variable-if-set-p x)
- (makunbound x))))
- ;; Delete the load-history element for this file.
- (setq load-history (delq (assoc file load-history) load-history)))
+ (dolist (x unload-function-features-list)
+ (if (consp x)
+ (case (car x)
+ ;; Remove any feature names that this file provided.
+ (provide
+ (setq features (delq (cdr x) features)))
+ ((defun autoload)
+ (let ((fun (cdr x)))
+ (when (fboundp fun)
+ (when (fboundp 'ad-unadvise)
+ (ad-unadvise fun))
+ (let ((aload (get fun 'autoload)))
+ (if (and aload (eq fun restore-autoload))
+ (fset fun (cons 'autoload aload))
+ (fmakunbound fun))))))
+ ;; (t . SYMBOL) comes before (defun . SYMBOL)
+ ;; and says we should restore SYMBOL's autoload
+ ;; when we undefine it.
+ ((t) (setq restore-autoload (cdr x)))
+ ((require defface) nil)
+ (t (message "Unexpected element %s in load-history" x)))
+ ;; Kill local values as much as possible.
+ (dolist (buf (buffer-list))
+ (with-current-buffer buf
+ (if (and (boundp x) (timerp (symbol-value x)))
+ (cancel-timer (symbol-value x)))
+ (kill-local-variable x)))
+ (if (and (boundp x) (timerp (symbol-value x)))
+ (cancel-timer (symbol-value x)))
+ ;; Get rid of the default binding if we can.
+ (unless (local-variable-if-set-p x)
+ (makunbound x))))
+ ;; Delete the load-history element for this file.
+ (setq load-history (delq (assoc file load-history) load-history))))
;; Don't return load-history, it is not useful.
nil)
diff --git a/lisp/mouse.el b/lisp/mouse.el
index 27c5dd901f7..82d12ccbdd0 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -151,6 +151,26 @@ PREFIX is the prefix argument (if any) to pass to the command."
;; mouse-major-mode-menu was using `command-execute' instead.
(call-interactively cmd))))
+(defun minor-mode-menu-from-indicator (indicator)
+ "Show menu, if any, for minor mode specified by INDICATOR.
+Interactively, INDICATOR is read using completion."
+ (interactive (list (completing-read "Minor mode indicator: "
+ (describe-minor-mode-completion-table-for-indicator))))
+ (let ((minor-mode (lookup-minor-mode-from-indicator indicator)))
+ (if minor-mode
+ (let* ((map (cdr-safe (assq minor-mode minor-mode-map-alist)))
+ (menu (and (keymapp map) (lookup-key map [menu-bar]))))
+ (if menu
+ (popup-menu menu)
+ (message "No menu for minor mode `%s'" minor-mode)))
+ (error "Cannot find minor mode for `%s'" indicator))))
+
+(defun mouse-minor-mode-menu (event)
+ "Show minor-mode menu for EVENT on minor modes area of the mode line."
+ (interactive "@e")
+ (let ((indicator (car (nth 4 (car (cdr event))))))
+ (minor-mode-menu-from-indicator indicator)))
+
(defvar mouse-major-mode-menu-prefix) ; dynamically bound
(defun mouse-major-mode-menu (event &optional prefix)
diff --git a/lisp/obsolete/mlsupport.el b/lisp/obsolete/mlsupport.el
index d1844cd42ce..2465ea4eabd 100644
--- a/lisp/obsolete/mlsupport.el
+++ b/lisp/obsolete/mlsupport.el
@@ -186,10 +186,10 @@
(newline (ml-prefix-argument)))
(defun ml-next-line ()
- (next-line (ml-prefix-argument)))
+ (forward-line (ml-prefix-argument)))
(defun ml-previous-line ()
- (previous-line (ml-prefix-argument)))
+ (forward-line (- (ml-prefix-argument))))
(defun delete-to-kill-buffer ()
(kill-region (point) (mark)))
diff --git a/lisp/progmodes/ada-xref.el b/lisp/progmodes/ada-xref.el
index c37d11910d4..ddea4c293df 100644
--- a/lisp/progmodes/ada-xref.el
+++ b/lisp/progmodes/ada-xref.el
@@ -1706,7 +1706,7 @@ Information is extracted from the ali file."
(beginning-of-line)
;; while we have a continuation line, go up one line
(while (looking-at "^\\.")
- (previous-line 1)
+ (forward-line -1)
(beginning-of-line))
(unless (looking-at (concat "[0-9]+.[0-9]+[ *]"
(ada-name-of identlist) "[ <{=\(\[]"))
@@ -1735,11 +1735,11 @@ Information is extracted from the ali file."
(let ((current-line (buffer-substring
(point) (save-excursion (end-of-line) (point)))))
(save-excursion
- (next-line 1)
+ (forward-line 1)
(beginning-of-line)
(while (looking-at "^\\.\\(.*\\)")
(set 'current-line (concat current-line (match-string 1)))
- (next-line 1))
+ (forward-line 1))
)
(if (re-search-backward "^X [0-9]+ \\([a-zA-Z0-9_.-]+\\)" nil t)
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index 4148f327ecc..275773049e7 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -1130,7 +1130,7 @@ where they were found."
(if (memq (car order) '(tag-exact-file-name-match-p
tag-file-name-match-p
tag-partial-file-name-match-p))
- (save-excursion (next-line 1)
+ (save-excursion (forward-line 1)
(file-of-tag))
(file-of-tag)))
tag-info (funcall snarf-tag-function))
@@ -1454,10 +1454,10 @@ where they were found."
(tag-info (save-excursion (funcall snarf-tag-function)))
(tag (if (eq t (car tag-info)) nil (car tag-info)))
(file-path (save-excursion (if tag (file-of-tag)
- (save-excursion (next-line 1)
+ (save-excursion (forward-line 1)
(file-of-tag)))))
(file-label (if tag (file-of-tag t)
- (save-excursion (next-line 1)
+ (save-excursion (forward-line 1)
(file-of-tag t))))
(pt (with-current-buffer standard-output (point))))
(if tag
@@ -1884,7 +1884,7 @@ directory specification."
(funcall tags-apropos-function regexp))))
(etags-tags-apropos-additional regexp))
(with-current-buffer "*Tags List*"
- (require 'apropos)
+ (eval-and-compile (require 'apropos))
(apropos-mode)
;; apropos-mode is derived from fundamental-mode and it kills
;; all local variables.
diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el
index 4d2dd7f315e..eebfd377a7e 100644
--- a/lisp/progmodes/idlw-shell.el
+++ b/lisp/progmodes/idlw-shell.el
@@ -1474,7 +1474,7 @@ Otherwise just move the line. Move down unless UP is non-nil."
(if (and idlwave-shell-arrows-do-history
(>= (1+ (save-excursion (end-of-line) (point))) proc-pos))
(comint-previous-input arg)
- (previous-line arg))))
+ (forward-line (- arg)))))
(defun idlwave-shell-up-or-history (&optional arg)
"When in last line of process buffer, move to previous input.
diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el
index 7cff1bc516e..470988f4c14 100644
--- a/lisp/progmodes/prolog.el
+++ b/lisp/progmodes/prolog.el
@@ -31,7 +31,7 @@
;;; Code:
-(defvar comint-prompt-regexp)
+(eval-when-compile (require 'comint))
(defgroup prolog nil
@@ -269,6 +269,12 @@ Return not at end copies rest of line to end and sends it.
(defvar inferior-prolog-buffer nil)
+(defvar inferior-prolog-flavor 'unknown
+ "Either a symbol or a buffer position offset by one.
+If a buffer position, the flavor has not been determined yet and
+it is expected that the process's output has been or will
+be inserted at that position plus one.")
+
(defun inferior-prolog-run (&optional name)
(with-current-buffer (make-comint "prolog" (or name prolog-program-name))
(inferior-prolog-mode)
@@ -302,12 +308,6 @@ Return not at end copies rest of line to end and sends it.
;; Try again.
(inferior-prolog-process))))
-(defvar inferior-prolog-flavor 'unknown
- "Either a symbol or a buffer position offset by one.
-If a buffer position, the flavor has not been determined yet and
-it is expected that the process's output has been or will
-be inserted at that position plus one.")
-
(defun inferior-prolog-guess-flavor (&optional ignored)
(save-excursion
(goto-char (1+ inferior-prolog-flavor))
diff --git a/lisp/smerge-mode.el b/lisp/smerge-mode.el
index 5d4400958d6..a33d21925b7 100644
--- a/lisp/smerge-mode.el
+++ b/lisp/smerge-mode.el
@@ -645,50 +645,119 @@ Point is moved to the end of the conflict."
(error nil)))
found))
+;;; Refined change highlighting
+
+(defvar smerge-refine-forward-function 'smerge-refine-forward
+ "Function used to determine an \"atomic\" element.
+You can set it to `forward-char' to get char-level granularity.
+Its behavior has mainly two restrictions:
+- if this function encounters a newline, it's important that it stops right
+ after the newline.
+ This only matters if `smerge-refine-ignore-whitespace' is nil.
+- it needs to be unaffected by changes performed by the `preproc' argument
+ to `smerge-refine-subst'.
+ This only matters if `smerge-refine-weight-hack' is nil.")
+
+(defvar smerge-refine-ignore-whitespace t
+ "If non-nil,Indicate that smerge-refine should try to ignore change in whitespace.")
+
+(defvar smerge-refine-weight-hack t
+ "If non-nil, pass to diff as many lines as there are chars in the region.
+I.e. each atomic element (e.g. word) will be copied as many times (on different
+lines) as it has chars. This has 2 advantages:
+- if `diff' tries to minimize the number *lines* (rather than chars)
+ added/removed, this adjust the weights so that adding/removing long
+ symbols is considered correspondingly more costly.
+- `smerge-refine-forward-function' only needs to be called when chopping up
+ the regions, and `forward-char' can be used afterwards.
+It has the following disadvantages:
+- cannot use `diff -w' because the weighting causes added spaces in a line
+ to be represented as added copies of some line, so `diff -w' can't do the
+ right thing any more.
+- may in degenerate cases take a 1KB input region and turn it into a 1MB
+ file to pass to diff.")
+
+(defun smerge-refine-forward (n)
+ (let ((case-fold-search nil)
+ (re "[[:upper:]]?[[:lower:]]+\\|[[:upper:]]+\\|[[:digit:]]+\\|.\\|\n"))
+ (when (and smerge-refine-ignore-whitespace
+ ;; smerge-refine-weight-hack causes additional spaces to
+ ;; appear as additional lines as well, so even if diff ignore
+ ;; whitespace changes, it'll report added/removed lines :-(
+ (not smerge-refine-weight-hack))
+ (setq re (concat "[ \t]*\\(?:" re "\\)")))
+ (dotimes (i n)
+ (unless (looking-at re) (error "Smerge refine internal error"))
+ (goto-char (match-end 0)))))
+
(defun smerge-refine-chopup-region (beg end file &optional preproc)
"Chopup the region into small elements, one per line.
Save the result into FILE.
If non-nil, PREPROC is called with no argument in a buffer that contains
a copy of the text, just before chopping it up. It can be used to replace
chars to try and eliminate some spurious differences."
- ;; ediff chops up into words, where the definition of a word is
- ;; customizable. Instead we here keep only one char per line.
- ;; The advantages are that there's nothing to configure, that we get very
- ;; fine results, and that it's trivial to map the line numbers in the
- ;; output of diff back into buffer positions. The disadvantage is that it
- ;; can take more time to compute the diff and that the result is sometimes
- ;; too fine. I'm not too concerned about the slowdown because conflicts
- ;; are usually significantly smaller than the whole file. As for the
- ;; problem of too-fine-refinement, I have found it to be unimportant
- ;; especially when you consider the cases where the fine-grain is just
- ;; what you want.
+ ;; We used to chop up char-by-char rather than word-by-word like ediff
+ ;; does. It had the benefit of simplicity and very fine results, but it
+ ;; often suffered from problem that diff would find correlations where
+ ;; there aren't any, so the resulting "change" didn't make much sense.
+ ;; You can still get this behavior by setting
+ ;; `smerge-refine-forward-function' to `forward-char'.
(let ((buf (current-buffer)))
(with-temp-buffer
(insert-buffer-substring buf beg end)
(when preproc (goto-char (point-min)) (funcall preproc))
+ (when smerge-refine-ignore-whitespace
+ ;; It doesn't make much of a difference for diff-fine-highlight
+ ;; because we still have the _/+/</>/! prefix anyway. Can still be
+ ;; useful in other circumstances.
+ (subst-char-in-region (point-min) (point-max) ?\n ?\s))
(goto-char (point-min))
(while (not (eobp))
- (forward-char 1)
- ;; We add \n after each char except after \n, so we get one line per
- ;; text char, where each line contains just one char, except for \n
- ;; chars which are represented by the empty line.
- (unless (eq (char-before) ?\n) (insert ?\n)))
+ (funcall smerge-refine-forward-function 1)
+ (let ((s (if (prog2 (forward-char -1) (bolp) (forward-char 1))
+ nil
+ (buffer-substring (line-beginning-position) (point)))))
+ ;; We add \n after each char except after \n, so we get
+ ;; one line per text char, where each line contains
+ ;; just one char, except for \n chars which are
+ ;; represented by the empty line.
+ (unless (eq (char-before) ?\n) (insert ?\n))
+ ;; HACK ALERT!!
+ (if smerge-refine-weight-hack
+ (dotimes (i (1- (length s))) (insert s "\n")))))
+ (unless (bolp) (error "Smerge refine internal error"))
(let ((coding-system-for-write 'emacs-mule))
(write-region (point-min) (point-max) file nil 'nomessage)))))
(defun smerge-refine-highlight-change (buf beg match-num1 match-num2 props)
- (let* ((startline (string-to-number (match-string match-num1)))
- (ol (make-overlay
- (+ beg startline -1)
- (+ beg (if (match-end match-num2)
- (string-to-number (match-string match-num2))
- startline))
- buf
- ;; Make them tend to shrink rather than spread when editing.
- 'front-advance nil)))
- (overlay-put ol 'evaporate t)
- (dolist (x props)
- (overlay-put ol (car x) (cdr x)))))
+ (with-current-buffer buf
+ (goto-char beg)
+ (let* ((startline (- (string-to-number match-num1) 1))
+ (beg (progn (funcall (if smerge-refine-weight-hack
+ 'forward-char
+ smerge-refine-forward-function)
+ startline)
+ (point)))
+ (end (progn (funcall (if smerge-refine-weight-hack
+ 'forward-char
+ smerge-refine-forward-function)
+ (if match-num2
+ (- (string-to-number match-num2)
+ startline)
+ 1))
+ (point))))
+ (when smerge-refine-ignore-whitespace
+ (skip-chars-backward " \t\n" beg) (setq end (point))
+ (goto-char beg)
+ (skip-chars-forward " \t\n" end) (setq beg (point)))
+ (when (> end beg)
+ (let ((ol (make-overlay
+ beg end nil
+ ;; Make them tend to shrink rather than spread when editing.
+ 'front-advance nil)))
+ (overlay-put ol 'evaporate t)
+ (dolist (x props) (overlay-put ol (car x) (cdr x)))
+ ol)))))
(defun smerge-refine-subst (beg1 end1 beg2 end2 props &optional preproc)
"Show fine differences in the two regions BEG1..END1 and BEG2..END2.
@@ -697,9 +766,9 @@ If non-nil, PREPROC is called with no argument in a buffer that contains
a copy of a region, just before preparing it to for `diff'. It can be used to
replace chars to try and eliminate some spurious differences."
(let* ((buf (current-buffer))
+ (pos (point))
(file1 (make-temp-file "diff1"))
(file2 (make-temp-file "diff2")))
-
;; Chop up regions into smaller elements and save into files.
(smerge-refine-chopup-region beg1 end1 file1 preproc)
(smerge-refine-chopup-region beg2 end2 file2 preproc)
@@ -710,21 +779,49 @@ replace chars to try and eliminate some spurious differences."
(let ((coding-system-for-read 'emacs-mule))
;; Don't forget -a to make sure diff treats it as a text file
;; even if it contains \0 and such.
- (call-process diff-command nil t nil "-a" file1 file2))
+ (call-process diff-command nil t nil
+ (if (and smerge-refine-ignore-whitespace
+ (not smerge-refine-weight-hack))
+ "-aw" "-a")
+ file1 file2))
;; Process diff's output.
(goto-char (point-min))
- (while (not (eobp))
- (if (not (looking-at "\\([0-9]+\\)\\(?:,\\([0-9]+\\)\\)?\\([acd]\\)\\([0-9]+\\)\\(?:,\\([0-9]+\\)\\)?$"))
- (error "Unexpected patch hunk header: %s"
- (buffer-substring (point) (line-end-position)))
- (let ((op (char-after (match-beginning 3))))
+ (let ((last1 nil)
+ (last2 nil))
+ (while (not (eobp))
+ (if (not (looking-at "\\([0-9]+\\)\\(?:,\\([0-9]+\\)\\)?\\([acd]\\)\\([0-9]+\\)\\(?:,\\([0-9]+\\)\\)?$"))
+ (error "Unexpected patch hunk header: %s"
+ (buffer-substring (point) (line-end-position))))
+ (let ((op (char-after (match-beginning 3)))
+ (m1 (match-string 1))
+ (m2 (match-string 2))
+ (m4 (match-string 4))
+ (m5 (match-string 5)))
(when (memq op '(?d ?c))
- (smerge-refine-highlight-change buf beg1 1 2 props))
+ (setq last1
+ (smerge-refine-highlight-change buf beg1 m1 m2 props)))
(when (memq op '(?a ?c))
- (smerge-refine-highlight-change buf beg2 4 5 props)))
+ (setq last2
+ (smerge-refine-highlight-change buf beg2 m4 m5 props))))
(forward-line 1) ;Skip hunk header.
(and (re-search-forward "^[0-9]" nil 'move) ;Skip hunk body.
- (goto-char (match-beginning 0))))))
+ (goto-char (match-beginning 0))))
+ ;; (assert (or (null last1) (< (overlay-start last1) end1)))
+ ;; (assert (or (null last2) (< (overlay-start last2) end2)))
+ (if smerge-refine-weight-hack
+ (progn
+ ;; (assert (or (null last1) (<= (overlay-end last1) end1)))
+ ;; (assert (or (null last2) (<= (overlay-end last2) end2)))
+ )
+ ;; smerge-refine-forward-function when calling in chopup may
+ ;; have stopped because it bumped into EOB whereas in
+ ;; smerge-refine-weight-hack it may go a bit further.
+ (if (and last1 (> (overlay-end last1) end1))
+ (move-overlay last1 (overlay-start last1) end1))
+ (if (and last2 (> (overlay-end last2) end2))
+ (move-overlay last2 (overlay-start last2) end2))
+ )))
+ (goto-char pos)
(delete-file file1)
(delete-file file2))))
diff --git a/lisp/textmodes/bib-mode.el b/lisp/textmodes/bib-mode.el
index b457956b9ba..74800197bcc 100644
--- a/lisp/textmodes/bib-mode.el
+++ b/lisp/textmodes/bib-mode.el
@@ -127,7 +127,7 @@ with the cdr.")
((null slots)
(if (bobp)
""
- (progn (previous-line 1) (bib-find-key bib-assoc))))
+ (progn (forward-line -1) (bib-find-key bib-assoc))))
((looking-at (car (car slots)))
(cdr (car slots)))
(t (bib-find-key (cdr slots)))
@@ -181,7 +181,7 @@ with the cdr.")
(beginning-of-line nil)
(push-mark (point))
(re-search-forward "^ *$" nil 2)
- (next-line 1)
+ (forward-line 1)
(beginning-of-line nil))
(defun unread-bib ()
diff --git a/lisp/textmodes/two-column.el b/lisp/textmodes/two-column.el
index e1f55c0dece..367a33a85b8 100644
--- a/lisp/textmodes/two-column.el
+++ b/lisp/textmodes/two-column.el
@@ -463,7 +463,7 @@ First column's text sSs Second column's text
(1+ (point)))))
(delete-region point (point))
(setq n 0))
- (next-line 1)))))
+ (forward-line 1)))))
@@ -531,7 +531,7 @@ off trailing spaces with \\[delete-trailing-whitespace]."
(end-of-line)
(indent-to-column 2C-window-width)
(insert 2C-separator string))
- (next-line 1) ; add one if necessary
+ (forward-line 1) ; add one if necessary
(set-buffer b2))))
(unless (window-full-width-p)
(enlarge-window 99999 t)))
diff --git a/lisp/vc-arch.el b/lisp/vc-arch.el
index 96957de0812..3c4e4b4d791 100644
--- a/lisp/vc-arch.el
+++ b/lisp/vc-arch.el
@@ -442,11 +442,11 @@ Return non-nil if FILE is unchanged."
(concat "*/" string))
"*"))))))
-(defun vc-arch-revision-completion-table (file)
- (lexical-let ((file file))
+(defun vc-arch-revision-completion-table (files)
+ (lexical-let ((files files))
(lambda (string pred action)
;; FIXME: complete revision patches as well.
- (let* ((root (expand-file-name "{arch}" (vc-arch-root file)))
+ (let* ((root (expand-file-name "{arch}" (vc-arch-root (car files))))
(table (vc-arch--version-completion-table root string)))
(complete-with-action action table string pred)))))
diff --git a/lisp/vc-bzr.el b/lisp/vc-bzr.el
index 5ed46431fda..801e1942cb6 100644
--- a/lisp/vc-bzr.el
+++ b/lisp/vc-bzr.el
@@ -391,7 +391,6 @@ EDITABLE is ignored."
(list "-r" (format "%s..%s" rev1 rev2))
(list "-r" rev1))))))
-(defalias 'vc-bzr-diff-tree 'vc-bzr-diff)
;; FIXME: vc-{next,previous}-revision need fixing in vc.el to deal with
diff --git a/lisp/vc-cvs.el b/lisp/vc-cvs.el
index 5ffb4815182..79a4263854d 100644
--- a/lisp/vc-cvs.el
+++ b/lisp/vc-cvs.el
@@ -962,11 +962,11 @@ is non-nil."
(push (match-string 1) res))
res)))
-(defun vc-cvs-revision-completion-table (file)
- (lexical-let ((file file)
+(defun vc-cvs-revision-completion-table (files)
+ (lexical-let ((files files)
table)
(setq table (lazy-completion-table
- table (lambda () (vc-cvs-revision-table file))))
+ table (lambda () (vc-cvs-revision-table (car files)))))
table))
diff --git a/lisp/vc-git.el b/lisp/vc-git.el
index 4bf6506dcb1..07714b26c32 100644
--- a/lisp/vc-git.el
+++ b/lisp/vc-git.el
@@ -87,8 +87,7 @@
;; - comment-history (file) ??
;; - update-changelog (files) COULD BE SUPPORTED
;; * diff (file &optional rev1 rev2 buffer) OK
-;; - revision-completion-table (file) NEEDED?
-;; - diff-tree (dir &optional rev1 rev2) OK
+;; - revision-completion-table (files) NEEDED?
;; - annotate-command (file buf &optional rev) OK
;; - annotate-time () OK
;; - annotate-current-time () NOT NEEDED
@@ -319,7 +318,8 @@
(vc-git-command buf 1 files "diff-tree" "--exit-code" "-p" rev1 rev2 "--")
(vc-git-command buf 1 files "diff-index" "--exit-code" "-p" (or rev1 "HEAD") "--"))))
-(defun vc-git-revision-table (file)
+(defun vc-git-revision-table (files)
+ ;; What about `files'?!? --Stef
(let ((table (list "HEAD")))
(with-temp-buffer
(vc-git-command t nil nil "for-each-ref" "--format=%(refname)")
@@ -328,16 +328,13 @@
(push (match-string 2) table)))
table))
-(defun vc-git-revision-completion-table (file)
- (lexical-let ((file file)
+(defun vc-git-revision-completion-table (files)
+ (lexical-let ((files files)
table)
(setq table (lazy-completion-table
- table (lambda () (vc-git-revision-table file))))
+ table (lambda () (vc-git-revision-table files))))
table))
-(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)))
diff --git a/lisp/vc-hg.el b/lisp/vc-hg.el
index 2e90d06fbc5..872be45a2c1 100644
--- a/lisp/vc-hg.el
+++ b/lisp/vc-hg.el
@@ -76,8 +76,7 @@
;; - comment-history (file) NOT NEEDED
;; - update-changelog (files) NOT NEEDED
;; * diff (files &optional rev1 rev2 buffer) OK
-;; - revision-completion-table (file) COMMENTED OUT AS A WORKAROUND FOR A BUG
-;; - diff-tree (dir &optional rev1 rev2) TEST IT
+;; - revision-completion-table (files) OK?
;; - annotate-command (file buf &optional rev) OK
;; - annotate-time () OK
;; - annotate-current-time () ?? NOT NEEDED
@@ -294,24 +293,21 @@
(list "-r" oldvers))
(list ""))))))
-(defun vc-hg-revision-table (file)
- (let ((default-directory (file-name-directory file)))
+(defun vc-hg-revision-table (files)
+ (let ((default-directory (file-name-directory (car files))))
(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)
+(defun vc-hg-revision-completion-table (files)
+ (lexical-let ((files files)
table)
(setq table (lazy-completion-table
- table (lambda () (vc-hg-revision-table file))))
+ table (lambda () (vc-hg-revision-table files))))
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 revision)
"Execute \"hg annotate\" on FILE, inserting the contents in BUFFER.
Optional arg REVISION is a revision to annotate from."
diff --git a/lisp/vc-mcvs.el b/lisp/vc-mcvs.el
index aa99e3f4273..0a2e69cefac 100644
--- a/lisp/vc-mcvs.el
+++ b/lisp/vc-mcvs.el
@@ -463,19 +463,6 @@ The changes are between FIRST-REVISION and SECOND-REVISION."
(vc-switches 'MCVS 'diff))))
(if async 1 status))) ; async diff, pessimistic assumption.
-(defun vc-mcvs-diff-tree (dir &optional rev1 rev2)
- "Diff all files at and below DIR."
- (with-current-buffer "*vc-diff*"
- ;; Run the command from the root dir so that `mcvs filt' returns
- ;; valid relative names.
- (setq default-directory (vc-mcvs-root dir))
- ;; cvs diff: use a single call for the entire tree
- (let ((coding-system-for-read (or coding-system-for-read 'undecided)))
- (apply 'vc-mcvs-command "*vc-diff*" 1 dir "diff"
- (and rev1 (concat "-r" rev1))
- (and rev2 (concat "-r" rev2))
- (vc-switches 'MCVS 'diff)))))
-
(defun vc-mcvs-annotate-command (file buffer &optional revision)
"Execute \"mcvs annotate\" on FILE, inserting the contents in BUFFER.
Optional arg REVISION is a revision to annotate from."
diff --git a/lisp/vc-mtn.el b/lisp/vc-mtn.el
index 5365b4d9289..0b209fdd5af 100644
--- a/lisp/vc-mtn.el
+++ b/lisp/vc-mtn.el
@@ -168,7 +168,6 @@
(defun vc-mtn-wash-log (file))
-(defalias 'vc-mtn-diff-tree 'vc-mtn-diff)
(defun vc-mtn-diff (files &optional rev1 rev2 buffer)
(apply 'vc-mtn-command (or buffer "*vc-diff*") 1 files "diff"
(append (if rev1 (list "-r" rev1)) (if rev2 (list "-r" rev2)))))
@@ -239,10 +238,11 @@
(push (match-string 0) ids))
ids)))
-(defun vc-mtn-revision-completion-table (file)
+(defun vc-mtn-revision-completion-table (files)
;; TODO: Implement completion for for selectors
;; TODO: Implement completion for composite selectors.
- (lexical-let ((file file))
+ (lexical-let ((files files))
+ ;; What about using `files'?!? --Stef
(lambda (string pred action)
(cond
;; "Tag" selectors.
diff --git a/lisp/vc-svn.el b/lisp/vc-svn.el
index 43643b931d9..76fdbe5162f 100644
--- a/lisp/vc-svn.el
+++ b/lisp/vc-svn.el
@@ -437,10 +437,6 @@ The changes are between FIRST-VERSION and SECOND-VERSION."
;; status w.r.t whether the diff was empty or not.
(buffer-size (get-buffer buffer)))))
-(defun vc-svn-diff-tree (dir &optional rev1 rev2)
- "Diff all files at and below DIR."
- (vc-svn-diff (list (file-name-as-directory dir)) rev1 rev2))
-
;;;
;;; Snapshot system
;;;
diff --git a/lisp/vc.el b/lisp/vc.el
index 0cf800c2ddd..09898aa98c1 100644
--- a/lisp/vc.el
+++ b/lisp/vc.el
@@ -49,15 +49,15 @@
;;
;; Features in the new version:
;; * Key commands (vc-next-action = C-x v v, vc-print-log = C-x v l, vc-revert
-;; = C-x v u, vc-rollback = C-x v c, vc-diff = C-x v =, vc-update = C-x v +)
+;; = C-x v u, vc-rollback = C-x v c, vc-diff = C-x v =, vc-update = C-x v +)
;; now operate on filesets rather than individual files.
;; * The fileset for a command is either (a) all marked files in VC-dired
;; mode, (b) the currently visited file if it's under version control,
;; or (c) the current directory if the visited buffer is not under
-;; version control and a wildcarding-enable flag has been set.
+;; version control and a wildcarding-enable flag has been set.
;;
-;; If you maintain a client of the mode or customize it in your .emacs,
-;; note that some backend functions which formerly took single file arguments
+;; If you maintain a client of the mode or customize it in your .emacs,
+;; note that some backend functions which formerly took single file arguments
;; now take a list of files. These include: register, checkin, print-log,
;; rollback, and diff.
@@ -129,7 +129,7 @@
;; that return 'file have per-file revision numbering; backends
;; that return 'repository have per-repository revision numbering,
;; so a revision level implicitly identifies a changeset
-;;
+;;
;; STATE-QUERYING FUNCTIONS
;;
;; * registered (file)
@@ -168,7 +168,7 @@
;;
;; Return the working revision of FILE. This is the revision fetched
;; by the last checkout or upate, not necessarily the same thing as the
-;; head or tip revision. Should return "0" for a file added but not yet
+;; head or tip revision. Should return "0" for a file added but not yet
;; committed.
;;
;; - latest-on-branch-p (file)
@@ -197,7 +197,7 @@
;; - mode-line-string (file)
;;
;; If provided, this function should return the VC-specific mode
-;; line string for FILE. The returned string should have a
+;; 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
@@ -213,8 +213,8 @@
;;
;; * create-repo (backend)
;;
-;; Create an empty repository in the current directory and initialize
-;; it so VC mode can add files to it. For file-oriented systems, this
+;; 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)
@@ -223,7 +223,7 @@
;; 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. (Note: in older versions of VC, this
+;; to the backend command. (Note: in older versions of VC, this
;; command took a single file argument and not a list.)
;;
;; - init-revision (file)
@@ -264,7 +264,7 @@
;; 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
+;; the backend command. (Note: in older versions of VC, this
;; command took a single file argument and not a list.)
;;
;; * find-revision (file rev buffer)
@@ -374,18 +374,11 @@
;; differences found), or 1 (either non-empty diff or the diff is
;; run asynchronously).
;;
-;; - revision-completion-table (file)
+;; - revision-completion-table (files)
;;
-;; Return a completion table for existing revisions of FILE.
+;; Return a completion table for existing revisions of FILES.
;; The default is to not use any completion table.
;;
-;; - diff-tree (dir &optional rev1 rev2)
-;;
-;; Insert the diff for all files at and below DIR into the *vc-diff*
-;; buffer. The meaning of REV1 and REV2 is the same as for
-;; vc-BACKEND-diff. The default implementation does an explicit tree
-;; walk, calling vc-BACKEND-diff for each individual file.
-;;
;; - annotate-command (file buf &optional rev)
;;
;; If this function is provided, it should produce an annotated display
@@ -620,7 +613,7 @@ 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"
+(defcustom vc-directory-exclusion-list '("SCCS" "RCS" "CVS" "MCVS" ".svn"
".git" ".hg" ".bzr" "{arch}")
"List of directory names to be ignored when walking directory trees."
:type '(repeat string)
@@ -859,12 +852,11 @@ been updated to their corresponding values."
`(let ((vc-touched-properties (list t)))
,form
(dolist (file ,files)
- (mapc (lambda (setting)
- (let ((property (car setting)))
- (unless (memq property vc-touched-properties)
- (put (intern file vc-file-prop-obarray)
- property (cdr setting)))))
- ,settings))))
+ (dolist (setting ,settings)
+ (let ((property (car setting)))
+ (unless (memq property vc-touched-properties)
+ (put (intern file vc-file-prop-obarray)
+ property (cdr setting))))))))
;; Two macros for elisp programming
@@ -874,7 +866,7 @@ been updated to their corresponding values."
Check in FILE with COMMENT (a string) after BODY has been executed.
FILE is passed through `expand-file-name'; BODY executed within
`save-excursion'. If FILE is not under version control, or you are
-using a locking version-control system and the file is locked by
+using a locking version-control system and the file is locked by
somebody else, signal error."
(declare (debug t) (indent 2))
(let ((filevar (make-symbol "file")))
@@ -1010,7 +1002,7 @@ 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-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
+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."
;; FIXME: file-relative-name can return a bogus result because
@@ -1020,15 +1012,15 @@ that is inserted into the command line before the filename."
(mapcar (lambda (f) (file-relative-name (expand-file-name f)))
(if (listp file-or-list) file-or-list (list file-or-list))))
(full-command
- ;; What we're doing here is preparing a version of the command
+ ;; What we're doing here is preparing a version of the command
;; for display in a debug-progess message. If it's fewer than
- ;; 20 characters display the entire command (without trailing
+ ;; 20 characters display the entire command (without trailing
;; newline). Otherwise display the first 20 followed by an ellipsis.
(concat (if (string= (substring command -1) "\n")
(substring command 0 -1)
command)
- " "
- (vc-delistify (mapcar (lambda (s) (if (> (length s) 20) (concat (substring s 0 2) "...") s)) flags))
+ " "
+ (vc-delistify (mapcar (lambda (s) (if (> (length s) 20) (concat (substring s 0 2) "...") s)) flags))
" " (vc-delistify files))))
(save-current-buffer
(unless (or (eq buffer t)
@@ -1082,7 +1074,7 @@ that is inserted into the command line before the filename."
(if vc-command-messages
(message "Running %s...OK = %d" full-command status)))
(vc-exec-after
- `(run-hook-with-args 'vc-post-command-functions
+ `(run-hook-with-args 'vc-post-command-functions
',command ',file-or-list ',flags))
status))))
@@ -1168,7 +1160,8 @@ Used by `vc-restore-buffer-context' to later restore the context."
CONTEXT is that which `vc-buffer-context' returns."
(let ((point-context (nth 0 context))
(mark-context (nth 1 context))
- (reparse (nth 2 context)))
+ ;; (reparse (nth 2 context))
+ )
;; The new compilation code does not use compilation-error-list any
;; more, so the code below is now ineffective and might as well
;; be disabled. -- Stef
@@ -1251,29 +1244,23 @@ Only files already under version control are noticed."
(nreverse flattened)))
(defun vc-deduce-fileset (&optional allow-directory-wildcard)
- "Deduce a set of files and a backend to apply an operation to.
-
-If we're in VC-dired-mode, the fileset is the list of marked
-files. Otherwise, if we're looking at a buffer visiting a
-version-controlled file. the fileset is a singleton containing
-the relative filename, throw an error.
-
-If neither of these things is true, but allow-directory-wildcard is on,
-select all files under version control at and below the current
-directory.
-
-Otherwise, throw an error.
-"
- (cond (vc-dired-mode
- (let ((regexp (dired-marker-regexp))
- (marked (dired-map-over-marks (dired-get-filename) nil)))
+ "Deduce a set of files and a backend to which to apply an operation.
+
+If we're in VC-dired mode, the fileset is the list of marked files.
+Otherwise, if we're looking at a buffer visiting a version-controlled file,
+the fileset is a singleton containing this file.
+If neither of these things is true, but ALLOW-DIRECTORY-WILDCARD is on
+and we're in a dired buffer, select the current directory.
+Otherwise, throw an error."
+ (cond (vc-dired-mode
+ (let ((marked (dired-map-over-marks (dired-get-filename) nil)))
(unless marked
(error "No files have been selected."))
;; All members of the fileset must have the same backend
(let ((firstbackend (vc-backend (car marked))))
- (mapc (lambda (f) (unless (eq (vc-backend f) firstbackend)
- (error "All members of a fileset must be under the same version-control system.")))
- (cdr marked)))
+ (dolist (f (cdr marked))
+ (unless (eq (vc-backend f) firstbackend)
+ (error "All members of a fileset must be under the same version-control system."))))
marked))
((vc-backend buffer-file-name)
(list buffer-file-name))
@@ -1281,12 +1268,17 @@ Otherwise, throw an error.
(progn
(set-buffer vc-parent-buffer)
(vc-deduce-fileset)))
- ;; This is guarded by an enabling arg so users won't potentially
- ;; shoot themselves in the foot by modifying a fileset they can't
+ ;; This is guarded by an enabling arg so users won't potentially
+ ;; shoot themselves in the foot by modifying a fileset they can't
;; verify by eyeball. Allow it for nondestructive commands like
;; making diffs, or possibly for destructive ones that have
;; confirmation prompts.
- (allow-directory-wildcard
+ ((and allow-directory-wildcard
+ ;; I think this is a misfeature. For now, I'll leave it in, but
+ ;; I'll disable it anywhere else than in dired buffers. --Stef
+ (and (derived-mode-p 'dired-mode)
+ (equal buffer-file-name nil)
+ (equal list-buffers-directory default-directory)))
(progn
(message "All version-controlled files below %s selected."
default-directory)
@@ -1377,7 +1369,6 @@ with the logmessage as change commentary. A writable file is retained.
merge in the changes into your working copy."
(interactive "P")
(let* ((files (vc-deduce-fileset))
- (backend (vc-backend (car files)))
(state (vc-state (car files)))
(model (vc-checkout-model (car files)))
revision)
@@ -1411,7 +1402,7 @@ merge in the changes into your working copy."
(or (y-or-n-p (message "Use %s on disk, keeping modified buffer? " file))
(error "Aborted")))))))
;; Do the right thing
- (cond
+ (cond
;; Files aren't registered
((not state)
(mapc 'vc-register files))
@@ -1423,16 +1414,16 @@ merge in the changes into your working copy."
(setq revision (read-string "Branch, revision, or backend to move to: "))
(let ((vsym (intern-soft (upcase revision))))
(if (member vsym vc-handled-backends)
- (mapc (lambda (file) (vc-transfer-file file vsym)) files)
- (mapc (lambda (file)
- (vc-checkout file (eq model 'implicit) revision))))))
+ (dolist (file files) (vc-transfer-file file vsym))
+ (dolist (file files)
+ (vc-checkout file (eq model 'implicit) revision)))))
((not (eq model 'implicit))
;; check the files out
- (mapc (lambda (file) (vc-checkout file t)) files))
+ (dolist (file files) (vc-checkout file t)))
(t
- ;; do nothing
- (message "Fileset is up-to-date"))))
- ;; Files have local changes
+ ;; do nothing
+ (message "Fileset is up-to-date"))))
+ ;; Files have local changes
((eq state 'edited)
(let ((ready-for-commit files))
;; If files are edited but read-only, give user a chance to correct
@@ -1444,27 +1435,25 @@ merge in the changes into your working copy."
(error "Aborted"))
(set-file-modes file (logior (file-modes file) 128))
(let ((visited (get-file-buffer file)))
- (if visited
- (save-excursion
- (set-buffer visited)
+ (if visited
+ (with-current-buffer visited
(toggle-read-only -1)))))))
;; Allow user to revert files with no changes
(save-excursion
- (let ((revertlist '()))
- (dolist (file files)
- (let ((visited (get-file-buffer file)))
- ;; For files with locking, if the file does not contain
- ;; any changes, just let go of the lock, i.e. revert.
- (if (and (not (eq model 'implicit))
- (vc-workfile-unchanged-p file)
- ;; If buffer is modified, that means the user just
- ;; said no to saving it; in that case, don't revert,
- ;; because the user might intend to save after
- ;; finishing the log entry and committing.
- (not (and visited (buffer-modified-p))))
- (progn
- (vc-revert-file file)
- (delete file ready-for-commit)))))))
+ (dolist (file files)
+ (let ((visited (get-file-buffer file)))
+ ;; For files with locking, if the file does not contain
+ ;; any changes, just let go of the lock, i.e. revert.
+ (if (and (not (eq model 'implicit))
+ (vc-workfile-unchanged-p file)
+ ;; If buffer is modified, that means the user just
+ ;; said no to saving it; in that case, don't revert,
+ ;; because the user might intend to save after
+ ;; finishing the log entry and committing.
+ (not (and visited (buffer-modified-p))))
+ (progn
+ (vc-revert-file file)
+ (delete file ready-for-commit))))))
;; Remaining files need to be committed
(if (not ready-for-commit)
(message "No files remain to be committed")
@@ -1478,12 +1467,12 @@ merge in the changes into your working copy."
(vc-checkin ready-for-commit revision))))))))
;; locked by somebody else (locking VCSes only)
((stringp state)
- (let ((revision
- (if verbose
+ (let ((revision
+ (if verbose
(read-string "Revision to steal: ")
(vc-working-revision file))))
- (mapc (lambda (file) (vc-steal-lock file revision state) files))))
- ;; needs-patch
+ (dolist (file files) (vc-steal-lock file revision state))))
+ ;; needs-patch
((eq state 'needs-patch)
(dolist (file files)
(if (yes-or-no-p (format
@@ -1504,12 +1493,10 @@ merge in the changes into your working copy."
;; unlocked-changes
((eq state 'unlocked-changes)
(dolist (file files)
- (if (not (equal buffer-file-name file))
+ (if (not (equal buffer-file-name file))
(find-file-other-window file))
(if (save-window-excursion
- (vc-diff-internal
- (vc-backend file) nil (list file)
- (vc-working-revision file) nil)
+ (vc-diff-internal nil (list file) (vc-working-revision file) nil)
(goto-char (point-min))
(let ((inhibit-read-only t))
(insert
@@ -1644,9 +1631,9 @@ entered COMMENT. If COMMENT is t, also do action immediately with an
empty comment. Remember the file's buffer in `vc-parent-buffer'
\(current one if no file). AFTER-HOOK specifies the local value
for vc-log-operation-hook."
- (let ((parent
+ (let ((parent
(if (and files (equal (length files) 1))
- (get-file-buffer (car files))
+ (get-file-buffer (car files))
(current-buffer))))
(if vc-before-checkin-hook
(if files
@@ -1774,7 +1761,7 @@ the buffer contents as a comment."
;; Check and record the comment, if any.
(unless nocomment
;; Comment too long?
- (vc-call-backend (or (and vc-log-fileset (vc-backend (car vc-log-fileset)))
+ (vc-call-backend (or (if vc-log-fileset (vc-backend vc-log-fileset))
(vc-responsible-backend default-directory))
'logentry-check)
(run-hooks 'vc-logentry-check-hook))
@@ -1810,8 +1797,8 @@ the buffer contents as a comment."
(pop-to-buffer tmp-vc-parent-buffer))))
;; Now make sure we see the expanded headers
(if log-fileset
- (mapc
- (lambda (file) (vc-resynch-buffer file vc-keep-workfiles t))
+ (mapc
+ (lambda (file) (vc-resynch-buffer file vc-keep-workfiles t))
log-fileset))
(if vc-dired-mode
(dired-move-to-filename))
@@ -1819,24 +1806,24 @@ the buffer contents as a comment."
;;; Additional entry points for examining version histories
-(defun vc-default-diff-tree (backend dir rev1 rev2)
- "List differences for all registered files at and below DIR.
-The meaning of REV1 and REV2 is the same as for `vc-revision-diff'."
- ;; This implementation does an explicit tree walk, and calls
- ;; vc-BACKEND-diff directly for each file. An optimization
- ;; would be to use `vc-diff-internal', so that diffs can be local,
- ;; and to call it only for files that are actually changed.
- ;; However, this is expensive for some backends, and so it is left
- ;; to backend-specific implementations.
- (setq default-directory dir)
- (vc-file-tree-walk
- default-directory
- (lambda (f)
- (vc-exec-after
- `(let ((coding-system-for-read (vc-coding-system-for-diff ',f)))
- (message "Looking at %s" ',f)
- (vc-call-backend ',(vc-backend f)
- 'diff (list ',f) ',rev1 ',rev2))))))
+;; (defun vc-default-diff-tree (backend dir rev1 rev2)
+;; "List differences for all registered files at and below DIR.
+;; The meaning of REV1 and REV2 is the same as for `vc-revision-diff'."
+;; ;; This implementation does an explicit tree walk, and calls
+;; ;; vc-BACKEND-diff directly for each file. An optimization
+;; ;; would be to use `vc-diff-internal', so that diffs can be local,
+;; ;; and to call it only for files that are actually changed.
+;; ;; However, this is expensive for some backends, and so it is left
+;; ;; to backend-specific implementations.
+;; (setq default-directory dir)
+;; (vc-file-tree-walk
+;; default-directory
+;; (lambda (f)
+;; (vc-exec-after
+;; `(let ((coding-system-for-read (vc-coding-system-for-diff ',f)))
+;; (message "Looking at %s" ',f)
+;; (vc-call-backend ',(vc-backend f)
+;; 'diff (list ',f) ',rev1 ',rev2))))))
(defun vc-coding-system-for-diff (file)
"Return the coding system for reading diff output for FILE."
@@ -1885,7 +1872,10 @@ The meaning of REV1 and REV2 is the same as for `vc-revision-diff'."
(goto-char (point-min))
(shrink-window-if-larger-than-buffer))
-(defun vc-diff-internal (backend async files rev1 rev2 &optional verbose)
+(defvar vc-diff-added-files nil
+ "If non-nil, diff added files by comparing them to /dev/null.")
+
+(defun vc-diff-internal (async files rev1 rev2 &optional verbose)
"Report diffs between two revisions of a fileset.
Diff output goes to the *vc-diff* buffer. The function
returns t if the buffer had changes, nil otherwise."
@@ -1895,30 +1885,38 @@ returns t if the buffer had changes, nil otherwise."
;; Set coding system based on the first file. It's a kluge,
;; but the only way to set it for each file included would
;; be to call the back end separately for each file.
- (coding-system-for-read
+ (coding-system-for-read
(if files (vc-coding-system-for-diff (car files)) 'undecided)))
(vc-setup-buffer "*vc-diff*")
(message "Finding changes in %s..." filenames)
- ;; Many backends don't handle well the case of a file that has been
- ;; added but not yet committed to the repo (notably CVS and Subversion).
- ;; Do that work here so the backends don't have to futz with it.
- (let ((filtered '()))
- (dolist (file files)
- (cond ((and (not (file-directory-p file)) (string= (vc-working-revision file) "0"))
- (progn
- ;; This file is added but not yet committed;
- ;; there is no master file to diff against.
- (if (or rev1 rev2)
- (error "No revisions of %s exist" file)
- ;; We regard this as "changed".
- ;; Diff it against /dev/null.
- (apply 'vc-do-command "*vc-diff*"
- 1 "diff" file
- (append (vc-switches nil 'diff) '("/dev/null"))))))
- (t
- (add-to-list 'filtered file t))))
- (let ((vc-disable-async-diff (not async)))
- (vc-call-backend backend 'diff filtered rev1 rev2 "*vc-diff*")))
+ ;; Many backends don't handle well the case of a file that has been
+ ;; added but not yet committed to the repo (notably CVS and Subversion).
+ ;; Do that work here so the backends don't have to futz with it. --ESR
+ ;;
+ ;; Actually most backends (including CVS) have options to control the
+ ;; behavior since which one is better depends on the user and on the
+ ;; situation). Worse yet: this code does not handle the case where
+ ;; `file' is a directory which contains added files.
+ ;; I made it conditional on vc-diff-added-files but it should probably
+ ;; just be removed (or copied/moved to specific backends). --Stef.
+ (when vc-diff-added-files
+ (let ((filtered '()))
+ (dolist (file files)
+ (if (or (file-directory-p file)
+ (not (string= (vc-working-revision file) "0")))
+ (push file filtered)
+ ;; This file is added but not yet committed;
+ ;; there is no master file to diff against.
+ (if (or rev1 rev2)
+ (error "No revisions of %s exist" file)
+ ;; We regard this as "changed".
+ ;; Diff it against /dev/null.
+ (apply 'vc-do-command "*vc-diff*"
+ 1 "diff" file
+ (append (vc-switches nil 'diff) '("/dev/null"))))))
+ (setq files (nreverse filtered))))
+ (let ((vc-disable-async-diff (not async)))
+ (vc-call diff files rev1 rev2 "*vc-diff*"))
(set-buffer "*vc-diff*")
(if (and (zerop (buffer-size))
(not (get-buffer-process (current-buffer))))
@@ -1936,14 +1934,13 @@ returns t if the buffer had changes, nil otherwise."
t)))
;;;###autoload
-(defun vc-history-diff (backend files rev1 rev2)
+(defun vc-version-diff (files rev1 rev2)
"Report diffs between revisions of the fileset in the repository history."
(interactive
(let* ((files (vc-deduce-fileset t))
(first (car files))
- (backend (vc-backend first))
(completion-table
- (vc-call-backend backend 'revision-completion-table first))
+ (vc-call revision-completion-table files))
(rev1-default nil)
(rev2-default nil))
(cond
@@ -1980,47 +1977,37 @@ returns t if the buffer had changes, nil otherwise."
(read-string rev2-prompt nil nil rev2-default))))
(if (string= rev1 "") (setq rev1 nil))
(if (string= rev2 "") (setq rev2 nil))
- (list backend files rev1 rev2))))
+ (list files rev1 rev2))))
(if (and (not rev1) rev2)
(error "Not a valid revision range."))
- (vc-diff-internal backend t files rev1 rev2 (interactive-p)))
+ (vc-diff-internal t files rev1 rev2 (interactive-p)))
-(defun vc-contains-version-controlled-file (dir)
- "Return t if DIR contains a version-controlled file, nil otherwise."
- (catch 'found
- (mapc (lambda (f) (and (not (file-directory-p f)) (vc-backend f) (throw 'found 't))) (directory-files dir))
- nil))
+;; (defun vc-contains-version-controlled-file (dir)
+;; "Return t if DIR contains a version-controlled file, nil otherwise."
+;; (catch 'found
+;; (mapc (lambda (f) (and (not (file-directory-p f)) (vc-backend f) (throw 'found 't))) (directory-files dir))
+;; nil))
;;;###autoload
-(defun vc-diff (historic)
+(defun vc-diff (historic &optional not-urgent)
"Display diffs between file revisions.
Normally this compares the currently selected fileset with their
-working revisions. With a prefix argument HISTORIC, it reads two revision
+working revisions. With a prefix argument HISTORIC, it reads two revision
designators specifying which revisions to compare.
If no current fileset is available (that is, we are not in
VC-Dired mode and the visited file of the current buffer is not
-under version control) behave specially; if there are
-version-controlled files in the current directory, treat all
-version-controlled files recursively beneath the current
-directory as the selected fileset.
-"
+under version control) and we're in a Dired buffer, use
+the current directory.
+The optional argument NOT-URGENT non-nil means it is ok to say no to
+saving the buffer."
+ (interactive (list current-prefix-arg t))
+ (if historic
+ (call-interactively 'vc-version-diff)
+ (let* ((files (vc-deduce-fileset t)))
+ (if buffer-file-name (vc-buffer-sync not-urgent))
+ (vc-diff-internal t files nil nil (interactive-p)))))
- (interactive "P")
- (cond
- ;;((not (vc-contains-version-controlled-file default-directory))
- ;;(error "No version-controlled files directly beneath default directory"))
- (historic
- (call-interactively 'vc-history-diff))
- (t
- (let* ((files (vc-deduce-fileset t))
- (first (car files))
- (backend
- (cond ((file-directory-p first)
- (vc-responsible-backend first))
- (t
- (vc-backend first)))))
- (vc-diff-internal backend t files nil nil (interactive-p))))))
;;;###autoload
(defun vc-revision-other-window (rev)
@@ -2252,7 +2239,7 @@ There is a special command, `*l', to mark all files currently locked."
(setq mode-name (concat mode-name backend-name))
;; Add menu after `vc-dired-mode-map' has `dired-mode-map' as the parent.
(let ((vc-dire-menu-map (copy-keymap vc-menu-map)))
- (define-key-after (lookup-key vc-dired-mode-map [menu-bar]) [vc]
+ (define-key-after (lookup-key vc-dired-mode-map [menu-bar]) [vc]
(cons backend-name vc-dire-menu-map) 'subdir)))
(setq vc-dired-mode t))
@@ -2377,12 +2364,11 @@ Called by dired after any portion of a vc-dired buffer has been read in."
(let (result)
;; Check whether dired is loaded.
(when (fboundp 'dired-buffers-for-dir)
- (mapc (lambda (buffer)
- (with-current-buffer buffer
- (if vc-dired-mode
- (setq result (append result (list buffer))))))
- (dired-buffers-for-dir dir)))
- result))
+ (dolist (buffer (dired-buffers-for-dir dir))
+ (with-current-buffer buffer
+ (if vc-dired-mode
+ (push buffer result)))))
+ (nreverse result)))
(defun vc-dired-resynch-file (file)
"Update the entries for FILE in any VC Dired buffers that list it."
@@ -2484,7 +2470,7 @@ allowed and simply skipped)."
If WORKING-REVISION is non-nil, leave the point at that revision."
(interactive)
(let* ((files (vc-deduce-fileset))
- (backend (vc-backend (car files)))
+ (backend (vc-backend files))
(working-revision (or working-revision (vc-working-revision (car files)))))
;; Don't switch to the output buffer before running the command,
;; so that any buffer-local settings in the vc-controlled
@@ -2513,8 +2499,7 @@ If WORKING-REVISION is non-nil, leave the point at that revision."
This asks for confirmation if the buffer contents are not identical
to the working revision (except for keyword expansion)."
(interactive)
- (let* ((files (vc-deduce-fileset))
- (backend (vc-backend (car files))))
+ (let* ((files (vc-deduce-fileset)))
;; If any of the files is visited by the current buffer, make
;; sure buffer is saved. If the user says `no', abort since
;; we cannot show the changes and ask for confirmation to
@@ -2522,13 +2507,13 @@ to the working revision (except for keyword expansion)."
(if (or (not files) (memq (buffer-file-name) files))
(vc-buffer-sync nil))
(dolist (file files)
- (let (buf (get-file-buffer file))
+ (let ((buf (get-file-buffer file)))
(if (and buf (buffer-modified-p buf))
(error "Please kill or save all modified buffers before reverting.")))
(if (vc-up-to-date-p file)
(unless (yes-or-no-p (format "%s seems up-to-date. Revert anyway? " file))
(error "Revert canceled"))))
- (if (vc-diff-internal backend vc-allow-async-revert files nil nil)
+ (if (vc-diff-internal vc-allow-async-revert files nil nil)
(progn
(unless (yes-or-no-p (format "Discard changes in %s? " (vc-delistify files)))
(error "Revert canceled"))
@@ -2547,7 +2532,7 @@ This may be either a file-level or a repository-level operation,
depending on the underlying version-control system."
(interactive)
(let* ((files (vc-deduce-fileset))
- (backend (vc-backend (car files)))
+ (backend (vc-backend files))
(granularity (vc-call-backend backend 'revision-granularity)))
(unless (vc-find-backend-function backend 'rollback)
(error "Rollback is not supported in %s" backend))
@@ -2572,8 +2557,8 @@ depending on the underlying version-control system."
(message "Finding changes...")
(let* ((tip (vc-working-revision (car files)))
(previous (vc-call previous-revision (car files) tip)))
- (vc-diff-internal backend nil files previous tip))
- ;; Display changes
+ (vc-diff-internal nil files previous tip))
+ ;; Display changes
(unless (yes-or-no-p "Discard these revisions? ")
(error "Rollback canceled"))
(delete-windows-on "*vc-diff*")
@@ -2586,7 +2571,7 @@ depending on the underlying version-control system."
`((vc-state . ,'up-to-date)
(vc-checkout-time . , (nth 5 (file-attributes file)))
(vc-working-revision . nil)))
- (mapc (lambda (f) (vc-resynch-buffer f t t)) files)
+ (dolist (f files) (vc-resynch-buffer f t t))
(message "Rolling back %s...done" (vc-delistify files))))
;;;###autoload
@@ -2595,9 +2580,9 @@ depending on the underlying version-control system."
;;;###autoload
(defun vc-update ()
"Update the current fileset's files to their tip revisions.
-For each one that contains no changes, and is not locked, then this simply
-replaces the work file with the latest revision on its branch. If the file
-contains changes, and the backend supports merging news, then any recent
+For each one that contains no changes, and is not locked, then this simply
+replaces the work file with the latest revision on its branch. If the file
+contains changes, and the backend supports merging news, then any recent
changes from the current branch are merged into the working file."
(interactive)
(dolist (file (vc-deduce-fileset))
@@ -2623,7 +2608,7 @@ changes from the current branch are merged into the working file."
(defun vc-version-backup-file (file &optional rev)
"Return name of backup file for revision REV of FILE.
If version backups should be used for FILE, and there exists
-such a backup for REV or the working revision of file, return
+such a backup for REV or the working revision of file, return
its name; otherwise return nil."
(when (vc-call make-version-backups-p file)
(let ((backup-file (vc-version-backup-file-name file rev)))
@@ -3048,10 +3033,6 @@ to provide the `find-revision' operation instead."
(vc-call-backend backend 'wash-log)
(buffer-string))))
-(defun vc-default-unregister (backend file)
- "Default implementation of `vc-unregister', signals an error."
- (error "Unregistering files is not supported for %s" backend))
-
(defun vc-default-receive-file (backend file rev)
"Let BACKEND receive FILE from another version control system."
(vc-call-backend backend 'register file rev ""))
@@ -3283,9 +3264,9 @@ age, and everything that is older than that is shown in blue.
Customization variables:
`vc-annotate-menu-elements' customizes the menu elements of the
-mode-specific menu. `vc-annotate-color-map' and
-`vc-annotate-very-old-color' defines the mapping of time to
-colors. `vc-annotate-background' specifies the background color."
+mode-specific menu. `vc-annotate-color-map' and
+`vc-annotate-very-old-color' define the mapping of time to colors.
+`vc-annotate-background' specifies the background color."
(interactive
(save-current-buffer
(vc-ensure-vc-buffer)
@@ -3422,11 +3403,8 @@ revisions after."
(if (not prev-rev)
(message "Cannot diff from any revision prior to %s" rev-at-line)
(save-window-excursion
- (vc-diff-internal
- (vc-backend vc-annotate-parent-file)
- nil
- (list vc-annotate-parent-file)
- prev-rev rev-at-line))
+ (vc-diff-internal nil (list vc-annotate-parent-file)
+ prev-rev rev-at-line))
(switch-to-buffer "*vc-diff*"))))))
(defun vc-annotate-warp-revision (revspec)
View Lorry Controller Status