contrib/mercurial.el
changeset 5081 ea7b982b6c08
parent 4694 6bf58c9400e2
child 5142 2ffe3e2a1ac2
equal deleted inserted replaced
5080:73fdc8bd3ed8 5081:ea7b982b6c08
   424   "Read a integer value."
   424   "Read a integer value."
   425   (save-excursion
   425   (save-excursion
   426     (if (or (not default) current-prefix-arg)
   426     (if (or (not default) current-prefix-arg)
   427         (string-to-number
   427         (string-to-number
   428          (eval (list* 'read-string
   428          (eval (list* 'read-string
   429                       (or prompt "") 
   429                       (or prompt "")
   430                       (if default (cons (format "%d" default) nil) nil))))
   430                       (if default (cons (format "%d" default) nil) nil))))
   431       default)))
   431       default)))
   432 
   432 
   433 (defun hg-read-config ()
   433 (defun hg-read-config ()
   434   "Return an alist of (key . value) pairs of Mercurial config data.
   434   "Return an alist of (key . value) pairs of Mercurial config data.
   563 	       (status (cdr info))
   563 	       (status (cdr info))
   564 	       (buf (find-buffer-visiting (concat root name))))
   564 	       (buf (find-buffer-visiting (concat root name))))
   565 	  (when buf
   565 	  (when buf
   566 	    (set-buffer buf)
   566 	    (set-buffer buf)
   567 	    (hg-mode-line-internal status parents)))))))
   567 	    (hg-mode-line-internal status parents)))))))
   568   
   568 
   569 
   569 
   570 ;;; View mode bits.
   570 ;;; View mode bits.
   571 
   571 
   572 (defun hg-exit-view-mode (buf)
   572 (defun hg-exit-view-mode (buf)
   573   "Exit from hg-view-mode.
   573   "Exit from hg-view-mode.
   586   (hg-feature-cond (xemacs (view-minor-mode prev-buffer 'hg-exit-view-mode))
   586   (hg-feature-cond (xemacs (view-minor-mode prev-buffer 'hg-exit-view-mode))
   587 		   (t (view-mode-enter nil 'hg-exit-view-mode)))
   587 		   (t (view-mode-enter nil 'hg-exit-view-mode)))
   588   (setq hg-view-mode t)
   588   (setq hg-view-mode t)
   589   (setq truncate-lines t)
   589   (setq truncate-lines t)
   590   (when file-name
   590   (when file-name
   591     (setq hg-view-file-name 
   591     (setq hg-view-file-name
   592 	  (hg-abbrev-file-name file-name))))
   592 	  (hg-abbrev-file-name file-name))))
   593 
   593 
   594 (defun hg-file-status (file)
   594 (defun hg-file-status (file)
   595   "Return status of FILE, or nil if FILE does not exist or is unmanaged."
   595   "Return status of FILE, or nil if FILE does not exist or is unmanaged."
   596   (let* ((s (hg-run "status" file))
   596   (let* ((s (hg-run "status" file))
   701 					       '((normal . "")
   701 					       '((normal . "")
   702 						 (removed . "r")
   702 						 (removed . "r")
   703 						 (added . "a")
   703 						 (added . "a")
   704 						 (deleted . "!")
   704 						 (deleted . "!")
   705 						 (modified . "m"))))))))
   705 						 (modified . "m"))))))))
   706   
   706 
   707 (defun hg-mode-line (&optional force)
   707 (defun hg-mode-line (&optional force)
   708   "Update the modeline with the current status of a file.
   708   "Update the modeline with the current status of a file.
   709 An update occurs if optional argument FORCE is non-nil,
   709 An update occurs if optional argument FORCE is non-nil,
   710 hg-update-modeline is non-nil, or we have not yet checked the state of
   710 hg-update-modeline is non-nil, or we have not yet checked the state of
   711 the file."
   711 the file."
   998   (hg-sync-buffers path)
   998   (hg-sync-buffers path)
   999   (let ((a-path (hg-abbrev-file-name path))
   999   (let ((a-path (hg-abbrev-file-name path))
  1000         ;; none revision is specified explicitly
  1000         ;; none revision is specified explicitly
  1001         (none (and (not rev1) (not rev2)))
  1001         (none (and (not rev1) (not rev2)))
  1002         ;; only one revision is specified explicitly
  1002         ;; only one revision is specified explicitly
  1003         (one (or (and (or (equal rev1 rev2) (not rev2)) rev1) 
  1003         (one (or (and (or (equal rev1 rev2) (not rev2)) rev1)
  1004                  (and (not rev1) rev2)))
  1004                  (and (not rev1) rev2)))
  1005 	diff)
  1005 	diff)
  1006     (hg-view-output ((cond
  1006     (hg-view-output ((cond
  1007 		      (none
  1007 		      (none
  1008 		       (format "Mercurial: Diff against parent of %s" a-path))
  1008 		       (format "Mercurial: Diff against parent of %s" a-path))
  1010 		       (format "Mercurial: Diff of rev %s of %s" one a-path))
  1010 		       (format "Mercurial: Diff of rev %s of %s" one a-path))
  1011 		      (t
  1011 		      (t
  1012 		       (format "Mercurial: Diff from rev %s to %s of %s"
  1012 		       (format "Mercurial: Diff from rev %s to %s of %s"
  1013 			       rev1 rev2 a-path))))
  1013 			       rev1 rev2 a-path))))
  1014       (cond
  1014       (cond
  1015        (none 
  1015        (none
  1016         (call-process (hg-binary) nil t nil "diff" path))
  1016         (call-process (hg-binary) nil t nil "diff" path))
  1017        (one
  1017        (one
  1018         (call-process (hg-binary) nil t nil "diff" "-r" one path))
  1018         (call-process (hg-binary) nil t nil "diff" "-r" one path))
  1019        (t
  1019        (t
  1020         (call-process (hg-binary) nil t nil "diff" "-r" rev1 "-r" rev2 path)))
  1020         (call-process (hg-binary) nil t nil "diff" "-r" rev1 "-r" rev2 path)))
  1098         (r1 (or rev1 "tip"))
  1098         (r1 (or rev1 "tip"))
  1099         (r2 (or rev2 "0"))
  1099         (r2 (or rev2 "0"))
  1100         (limit (format "%d" (or log-limit hg-log-limit))))
  1100         (limit (format "%d" (or log-limit hg-log-limit))))
  1101     (hg-view-output ((if (equal r1 r2)
  1101     (hg-view-output ((if (equal r1 r2)
  1102                          (format "Mercurial: Log of rev %s of %s" rev1 a-path)
  1102                          (format "Mercurial: Log of rev %s of %s" rev1 a-path)
  1103                        (format 
  1103                        (format
  1104                         "Mercurial: at most %s log(s) from rev %s to %s of %s"
  1104                         "Mercurial: at most %s log(s) from rev %s to %s of %s"
  1105                         limit r1 r2 a-path)))
  1105                         limit r1 r2 a-path)))
  1106       (eval (list* 'call-process (hg-binary) nil t nil
  1106       (eval (list* 'call-process (hg-binary) nil t nil
  1107                    "log"
  1107                    "log"
  1108                    "-r" (format "%s:%s" r1 r2)
  1108                    "-r" (format "%s:%s" r1 r2)
  1121 LOG-LIMIT defaults to `hg-log-limit'.
  1121 LOG-LIMIT defaults to `hg-log-limit'.
  1122 With a prefix argument, prompt for each parameter."
  1122 With a prefix argument, prompt for each parameter."
  1123   (interactive (list (hg-read-file-name " to log")
  1123   (interactive (list (hg-read-file-name " to log")
  1124                      (hg-read-rev " to start with"
  1124                      (hg-read-rev " to start with"
  1125                                   "tip")
  1125                                   "tip")
  1126                      (hg-read-rev " to end with" 
  1126                      (hg-read-rev " to end with"
  1127 				  "0")
  1127 				  "0")
  1128                      (hg-read-number "Output limited to: "
  1128                      (hg-read-number "Output limited to: "
  1129                                      hg-log-limit)))
  1129                                      hg-log-limit)))
  1130   (hg-log (hg-root path) rev1 rev2 log-limit))
  1130   (hg-log (hg-root path) rev1 rev2 log-limit))
  1131 
  1131