mercurial-crew-with-dirclash: contrib/mercurial.el comparison

comparison contrib/mercurial.el @ 995:1e4b009b379e

Emacs support: add hg-revert-buffer.

author	Bryan O'Sullivan <bos@serpentine.com>
date	Sun, 21 Aug 2005 21:51:01 -0800
parents	d845a1f174bb
children	5ed566574486

comparison

equal deleted inserted replaced

-:a66e249d77ae
+:1e4b009b379e
 :group 'mercurial)
 (defcustom hg-log-limit 50
 "The maximum number of revisions that hg-log will display."
 :type 'integer
+:group 'mercurial)
+(defcustom hg-update-modeline t
+"Whether to update the modeline with the status of a file after every save.
+Set this to nil on platforms with poor process management, such as Windows."
+:type 'boolean
 :group 'mercurial)
 ;;; Other variables.
 (define-key hg-prefix-map "c" 'hg-undo)
 (define-key hg-prefix-map "g" 'hg-annotate)
 (define-key hg-prefix-map "l" 'hg-log)
 (define-key hg-prefix-map "n" 'hg-commit-file)
 ;; (define-key hg-prefix-map "r" 'hg-update)
-(define-key hg-prefix-map "u" 'hg-revert-file)
+(define-key hg-prefix-map "u" 'hg-revert-buffer)
 (define-key hg-prefix-map "~" 'hg-version-other-window)
 (defvar hg-mode-map (make-sparse-keymap))
 (define-key hg-mode-map "\C-xv" 'hg-prefix-map)
 'hg-buffer-mouse-clicked)
 ;;; Convenience functions.
-(defun hg-binary ()
+(defsubst hg-binary ()
 (if hg-binary
 hg-binary
 (error "No `hg' executable found!")))
-(defun hg-replace-in-string (str regexp newtext &optional literal)
+(defsubst hg-replace-in-string (str regexp newtext &optional literal)
 "Replace all matches in STR for REGEXP with NEWTEXT string.
 Return the new string.  Optional LITERAL non-nil means do a literal
 replacement.
 This function bridges yet another pointless impedance gap between
 XEmacs and GNU Emacs."
 (if (fboundp 'replace-in-string)
 (replace-in-string str regexp newtext literal)
 (replace-regexp-in-string regexp newtext str nil literal)))
-(defun hg-chomp (str)
+(defsubst hg-chomp (str)
 "Strip trailing newlines from a string."
 (hg-replace-in-string str "[\r\n]+$" ""))
 (defun hg-run-command (command &rest args)
 "Run the shell command COMMAND, returning (EXIT-CODE . COMMAND-OUTPUT).
 (unless (fboundp 'view-minor-mode)
 (defun view-minor-mode (prev-buffer exit-func)
 (view-mode)))
-(defun hg-abbrev-file-name (file)
+(defsubst hg-abbrev-file-name (file)
+"Portable wrapper around abbreviate-file-name."
 (if hg-running-xemacs
 (abbreviate-file-name file t)
 (abbreviate-file-name file)))
 (defun hg-read-file-name (&optional prompt default)
 	 (output (cdr s)))
 (if (= exit 0)
 	(let ((state (assoc (substring output 0 (min (length output) 2))
 			    '(("M " . modified)
 			      ("A " . added)
-			      ("R " . removed)))))
+			      ("R " . removed)
+			      ("? " . nil)))))
 	  (if state
 	      (cdr state)
 	    'normal)))))
 (defun hg-tip ()
 	  (pop-to-buffer view-buf-name)
 	  (hg-view-mode ,prev-buf ,@v-m-rest))))))
 (put 'hg-view-output 'lisp-indent-function 1)
+;;; Context save and restore across revert.
+(defun hg-position-context (pos)
+"Return information to help find the given position again."
+(let* ((end (min (point-max) (+ pos 98))))
+(list pos
+	  (buffer-substring (max (point-min) (- pos 2)) end)
+	  (- end pos))))
+(defun hg-buffer-context ()
+"Return information to help restore a user's editing context.
+This is useful across reverts and merges, where a context is likely
+to have moved a little, but not really changed."
+(let ((point-context (hg-position-context (point)))
+	(mark-context (let ((mark (mark-marker)))
+			(and mark (hg-position-context mark)))))
+(list point-context mark-context)))
+(defun hg-find-context (ctx)
+"Attempt to find a context in the given buffer.
+Always returns a valid, hopefully sane, position."
+(let ((pos (nth 0 ctx))
+	(str (nth 1 ctx))
+	(fixup (nth 2 ctx)))
+(save-excursion
+(goto-char (max (point-min) (- pos 15000)))
+(if (and (not (equal str ""))
+	       (search-forward str nil t))
+	  (- (point) fixup)
+	(max pos (point-min))))))
+(defun hg-restore-context (ctx)
+"Attempt to restore the user's editing context."
+(let ((point-context (nth 0 ctx))
+	(mark-context (nth 1 ctx)))
+(goto-char (hg-find-context point-context))
+(when mark-context
+(set-mark (hg-find-context mark-context)))))
 ;;; Hooks.
-(defun hg-mode-line ()
+(defun hg-mode-line (&optional force)
-(when (hg-root)
+"Update the modeline with the current status of a file.
+An update occurs if optional argument FORCE is non-nil,
+hg-update-modeline is non-nil, or we have not yet checked the state of
+the file."
+(when (and (hg-root) (or force hg-update-modeline (not hg-mode)))
 (let ((status (hg-file-status buffer-file-name)))
 (setq hg-status status
 	    hg-mode (and status (concat " Hg:"
 					(car (hg-tip))
 					(cdr (assq status
 --------                              ---  -----------  ------------
 Help overview (what you are reading)  G    C-c h h      hg-help-overview
 Tell Mercurial to manage a file       G    C-c h a      hg-add
 Commit changes to current file only   L    C-x v n      hg-commit
-Undo changes to file since commit     L    C-x v u      hg-revert-file
+Undo changes to file since commit     L    C-x v u      hg-revert-buffer
 Diff file vs last checkin             L    C-x v =      hg-diff
 View file change history              L    C-x v l      hg-log
 View annotated file                   L    C-x v a      hg-annotate
 (defun hg-diff (path &optional rev1 rev2)
 (interactive (list (hg-read-file-name " to diff")
 		     (hg-read-rev " to start with")
 		     (let ((rev2 (hg-read-rev " to end with" 'working-dir)))
 		       (and (not (eq rev2 'working-dir)) rev2))))
-(let ((a-path (hg-abbrev-file-name path)))
+(unless rev1
+(setq rev1 "-1"))
+(let ((a-path (hg-abbrev-file-name path))
+	diff)
 (hg-view-output ((if (equal rev1 rev2)
 			 (format "Mercurial: Rev %s of %s" rev1 a-path)
 		       (format "Mercurial: Rev %s to %s of %s"
 			       rev1 (or rev2 "Current") a-path)))
 (if rev2
 	  (call-process (hg-binary) nil t nil "diff" "-r" rev1 "-r" rev2 path)
 	(call-process (hg-binary) nil t nil "diff" "-r" rev1 path))
 (diff-mode)
-(font-lock-fontify-buffer))))
+(setq diff (not (= (point-min) (point-max))))
+(font-lock-fontify-buffer))
+diff))
 (defun hg-forget (path)
 (interactive (list (hg-read-file-name " to forget")))
 (let ((buf (current-buffer))
 	(update (equal buffer-file-name path)))
 (defun hg-log (path &optional rev1 rev2)
 (interactive (list (hg-read-file-name " to log")
 		     (hg-read-rev " to start with" "-1")
 		     (hg-read-rev " to end with" (format "-%d" hg-log-limit))))
-(message "log %s %s" rev1 rev2)
-(sit-for 1)
 (let ((a-path (hg-abbrev-file-name path)))
 (hg-view-output ((if (equal rev1 rev2)
 			 (format "Mercurial: Rev %s of %s" rev1 a-path)
 		       (format "Mercurial: Rev %s to %s of %s"
 			       rev1 (or rev2 "Current") a-path)))
 (defun hg-push ()
 (interactive)
 (error "not implemented"))
-(defun hg-revert ()
+(defun hg-revert-buffer-internal ()
-(interactive)
+(let ((ctx (hg-buffer-context)))
-(error "not implemented"))
+(message "Reverting %s..." buffer-file-name)
+(hg-run0 "revert" buffer-file-name)
-(defun hg-revert-file ()
+(revert-buffer t t t)
-(interactive)
+(hg-restore-context ctx)
-(error "not implemented"))
+(hg-mode-line)
+(message "Reverting %s...done" buffer-file-name)))
+(defun hg-revert-buffer ()
+(interactive)
+(let ((vc-suppress-confirm nil)
+	(obuf (current-buffer))
+	diff)
+(vc-buffer-sync)
+(unwind-protect
+	(setq diff (hg-diff buffer-file-name))
+(when diff
+	(unless (yes-or-no-p "Discard changes? ")
+	  (error "Revert cancelled")))
+(when diff
+	(let ((buf (current-buffer)))
+	  (delete-window (selected-window))
+	  (kill-buffer buf))))
+(set-buffer obuf)
+(when diff
+(hg-revert-buffer-internal))))
 (defun hg-root (&optional path)
 (interactive (list (hg-read-file-name)))
 (let ((root (do ((prev nil dir)
 		   (dir (file-name-directory (or path (buffer-file-name)))
 (provide 'mercurial)
 ;;; Local Variables:
-;;; mode: emacs-lisp
 ;;; prompt-to-byte-compile: nil
 ;;; end:

Mercurial > hg > mercurial-crew-with-dirclash

comparison contrib/mercurial.el @ 995:1e4b009b379e