beta38-pre1 has been uploaded
26 years
SL Baur
SL Baur
This all but the most recent (w/in the last hour) patches posted to
xemacs-beta or sent directly to me. I've tested it under two
different configurations and successfully ran `make install'.
CVS:
http://cvs.xemacs.org/
Patch from vanilla beta37:
ftp://ftp.xemacs.org/pub/xemacs/beta/testing/
-- LDAP fixes from Oscar Figueiredo
-- Fix Lisp union type on MS Windows from Andy Piper
-- Miscellaneous patches from Jonathan Harris, Kirill Katsnelson
-- Build clean up.
- 1 participants
- 0 comments
Re: [Success] 21.0 "Pygmy" XEmacs Lucid (beta37) on i586-pc-linux
26 years
SL Baur
SL Baur
Larry Ayers <layers(a)marktwain.net> writes:
> BTW I recommend the xfstt true-type font server if you like scalable
> fonts with XEmacs; this server will render fonts on-screen very well
> compared to equivalent Postscript fonts from the same foundry.
Cool. Could you please post a pointer to the source?
- 2 participants
- 1 comments
Re: [CRASH] in GC, in compact_string_chars()
26 years
SL Baur
SL Baur
Kirill M Katsnelson <kkm(a)kis.ru> writes:
> I see a corruption in a string_char_block struture. I remember that I have
> already been debugging this place:
> if (FREE_STRUCT_P (from_s_chars))
> {
> fullsize = ((struct unused_string_chars *) from_s_chars)->fullsize;
> from_pos += fullsize;
> continue;
> }
> string = from_s_chars->string;
> assert (!(FREE_STRUCT_P (string)));
If memory serves, this is near the same place where Andrew Cosgriff
was getting crashes or inflooping.
> In the above assert statement, string variable has an ascii value, like
> 0x4C282020 (this is from modeline: " (L" isp interaction), or something
> else, but always characters. This no doubt ends up with GPF, or SEGV,
> whatever you call this sweetie on your system.
> I spent my whole life and borrowed another one catching the reason for
> that, and all to no avail. Does anybody remember something related to
> such a crash?
> I have no reproduction. This is the third time in the last 2 days
> I'm getting this, and the first time in debug build.
Catching corruption problems like this in GC definitely makes it more
difficult to debug.
- 1 participants
- 0 comments
[patch] pcl-cvs enhancements
26 years
Greg Klanderman
Greg Klanderman
I'm not sure how many people are using pcl-cvs - if there's something
better please let me know. And I'm not sure what the issues are with
keeping in synch with the cyclic folk, though it doesn't seem much is
happening on pcl-cvs there.
Anyway, pcl-cvs seemed to have much potential for being pretty nice,
though greatly in need of some new features. So I added a bunch of
the major ones I felt were lacking. I'm still planning on changing
some less-major interface issues - in particular, the temp buffer
showing is horrendous. Anyone has ideas there, please send them my
way. I will also add some more motion commands and small stuff as I
use it more.
Summary of the changes contained here:
- path fix for finding `cvs'
- compiler warning cleanup
- toggle marks command `T' can be used prior to all commands that
use marks, toggling whether to use them or not. new variable for
whether they should be used by default.
- New flags variables for all commands. For all cvs-mode-* commands
that could logically take flags, a single C-u argument means
"prompt me for local flags", where "local" means for this command
invocation only. The local flags are saved to be the default next
time you use C-u a single time. Two C-u arguments means "prompt
me for global flags", where "global" means they will be used for
all later invocations that don't set flags. Default is current
global flags.
- a few cleanups to fix the fact that you could C-g or error out of
a command leaving pcl-cvs in an inconsistent state.
- show directory entries relative to the directory you ran cvs
update on, not `/'.
- tweak buffer formatting.
- re-sort the tins after adding a directory as things will sort
differently.
If these patches are accepted, I will submit needed documentation
updates and re-indent all the functions that need it. I just didn't
want to spend the time if they are not accepted.
Feedback is welcome...
greg
1998-04-27 Greg Klanderman <greg(a)alphatech.com>
* pcl-cvs.el (cvs-find-program): use decode-path-internal.
1998-04-24 Greg Klanderman <greg(a)alphatech.com>
* pcl-cvs.el (cvs-execute-list): remove unused binding of
`arg-str'.
(cvs-mode-commit): remove unused binding of `cvs-buf'.
(cvs-mode-emerge): ditto.
(cvs-old-ediff-interface): ditto.
(cvs-mode-changelog-commit): ditto.
* pcl-cvs.el (cvs-mode-toggle-marks): new function.
(cvs-mode-map): bind it to `T'.
(cvs-default-ignore-marks): New variable to specify default mark
behavior for non-diffing commands.
(cvs-diff-ignore-marks): Update docstring.
(cvs-ignore-marks-p): simple predicate added.
(cvs-mode-commit): use cvs-ignore-marks-p in the call to
cvs-get-marked.
(cvs-mode-diff-cvs): ditto.
(cvs-mode-diff-head): ditto.
(cvs-mode-diff-backup): ditto.
(cvs-mode-diff-vendor): ditto.
(cvs-mode-remove-file): ditto.
(cvs-mode-undo-local-changes): ditto.
(cvs-mode-acknowledge): ditto.
(cvs-mode-add): ditto.
(cvs-mode-ignore): ditto.
(cvs-mode-status): ditto.
(cvs-mode-log): ditto.
(cvs-mode-tag): ditto.
(cvs-mode-rtag): ditto.
(cvs-mode-byte-compile-files): ditto.
(cvs-mode-changelog-commit): ditto.
* pcl-cvs.el: eval-when-compile compiler pacification.
* pcl-cvs.el (cvs-examine): use cvs-maybe-use-local-flags and
cvs-*-flags. Argument now means `set flags', *not* `local'.
(cvs-update): ditto.
(cvs-update-other-window): ditto.
(cvs-mode-update-no-prompt): ditto (but had no arg previously).
(cvs-do-update): remove `local' arg.
(cvs-mode-commit): use cvs-maybe-use-local-flags and cvs-*-flags.
(cvs-mode-changelog-commit): ditto.
(cvs-edit-done): use cvs-commit-flags-to-use, set from either
cvs-mode-commit or cvs-mode-changelog-commit.
1998-04-23 Greg Klanderman <greg(a)alphatech.com>
* pcl-cvs.el (cvs-commit-flags): new flags variable.
(cvs-remove-flags): ditto.
(cvs-undo-flags): ditto.
(cvs-*-flags-local): add defvars for local flags
(cvs-*-flags-history): add defvars for flag histories.
(cvs-mode-add): use cvs-maybe-use-local-flags and cvs-*-flags.
(cvs-mode-status): ditto.
(cvs-mode-log): ditto.
(cvs-mode-tag): ditto
(cvs-mode-rtag): ditto
(cvs-mode-remove-file): ditto
(cvs-mode-undo-local-changes): Don't update cvs fileinfo state
until we know we're not going to signal an error on an unhandled case.
(cvs-mode-undo-local-changes): use cvs-maybe-use-local-flags and
cvs-*-flags.
(cvs-mode-diff-cvs): only construct the argument list once.
(cvs-mode-diff-head): ditto.
(cvs-mode-diff-backup): ditto.
(cvs-mode-diff-vendor): ditto.
(cvs-mode-diff-cvs): use cvs-maybe-use-local-flags and
cvs-*-flags. Argument now means `set flags', *not* `toggle marks'.
(cvs-mode-diff-head): ditto.
(cvs-mode-diff-backup): ditto.
(cvs-mode-diff-vendor): ditto.
1998-04-16 Greg Klanderman <greg(a)alphatech.com>
* pcl-cvs.el (cvs-add-flags): new flags variable for cvs add.
(cvs-maybe-use-local-flags): new macro to use for handling C-u
argument to cvs-mode commands for setting flags.
* pcl-cvs.el (cvs-startup-message): take out CVS ID tags
* pcl-cvs.el (cvs-do-update): tweak buffer formatting
* pcl-cvs.el (cvs-default-directory): new var to save the
working/update directory.
(cvs-do-update): set it.
(cvs-dir-name-relative-to-root): new function - give the directory
name relative to cvs-default-root.
(cvs-pp): use it to format DIRCHANGE entries, show the path only
relative to the root update directory.
* pcl-cvs.el (cvs-add-file-update-buffer): update docs
(cvs-add-do-update): new function - just update the buffer and tins
(cvs-add-buffer-how): new function - has just the part of
cvs-add-file-update-buffer that wants to be done prior to actually
running cvs.
(cvs-add-how): new function - separate files to be added into new
files, new directories, and resurrected files.
(cvs-mode-add): Use the above to avoid modifying the
buffer before the add is actually performed. this way we don't
get confused if the user quits out of the add while entering the
description. also, if directories are added, we now resort the
buffer as directories sort differently than files.
--- pcl-cvs.el Thu Apr 23 07:15:12 1998
+++ /home/greg/emacs/xemacs-20.5/pcl-cvs.el Mon Apr 27 21:13:30 1998
＠＠ -1,7 +1,7 ＠＠
;;;
;;;#ident "＠(#)OrigId: pcl-cvs.el,v 1.93 1993/05/31 22:44:00 ceder Exp "
;;;
-;;;#ident "＠(#)cvs/contrib/pcl-cvs:$Name: $:$Id: pcl-cvs.el,v 1.3 1998/04/23 11:15:12 steveb Exp $"
+;;;#ident "＠(#)cvs/contrib/pcl-cvs:$Name: $:$Id: pcl-cvs.el,v 1.1.1.1 1996/12/18 03:32:27 steve Exp $"
;;;
;;; pcl-cvs.el -- A Front-end to CVS 1.3 or later.
;;; Release 1.05-CVS-$Name: $.
＠＠ -43,11 +43,13 ＠＠
;; also use $GNU here, since may folks might install CVS as a GNU package
;;
(defun cvs-find-program (program)
- (let ((path (list (getenv "LOCAL")
- (getenv "GNU")
- "/usr/local/bin"
- "/usr/bin"
- "/bin")))
+ (let ((path (if (getenv "PATH")
+ (decode-path-internal (getenv "PATH"))
+ (list (getenv "LOCAL")
+ (getenv "GNU")
+ "/usr/local/bin"
+ "/usr/bin"
+ "/bin"))))
(while path
(if (stringp (car path))
(let ((abs-program (expand-file-name program (car path))))
＠＠ -139,8 +141,8 ＠＠
(defconst cvs-startup-message
(if cvs-inhibit-copyright-message
- "PCL-CVS release 1.05-CVS-$Name: $"
- "PCL-CVS release 1.05 from CVS release $Name: $.
+ "PCL-CVS release 1.05-CVS"
+ "PCL-CVS release 1.05 from CVS release.
Copyright (C) 1992, 1993 Per Cederqvist
Pcl-cvs comes with absolutely no warranty; for details consult the manual.
This is free software, and you are welcome to redistribute it under certain
＠＠ -206,11 +208,18 ＠＠
"*Name of the cvs temporary buffer.
Output from cvs is placed here by synchronous commands.")
+(defvar cvs-default-ignore-marks nil
+ "*Non-nil if non-diffing cvs mode commands should ignore any marked files.
+Normally they run on the files that are marked (with cvs-mode-mark),
+or the file under the cursor if no files are marked. If this variable
+is set to a non-nil value they will by default run on the file on the
+current line. See also `cvs-diff-ignore-marks'")
+
(defvar cvs-diff-ignore-marks nil
"*Non-nil if cvs-diff and cvs-mode-diff-backup should ignore any marked files.
Normally they run diff on the files that are marked (with cvs-mode-mark),
or the file under the cursor if no files are marked. If this variable
-is set to a non-nil value they will always run diff on the file on the
+is set to a non-nil value they will by default run diff on the file on the
current line.")
;;; (setq cvs-status-flags '("-v"))
＠＠ -248,6 +257,19 ＠＠
To restrict the update to the current working directory, set this to \"-l\".")
+(defvar cvs-add-flags nil
+ "*List of strings to use as flags to pass to ``cvs add''. Default is none")
+
+(defvar cvs-commit-flags nil
+ "*List of strings to use as flags to pass to ``cvs commit''. Default is none")
+
+(defvar cvs-remove-flags nil
+ "*List of strings to use as flags to pass to ``cvs remove''. Default is none")
+
+(defvar cvs-undo-flags nil
+ "*List of strings to use as flags to pass to ``cvs update'' from
+cvs-mode-undo-local-changes. Default is none")
+
(defvar cvs-update-prog-output-skip-regexp "$"
"*A regexp that matches the end of the output from all cvs update programs.
That is, output from any programs that are run by CVS (by the flag -u in the
＠＠ -275,6 +297,45 ＠＠
(defvar cvs-commit-list nil
"Used internally by pcl-cvs.")
+(defvar cvs-default-directory nil
+ "Used internally by pcl-cvs.")
+
+;;; save the last locally set flags for each command
+;;; so we can offer them again next time.
+;;;
+(defvar cvs-status-flags-local nil)
+(defvar cvs-log-flags-local nil)
+(defvar cvs-tag-flags-local nil)
+(defvar cvs-rtag-flags-local nil)
+(defvar cvs-diff-flags-local nil)
+(defvar cvs-update-optional-flags-local '("-l"))
+(defvar cvs-add-flags-local nil)
+(defvar cvs-commit-flags-local nil)
+(defvar cvs-remove-flags-local nil)
+(defvar cvs-undo-flags-local nil)
+
+;;; save entire history of flags for each command.
+;;;
+(defvar cvs-status-flags-history nil)
+(defvar cvs-log-flags-history nil)
+(defvar cvs-tag-flags-history nil)
+(defvar cvs-rtag-flags-history nil)
+(defvar cvs-diff-flags-history nil)
+(defvar cvs-update-optional-flags-history nil)
+(defvar cvs-add-flags-history nil)
+(defvar cvs-commit-flags-history nil)
+(defvar cvs-remove-flags-history nil)
+(defvar cvs-undo-flags-history nil)
+
+;;; ----------------------------------
+;;; compiler pacification
+;;;
+(eval-when-compile
+ (defvar cvs-commit-flags-to-use)
+ (defvar ediff-version)
+ (defvar cvs-emerge-tmp-head-file)
+ (defvar cvs-ediff-tmp-head-file))
+
;;; The cvs data structure:
;;;
;;; When the `cvs update' is ready we parse the output. Every file
＠＠ -483,8 +544,37 ＠＠
(erase-buffer)))
;;----------
-;;;###autoload
-(defun cvs-examine (directory &optional local)
+(defmacro cvs-maybe-use-local-flags (arg flags desc &rest body)
+ "Macro to use to handle local argument setting."
+ (let ((local-flags (gensym))
+ (global (gensym))
+ (local-save (intern (concat (symbol-name flags) "-local")))
+ (history (intern (concat (symbol-name flags) "-history"))))
+ `(let ((,local-flags ,flags)
+ (,global (and (> (prefix-numeric-value ,arg) 4)
+ (< (prefix-numeric-value ,arg) 64))))
+ (when ,arg
+ (setq ,local-flags
+ (cvs-make-list
+ (read-string (concat (if ,global "Globally" "Locally")
+ " set "
+ ,desc
+ ": ")
+ (mapconcat 'identity
+ (if ,global
+ ,flags
+ ,local-save)
+ " ")
+ ',history)))
+ (setq ,local-save ,local-flags)
+ (if ,global
+ (setq ,flags ,local-flags)))
+ (let ((,flags ,local-flags))
+ ,＠body))))
+(put 'cvs-maybe-use-local-flags 'lisp-indent-function 3)
+
+;;----------
+(defun cvs-examine (directory &optional arg)
"Run a 'cvs -n update' in the current working directory.
That is, check what needs to be done, but don't change the disc.
Feed the output to a *cvs* buffer and run cvs-mode on it.
＠＠ -497,13 +587,15 ＠＠
(interactive (list (read-file-name "CVS Update (directory): "
nil default-directory nil)
current-prefix-arg))
+ (cvs-maybe-use-local-flags arg cvs-update-optional-flags
+ "`cvs update -n' flags"
(let ((use-dialog-box nil))
- (cvs-do-update directory local 'noupdate))
- (switch-to-buffer cvs-buffer-name))
+ (cvs-do-update directory 'noupdate))
+ (switch-to-buffer cvs-buffer-name)))
;;----------
;;;###autoload
-(defun cvs-update (directory &optional local)
+(defun cvs-update (directory &optional arg)
"Run a 'cvs update' in the current working directory. Feed the
output to a *cvs* buffer and run cvs-mode on it.
If optional prefix argument LOCAL is non-nil, 'cvs update -l' is run."
＠＠ -514,12 +606,14 ＠＠
;; If the previous prompt was in a dialog box, the save-some-buffers
;; call in cvs-do-update will lose.
(let ((use-dialog-box nil))
- (cvs-do-update directory local nil))
+ (cvs-maybe-use-local-flags arg cvs-update-optional-flags
+ "`cvs update' flags"
+ (cvs-do-update directory nil)))
(switch-to-buffer cvs-buffer-name))
;;----------
;;;###autoload
-(defun cvs-update-other-window (directory &optional local)
+(defun cvs-update-other-window (directory &optional arg)
"Run a 'cvs update' in the current working directory. Feed the
output to a *cvs* buffer, display it in the other window, and run
cvs-mode on it.
＠＠ -529,7 +623,9 ＠＠
(interactive (list (read-file-name "CVS Update other window (directory): "
nil default-directory nil)
current-prefix-arg))
- (cvs-do-update directory local nil)
+ (cvs-maybe-use-local-flags arg cvs-update-optional-flags
+ "`cvs update' flags"
+ (cvs-do-update directory nil))
(switch-to-buffer-other-window cvs-buffer-name))
;;----------
＠＠ -553,14 +649,16 ＠＠
(cdr head)))
;;----------
-(defun cvs-mode-update-no-prompt ()
+(defun cvs-mode-update-no-prompt (&optional arg)
"Run cvs update in current directory."
- (interactive)
- (cvs-do-update default-directory nil nil))
+ (interactive "P")
+ (cvs-maybe-use-local-flags arg cvs-update-optional-flags
+ "`cvs update' flags"
+ (cvs-do-update default-directory nil)))
;;----------
-(defun cvs-do-update (directory local dont-change-disc)
+(defun cvs-do-update (directory dont-change-disc)
"Do a 'cvs update' in DIRECTORY.
Args: DIRECTORY LOCAL DONT-CHANGE-DISC.
＠＠ -628,7 +726,6 ＠＠
(setq args (concat (if cvs-cvsroot (concat " -d " cvs-cvsroot))
(if dont-change-disc " -n ")
" update "
- (if local " -l ")
(if cvs-update-optional-flags
(mapconcat 'identity
(copy-sequence cvs-update-optional-flags)
＠＠ -637,6 +734,7 ＠＠
;; Set up the buffer that receives the stderr output from "cvs update".
(set-buffer update-buffer)
(setq default-directory this-dir)
+ (setq cvs-default-directory this-dir)
(make-local-variable 'cvs-stdout-file)
(setq cvs-stdout-file temp-name)
＠＠ -663,8 +761,15 ＠＠
(setq cvs-cookie-handle
(collection-create
cvs-buffer-name 'cvs-pp
- cvs-startup-message ;See comment above cvs-startup-message.
- "---------- End -----"))
+ (format "%s\n\nCVSROOT directory: %s\nWorking directory: %s\n"
+ cvs-startup-message ;See comment above cvs-startup-message.
+ (if (stringp cvs-default-directory)
+ (directory-file-name cvs-default-directory)
+ "?????")
+ (if (stringp cvs-cvsroot)
+ (directory-file-name cvs-cvsroot)
+ "?????"))
+ "\n---------- End -----"))
(cookie-enter-first
cvs-cookie-handle
＠＠ -1021,7 +1126,7 ＠＠
(insert "Pcl-cvs Version: "
"＠(#)OrigId: pcl-cvs.el,v 1.93 1993/05/31 22:44:00 ceder Exp\n")
(insert "CVS Version: "
- "＠(#)lisp/pcl-cvs:$Name: $:$Id: pcl-cvs.el,v 1.3 1998/04/23 11:15:12 steveb Exp $\n\n")
+ "＠(#)lisp/pcl-cvs:$Name: $:$Id: pcl-cvs.el,v 1.1.1.1 1996/12/18 03:32:27 steve Exp $\n\n")
(insert (format "--- Contents of stdout buffer (%d chars) ---\n"
(length stdout)))
(insert stdout)
＠＠ -1647,6 +1752,19 ＠＠
"cvs-parse-stdout"))))))
;;----------
+(defun cvs-dir-name-relative-to-root (dir)
+ (if (stringp cvs-default-directory)
+ (let ((base (directory-file-name
+ (file-name-as-directory
+ (expand-file-name cvs-default-directory))))
+ (child (expand-file-name dir)))
+ (if (and (>= (length child) (length base))
+ (string= base (substring child 0 (length base))))
+ (concat "." (substring child (length base)))
+ dir))
+ dir))
+
+;;----------
(defun cvs-pp (fileinfo)
"Pretty print FILEINFO. Insert a printed representation in current buffer.
For use by the cookie package."
＠＠ -1686,7 +1804,8 ＠＠
((eq a 'REM-EXIST)
(format "%s Conflict: Removed by you, but still exists: %s" s f))
((eq a 'DIRCHANGE)
- (format "\nIn directory %s:" (cvs-fileinfo->dir fileinfo)))
+ (format "\nIn directory %s:" (cvs-dir-name-relative-to-root
+ (cvs-fileinfo->dir fileinfo))))
((eq a 'MOVE-AWAY)
(format "%s Move away %s - it is in the way" s f))
((eq a 'REPOS-MISSING)
＠＠ -1735,6 +1854,7 ＠＠
(define-key cvs-mode-map "M" 'cvs-mode-mark-all-files)
(define-key cvs-mode-map "Q" 'cvs-examine)
(define-key cvs-mode-map "R" 'cvs-mode-revert-updated-buffers)
+ (define-key cvs-mode-map "T" 'cvs-mode-toggle-marks)
(define-key cvs-mode-map "U" 'cvs-mode-undo-local-changes)
(define-key cvs-mode-map "a" 'cvs-mode-add)
(define-key cvs-mode-map "b" 'cvs-mode-diff-backup)
＠＠ -1759,6 +1879,32 ＠＠
(define-key cvs-mode-map "x" 'cvs-mode-remove-handled))
;;----------
+(defun cvs-mode-toggle-marks ()
+ "Toggle whether the next CVS command uses marks."
+ (interactive)
+ (cond ((eq last-command 'cvs-mode-toggle-marks)
+ (setq this-command 'cvs-mode-untoggle-marks))
+ (t
+ (setq this-command 'cvs-mode-toggle-marks)))
+ (let ((last-command this-command))
+ (let ((dflt (cvs-ignore-marks-p cvs-default-ignore-marks))
+ (diff (cvs-ignore-marks-p cvs-diff-ignore-marks)))
+ (cond ((and dflt diff)
+ (message "Ignore marks for next command..."))
+ ((and (not dflt) (not diff))
+ (message "Using marks for next command..."))
+ ((and (not dflt) diff)
+ (message "Ignore marks for diff, use for other commands..."))
+ ((and dflt (not diff))
+ (message "Use marks for diff, ignore for other commands..."))))))
+
+;;----------
+(defun cvs-ignore-marks-p (default)
+ (let ((toggled (eq last-command 'cvs-mode-toggle-marks)))
+ (or (and default (not toggled))
+ (and toggled (not default)))))
+
+;;----------
(defun cvs-get-marked (&optional ignore-marks ignore-contents)
"Return a list of all selected tins.
Args: &optional IGNORE-MARKS IGNORE-CONTENTS.
＠＠ -1916,17 +2062,18 ＠＠
(eq type 'CONFLICT)))))
;;----------
-(defun cvs-mode-commit ()
+(defun cvs-mode-commit (&optional arg)
"Check in all marked files, or the current file.
The user will be asked for a log message in a buffer.
If cvs-erase-input-buffer is non-nil that buffer will be erased.
Otherwise mark and point will be set around the entire contents of the
buffer so that it is easy to kill the contents of the buffer with \\[kill-region]."
- (interactive)
- (let* ((cvs-buf (current-buffer))
- (marked (cvs-filter (function cvs-committable)
- (cvs-get-marked))))
+ (interactive "P")
+ (cvs-maybe-use-local-flags arg cvs-commit-flags "`cvs commit' flags"
+ (let* ((marked (cvs-filter (function cvs-committable)
+ (cvs-get-marked (cvs-ignore-marks-p
+ cvs-default-ignore-marks)))))
(if (null marked)
(error "Nothing to commit!")
(pop-to-buffer (get-buffer-create cvs-commit-prompt-buffer))
＠＠ -1938,14 +2085,17 ＠＠
(cvs-edit-mode)
(make-local-variable 'cvs-commit-list)
(setq cvs-commit-list marked)
- (message "Press C-c C-c when you are done editing."))))
+ (make-local-variable 'cvs-commit-flags-to-use)
+ (setq cvs-commit-flags-to-use cvs-commit-flags)
+ (message "Press C-c C-c when you are done editing.")))))
;;----------
(defun cvs-edit-done ()
"Commit the files to the repository."
(interactive)
- (if (null cvs-commit-list)
+ (if (or (null cvs-commit-list)
+ (not (boundp 'cvs-commit-flags-to-use)))
(error "You have already committed the files"))
(if (and (> (point-max) 1)
(/= (char-after (1- (point-max))) ?\n)
＠＠ -1959,6 +2109,7 ＠＠
(insert ?\n)))
(save-some-buffers)
(let ((cc-list cvs-commit-list)
+ (cvs-commit-flags cvs-commit-flags-to-use)
(cc-buffer (get-buffer cvs-buffer-name))
(msg-buffer (current-buffer))
(msg (buffer-substring (point-min) (point-max))))
＠＠ -1966,10 +2117,11 ＠＠
(bury-buffer msg-buffer)
(cvs-use-temp-buffer)
(message "Committing...")
- (if (cvs-execute-list cc-list cvs-program
- (if cvs-cvsroot
- (list "-d" cvs-cvsroot "commit" "-m" msg)
- (list "commit" "-m" msg))
+ (if (cvs-execute-list cc-list
+ cvs-program
+ (append (if cvs-cvsroot (list "-d" cvs-cvsroot))
+ (list "commit" "-m" msg)
+ cvs-commit-flags)
"Committing %s...")
(error "Something went wrong. Check the %s buffer carefully."
cvs-temp-buffer-name))
＠＠ -1981,6 +2133,7 ＠＠
(apply 'tin-invalidate cvs-cookie-handle cc-list)
(set-buffer msg-buffer)
(setq cvs-commit-list nil)
+ (makunbound 'cvs-commit-flags-to-use)
(set-buffer cc-buffer)
(if cvs-auto-remove-handled
(cvs-mode-remove-handled)))
＠＠ -2034,8 +2187,7 ＠＠
(while tin-list
(let ((current-dir (cvs-fileinfo->dir (tin-cookie cvs-cookie-handle
(car tin-list))))
- arg-list
- arg-str)
+ arg-list)
;; Collect all marked files in this directory.
＠＠ -2184,9 +2336,9 ＠＠
(setq result (cons (car tins) result)))
(setq tins (cdr tins))))
(nreverse result)))
-
+
;;----------
-(defun cvs-mode-diff-cvs (&optional ignore-marks)
+(defun cvs-mode-diff-cvs (&optional arg ignore-marks)
"Diff the selected files against the base revisions in the repository.
If the variable cvs-diff-ignore-marks is non-nil any marked files will not be
＠＠ -2201,11 +2353,11 ＠＠
(if (not (listp cvs-diff-flags))
(error "cvs-diff-flags should be set using cvs-set-diff-flags."))
(save-some-buffers)
+ (cvs-maybe-use-local-flags arg cvs-diff-flags "`cvs diff' flags"
(message "cvsdiffing...")
(let ((marked-file-list (cvs-diffable
- (cvs-get-marked
- (or (and ignore-marks (not cvs-diff-ignore-marks))
- (and (not ignore-marks) cvs-diff-ignore-marks))))))
+ (cvs-get-marked (cvs-ignore-marks-p
+ cvs-diff-ignore-marks)))))
(while marked-file-list
(let ((fileinfo-to-diff (tin-cookie cvs-cookie-handle
(car marked-file-list)))
＠＠ -2231,32 +2383,25 ＠＠
(setq buffer-read-only nil)
(setq default-directory local-def-directory)
(erase-buffer)
+ (let ((arglist (append (if cvs-cvsroot (list "-d" cvs-cvsroot))
+ '("diff")
+ cvs-diff-flags
+ (list (cvs-fileinfo->file-name
+ fileinfo-to-diff)))))
(insert (format "=== cd %s\n" default-directory))
(insert (format "=== cvs %s\n\n"
- (mapconcat 'cvs-quote-multiword-string
- (nconc (if cvs-cvsroot
- (list "-d" cvs-cvsroot "diff")
- '("diff"))
- (copy-sequence cvs-diff-flags)
- (list (cvs-fileinfo->file-name
- fileinfo-to-diff)))
- " ")))
- (if (apply 'call-process cvs-program nil t t
- (nconc (if cvs-cvsroot
- (list "-d" cvs-cvsroot "diff")
- '("diff"))
- (copy-sequence cvs-diff-flags)
- (list (cvs-fileinfo->file-name fileinfo-to-diff))))
+ (mapconcat 'cvs-quote-multiword-string arglist " ")))
+ (if (apply 'call-process cvs-program nil t t arglist)
(message "cvsdiffing %s... Done."
(cvs-fileinfo->file-name fileinfo-to-diff))
(message "cvsdiffing %s... No differences found."
- (cvs-fileinfo->file-name fileinfo-to-diff)))
+ (cvs-fileinfo->file-name fileinfo-to-diff))))
(goto-char (point-max))
(setq marked-file-list (cdr marked-file-list)))))
- (message "cvsdiffing... Done."))
+ (message "cvsdiffing... Done.")))
;;----------
-(defun cvs-mode-diff-head (&optional ignore-marks)
+(defun cvs-mode-diff-head (&optional arg ignore-marks)
"Diff the selected files against the head revisions in the repository.
If the variable cvs-diff-ignore-marks is non-nil any marked files will not be
＠＠ -2271,11 +2416,11 ＠＠
(if (not (listp cvs-diff-flags))
(error "cvs-diff-flags should be set using cvs-set-diff-flags."))
(save-some-buffers)
+ (cvs-maybe-use-local-flags arg cvs-diff-flags "`cvs diff' flags"
(message "cvsdiffing...")
(let ((marked-file-list (cvs-diffable
- (cvs-get-marked
- (or (and ignore-marks (not cvs-diff-ignore-marks))
- (and (not ignore-marks) cvs-diff-ignore-marks))))))
+ (cvs-get-marked (cvs-ignore-marks-p
+ cvs-diff-ignore-marks)))))
(while marked-file-list
(let ((fileinfo-to-diff (tin-cookie cvs-cookie-handle
(car marked-file-list)))
＠＠ -2301,32 +2446,25 ＠＠
(setq buffer-read-only nil)
(setq default-directory local-def-directory)
(erase-buffer)
+ (let ((arglist (append (if cvs-cvsroot (list "-d" cvs-cvsroot))
+ '("diff" "-rHEAD")
+ cvs-diff-flags
+ (list (cvs-fileinfo->file-name
+ fileinfo-to-diff)))))
(insert (format "=== cd %s\n" default-directory))
(insert (format "=== cvs %s\n\n"
- (mapconcat 'cvs-quote-multiword-string
- (nconc (if cvs-cvsroot
- (list "-d" cvs-cvsroot "diff" "-rHEAD")
- '("diff" "-rHEAD"))
- (copy-sequence cvs-diff-flags)
- (list (cvs-fileinfo->file-name
- fileinfo-to-diff)))
- " ")))
- (if (apply 'call-process cvs-program nil t t
- (nconc (if cvs-cvsroot
- (list "-d" cvs-cvsroot "diff" "-rHEAD")
- '("diff" "-rHEAD"))
- (copy-sequence cvs-diff-flags)
- (list (cvs-fileinfo->file-name fileinfo-to-diff))))
+ (mapconcat 'cvs-quote-multiword-string arglist " ")))
+ (if (apply 'call-process cvs-program nil t t arglist)
(message "cvsdiffing %s... Done."
(cvs-fileinfo->file-name fileinfo-to-diff))
(message "cvsdiffing %s... No differences found."
- (cvs-fileinfo->file-name fileinfo-to-diff)))
+ (cvs-fileinfo->file-name fileinfo-to-diff))))
(goto-char (point-max))
(setq marked-file-list (cdr marked-file-list)))))
- (message "cvsdiffing... Done."))
+ (message "cvsdiffing... Done.")))
;;----------
-(defun cvs-mode-diff-backup (&optional ignore-marks)
+(defun cvs-mode-diff-backup (&optional arg ignore-marks)
"Diff the files against the backup file.
This command can be used on files that are marked with \"Merged\"
or \"Conflict\" in the *cvs* buffer.
＠＠ -2343,12 +2481,11 ＠＠
(if (not (listp cvs-diff-flags))
(error "cvs-diff-flags should be set using cvs-set-diff-flags."))
(save-some-buffers)
+ (cvs-maybe-use-local-flags arg cvs-diff-flags "`cvs diff' flags"
(let ((marked-file-list (cvs-filter
(function cvs-backup-diffable)
- (cvs-get-marked
- (or
- (and ignore-marks (not cvs-diff-ignore-marks))
- (and (not ignore-marks) cvs-diff-ignore-marks))))))
+ (cvs-get-marked (cvs-ignore-marks-p
+ cvs-diff-ignore-marks)))))
(if (null marked-file-list)
(error "No ``Conflict'' or ``Merged'' file selected!"))
(message "backup diff...")
＠＠ -2383,23 +2520,21 ＠＠
(setq buffer-read-only nil)
(setq default-directory local-def-directory)
(erase-buffer)
+ (let ((arglist (append cvs-diff-flags
+ backup-temp-files)))
(insert (format "=== cd %s\n" default-directory))
(insert (format "=== %s %s\n\n"
cvs-diff-program
- (mapconcat 'cvs-quote-multiword-string
- (nconc (copy-sequence cvs-diff-flags)
- backup-temp-files)
- " ")))
- (apply 'call-process cvs-diff-program nil t t
- (nconc (copy-sequence cvs-diff-flags) backup-temp-files))
+ (mapconcat 'cvs-quote-multiword-string arglist " ")))
+ (apply 'call-process cvs-diff-program nil t t arglist))
(goto-char (point-max))
(message "backup diff %s... Done."
(cvs-fileinfo->file-name fileinfo-to-diff))
(setq marked-file-list (cdr marked-file-list)))))
- (message "backup diff... Done."))
+ (message "backup diff... Done.")))
;;----------
-(defun cvs-mode-diff-vendor (&optional ignore-marks)
+(defun cvs-mode-diff-vendor (&optional arg ignore-marks)
"Diff the revisions merged into the current file. I.e. show what changes
were merged in.
＠＠ -2418,12 +2553,11 ＠＠
(if (not (listp cvs-diff-flags))
(error "cvs-diff-flags should be set using cvs-set-diff-flags."))
(save-some-buffers)
+ (cvs-maybe-use-local-flags arg cvs-diff-flags "`cvs diff' flags"
(let ((marked-file-list (cvs-filter
(function cvs-vendor-diffable)
- (cvs-get-marked
- (or
- (and ignore-marks (not cvs-diff-ignore-marks))
- (and (not ignore-marks) cvs-diff-ignore-marks))))))
+ (cvs-get-marked (cvs-ignore-marks-p
+ cvs-diff-ignore-marks)))))
(if (null marked-file-list)
(error "No ``Conflict'' or ``Merged'' file selected!"))
(message "vendor diff...")
＠＠ -2459,15 +2593,13 ＠＠
(setq buffer-read-only nil)
(setq default-directory local-def-directory)
(erase-buffer)
+ (let ((arglist (append cvs-diff-flags
+ vendor-temp-files)))
(insert (format "=== cd %s\n" default-directory))
(insert (format "=== %s %s\n\n"
cvs-diff-program
- (mapconcat 'cvs-quote-multiword-string
- (nconc (copy-sequence cvs-diff-flags)
- vendor-temp-files)
- " ")))
- (apply 'call-process cvs-diff-program nil t t
- (nconc (copy-sequence cvs-diff-flags) vendor-temp-files))
+ (mapconcat 'cvs-quote-multiword-string arglist " ")))
+ (apply 'call-process cvs-diff-program nil t t arglist))
(goto-char (point-max))
(message "vendor diff %s... Done."
(cvs-fileinfo->file-name fileinfo-to-diff))
＠＠ -2476,7 +2608,7 ＠＠
(delete-file (car vendor-temp-files))
(setq vendor-temp-files (cdr vendor-temp-files)))
(setq marked-file-list (cdr marked-file-list)))))
- (message "vendor diff... Done."))
+ (message "vendor diff... Done.")))
;;----------
(defun cvs-backup-diffable (tin)
＠＠ -2679,30 +2811,36 ＠＠
(t nil)))
;;----------
-(defun cvs-mode-remove-file ()
+(defun cvs-mode-remove-file (&optional arg)
"Remove all marked files."
- (interactive)
- (let ((files-to-remove (cvs-do-removal (cvs-get-marked))))
+ (interactive "P")
+ (cvs-maybe-use-local-flags arg cvs-remove-flags "`cvs remove' flags"
+ (let ((files-to-remove (cvs-do-removal (cvs-get-marked
+ (cvs-ignore-marks-p
+ cvs-default-ignore-marks)))))
(if (null files-to-remove)
nil
(cvs-use-temp-buffer)
(message "removing from repository...")
- (if (cvs-execute-list files-to-remove cvs-program
- (if cvs-cvsroot
- (list "-d" cvs-cvsroot "remove")
- '("remove"))
+ (if (cvs-execute-list files-to-remove
+ cvs-program
+ (append (if cvs-cvsroot (list "-d" cvs-cvsroot))
+ '("remove")
+ cvs-remove-flags)
"removing %s from repository...")
(error "CVS exited with non-zero exit status.")
- (message "removing from repository... Done.")))))
+ (message "removing from repository... Done."))))))
;;----------
-(defun cvs-mode-undo-local-changes ()
+(defun cvs-mode-undo-local-changes (&optional arg)
"Undo local changes to all marked files.
The file is removed and `cvs update FILE' is run."
- (interactive)
- (let ((tins-to-undo (cvs-get-marked)))
+ (interactive "P")
+ (cvs-maybe-use-local-flags arg cvs-undo-flags "undo local changes flags"
+ (let ((tins-to-undo (cvs-get-marked (cvs-ignore-marks-p
+ cvs-default-ignore-marks))))
(cvs-use-temp-buffer)
(mapcar 'cvs-insert-full-path tins-to-undo)
(cond
＠＠ -2714,29 +2852,17 ＠＠
(fileinfo (tin-cookie cvs-cookie-handle tin))
(type (cvs-fileinfo->type fileinfo)))
(cond
- ((or
- (eq type 'UPDATED)
- (eq type 'PATCHED)
- (eq type 'MODIFIED)
- (eq type 'MERGED)
- (eq type 'CONFLICT)
- (eq type 'CVS-REMOVED)
- (eq type 'REM-CONFLICT)
- (eq type 'MOVE-AWAY)
- (eq type 'REMOVED))
- (if (not (eq type 'REMOVED))
- (delete-file (cvs-full-path tin)))
- (setq files-to-update (cons tin files-to-update))
- (cvs-set-fileinfo->type fileinfo 'UPDATED)
- (cvs-set-fileinfo->handled fileinfo t)
- (tin-invalidate cvs-cookie-handle tin))
+ ((memq type '(UPDATED PATCHED MODIFIED MERGED CONFLICT
+ CVS-REMOVED REM-CONFLICT MOVE-AWAY REMOVED))
+ (setq files-to-update (cons tin files-to-update)))
((eq type 'MOD-CONFLICT)
(error "Use cvs-mode-add instead on %s."
(cvs-fileinfo->file-name fileinfo)))
((eq type 'REM-CONFLICT)
- (error "Can't deal with a file you have removed and recreated."))
+ (error "Can't deal with a file you have removed and recreated: %s."
+ (cvs-fileinfo->file-name fileinfo)))
((eq type 'DIRCHANGE)
(error "Undo on directories not supported (yet)."))
＠＠ -2744,19 +2870,37 ＠＠
((eq type 'ADDED)
(error "There is no old revision to get for %s"
(cvs-fileinfo->file-name fileinfo)))
- (t (error "cvs-mode-undo-local-changes: can't handle an %s"
+ (t (error "cvs-mode-undo-local-changes: can't handle type %s"
type)))
(setq tins-to-undo (cdr tins-to-undo))))
+ (setq tins-to-undo files-to-update)
+ (while tins-to-undo
+ (let* ((tin (car tins-to-undo))
+ (fileinfo (tin-cookie cvs-cookie-handle tin))
+ (type (cvs-fileinfo->type fileinfo)))
+ (cond
+ ((memq type '(UPDATED PATCHED MODIFIED MERGED CONFLICT
+ CVS-REMOVED REM-CONFLICT MOVE-AWAY REMOVED))
+ (if (not (eq type 'REMOVED))
+ (delete-file (cvs-full-path tin)))
+ (cvs-set-fileinfo->type fileinfo 'UPDATED)
+ (cvs-set-fileinfo->handled fileinfo t)
+ (tin-invalidate cvs-cookie-handle tin))
+
+ (t (error "serious error in cvs-mode-undo-local-changes")))
+
+ (setq tins-to-undo (cdr tins-to-undo))))
(cvs-use-temp-buffer)
(message "Re-getting files from repository...")
- (if (cvs-execute-list files-to-update cvs-program
- (if cvs-cvsroot
- (list "-d" cvs-cvsroot "update")
- '("update"))
+ (if (cvs-execute-list files-to-update
+ cvs-program
+ (append (if cvs-cvsroot (list "-d" cvs-cvsroot))
+ '("update")
+ cvs-undo-flags)
"Re-getting %s from repository...")
(error "CVS exited with non-zero exit status.")
- (message "Re-getting files from repository... Done.")))))))
+ (message "Re-getting files from repository... Done."))))))))
;;----------
(defun cvs-mode-acknowledge ()
＠＠ -2765,7 +2909,8 ＠＠
(interactive)
(mapcar (function (lambda (tin)
(tin-delete cvs-cookie-handle tin)))
- (cvs-get-marked)))
+ (cvs-get-marked (cvs-ignore-marks-p
+ cvs-default-ignore-marks))))
;;----------
(defun cvs-mode-unmark-up (pos)
＠＠ -2798,11 +2943,11 ＠＠
;;----------
(defun cvs-add-file-update-buffer (tin)
- "Sub-function to cvs-mode-add. Internal use only. Update the display. Return
-non-nil if `cvs add' should be called on this file.
+ "Sub-function to cvs-mode-add. Internal use only.
+Update the display for tin.
Args: TIN.
-Returns 'DIR, 'ADD, 'ADD-DIR, or 'RESURRECT."
+Returns 'ADD, 'ADD-DIR, or 'RESURRECT."
(let ((fileinfo (tin-cookie cvs-cookie-handle tin)))
(cond
＠＠ -2822,18 +2967,46 ＠＠
'RESURRECT))))
;;----------
-(defun cvs-add-sub (cvs-buf candidates)
+(defun cvs-add-do-update (cvs-buf candidates)
+ "Internal use only. Update display for CANDIDATES.
+Args: CVS-BUF CANDIDATES.
+
+CANDIDATES is a list of tins. Updates the CVS-BUF."
+
+ (while candidates
+ (cvs-add-file-update-buffer (car candidates))
+ (setq candidates (cdr candidates))))
+
+;;----------
+(defun cvs-add-buffer-how (tin)
+ "Sub-function to cvs-mode-add. Internal use only.
+Return non-nil if `cvs add' should be called on this file.
+Args: TIN.
+
+Returns 'ADD, 'ADD-DIR, or 'RESURRECT."
+
+ (let ((fileinfo (tin-cookie cvs-cookie-handle tin)))
+ (cond
+ ((eq (cvs-fileinfo->type fileinfo) 'UNKNOWN-DIR)
+ 'ADD-DIR)
+ ((eq (cvs-fileinfo->type fileinfo) 'UNKNOWN)
+ 'ADD)
+ ((eq (cvs-fileinfo->type fileinfo) 'REMOVED)
+ 'RESURRECT))))
+
+;;----------
+(defun cvs-add-how (cvs-buf candidates)
"Internal use only.
Args: CVS-BUF CANDIDATES.
-CANDIDATES is a list of tins. Updates the CVS-BUF and returns a list of lists.
+CANDIDATES is a list of tins. Returns a list of lists.
The first list is unknown tins that shall be `cvs add -m msg'ed.
The second list is unknown directory tins that shall be `cvs add -m msg'ed.
The third list is removed files that shall be `cvs add'ed (resurrected)."
(let (add add-dir resurrect)
(while candidates
- (let ((type (cvs-add-file-update-buffer (car candidates))))
+ (let ((type (cvs-add-buffer-how (car candidates))))
(cond ((eq type 'ADD)
(setq add (cons (car candidates) add)))
((eq type 'ADD-DIR)
＠＠ -2844,13 +3017,16 ＠＠
(list add add-dir resurrect)))
;;----------
-(defun cvs-mode-add ()
+(defun cvs-mode-add (&optional arg)
"Add marked files to the cvs repository."
- (interactive)
+ (interactive "P")
+ (cvs-maybe-use-local-flags arg cvs-add-flags "`cvs add' flags"
+ ;; (message "add flags = %s" cvs-add-flags) (sit-for 5)
(let* ((buf (current-buffer))
- (marked (cvs-get-marked))
- (result (cvs-add-sub buf marked))
+ (marked (cvs-get-marked (cvs-ignore-marks-p
+ cvs-default-ignore-marks)))
+ (result (cvs-add-how buf marked))
(added (car result))
(newdirs (car (cdr result)))
(resurrect (car (cdr (cdr result))))
＠＠ -2864,31 +3040,33 ＠＠
(message "Resurrecting files from repository...")
(if (cvs-execute-list resurrect
cvs-program
- (if cvs-cvsroot
- (list "-d" cvs-cvsroot "add")
- '("add"))
+ (append (if cvs-cvsroot (list "-d" cvs-cvsroot))
+ (list "add")
+ cvs-add-flags)
"Resurrecting %s from repository...")
(error "CVS exited with non-zero exit status.")
+ (cvs-add-do-update buf resurrect)
(message "Resurrecting files from repository... Done."))))
(cond (added
(message "Adding new files to repository...")
(if (cvs-execute-list added
cvs-program
- (if cvs-cvsroot
- (list "-d" cvs-cvsroot "add" "-m" msg)
- (list "add" "-m" msg))
+ (append (if cvs-cvsroot (list "-d" cvs-cvsroot))
+ (list "add" "-m" msg)
+ cvs-add-flags)
"Adding %s to repository...")
(error "CVS exited with non-zero exit status.")
+ (cvs-add-do-update buf added)
(message "Adding new files to repository... Done."))))
(cond (newdirs
(message "Adding new directories to repository...")
(if (cvs-execute-list newdirs
cvs-program
- (if cvs-cvsroot
- (list "-d" cvs-cvsroot "add" "-m" msg)
- (list "add" "-m" msg))
+ (append (if cvs-cvsroot (list "-d" cvs-cvsroot))
+ (list "add" "-m" msg)
+ cvs-add-flags)
"Adding %s to repository...")
(error "CVS exited with non-zero exit status.")
(while newdirs
＠＠ -2903,9 +3081,12 ＠＠
(cvs-set-fileinfo->file-name fileinfo ".")
(tin-invalidate cvs-cookie-handle tin)
(setq newdirs (cdr newdirs))))
+ (cvs-add-do-update buf newdirs)
+ (cookie-sort cvs-cookie-handle
+ (function cvs-compare-fileinfos))
;; FIXME: this should really run cvs-update-no-prompt on the
;; subdir and insert everthing in the current list.
- (message "You must re-update to visit the new directories."))))))
+ (message "You must re-update to visit the new directories.")))))))
;;----------
(defun cvs-mode-ignore ()
＠＠ -2920,7 +3101,8 ＠＠
(eq type 'UNKNOWN-DIR))
(cvs-append-to-ignore fileinfo)
(tin-delete cvs-cookie-handle tin))))))
- (cvs-get-marked)))
+ (cvs-get-marked (cvs-ignore-marks-p
+ cvs-default-ignore-marks))))
;;----------
(defun cvs-append-to-ignore (fileinfo)
＠＠ -2939,14 +3121,17 ＠＠
(save-buffer)))
;;----------
-(defun cvs-mode-status ()
+(defun cvs-mode-status (&optional arg)
"Show cvs status for all marked files."
- (interactive)
+ (interactive "P")
(save-some-buffers)
+ (cvs-maybe-use-local-flags arg cvs-status-flags "`cvs status' flags"
(if (not (listp cvs-status-flags))
(error "cvs-status-flags should be set using cvs-set-status-flags."))
- (let ((marked (cvs-get-marked nil t)))
+ (let ((marked (cvs-get-marked (cvs-ignore-marks-p
+ cvs-default-ignore-marks)
+ t)))
(cvs-use-temp-buffer)
(message "Running cvs status ...")
(if (cvs-execute-list marked
＠＠ -2956,16 +3141,19 ＠＠
cvs-status-flags)
"Running cvs -Q status %s...")
(error "CVS exited with non-zero exit status.")
- (message "Running cvs -Q status ... Done."))))
+ (message "Running cvs -Q status ... Done.")))))
;;----------
-(defun cvs-mode-log ()
+(defun cvs-mode-log (&optional arg)
"Display the cvs log of all selected files."
- (interactive)
+ (interactive "P")
+ (cvs-maybe-use-local-flags arg cvs-log-flags "`cvs log' flags"
(if (not (listp cvs-log-flags))
(error "cvs-log-flags should be set using cvs-set-log-flags."))
- (let ((marked (cvs-get-marked nil t)))
+ (let ((marked (cvs-get-marked (cvs-ignore-marks-p
+ cvs-default-ignore-marks)
+ t)))
(cvs-use-temp-buffer)
(message "Running cvs log ...")
(if (cvs-execute-list marked
＠＠ -2975,16 +3163,19 ＠＠
cvs-log-flags)
"Running cvs log %s...")
(error "CVS exited with non-zero exit status.")
- (message "Running cvs log ... Done."))))
+ (message "Running cvs log ... Done.")))))
;;----------
-(defun cvs-mode-tag ()
+(defun cvs-mode-tag (&optional arg)
"Run 'cvs tag' on all selected files."
- (interactive)
+ (interactive "P")
+ (cvs-maybe-use-local-flags arg cvs-tag-flags "`cvs tag' flags"
(if (not (listp cvs-tag-flags))
(error "cvs-tag-flags should be set using cvs-set-tag-flags."))
- (let ((marked (cvs-get-marked nil t))
+ (let ((marked (cvs-get-marked (cvs-ignore-marks-p
+ cvs-default-ignore-marks)
+ t))
(tag-args (cvs-make-list (read-string "Tag name (and flags): "))))
(cvs-use-temp-buffer)
(message "Running cvs tag ...")
＠＠ -2996,16 +3187,19 ＠＠
tag-args)
"Running cvs tag %s...")
(error "CVS exited with non-zero exit status.")
- (message "Running cvs tag ... Done."))))
+ (message "Running cvs tag ... Done.")))))
;;----------
-(defun cvs-mode-rtag ()
+(defun cvs-mode-rtag (&optional arg)
"Run 'cvs rtag' on all selected files."
- (interactive)
+ (interactive "P")
+ (cvs-maybe-use-local-flags arg cvs-rtag-flags "`cvs rtag' flags"
(if (not (listp cvs-rtag-flags))
(error "cvs-rtag-flags should be set using cvs-set-rtag-flags."))
- (let ((marked (cvs-get-marked nil t))
+ (let ((marked (cvs-get-marked (cvs-ignore-marks-p
+ cvs-default-ignore-marks)
+ t))
;; FIXME: should give selection from the modules file
(module-name (read-string "Module name: "))
;; FIXME: should also ask for an existing tag *or* date
＠＠ -3021,14 +3215,15 ＠＠
(list module-name))
"Running cvs rtag %s...")
(error "CVS rtag exited with non-zero exit status.")
- (message "Running cvs rtag ... Done."))))
+ (message "Running cvs rtag ... Done.")))))
;;----------
(defun cvs-mode-byte-compile-files ()
"Run byte-compile-file on all selected files that end in '.el'."
(interactive)
- (let ((marked (cvs-get-marked)))
+ (let ((marked (cvs-get-marked (cvs-ignore-marks-p
+ cvs-default-ignore-marks))))
(while marked
(let ((filename (cvs-full-path (car marked))))
(if (string-match "\\.el$" filename)
＠＠ -3091,8 +3286,7 ＠＠
Args: POS."
(interactive "d")
- (let* ((cvs-buf (current-buffer))
- (tin (tin-locate cvs-cookie-handle pos)))
+ (let* ((tin (tin-locate cvs-cookie-handle pos)))
(if (boundp 'cvs-emerge-tmp-head-file)
(error "There can only be one emerge session active at a time."))
(if tin
＠＠ -3170,8 +3364,7 ＠＠
"Emerge like interface for older ediffs.
Args: POS"
- (let* ((cvs-buf (current-buffer))
- (tin (tin-locate cvs-cookie-handle pos)))
+ (let* ((tin (tin-locate cvs-cookie-handle pos)))
(if tin
(let* ((fileinfo (tin-cookie cvs-cookie-handle tin))
(type (cvs-fileinfo->type fileinfo)))
＠＠ -3609,7 +3802,7 ＠＠
(forward-line 1))
(indent-rigidly (point-min) (point-max) (- common)))))
-(defun cvs-mode-changelog-commit ()
+(defun cvs-mode-changelog-commit (&optional arg)
"Check in all marked files, or the current file.
Ask the user for a log message in a buffer.
＠＠ -3626,11 +3819,11 ＠＠
the files we're checking in, and finally
- use those paragraphs as the log text."
- (interactive)
-
- (let* ((cvs-buf (current-buffer))
- (marked (cvs-filter (function cvs-committable)
- (cvs-get-marked))))
+ (interactive "P")
+ (cvs-maybe-use-local-flags arg cvs-commit-flags "`cvs commit' flags"
+ (let* ((marked (cvs-filter (function cvs-committable)
+ (cvs-get-marked (cvs-ignore-marks-p
+ cvs-default-ignore-marks)))))
(if (null marked)
(error "Nothing to commit!")
(pop-to-buffer (get-buffer-create cvs-commit-prompt-buffer))
＠＠ -3649,7 +3842,9 ＠＠
(cvs-edit-mode)
(make-local-variable 'cvs-commit-list)
(setq cvs-commit-list marked)
- (message "Press C-c C-c when you are done editing."))))
+ (make-local-variable 'cvs-commit-flags-to-use)
+ (setq cvs-commit-flags-to-use cvs-commit-flags)
+ (message "Press C-c C-c when you are done editing.")))))
(provide 'pcl-cvs)
- 1 participants
- 0 comments
Re: [PATCH] Frame crash and extra minibuffers fixes
26 years
SL Baur
SL Baur
Greg Klanderman <greg(a)alphatech.com> writes:
>>> Steve, was this to fix a bug or did it just look wrong?
sb>
sb> It was to fix a bug. `called_from_delete_device' can never be less
sb> than 0 so it is a degenerate comparison.
> The bug being that called_from_delete_device can never be negative, or
> that this code not being run was actually causing a problem for someone?
The former.
>>> I see nowhere that function is called with other than 0 or 1,
>>> so maybe this code should just be ifdef'd out or removed?
sb>
sb> Yes, reversing the patch I made is equivalent to `if (1)' so there
sb> little point to keeping that conditional if it is causing problems.
> You mean `if (0)', of course...
Of course, oops.
> Can you reproduce this:
> xemacs -q
> <split window, load 2 files>
> M-x ediff-buffers
`Symbol's value as variable is void: allow-remote-paths'
> quit ediff
> M-x ediff-buffers again
> Do you get spurious creation of a minibuffer only frame?
> Both Kirill and I do.
I've applied half of Kirill's patch and #if 0'ed out the `if' I
changed and he reverted. There'll be a snapshot made tonight.
- 2 participants
- 1 comments
[patch] pcl-cvs-xemacs font locking
26 years
Greg Klanderman
Greg Klanderman
Fix the highly losing font locking..
greg
1998-04-24 Greg Klanderman <greg(a)alphatech.com>
* pcl-cvs-xemacs.el (pcl-cvs-font-lock-keywords): fix these so
they work reasonably.
--- pcl-cvs-xemacs.el Wed Jan 14 01:44:45 1998
+++ /home/greg/emacs/xemacs-20.5/pcl-cvs-xemacs.el Wed Apr 22 13:58:54 1998
＠＠ -108,12 +108,37 ＠＠
(looking-at "^[* ] ")))))
(mode-motion-highlight-line event)))
+(defconst pcl-cvs-status-list
+ '("Updated"
+ "Patched"
+ "Modified"
+ "Merged"
+ "Conflict"
+ "Added"
+ "Removed"
+ "Unknown dir"
+ "Unknown"
+ "Removed from repository:"
+ "Conflict: Removed from repository, changed by you:"
+ "Conflict: Removed by you, changed in repository:"
+ "Conflict: Removed by you, but still exists:")
+ "List of status values in pcl-cvs")
+
(defconst pcl-cvs-font-lock-keywords
- '(("^In directory \\(.+\\)$" 1 cvs-header-face)
- ("^[* ] \\w+ +\\(ci\\)" 1 cvs-status-face)
- ("^[* ] \\(Conflict\\|Merged\\)" 1 cvs-status-face)
- ("^[* ] \\w+ +\\(ci +\\)?\\(.+\\)$" 2 cvs-filename-face)
- )
+ (let ((file-line (concat "^[* ] \\(\\("
+ (mapconcat 'identity
+ pcl-cvs-status-list
+ "\\|")
+ "\\)\\( +ci\\)?\\)\\(.+\\)$"))
+ (move-away "\\(Move away\\) \\(.*\\) \\(- it is in the way\\)"))
+ `(("^In directory \\(.+\\)[:]$" 1 cvs-header-face)
+ (,file-line 1 cvs-status-face)
+ (,file-line 4 cvs-filename-face)
+ (,move-away 1 cvs-status-face)
+ (,move-away 3 cvs-status-face)
+ (,move-away 2 cvs-filename-face)
+ ("This repository directory is missing! Remove this directory manually."
+ 0 cvs-status-face)))
"Patterns to highlight in the *cvs* buffer.")
;;;###autoload
- 1 participants
- 0 comments
Re: [PATCH] menubar selection in mswindows
26 years
Hrvoje Niksic
Hrvoje Niksic
Jan Vroonhof <vroonhof(a)math.ethz.ch> writes:
> Hrvoje Niksic <hniksic(a)srce.hr> writes:
>
> > Lstreams rule. Look at my latest and greatest md5.c implementation to
> > see how simple it is to set up a decoding lstream for that purpose.
>
> Does that mean that md5.c mow works under MULE?
Yes, since quite a while. I made some cleanups to the file, and it
passed my file coding tests.
--
Hrvoje Niksic <hniksic(a)srce.hr> | Student at FER Zagreb, Croatia
--------------------------------+--------------------------------
Unspeakable horrors from outer space paralyze the living and
resurrect the dead!
- 1 participants
- 0 comments
Re: select-window focus problem [was: Re: minor compile.el bug]
26 years
Greg Klanderman
Greg Klanderman
OK, I really really think this is right this time. I talked to Ben
and Kyle some and have tested it a bit with more complicated cases.
(this is the (setq focus-follows-mouse t) (select-frame (next-frame))
bug in case you've lost track.)
One issue is that investigate_focus_change and focus_follows_mouse are
now used in cmdloop.c, so prototypes should be placed into some
appropriate header file. I wasn't sure where was right so I just put
externs in Fcommand_loop_1, which is a bit yucko.
greg
1998-04-27 Greg Klanderman <greg(a)alphatech.com>
* cmdloop.c (Fcommand_loop_1): Call investigate_frame_change if
focus_follows_mouse is true.
* event-stream.c (next_event_internal): Only call
investigate_frame_change if focus_follows_mouse is false.
* event-stream.c (investigate_frame_change): Fix
focus_follows_mouse handling. It was the case that, with
focus_follows_mouse true, (select-frame (next-frame)) could leave
next-frame with input focus, but not window manager focus. Now
needs to be called from 2 places, conditional on the value of
focus_follows_mouse.
Index: src/event-stream.c
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs-20/src/event-stream.c,v
retrieving revision 1.39
diff -u -r1.39 event-stream.c
--- event-stream.c 1998/04/14 07:47:12 1.39
+++ event-stream.c 1998/04/28 08:39:46
＠＠ -1718,8 +1718,9 ＠＠
run_hook (Qdeselect_frame_hook);
}
-/* When select-frame is called, we want to tell the window system that
- the focus should be changed to point to the new frame. However,
+/* When select-frame is called and focus_follows_mouse is false, we want
+ to tell the window system that the focus should be changed to point to
+ the new frame. However,
sometimes Lisp functions will temporarily change the selected frame
(e.g. to call a function that operates on the selected frame),
and it's annoying if this focus-change happens exactly when
＠＠ -1729,9 +1730,17 ＠＠
an event from the user. To do this, we keep track of the frame
where the window-manager focus lies on, and just before waiting
for user events, check the currently selected frame and change
- the focus as necessary. */
+ the focus as necessary.
-static void
+ On the other hand, if focus_follows_mouse is true, we need to switch the
+ selected frame back to the frame with window manager focus just before we
+ execute the next command in Fcommand_loop_1, just as the selected buffer is
+ reverted after a set-buffer.
+
+ Both cases are handled by this function. It must be called as appropriate
+ from these two places, depending on the value of focus_follows_mouse. */
+
+void
investigate_frame_change (void)
{
Lisp_Object devcons, concons;
＠＠ -1751,14 +1760,46 ＠＠
in emacs_handle_focus_change_final() is based on the _FOR_HOOKS
value, we need to do so too. */
if (!NILP (sel_frame) &&
- !focus_follows_mouse &&
!EQ (DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d), sel_frame) &&
!NILP (DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d)) &&
!EQ (DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d), sel_frame))
{
- /* prevent us from issuing the same request more than once */
- DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d) = sel_frame;
- MAYBE_DEVMETH (d, focus_on_frame, (XFRAME (sel_frame)));
+ /* At this point, we know that the frame has been changed. Now, if
+ * focus_follows_mouse is not set, we finish off the frame change,
+ * so that user events will now come from the new frame. Otherwise,
+ * if focus_follows_mouse is set, no gratuitous frame changing
+ * should take place. Set the focus back to the frame which was
+ * originally selected for user input.
+ */
+ if (!focus_follows_mouse)
+ {
+ /* prevent us from issuing the same request more than once */
+ DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d) = sel_frame;
+ MAYBE_DEVMETH (d, focus_on_frame, (XFRAME (sel_frame)));
+ }
+ else
+ {
+ Lisp_Object old_frame = Qnil;
+
+ /* #### Do we really want to check OUGHT ??
+ * It seems to make sense, though I have never seen us
+ * get here and have it be non-nil.
+ */
+ if (FRAMEP (DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d)))
+ old_frame = DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d);
+ else if (FRAMEP (DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d)))
+ old_frame = DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d);
+
+ /* #### Can old_frame ever be NIL? play it safe.. */
+ if (!NILP (old_frame))
+ {
+ /* Fselect_frame is not really the right thing: it frobs the
+ * buffer stack. But there's no easy way to do the right
+ * thing, and this code already had this problem anyway.
+ */
+ Fselect_frame (old_frame);
+ }
+ }
}
}
}
＠＠ -1932,7 +1973,12 ＠＠
assert (NILP (XEVENT_NEXT (target_event)));
GCPRO1 (target_event);
- investigate_frame_change ();
+
+ /* When focus_follows_mouse is nil, if a frame change took place, we need
+ * to actually switch window manager focus to the selected window now.
+ */
+ if (!focus_follows_mouse)
+ investigate_frame_change ();
if (allow_queued && !NILP (command_event_queue))
{
Index: src/cmdloop.c
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs-20/src/cmdloop.c,v
retrieving revision 1.6
diff -u -r1.6 cmdloop.c
--- cmdloop.c 1998/03/31 20:11:27 1.6
+++ cmdloop.c 1998/04/28 08:39:46
＠＠ -533,6 +533,15 ＠＠
while (EQ (Vcommand_loop, old_loop))
#endif /* LISP_COMMAND_LOOP */
{
+ /* If focus_follows_mouse, make sure the frame with window manager
+ focus is selected. */
+ { extern void investigate_frame_change (void);
+ extern int focus_follows_mouse;
+
+ if (focus_follows_mouse)
+ investigate_frame_change ();
+ }
+
/* Make sure the current window's buffer is selected. */
{
Lisp_Object selected_window = Fselected_window (Qnil);
- 1 participants
- 0 comments
[CRASH] in GC, in compact_string_chars()
26 years
Kirill M. Katsnelson
Kirill M. Katsnelson
I see a corruption in a string_char_block struture. I remember that I have
already been debugging this place:
if (FREE_STRUCT_P (from_s_chars))
{
fullsize = ((struct unused_string_chars *) from_s_chars)->fullsize;
from_pos += fullsize;
continue;
}
string = from_s_chars->string;
assert (!(FREE_STRUCT_P (string)));
In the above assert statement, string variable has an ascii value, like
0x4C282020 (this is from modeline: " (L" isp interaction), or something
else, but always characters. This no doubt ends up with GPF, or SEGV,
whatever you call this sweetie on your system.
I spent my whole life and borrowed another one catching the reason for
that, and all to no avail. Does anybody remember something related to
such a crash?
I have no reproduction. This is the third time in the last 2 days
I'm getting this, and the first time in debug build.
Kirill, clueless.
Backtrace, of no value, just in case:
compact_string_chars() line 4049 + 3 bytes
gc_sweep() line 4254
garbage_collect_1() line 4559
funcall_recording_as(int 555206584, int 3, int * 0x0082e460) line 3116
Ffuncall(int 3, int * 0x0082e460) line 3238 + 19 bytes
call2(int 555206584, int 1104342316, int -1581761356) line 3928 + 11 bytes
map_keymap_mapper(const key_data * 0x0082e49c, int -1581761356, void * 0x2117c7b8) line 2971 + 28 bytes
map_keymap_unsorted_mapper(void * 0xc0000077, void * 0xa1b83cb4, void * 0x0082e5a8) line 2808 + 20 bytes
maphash(int (void *, void *, void *)* 0x0109dd63 map_keymap_unsorted_mapper(void *, void *, void *), _C_hashtable * 0x0082e4ec, void * 0x0082e5a8) line 470 + 20 bytes
elisp_maphash(int (void *, void *, void *)* 0x0109dd63 map_keymap_unsorted_mapper(void *, void *, void *), int 565628096, void * 0x0082e5a8) line 886 + 17 bytes
map_keymap_unsorted_mapper(void * 0x00000001, void * 0x21b6cf80, void * 0x0082e5a8) line 2800 + 30 bytes
maphash(int (void *, void *, void *)* 0x0109dd63 map_keymap_unsorted_mapper(void *, void *, void *), _C_hashtable * 0x0082e574, void * 0x0082e5a8) line 470 + 20 bytes
elisp_maphash(int (void *, void *, void *)* 0x0109dd63 map_keymap_unsorted_mapper(void *, void *, void *), int 565625536, void * 0x0082e5a8) line 886 + 17 bytes
map_keymap(int 565625536, int 0, void (const key_data *, int, void *)* 0x0109dce6 map_keymap_mapper(const key_data *, int, void *), void * 0x2117c7b8) line 2992 + 18 bytes
Fmap_keymap(int 555206584, int 565625216, int -1582282748) line 3030 + 45 bytes
funcall_recording_as(int -1582147484, int 2, int * 0x0082e744) line 3193 + 105 bytes
Ffuncall(int 3, int * 0x0082e744) line 3238 + 19 bytes
Fbyte_code(int 1628948484, int -2129147840, int 4) line 416 + 16 bytes
funcall_lambda(int 555206764, int 4, int * 0x0082ea28) line 3599 + 35 bytes
funcall_recording_as(int -1581824388, int 4, int * 0x0082ea24) line 3200 + 20 bytes
Ffuncall(int 5, int * 0x0082ea24) line 3238 + 19 bytes
Fbyte_code(int 1628948004, int -2129148316, int 5) line 416 + 16 bytes
funcall_lambda(int 555206312, int 1, int * 0x0082f2b4) line 3599 + 35 bytes
funcall_recording_as(int -1582147852, int 1, int * 0x0082f2b0) line 3200 + 20 bytes
Ffuncall(int 2, int * 0x0082f2b0) line 3238 + 19 bytes
Fbyte_code(int 1641182160, int -2117236224, int 4) line 416 + 16 bytes
Feval(int 1104011172) line 3063 + 153 bytes
readevalloop(int 565436672, int 1639592672, int (int)* 0x0104a0f2 Feval(int), int 0) line 1340 + 7 bytes
Fload_internal(int 1639592672, int -1582282748, int -1582282748, int -1582282748, int -1582152140, int -1582282748) line 747 + 23 bytes
funcall_recording_as(int -1582145900, int 5, int * 0x0082f958) line 3193 + 207 bytes
Ffuncall(int 6, int * 0x0082f958) line 3238 + 19 bytes
Fbyte_code(int 1629338824, int -2128757412, int 11) line 416 + 16 bytes
funcall_lambda(int 555597388, int 4, int * 0x0082fb98) line 3599 + 35 bytes
funcall_recording_as(int -1582145708, int 4, int * 0x0082fb94) line 3200 + 20 bytes
Ffuncall(int 5, int * 0x0082fb94) line 3238 + 19 bytes
call4(int -1582145708, int 1639592672, int -1582282748, int -1582282748, int -1582282748) line 3964 + 11 bytes
do_autoload(int 1103146012, int -1581690780) line 2761 + 80 bytes
Fcommand_execute(int -1581690780, int -1582282748, int -1582282748) line 2566 + 13 bytes
execute_command_event(command_builder * 0x01c37640, int 565448908) line 4289 + 25 bytes
Fdispatch_event(int 565448908) line 4591 + 71 bytes
Fcommand_loop_1() line 574 + 9 bytes
command_loop_1(int -1582282748) line 495
condition_case_1(int -1582282652, int (int)* 0x0102ee06 command_loop_1(int), int -1582282748, int (int, int)* 0x0102e8b4 cmd_error(int, int), int -1582282748) line 1653 + 7 bytes
command_loop_3() line 256 + 35 bytes
command_loop_2(int -1582282748) line 268
internal_catch(int -1582172356, int (int)* 0x0102ea04 command_loop_2(int), int -1582282748, int * 0x00000000) line 1328 + 7 bytes
initial_command_loop(int -1582282748) line 305 + 26 bytes
STACK_TRACE_EYE_CATCHER(int 1, char * * 0x01b2e340, char * * 0x01b84d00, int 0) line 1677 + 9 bytes
main(int 1, char * * 0x01b2e340, char * * 0x01b84d00) line 2094 + 21 bytes
mainCRTStartup + 211 bytes
_start() line 118
KERNEL32! 77f1b304()
- 1 participants
- 0 comments
Re: [crash]: more on `internal bug', and another `fatal i/o error'
26 years
SL Baur
SL Baur
Karl M Hegbloom <karlheg(a)inetarena.com> writes:
> gesture, and XEmacs disappeared. There was no core dump. I found
> this in ~/.xsession-errors:
...
> xemacs: Fatal I/O Error 14 (Bad address) on display connection ":0.0"
> after 107657 requests (107655 known processed) with 0 events remaining.
That's the same thing I got after viewing your message. I hope you
have an author-copy stashed away somewhere. It is definitely tickling
a bug somewhere in XEmacs.
> The backtrace is from the crash I sent a screenshot of, and the last
> message is from the disappearing act.
- 1 participants
- 0 comments