135 (define-key hg-prefix-map "c" 'hg-undo) |
141 (define-key hg-prefix-map "c" 'hg-undo) |
136 (define-key hg-prefix-map "g" 'hg-annotate) |
142 (define-key hg-prefix-map "g" 'hg-annotate) |
137 (define-key hg-prefix-map "l" 'hg-log) |
143 (define-key hg-prefix-map "l" 'hg-log) |
138 (define-key hg-prefix-map "n" 'hg-commit-file) |
144 (define-key hg-prefix-map "n" 'hg-commit-file) |
139 ;; (define-key hg-prefix-map "r" 'hg-update) |
145 ;; (define-key hg-prefix-map "r" 'hg-update) |
140 (define-key hg-prefix-map "u" 'hg-revert-file) |
146 (define-key hg-prefix-map "u" 'hg-revert-buffer) |
141 (define-key hg-prefix-map "~" 'hg-version-other-window) |
147 (define-key hg-prefix-map "~" 'hg-version-other-window) |
142 |
148 |
143 (defvar hg-mode-map (make-sparse-keymap)) |
149 (defvar hg-mode-map (make-sparse-keymap)) |
144 (define-key hg-mode-map "\C-xv" 'hg-prefix-map) |
150 (define-key hg-mode-map "\C-xv" 'hg-prefix-map) |
145 |
151 |
187 'hg-buffer-mouse-clicked) |
193 'hg-buffer-mouse-clicked) |
188 |
194 |
189 |
195 |
190 ;;; Convenience functions. |
196 ;;; Convenience functions. |
191 |
197 |
192 (defun hg-binary () |
198 (defsubst hg-binary () |
193 (if hg-binary |
199 (if hg-binary |
194 hg-binary |
200 hg-binary |
195 (error "No `hg' executable found!"))) |
201 (error "No `hg' executable found!"))) |
196 |
202 |
197 (defun hg-replace-in-string (str regexp newtext &optional literal) |
203 (defsubst hg-replace-in-string (str regexp newtext &optional literal) |
198 "Replace all matches in STR for REGEXP with NEWTEXT string. |
204 "Replace all matches in STR for REGEXP with NEWTEXT string. |
199 Return the new string. Optional LITERAL non-nil means do a literal |
205 Return the new string. Optional LITERAL non-nil means do a literal |
200 replacement. |
206 replacement. |
201 |
207 |
202 This function bridges yet another pointless impedance gap between |
208 This function bridges yet another pointless impedance gap between |
203 XEmacs and GNU Emacs." |
209 XEmacs and GNU Emacs." |
204 (if (fboundp 'replace-in-string) |
210 (if (fboundp 'replace-in-string) |
205 (replace-in-string str regexp newtext literal) |
211 (replace-in-string str regexp newtext literal) |
206 (replace-regexp-in-string regexp newtext str nil literal))) |
212 (replace-regexp-in-string regexp newtext str nil literal))) |
207 |
213 |
208 (defun hg-chomp (str) |
214 (defsubst hg-chomp (str) |
209 "Strip trailing newlines from a string." |
215 "Strip trailing newlines from a string." |
210 (hg-replace-in-string str "[\r\n]+$" "")) |
216 (hg-replace-in-string str "[\r\n]+$" "")) |
211 |
217 |
212 (defun hg-run-command (command &rest args) |
218 (defun hg-run-command (command &rest args) |
213 "Run the shell command COMMAND, returning (EXIT-CODE . COMMAND-OUTPUT). |
219 "Run the shell command COMMAND, returning (EXIT-CODE . COMMAND-OUTPUT). |
266 |
272 |
267 (unless (fboundp 'view-minor-mode) |
273 (unless (fboundp 'view-minor-mode) |
268 (defun view-minor-mode (prev-buffer exit-func) |
274 (defun view-minor-mode (prev-buffer exit-func) |
269 (view-mode))) |
275 (view-mode))) |
270 |
276 |
271 (defun hg-abbrev-file-name (file) |
277 (defsubst hg-abbrev-file-name (file) |
|
278 "Portable wrapper around abbreviate-file-name." |
272 (if hg-running-xemacs |
279 (if hg-running-xemacs |
273 (abbreviate-file-name file t) |
280 (abbreviate-file-name file t) |
274 (abbreviate-file-name file))) |
281 (abbreviate-file-name file))) |
275 |
282 |
276 (defun hg-read-file-name (&optional prompt default) |
283 (defun hg-read-file-name (&optional prompt default) |
379 (pop-to-buffer view-buf-name) |
387 (pop-to-buffer view-buf-name) |
380 (hg-view-mode ,prev-buf ,@v-m-rest)))))) |
388 (hg-view-mode ,prev-buf ,@v-m-rest)))))) |
381 |
389 |
382 (put 'hg-view-output 'lisp-indent-function 1) |
390 (put 'hg-view-output 'lisp-indent-function 1) |
383 |
391 |
|
392 ;;; Context save and restore across revert. |
|
393 |
|
394 (defun hg-position-context (pos) |
|
395 "Return information to help find the given position again." |
|
396 (let* ((end (min (point-max) (+ pos 98)))) |
|
397 (list pos |
|
398 (buffer-substring (max (point-min) (- pos 2)) end) |
|
399 (- end pos)))) |
|
400 |
|
401 (defun hg-buffer-context () |
|
402 "Return information to help restore a user's editing context. |
|
403 This is useful across reverts and merges, where a context is likely |
|
404 to have moved a little, but not really changed." |
|
405 (let ((point-context (hg-position-context (point))) |
|
406 (mark-context (let ((mark (mark-marker))) |
|
407 (and mark (hg-position-context mark))))) |
|
408 (list point-context mark-context))) |
|
409 |
|
410 (defun hg-find-context (ctx) |
|
411 "Attempt to find a context in the given buffer. |
|
412 Always returns a valid, hopefully sane, position." |
|
413 (let ((pos (nth 0 ctx)) |
|
414 (str (nth 1 ctx)) |
|
415 (fixup (nth 2 ctx))) |
|
416 (save-excursion |
|
417 (goto-char (max (point-min) (- pos 15000))) |
|
418 (if (and (not (equal str "")) |
|
419 (search-forward str nil t)) |
|
420 (- (point) fixup) |
|
421 (max pos (point-min)))))) |
|
422 |
|
423 (defun hg-restore-context (ctx) |
|
424 "Attempt to restore the user's editing context." |
|
425 (let ((point-context (nth 0 ctx)) |
|
426 (mark-context (nth 1 ctx))) |
|
427 (goto-char (hg-find-context point-context)) |
|
428 (when mark-context |
|
429 (set-mark (hg-find-context mark-context))))) |
|
430 |
|
431 |
384 ;;; Hooks. |
432 ;;; Hooks. |
385 |
433 |
386 (defun hg-mode-line () |
434 (defun hg-mode-line (&optional force) |
387 (when (hg-root) |
435 "Update the modeline with the current status of a file. |
|
436 An update occurs if optional argument FORCE is non-nil, |
|
437 hg-update-modeline is non-nil, or we have not yet checked the state of |
|
438 the file." |
|
439 (when (and (hg-root) (or force hg-update-modeline (not hg-mode))) |
388 (let ((status (hg-file-status buffer-file-name))) |
440 (let ((status (hg-file-status buffer-file-name))) |
389 (setq hg-status status |
441 (setq hg-status status |
390 hg-mode (and status (concat " Hg:" |
442 hg-mode (and status (concat " Hg:" |
391 (car (hg-tip)) |
443 (car (hg-tip)) |
392 (cdr (assq status |
444 (cdr (assq status |
436 -------- --- ----------- ------------ |
488 -------- --- ----------- ------------ |
437 Help overview (what you are reading) G C-c h h hg-help-overview |
489 Help overview (what you are reading) G C-c h h hg-help-overview |
438 |
490 |
439 Tell Mercurial to manage a file G C-c h a hg-add |
491 Tell Mercurial to manage a file G C-c h a hg-add |
440 Commit changes to current file only L C-x v n hg-commit |
492 Commit changes to current file only L C-x v n hg-commit |
441 Undo changes to file since commit L C-x v u hg-revert-file |
493 Undo changes to file since commit L C-x v u hg-revert-buffer |
442 |
494 |
443 Diff file vs last checkin L C-x v = hg-diff |
495 Diff file vs last checkin L C-x v = hg-diff |
444 |
496 |
445 View file change history L C-x v l hg-log |
497 View file change history L C-x v l hg-log |
446 View annotated file L C-x v a hg-annotate |
498 View annotated file L C-x v a hg-annotate |
486 (defun hg-diff (path &optional rev1 rev2) |
538 (defun hg-diff (path &optional rev1 rev2) |
487 (interactive (list (hg-read-file-name " to diff") |
539 (interactive (list (hg-read-file-name " to diff") |
488 (hg-read-rev " to start with") |
540 (hg-read-rev " to start with") |
489 (let ((rev2 (hg-read-rev " to end with" 'working-dir))) |
541 (let ((rev2 (hg-read-rev " to end with" 'working-dir))) |
490 (and (not (eq rev2 'working-dir)) rev2)))) |
542 (and (not (eq rev2 'working-dir)) rev2)))) |
491 (let ((a-path (hg-abbrev-file-name path))) |
543 (unless rev1 |
|
544 (setq rev1 "-1")) |
|
545 (let ((a-path (hg-abbrev-file-name path)) |
|
546 diff) |
492 (hg-view-output ((if (equal rev1 rev2) |
547 (hg-view-output ((if (equal rev1 rev2) |
493 (format "Mercurial: Rev %s of %s" rev1 a-path) |
548 (format "Mercurial: Rev %s of %s" rev1 a-path) |
494 (format "Mercurial: Rev %s to %s of %s" |
549 (format "Mercurial: Rev %s to %s of %s" |
495 rev1 (or rev2 "Current") a-path))) |
550 rev1 (or rev2 "Current") a-path))) |
496 (if rev2 |
551 (if rev2 |
497 (call-process (hg-binary) nil t nil "diff" "-r" rev1 "-r" rev2 path) |
552 (call-process (hg-binary) nil t nil "diff" "-r" rev1 "-r" rev2 path) |
498 (call-process (hg-binary) nil t nil "diff" "-r" rev1 path)) |
553 (call-process (hg-binary) nil t nil "diff" "-r" rev1 path)) |
499 (diff-mode) |
554 (diff-mode) |
500 (font-lock-fontify-buffer)))) |
555 (setq diff (not (= (point-min) (point-max)))) |
|
556 (font-lock-fontify-buffer)) |
|
557 diff)) |
501 |
558 |
502 (defun hg-forget (path) |
559 (defun hg-forget (path) |
503 (interactive (list (hg-read-file-name " to forget"))) |
560 (interactive (list (hg-read-file-name " to forget"))) |
504 (let ((buf (current-buffer)) |
561 (let ((buf (current-buffer)) |
505 (update (equal buffer-file-name path))) |
562 (update (equal buffer-file-name path))) |
519 |
576 |
520 (defun hg-log (path &optional rev1 rev2) |
577 (defun hg-log (path &optional rev1 rev2) |
521 (interactive (list (hg-read-file-name " to log") |
578 (interactive (list (hg-read-file-name " to log") |
522 (hg-read-rev " to start with" "-1") |
579 (hg-read-rev " to start with" "-1") |
523 (hg-read-rev " to end with" (format "-%d" hg-log-limit)))) |
580 (hg-read-rev " to end with" (format "-%d" hg-log-limit)))) |
524 (message "log %s %s" rev1 rev2) |
|
525 (sit-for 1) |
|
526 (let ((a-path (hg-abbrev-file-name path))) |
581 (let ((a-path (hg-abbrev-file-name path))) |
527 (hg-view-output ((if (equal rev1 rev2) |
582 (hg-view-output ((if (equal rev1 rev2) |
528 (format "Mercurial: Rev %s of %s" rev1 a-path) |
583 (format "Mercurial: Rev %s of %s" rev1 a-path) |
529 (format "Mercurial: Rev %s to %s of %s" |
584 (format "Mercurial: Rev %s to %s of %s" |
530 rev1 (or rev2 "Current") a-path))) |
585 rev1 (or rev2 "Current") a-path))) |
542 |
597 |
543 (defun hg-push () |
598 (defun hg-push () |
544 (interactive) |
599 (interactive) |
545 (error "not implemented")) |
600 (error "not implemented")) |
546 |
601 |
547 (defun hg-revert () |
602 (defun hg-revert-buffer-internal () |
548 (interactive) |
603 (let ((ctx (hg-buffer-context))) |
549 (error "not implemented")) |
604 (message "Reverting %s..." buffer-file-name) |
550 |
605 (hg-run0 "revert" buffer-file-name) |
551 (defun hg-revert-file () |
606 (revert-buffer t t t) |
552 (interactive) |
607 (hg-restore-context ctx) |
553 (error "not implemented")) |
608 (hg-mode-line) |
|
609 (message "Reverting %s...done" buffer-file-name))) |
|
610 |
|
611 (defun hg-revert-buffer () |
|
612 (interactive) |
|
613 (let ((vc-suppress-confirm nil) |
|
614 (obuf (current-buffer)) |
|
615 diff) |
|
616 (vc-buffer-sync) |
|
617 (unwind-protect |
|
618 (setq diff (hg-diff buffer-file-name)) |
|
619 (when diff |
|
620 (unless (yes-or-no-p "Discard changes? ") |
|
621 (error "Revert cancelled"))) |
|
622 (when diff |
|
623 (let ((buf (current-buffer))) |
|
624 (delete-window (selected-window)) |
|
625 (kill-buffer buf)))) |
|
626 (set-buffer obuf) |
|
627 (when diff |
|
628 (hg-revert-buffer-internal)))) |
554 |
629 |
555 (defun hg-root (&optional path) |
630 (defun hg-root (&optional path) |
556 (interactive (list (hg-read-file-name))) |
631 (interactive (list (hg-read-file-name))) |
557 (let ((root (do ((prev nil dir) |
632 (let ((root (do ((prev nil dir) |
558 (dir (file-name-directory (or path (buffer-file-name))) |
633 (dir (file-name-directory (or path (buffer-file-name))) |