Anonymous avatar Anonymous committed 7b47d09

import pcl-cvs 2.0b2

Comments (0)

Files changed (7)

+;;;; @(#) compile-all.el,v 1.11 1993/05/31 18:40:25 ceder Exp
+;;;; This file byte-compiles all .el files in pcl-cvs release XXRELEASEXX.
+;;;;
+;;;; Copyright (C) 1991 Inge Wallin
+;;;;
+;;;; This file was once upon a time part of Elib, but have since been
+;;;; modified by Per Cederqvist.
+;;;;
+;;;; GNU Elib is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 1, or (at your option)
+;;;; any later version.
+;;;;
+;;;; GNU Elib is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with GNU Emacs; see the file COPYING.  If not, write to
+;;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;;;;
+
+
+(setq files-to-compile '("pcl-cvs" "pcl-cvs-lucid"))
+
+
+(defun compile-file-if-necessary (file)
+  "Compile FILE if necessary.
+
+This is done if FILE.el is newer than FILE.elc or if FILE.elc doesn't exist."
+  (let ((el-name (concat file ".el"))
+	(elc-name (concat file ".elc")))
+    (if (or (not (file-exists-p elc-name))
+	    (file-newer-than-file-p el-name elc-name))
+	(progn
+	  (message (format "Byte-compiling %s..." el-name))
+	  (byte-compile-file el-name)))))
+
+
+(defun compile-pcl-cvs ()
+  "Byte-compile all uncompiled files of pcl-cvs."
+
+  (interactive)
+
+  ;; Be sure to have . in load-path since a number of files
+  ;; depend on other files and we always want the newer one even if
+  ;; a previous version of pcl-cvs exists.
+  (let ((load-path (append '(".") load-path)))
+
+    (mapcar (function compile-file-if-necessary)
+	    files-to-compile)))
+;;; dired-cvs.el -- Extensions to dired.
+;;; Copyright (C) 1991,1992  Per Cederqvist
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+
+;;; Note that this package is still under development. Comments,
+;;; enhancements and bug fixes are welcome.
+;;; Send them to ceder@lysator.liu.se.
+
+;;; dired-cvs.el,v 1.4 1992/01/22 17:09:37 ceder Exp
+
+;;; This file works with the dired which says:
+;; >DIRED commands for Emacs.  1.4
+;; >Copyright (C) 1985, 1986, 1990 Free Software Foundation, Inc.
+;; >Enhanced from Emacs 18.55 dired by Sebastian Kremer <sk@thp.uni-koeln.de>
+;;; on the first three lines. It might not work with other versions of dired.
+
+(require 'pcl-cvs)
+(require 'dired)
+(define-prefix-command 'dired-Control-C-Prefix)
+
+(defvar dired-mode-hook nil)
+
+(setq dired-mode-hook
+      (` ((lambda ()
+	    (define-key dired-mode-map "\C-c" 'dired-Control-C-Prefix)
+	    (define-key dired-mode-map "\C-ca" 'dired-cvs-add)
+	    (define-key dired-mode-map "\C-cl" 'dired-mark-cvslog)
+	    (define-key dired-mode-map "\C-cr" 'dired-cvs-rename)
+	    (define-key dired-mode-map "\C-cd" 'dired-cvs-remove))
+	  (,@ dired-mode-hook)
+	  (,@ nil))))
+
+(defun dired-mark-cvslog (&optional arg)
+  "Compress marked (or next ARG) files."
+  (interactive "P")
+  (save-window-excursion
+    (pop-to-buffer (get-buffer-create cvs-temp-buffer-name))
+    (erase-buffer))
+  (dired-mark-map-check
+   'dired-cvslog arg "%d of %d logging%s failed - type W to see why %s"
+   'compress "Cvs log %s ")
+  (pop-to-buffer (get-buffer-create cvs-temp-buffer-name)))
+
+
+(defun dired-cvslog ()
+  ;; Return nil for success, offending filename else.
+  (let* ((file-to-log (dired-get-filename)))
+    (if (save-excursion
+	  (beginning-of-line)
+	  (looking-at dired-re-sym))
+	(progn
+	  (dired-log (concat
+		      "Attempt to cvs-log a symbolic link:\n"
+		      file-to-log))
+	  file-to-log)
+      (set-buffer (get-buffer cvs-temp-buffer-name))
+      (setq default-directory (file-name-directory file-to-log))
+      (call-process cvs-program nil t t "log"
+		    (file-name-nondirectory file-to-log)))))
+
+
+(defun dired-cvs-remove ()
+  "Remove one file from the repository."
+  (interactive)
+  (let ((filename (dired-get-filename)))
+  (cond
+   ((yes-or-no-p (format "Delete %s? " filename))
+    (let ((msg (read-string "Log message: ")))
+      (delete-file filename)
+      (let (buffer-read-only)
+	(delete-region (progn (beginning-of-line) (point))
+		       (progn (forward-line 1) (point))))
+      (pop-to-buffer (get-buffer-create cvs-temp-buffer-name))
+      (erase-buffer)
+      (setq default-directory (file-name-directory filename))
+      (message "Removing from repository...")
+      (call-process cvs-program nil t t "remove"
+		    (file-name-nondirectory filename))
+      (message "Removing from repository...Done."))))))
+
+
+(defun dired-cvs-add (file-info)
+  "Add one file from the repository."
+  (interactive "sFile declaration: ")
+  (let ((filename (dired-get-filename)))
+    (pop-to-buffer (get-buffer-create cvs-temp-buffer-name))
+    (erase-buffer)
+    (setq default-directory (file-name-directory filename))
+    (message "Adding to repository...")
+    (call-process cvs-program nil t t "add"
+		  "-m" file-info
+		  (file-name-nondirectory filename))
+    (message "Adding to repository...Done.")))
+
+
+(defun dired-cvs-rename (new-name)
+  "Rename a cvs file."
+  (interactive
+   (list (read-file-name
+	  (format "Rename %s to "
+		  (file-name-nondirectory (dired-get-filename)))
+	  (file-name-directory (dired-get-filename)))))
+
+  (let* ((old-name (dired-get-filename))
+	 (temp-name (make-temp-name (dired-get-filename))))
+    (copy-file (cvs-repository-name old-name)
+	       temp-name)
+    (rename-file old-name new-name)
+    ;; cd old-dir; rm old-name; cvs remove old-name; cvs commit -m '' old-name
+    ;; cd new-dir; cvs add new-name; cvs commit -m '' new-name
+    (shell-command (concat "cd " (file-name-directory old-name)
+			   " ; " cvs-program " remove "
+			   (file-name-nondirectory old-name)
+			   " ; " cvs-program " commit -m ' ' "
+			   (file-name-nondirectory old-name)
+			   " ; cd " (file-name-directory new-name)
+			   " ; " cvs-program " add -m ' ' "
+			   (file-name-nondirectory new-name)
+			   " ; " cvs-program " commit -fm ' ' "
+			   (file-name-nondirectory new-name)))
+    (delete-file (cvs-repository-name new-name))
+    (rename-file temp-name (cvs-repository-name new-name))
+    (dired-remove-entry-all-buffers old-name)
+    (dired-rename-visited old-name new-name)))
+
+(defun cvs-repository-name (filename)
+  "Get the name of the RCS file that corresponds to FILENAME.
+FILENAME should be a full path.
+Works by looking in (file-name-directory FILENAME)/CVS.adm/Repository."
+  (save-window-excursion
+    (set-buffer (find-file-noselect
+		 (concat (file-name-directory filename)
+			 "CVS.adm/Repository")))
+    (goto-char (point-min))
+    (let ((path (buffer-substring (point) (progn (end-of-line) (point)))))
+      (if (/= ?/ (elt path 0))
+	  (let ((root (getenv "CVSROOT")))
+	    (if root
+		(setq path (concat (file-name-as-directory root)
+				   path))
+	      (error "Must set CVSROOT environment variable."))))
+      (concat (file-name-as-directory path)
+	      (file-name-nondirectory filename)
+	      ",v"))))

pcl-cvs-bindings.el

+
+;; Bindings and autoloads for pcl-cvs-buffer.el
+
+(defvar cvs:buffer-command-map nil
+  "Map for commands that operate on the current buffer.")
+
+(if cvs:buffer-command-map
+    nil
+  (define-prefix-command 'cvs:buffer-command-map)
+  (setq cvs:buffer-command-map (symbol-function 'cvs:buffer-command-map))
+  (define-key 'cvs:buffer-command-map "l" 'cvs:log))
+
+(global-set-key "\C-c\C-v" 'cvs:buffer-command-map)

pcl-cvs-buffer.el

+;;; pcl-cvs-buffer.el,v 1.2 1993/01/18 01:28:03 ceder Exp
+;;; pcl-cvs-buffer.el -- Front-end to CVS 1.3 or later.  Release XXRELEASEXX.
+;;; Copyright (C) 1991, 1992  Per Cederqvist
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+(require 'string)
+
+(defvar cvs:log-args ""
+  "*Flags to pass to 'cvs log'. Used by cvs:log.")
+
+(defvar cvs:diff-args ""
+  "*Flags to pass to 'cvs diff'. Used by cvs:diff.")
+
+
+(defvar cvs:status-args ""
+  "*Flags to pass to 'cvs status'. Used by cvs:status.")
+
+(defun cvs:call-process-in-temp-buffer (program args message &optional noerrs)
+  "Call PROGRAM, sending output to a temporary buffer.
+ARGS is a list of strings to pass to the program. MESSAGE is
+displayed in the echo area while the program is running.
+Optional argument NOERRS should be an association list
+of (errorcodes messages)."
+  (cvs-use-temp-buffer)
+  (message "%s..." message)
+  (let ((code (apply (function call-process)
+		     program nil t t args)))
+    (cond
+     ((memq code noerrs)
+      (message "%s... %s" message (cdr (memq code noerrs))))
+     ((stringp code)
+      (message "%s received signal %s" program code))
+     ((zerop code)
+      (message "%s... Done." message))
+     (t
+      (message "%s exited with exit status %d" program code)))))
+	 
+
+(defun cvs:log (modify-args)
+  "Run a 'cvs log' on the current buffer.
+If optional prefix argument MODIFY-ARGS are given you are prompted for
+flags to pass to 'cvs log'."
+  (interactive "P")
+  (if (or modify-args (not (string= "" cvs:log-args)))
+      (setq cvs:log-args (read-string "Flags to pass to cvs log: "
+				      cvs:log-args)))
+  (cvs:call-process-in-temp-buffer
+   cvs-program
+   (cons "log"
+	 (ncon
+	  (cvs-filter (function (lambda (x) (not (string= "" x))))
+		      (elib-string-split "[ \t]" cvs:log-args))
+	  (cons (buffer-file-name) nil)))
+   "Running cvs log"))
+
+
+
+(defun cvs:diff (modify-args)
+  "Run a 'cvs diff' on the current buffer.
+If optional prefix argument MODIFY-ARGS are given you are prompted for
+flags to pass to 'cvs diff'."
+  (interactive "P")
+  (if (or modify-args
+	  (not (or (string= "" cvs:diff-args)
+		   (string= "-u" cvs:diff-args)
+		   (string= "-c" cvs:diff-args))))
+      (setq cvs:diff-args (read-string "Flags to pass to cvs diff: "
+				       cvs:diff-args)))
+  (cvs:call-process-in-temp-buffer
+   cvs-program
+   (cons "diff"
+	 (nconc
+	  (elib-string-split "[ \t]" cvs:diff-args)
+	  (cons (buffer-file-name) nil)))
+   "Running cvs diff"
+   '(1 "Differences found.")))
+
+(defun cvs:status (modify-args)
+  "Run a 'cvs status' on the current buffer.
+If optional prefix argument MODIFY-ARGS are given you are prompted for
+flags to pass to 'cvs status'."
+  (interactive "P")
+  (if (or modify-args (not (string= "" cvs:status-args)))
+      (setq cvs:status-args (read-string "Flags to pass to cvs status: "
+				      cvs:status-args)))
+  (let ((name (buffer-file-name)))
+    (cvs-use-temp-buffer)
+    (apply (function call-process)
+	   cvs-program nil t t "status"
+	   (nconc
+	    (elib-string-split "[ \t]" cvs:status-args)
+	    (cons name nil)))))
+
+
+(defun cvs:add (description)
+  "Run a 'cvs add' on the current buffer.
+DESCRIPTION is used as a description for the file."
+  (interactive "sFile description: ")
+
+  (let ((name (buffer-file-name)))
+    (cvs-use-temp-buffer)
+    (call-process cvs-program nil t t "add" "-m" description
+		  (file-name-nondirectory name))))
+(require 'cookie)
+
+(setq seeed 0)
+
+(defun printer (string)
+  (setq seeed (1+ seeed))
+  (concat string (format " %d" seeed)))
+
+(defun test ()
+  (interactive)
+  (let ((b  (generate-new-buffer "cookie-test")))
+    (switch-to-buffer b)
+  
+    (cookie-create b
+		   (function printer)
+		   "This is a header."
+		   "This is a footer.")
+    (cookie-enter-first b "This is the first cookie.")
+    (cookie-enter-last b "This is the last cookie.")
+    (message (cookie-cookie b (tin-nth b -2)))
+    (message (cookie-cookie b (tin-nth b -1)))
+    (if (or (tin-nth b 2) (tin-nth b -3))
+	(error "Error 78423."))
+    (cookie-enter-cookies b '("List one." "List two." "List three."))
+    (message "%s" "Entered list.")
+    (setq foo (tin-nth b 2))
+    (cookie-clear b)
+    (cookie-enter-cookies b '("Foo" "Bar" "Baz" "Bie" "LysKOM"))
+    (goto-char 1)
+;    (switch-to-buffer-other-window (get-buffer-create "*Report*"))
+;    (cookie-map-reverse (function (lambda (str) (insert str) (insert ?\n))) b)
+    (cookie-filter b (function (lambda (foo) (sit-for 0) (yes-or-no-p foo))))
+    (let ((a (point-min))
+	  (c (point-max))
+	  sell)
+      (switch-to-buffer-other-window (get-buffer-create "*Report*"))
+      (erase-buffer)
+      (while (< a c)
+	(setq sel  (tin-get-selection b a))
+	(if sel 
+	    (insert (format "%d - %s\n" a
+			    (cookie-cookie b sel))))
+	(setq a (1+ a))))))
+
+(defun d (b tin)
+  (message "%s" (cookie-cookie b tin))
+  (sit-for 2))
+
+(require 'dll)
+
+
+(prog1 nil (setq a (dll-create-from-list '(one two three four))))
+
+(dll-first a)
+a
+(dll-element dll (dll-nth a 0))
+(dll-element dll (dll-nth a 1))
+(dll-element dll (dll-nth a 2))
+(dll-element dll (dll-nth a 3))
+(dll-nth a 4)
+(dll-nth a 5)
+(dll-element dll (dll-nth a -1))
+(dll-element dll (dll-nth a -2))
+(dll-element dll (dll-nth a -3))
+(dll-element dll (dll-nth a -4))
+a
+(dll-nth a 0)
+(dll-nth a 1)
+(dll-nth a 2)
+(dll-nth a 3)
+(dll-nth a 4)
+(dll-nth a -1)
+(dll-nth a -2)
+(dll-nth a -3)
+(dll-nth a -4)
+(dll-nth a -5)
+
+(dll-nth a -6)
+
+(dll-map 'princ a)
+
+(prog1 nil (setq b (dll-create)))
+
+(dll-length a)
+(dll-length b)
+
+(dll-p a)
+(dll-p (current-buffer))
+
+(prog1 nil (dll-enter-first b 'foo))
+(prog1 nil (dll-enter-first b 'bar))
+(dll-map 'princ b)
+(prog1 nil (dll-enter-last b 'tail))
+(dll-first b)
+(dll-last b)
+(prog1 nil (setq c (dll-nth b -1)))
+(prog1 nil (dll-enter-before b c 'ST))
+(prog1 nil (setq c (dll-next b c)))
+(prog1 nil (setq c (dll-previous b c)))
+(dll-element dll c)
+(prog1 nil (dll-delete b c))
+(dll-empty b)
+(dll-empty (dll-create))
+(prog1 nil (setq e (dll-copy b)))
+(eq e b)
+(prog1 nil (setq e (dll-create-from-list '(18 45 8954 6542 237 236))))
+(dll-map-reverse (function (lambda (foo) (princ foo) (terpri))) e)
+(dll-map (function (lambda (foo) (princ foo) (terpri))) e)
+(prog1 nil (dll-sort e '<))
+(dll-all e)
+(prog1 nil (dll-filter e (function (lambda (foo)
+				     (= (* 2 (/ foo 2)) foo)))))
+(defun print-cvs-tin (foo)
+  "Debug utility."
+  (let ((cookie (tin-cookie cvs-cookie-handle foo))
+	(stream (get-buffer-create "debug")))
+    (princ "==============\n" stream)
+    (princ (cvs-fileinfo->file-name cookie) stream)
+    (princ "\n" stream)
+    (princ (cvs-fileinfo->dir cookie) stream)
+    (princ "\n" stream)
+    (princ (cvs-fileinfo->full-log cookie) stream)
+    (princ "\n" stream)
+    (princ (cvs-fileinfo->marked cookie) stream)
+    (princ "\n" stream)))
+
+(defun parse-cvs-bug-mail ()
+  "Try the current parser on a cvs bug message."
+  (interactive)
+  (goto-char (point-min))
+  (re-search-forward
+   "--- Contents of stdout buffer (\\([0-9]+\\) chars) ---\n")
+  (let ((size (string-to-int (buffer-substring (match-beginning 1)
+					       (match-end 1))))
+	(beg (point))
+	(stdout-buf (get-buffer-create "stdout")))
+    (save-window-excursion (set-buffer stdout-buf) (erase-buffer))
+    (goto-char (+ (point) size))
+    (if (looking-at "\n")
+	(forward-char))
+    (if (not (looking-at "--- End of stdout buffer ---"))
+	(error "Expected \"--- End of stdout buffer ---\" at point"))
+    (princ (buffer-substring beg (point)) stdout-buf)
+    (re-search-forward 
+     "--- Contents of stderr buffer (\\([0-9]+\\) chars) ---\n")
+    (let ((size (string-to-int (buffer-substring (match-beginning 1)
+						 (match-end 1))))
+	  (beg (point))
+	  (stderr-buf (get-buffer-create "stderr")))
+      (save-window-excursion (set-buffer stderr-buf) (erase-buffer))
+      (goto-char (+ (point) size))
+      (if (looking-at "\n")
+	  (forward-char))
+      (if (not (looking-at "--- End of stderr buffer ---"))
+	  (error "Expected \"--- End of stderr buffer ---\" at point"))
+      (princ (buffer-substring beg (point)) stderr-buf)
+      (cvs-parse-update stdout-buf stderr-buf)))
+  (switch-to-buffer-other-window "*cvs*"))
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.