aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorSam Steingold2000-08-03 18:11:47 +0000
committerSam Steingold2000-08-03 18:11:47 +0000
commit027b73ac1b06bae302a5bfe45d0b7e82ccd0fcd7 (patch)
tree4b2c8f1efdc148104f2c051634994661572aab03
parentbbe1599028a3702deefc4089e950957a72967ee2 (diff)
downloademacs-027b73ac1b06bae302a5bfe45d0b7e82ccd0fcd7.tar.gz
emacs-027b73ac1b06bae302a5bfe45d0b7e82ccd0fcd7.zip
* pcvs.el (cvs-do-commit): Use `buffer-substring-no-properties'
instead of `buffer-string'. (require 'cl): Always, not just when compiling. `ignore-errors' in `interactive', `list*', `defun*' &c make this necessary.
-rw-r--r--lisp/ChangeLog10
-rw-r--r--lisp/pcvs.el64
2 files changed, 41 insertions, 33 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 990527f0586..1dc3ecfa66c 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,11 @@
12000-08-03 Sam Steingold <sds@gnu.org>
2
3 * pcvs.el (cvs-do-commit): Use `buffer-substring-no-properties'
4 instead of `buffer-string'.
5 (require 'cl): Always, not just when compiling.
6 `ignore-errors' in `interactive', `list*', `defun*' &c make this
7 necessary.
8
12000-08-03 Eli Zaretskii <eliz@is.elta.co.il> 92000-08-03 Eli Zaretskii <eliz@is.elta.co.il>
2 10
3 * international/mule-cmds.el (select-safe-coding-system): Make 11 * international/mule-cmds.el (select-safe-coding-system): Make
@@ -35,7 +43,7 @@
35 fix. 43 fix.
36 (ebnf-version): New version number (3.2). 44 (ebnf-version): New version number (3.2).
37 (ebnf-format-color, ebnf-begin-job): Code fix. 45 (ebnf-format-color, ebnf-begin-job): Code fix.
38 46
392000-08-01 Eli Zaretskii <eliz@is.elta.co.il> 472000-08-01 Eli Zaretskii <eliz@is.elta.co.il>
40 48
41 * net/net-utils.el (nslookup-font-lock-keywords): Don't condition 49 * net/net-utils.el (nslookup-font-lock-keywords): Don't condition
diff --git a/lisp/pcvs.el b/lisp/pcvs.el
index c2e587d69fe..282c01041bd 100644
--- a/lisp/pcvs.el
+++ b/lisp/pcvs.el
@@ -14,7 +14,7 @@
14;; Maintainer: (Stefan Monnier) monnier+lists/cvs/pcl@flint.cs.yale.edu 14;; Maintainer: (Stefan Monnier) monnier+lists/cvs/pcl@flint.cs.yale.edu
15;; Keywords: CVS, version control, release management 15;; Keywords: CVS, version control, release management
16;; Version: $Name: $ 16;; Version: $Name: $
17;; Revision: $Id: pcvs.el,v 1.3 2000/05/10 22:28:36 monnier Exp $ 17;; Revision: $Id: pcvs.el,v 1.4 2000/06/12 04:48:35 monnier Exp $
18 18
19;; This file is part of GNU Emacs. 19;; This file is part of GNU Emacs.
20 20
@@ -56,7 +56,7 @@
56;;; Todo: 56;;; Todo:
57 57
58;; ******** FIX THE DOCUMENTATION ********* 58;; ******** FIX THE DOCUMENTATION *********
59;; 59;;
60;; - proper `g' that passes safe args and uses either cvs-status or cvs-examine 60;; - proper `g' that passes safe args and uses either cvs-status or cvs-examine
61;; - add toolbar entries 61;; - add toolbar entries
62;; - marking 62;; - marking
@@ -109,7 +109,7 @@
109 109
110;;; Code: 110;;; Code:
111 111
112(eval-when-compile (require 'cl)) 112(require 'cl)
113(require 'ewoc) ;Ewoc was once cookie 113(require 'ewoc) ;Ewoc was once cookie
114(require 'pcvs-defs) 114(require 'pcvs-defs)
115(require 'pcvs-util) 115(require 'pcvs-util)
@@ -131,9 +131,9 @@
131 131
132(defvar cvs-from-vc nil "Bound to t inside VC advice.") 132(defvar cvs-from-vc nil "Bound to t inside VC advice.")
133 133
134;;;; 134;;;;
135;;;; flags variables 135;;;; flags variables
136;;;; 136;;;;
137 137
138(defun cvs-defaults (&rest defs) 138(defun cvs-defaults (&rest defs)
139 (let ((defs (cvs-first defs cvs-shared-start))) 139 (let ((defs (cvs-first defs cvs-shared-start)))
@@ -195,9 +195,9 @@
195 "Mode-line control for displaying info on cvs process status.") 195 "Mode-line control for displaying info on cvs process status.")
196 196
197 197
198;;;; 198;;;;
199;;;; Query-Type-Descriptor for Tags 199;;;; Query-Type-Descriptor for Tags
200;;;; 200;;;;
201 201
202(autoload 'cvs-status-get-tags "cvs-status") 202(autoload 'cvs-status-get-tags "cvs-status")
203(defun cvs-tags-list () 203(defun cvs-tags-list ()
@@ -222,7 +222,7 @@
222(defconst cvs-qtypedesc-tag 222(defconst cvs-qtypedesc-tag
223 (cvs-qtypedesc-create 'identity 'identity 'cvs-tags-list 'cvs-tag-history)) 223 (cvs-qtypedesc-create 'identity 'identity 'cvs-tags-list 'cvs-tag-history))
224 224
225;;;; 225;;;;
226 226
227(defun cvs-mode! (&optional -cvs-mode!-fun -cvs-mode!-noerror) 227(defun cvs-mode! (&optional -cvs-mode!-fun -cvs-mode!-noerror)
228 "Switch to the *cvs* buffer. 228 "Switch to the *cvs* buffer.
@@ -258,9 +258,9 @@ If -CVS-MODE!-NOERROR is non-nil, then failure to find a *cvs* buffer does
258 ;; the selected window has not been changed by FUN 258 ;; the selected window has not been changed by FUN
259 (select-window cvs-mode!-owin))))))) 259 (select-window cvs-mode!-owin)))))))
260 260
261;;;; 261;;;;
262;;;; Prefixes 262;;;; Prefixes
263;;;; 263;;;;
264 264
265(defvar cvs-branches (list cvs-vendor-branch "HEAD" "HEAD")) 265(defvar cvs-branches (list cvs-vendor-branch "HEAD" "HEAD"))
266(cvs-prefix-define cvs-branch-prefix 266(cvs-prefix-define cvs-branch-prefix
@@ -313,7 +313,7 @@ the primay since reading the primary can deactivate it."
313 (cvs-prefix-get 'cvs-secondary-branch-prefix)))) 313 (cvs-prefix-get 'cvs-secondary-branch-prefix))))
314 (if branch (cons (concat (or arg "-r") branch) flags) flags))) 314 (if branch (cons (concat (or arg "-r") branch) flags) flags)))
315 315
316;;;; 316;;;;
317 317
318(define-minor-mode 318(define-minor-mode
319 cvs-minor-mode 319 cvs-minor-mode
@@ -349,7 +349,7 @@ from the current buffer."
349 (set (make-local-variable 'cvs-temp-buffer) 349 (set (make-local-variable 'cvs-temp-buffer)
350 (cvs-get-buffer-create 350 (cvs-get-buffer-create
351 (eval cvs-temp-buffer-name) 'noreuse)))))) 351 (eval cvs-temp-buffer-name) 'noreuse))))))
352 352
353 ;; handle the potential pre-existing process 353 ;; handle the potential pre-existing process
354 (let ((proc (get-buffer-process buf))) 354 (let ((proc (get-buffer-process buf)))
355 (when (and (not normal) (processp proc) 355 (when (and (not normal) (processp proc)
@@ -476,7 +476,7 @@ Working dir: " (abbreviate-file-name dir) "
476 (let ((procbuf (current-buffer)) 476 (let ((procbuf (current-buffer))
477 (cvsbuf cvs-buffer) 477 (cvsbuf cvs-buffer)
478 (single-dir (or single-dir (eq cvs-execute-single-dir t)))) 478 (single-dir (or single-dir (eq cvs-execute-single-dir t))))
479 479
480 (set-buffer procbuf) 480 (set-buffer procbuf)
481 (goto-char (point-max)) 481 (goto-char (point-max))
482 (unless (bolp) (let ((inhibit-read-only t)) (insert "\n"))) 482 (unless (bolp) (let ((inhibit-read-only t)) (insert "\n")))
@@ -499,7 +499,7 @@ Working dir: " (abbreviate-file-name dir) "
499 (dir (first dir+files+rest)) 499 (dir (first dir+files+rest))
500 (files (second dir+files+rest)) 500 (files (second dir+files+rest))
501 (rest (third dir+files+rest))) 501 (rest (third dir+files+rest)))
502 502
503 ;; setup the (current) process buffer 503 ;; setup the (current) process buffer
504 (set (make-local-variable 'cvs-postprocess) 504 (set (make-local-variable 'cvs-postprocess)
505 (if (null rest) 505 (if (null rest)
@@ -531,7 +531,7 @@ Working dir: " (abbreviate-file-name dir) "
531 (set-process-filter process 'cvs-update-filter) 531 (set-process-filter process 'cvs-update-filter)
532 (set-marker (process-mark process) (point-max)) 532 (set-marker (process-mark process) (point-max))
533 (ignore-errors (process-send-eof process)) ;close its stdin to avoid hangs 533 (ignore-errors (process-send-eof process)) ;close its stdin to avoid hangs
534 534
535 ;; now finish setting up the cvs-buffer 535 ;; now finish setting up the cvs-buffer
536 (set-buffer cvsbuf) 536 (set-buffer cvsbuf)
537 (setq cvs-mode-line-process (symbol-name (process-status process))) 537 (setq cvs-mode-line-process (symbol-name (process-status process)))
@@ -782,7 +782,7 @@ RM-MSGS if non-nil means remove messages."
782 ;; keep the rest 782 ;; keep the rest
783 (t (not (run-hook-with-args-until-success 783 (t (not (run-hook-with-args-until-success
784 'cvs-cleanup-functions fi)))))) 784 'cvs-cleanup-functions fi))))))
785 785
786 ;; mark dirs for removal 786 ;; mark dirs for removal
787 (when (and keep rm-dirs 787 (when (and keep rm-dirs
788 (eq (cvs-fileinfo->type last-fi) 'DIRCHANGE) 788 (eq (cvs-fileinfo->type last-fi) 'DIRCHANGE)
@@ -852,9 +852,9 @@ With a prefix argument, prompt for cvs FLAGS to use."
852 :noexist t)) 852 :noexist t))
853 853
854 854
855;;;; 855;;;;
856;;;; The code for running a "cvs update" and friends in various ways. 856;;;; The code for running a "cvs update" and friends in various ways.
857;;;; 857;;;;
858 858
859(defun-cvs-mode (cvs-mode-revert-buffer . SIMPLE) 859(defun-cvs-mode (cvs-mode-revert-buffer . SIMPLE)
860 (&optional ignore-auto noconfirm) 860 (&optional ignore-auto noconfirm)
@@ -981,7 +981,7 @@ for a lock file. If so, it inserts a message cookie in the *cvs* buffer."
981 (cvs-create-fileinfo 981 (cvs-create-fileinfo
982 'MESSAGE "" " " 982 'MESSAGE "" " "
983 (concat msg 983 (concat msg
984 (substitute-command-keys 984 (substitute-command-keys
985 "\n\t(type \\[cvs-mode-delete-lock] to delete it)")) 985 "\n\t(type \\[cvs-mode-delete-lock] to delete it)"))
986 :subtype 'TEMP)) 986 :subtype 'TEMP))
987 (pop-to-buffer (current-buffer)) 987 (pop-to-buffer (current-buffer))
@@ -1093,9 +1093,9 @@ If a prefix argument is given, move by that many lines."
1093 (interactive "p") 1093 (interactive "p")
1094 (ewoc-goto-next cvs-cookies (point) arg)) 1094 (ewoc-goto-next cvs-cookies (point) arg))
1095 1095
1096;;;; 1096;;;;
1097;;;; Mark handling 1097;;;; Mark handling
1098;;;; 1098;;;;
1099 1099
1100(defun-cvs-mode cvs-mode-mark (&optional arg) 1100(defun-cvs-mode cvs-mode-mark (&optional arg)
1101 "Mark the fileinfo on the current line. 1101 "Mark the fileinfo on the current line.
@@ -1180,7 +1180,7 @@ they should always be unmarked."
1180 (lambda (obj) (caar (member* obj cvs-ignore-marks-alternatives :key 'cdr))) 1180 (lambda (obj) (caar (member* obj cvs-ignore-marks-alternatives :key 'cdr)))
1181 (lambda () cvs-ignore-marks-alternatives) 1181 (lambda () cvs-ignore-marks-alternatives)
1182 nil t)) 1182 nil t))
1183 1183
1184(defun-cvs-mode cvs-mode-toggle-marks (arg) 1184(defun-cvs-mode cvs-mode-toggle-marks (arg)
1185 "Toggle whether the next CVS command uses marks. 1185 "Toggle whether the next CVS command uses marks.
1186See `cvs-prefix-set' for further description of the behavior. 1186See `cvs-prefix-set' for further description of the behavior.
@@ -1189,7 +1189,7 @@ See `cvs-prefix-set' for further description of the behavior.
1189\\[universal-argument] 3 selects `toggle-marks'." 1189\\[universal-argument] 3 selects `toggle-marks'."
1190 (interactive "P") 1190 (interactive "P")
1191 (cvs-prefix-set 'cvs-ignore-marks-modif arg)) 1191 (cvs-prefix-set 'cvs-ignore-marks-modif arg))
1192 1192
1193(defun cvs-ignore-marks-p (cmd &optional read-only) 1193(defun cvs-ignore-marks-p (cmd &optional read-only)
1194 (let ((default (if (member cmd cvs-invert-ignore-marks) 1194 (let ((default (if (member cmd cvs-invert-ignore-marks)
1195 (not cvs-default-ignore-marks) 1195 (not cvs-default-ignore-marks)
@@ -1232,7 +1232,7 @@ Args: &optional IGNORE-MARKS IGNORE-CONTENTS."
1232 (ewoc-collect cvs-cookies 1232 (ewoc-collect cvs-cookies
1233 'cvs-fileinfo->marked)) 1233 'cvs-fileinfo->marked))
1234 (list (ewoc-data (ewoc-locate cvs-cookies (point))))))) 1234 (list (ewoc-data (ewoc-locate cvs-cookies (point)))))))
1235 1235
1236 (if (or ignore-contents (not (eq (cvs-fileinfo->type fi) 'DIRCHANGE))) 1236 (if (or ignore-contents (not (eq (cvs-fileinfo->type fi) 'DIRCHANGE)))
1237 (push fi fis) 1237 (push fi fis)
1238 ;; If a directory is selected, return members, if any. 1238 ;; If a directory is selected, return members, if any.
@@ -1315,15 +1315,15 @@ The POSTPROC specified there (typically `cvs-edit') is then called,
1315(defun cvs-do-commit (flags) 1315(defun cvs-do-commit (flags)
1316 "Do the actual commit, using the current buffer as the log message." 1316 "Do the actual commit, using the current buffer as the log message."
1317 (interactive (list (cvs-flags-query 'cvs-commit-flags "cvs commit flags"))) 1317 (interactive (list (cvs-flags-query 'cvs-commit-flags "cvs commit flags")))
1318 (let ((msg (buffer-string))) 1318 (let ((msg (buffer-substring-no-properties (point-min) (point-max))))
1319 (cvs-mode!) 1319 (cvs-mode!)
1320 ;;(pop-to-buffer cvs-buffer) 1320 ;;(pop-to-buffer cvs-buffer)
1321 (cvs-mode-do "commit" (list* "-m" msg flags) 'commit))) 1321 (cvs-mode-do "commit" (list* "-m" msg flags) 'commit)))
1322 1322
1323 1323
1324;;;; 1324;;;;
1325;;;; CVS Mode commands 1325;;;; CVS Mode commands
1326;;;; 1326;;;;
1327 1327
1328(defun-cvs-mode (cvs-mode-insert . NOARGS) (file) 1328(defun-cvs-mode (cvs-mode-insert . NOARGS) (file)
1329 "Insert an entry for a specific file." 1329 "Insert an entry for a specific file."
@@ -1425,7 +1425,7 @@ Signal an error if there is no backup file."
1425 1425
1426;; 1426;;
1427;; Ediff support 1427;; Ediff support
1428;; 1428;;
1429 1429
1430(defvar ediff-after-quit-destination-buffer) 1430(defvar ediff-after-quit-destination-buffer)
1431(defvar cvs-transient-buffers) 1431(defvar cvs-transient-buffers)
@@ -1882,7 +1882,7 @@ With prefix argument, prompt for cvs flags."
1882 (cvs-flags-query 'cvs-tag-flags "tag flags"))) 1882 (cvs-flags-query 'cvs-tag-flags "tag flags")))
1883 (cvs-mode-do "tag" (append '("-d") flags (list tag)) 1883 (cvs-mode-do "tag" (append '("-d") flags (list tag))
1884 (when cvs-force-dir-tag 'tag))) 1884 (when cvs-force-dir-tag 'tag)))
1885 1885
1886 1886
1887;; Byte compile files. 1887;; Byte compile files.
1888 1888
@@ -1941,14 +1941,14 @@ With prefix argument, prompt for cvs flags."
1941 (default-directory (cvs-expand-dir-name cur-dir)) 1941 (default-directory (cvs-expand-dir-name cur-dir))
1942 (inhibit-read-only t) 1942 (inhibit-read-only t)
1943 (arg-list (funcall extractor fi))) 1943 (arg-list (funcall extractor fi)))
1944 1944
1945 ;; Execute the command unless extractor returned t. 1945 ;; Execute the command unless extractor returned t.
1946 (when (listp arg-list) 1946 (when (listp arg-list)
1947 (let* ((args (append constant-args arg-list))) 1947 (let* ((args (append constant-args arg-list)))
1948 1948
1949 (insert (format "=== cd %s\n=== %s %s\n\n" 1949 (insert (format "=== cd %s\n=== %s %s\n\n"
1950 cur-dir program (cvs-strings->string args))) 1950 cur-dir program (cvs-strings->string args)))
1951 1951
1952 ;; FIXME: return the exit status? 1952 ;; FIXME: return the exit status?
1953 (apply 'call-process program nil t t args) 1953 (apply 'call-process program nil t t args)
1954 (goto-char (point-max)))))) 1954 (goto-char (point-max))))))