Commits

scop  committed b46c31c

Bring back VC submenu for XEmacs

  • Participants
  • Parent commits 0e058b2

Comments (0)

Files changed (2)

+2007-09-28  Ville Skyttä  <scop@xemacs.org>
+
+	* vc-hooks.el: Bring back VC submenu for XEmacs.
+
 2007-09-26  Norbert Koch  <viteno@xemacs.org>
 
 	* Makefile (VERSION): XEmacs package 1.43 released.
 (fset 'vc-prefix-map vc-prefix-map)
 (define-key global-map "\C-xv" 'vc-prefix-map)
 
-(if (not (boundp 'vc-menu-map))
-    ;; Don't do the menu bindings if menu-bar.el wasn't loaded to defvar
-    ;; vc-menu-map.
-    ()
-  ;;(define-key vc-menu-map [show-files]
-  ;;  '("Show Files under VC" . (vc-directory t)))
-  (define-key vc-menu-map [vc-retrieve-snapshot]
-    '("Retrieve Snapshot" . vc-retrieve-snapshot))
-  (define-key vc-menu-map [vc-create-snapshot]
-    '("Create Snapshot" . vc-create-snapshot))
-  (define-key vc-menu-map [vc-directory] '("VC Directory Listing" . vc-directory))
-  (define-key vc-menu-map [separator1] '("----"))
-  (define-key vc-menu-map [vc-annotate] '("Annotate" . vc-annotate))
-  (define-key vc-menu-map [vc-rename-file] '("Rename File" . vc-rename-file))
-  (define-key vc-menu-map [vc-version-other-window]
-    '("Show Other Version" . vc-version-other-window))
-  (define-key vc-menu-map [vc-diff] '("Compare with Base Version" . vc-diff))
-  (define-key vc-menu-map [vc-update-change-log]
-    '("Update ChangeLog" . vc-update-change-log))
-  (define-key vc-menu-map [vc-print-log] '("Show History" . vc-print-log))
-  (define-key vc-menu-map [separator2] '("----"))
-  (define-key vc-menu-map [vc-insert-header]
-    '("Insert Header" . vc-insert-headers))
-  (define-key vc-menu-map [undo] '("Undo Last Check-In" . vc-cancel-version))
-  (define-key vc-menu-map [vc-revert-buffer]
-    '("Revert to Base Version" . vc-revert-buffer))
-  (define-key vc-menu-map [vc-update]
-    '("Update to Latest Version" . vc-update))
-  (define-key vc-menu-map [vc-next-action] '("Check In/Out" . vc-next-action))
-  (define-key vc-menu-map [vc-register] '("Register" . vc-register)))
+;; XEmacs change: menus for XEmacs
+
+(defconst vc-menu
+  '("Version Control"
+    :filter vc-menu-filter
+    [""                           vc-next-action          buffer-file-name nil]
+    ["Update to Latest Version"   vc-update               vc-mode]
+    ["Revert to Base Version"     vc-revert-buffer        vc-mode]
+    ["Undo Last Check-In"         vc-cancel-version       vc-mode]
+    ["Insert Header"              vc-insert-headers       vc-mode]
+    "----"
+    ["Show History"               vc-print-log            vc-mode]
+    ["Update ChangeLog"           vc-update-change-log    vc-mode]
+    ["Compare with Base Version"  vc-diff                 vc-mode]
+    ["Show Other Version"         vc-version-other-window vc-mode]
+    ["Rename File"                vc-rename-file          vc-mode]
+    ["Annotate"                   vc-annotate             vc-mode]
+    "----"
+    ["VC Directory Listing"       vc-directory            vc-mode]
+    ["Create Snapshot"            vc-create-snapshot      vc-mode]
+    ["Retrieve Snapshot"          vc-retrieve-snapshot    vc-mode]
+    )
+   "Menubar entry for using the revision control system.")
+
+(defun vc-menu-filter (menu-items)
+  (let* ((result menu-items)		; modify in-place
+	 (case-fold-search t)
+	 (type (vc-backend buffer-file-name))
+	 ;; VC works with full path!
+	 (file (if buffer-file-name
+		   buffer-file-name
+		 (expand-file-name (buffer-name))))
+	 op owner item status)
+    (setq op (cond ((null type)
+		    "Register File")
+		   ((eq type 'CVS)
+		    (setq status
+			  (vc-file-getprop buffer-file-name 'cvs-status))
+		    (if status
+			(cdr (assoc status
+				    '(("Locally Modified" . "Commit")
+				      ("Needs Merge" . "Merge with repository")
+				      ("Up-to-date" . "Do nothing to")
+				      ("Needs Checkout" . "Update"))))
+		      ;; #### - we're not gonna call cvs status just to
+		      ;; post a lousy menu...that's insane!
+		      "Next action on" 
+		      ))
+		   ;; these are all for RCS and SCCS
+		   ((not (setq owner (vc-locking-user file)))
+		    ;; VC locking user is faster now. vc-file-owner
+		    ;; is superceded by incompatible FSF version (JV).
+		    "Check out File")
+		   ((not (string-equal owner (user-login-name)))
+		    "Steal File Lock")
+		   (t "Check in File")))
+    ;; We do not want the full name in the menu
+    (setq file (file-name-nondirectory file))
+    (while (setq item (pop menu-items))
+      (and (vectorp item)
+	   (cond ((eq 'vc-next-action (aref item 1))
+		  (aset item 0 op)
+		  (aset item 3 file))
+		 ((eq 'vc-file-status (aref item 1))
+		  (aset item 2 (eq 'CVS type))
+		  (aset item 3 file))
+		 ((> (length item) 3)
+		  (aset item 3 file)))))
+    result))
+
+(and (featurep 'menubar)
+     current-menubar
+     (car (find-menu-item current-menubar '("Tools")))
+     (add-submenu '("Tools") vc-menu "Compare")
+     (add-menu-button '("Tools") "---" "Compare"))
+
+;;;###autoload(defun vc-load-vc-hooks ()
+;;;###autoload  (interactive)
+;;;###autoload  (require 'vc-hooks)
+;;;###autoload  (vc-find-file-hook))
+
+;;;###autoload(and (featurep 'menubar)
+;;;###autoload     (featurep 'xemacs)
+;;;###autoload     (not (or (featurep 'vc-hooks) (featurep 'infodock)))
+;;;###autoload     current-menubar
+;;;###autoload     (car (find-menu-item current-menubar '("Tools")))
+;;;###autoload     (add-submenu '("Tools")
+;;;###autoload		  '("Version Control"
+;;;###autoload		   ["Load VC" vc-load-vc-hooks t])
+;;;###autoload	"Compare"))
+
+;; End XEmacs change: menus
 
 ;; These are not correct and it's not currently clear how doing it
 ;; better (with more complicated expressions) might slow things down