Show More
@@ -43,22 +43,28 b'' | |||
|
43 | 43 | |
|
44 | 44 | ;;; Code: |
|
45 | 45 | |
|
46 | (require 'advice) | |
|
47 | (require 'cl) | |
|
46 | (eval-when-compile (require 'cl)) | |
|
48 | 47 | (require 'diff-mode) |
|
49 | 48 | (require 'easymenu) |
|
50 | 49 | (require 'executable) |
|
51 | 50 | (require 'vc) |
|
52 | 51 | |
|
52 | (defmacro hg-feature-cond (&rest clauses) | |
|
53 | "Test CLAUSES for feature at compile time. | |
|
54 | Each clause is (FEATURE BODY...)." | |
|
55 | (dolist (x clauses) | |
|
56 | (let ((feature (car x)) | |
|
57 | (body (cdr x))) | |
|
58 | (when (or (eq feature t) | |
|
59 | (featurep feature)) | |
|
60 | (return (cons 'progn body)))))) | |
|
61 | ||
|
53 | 62 | |
|
54 | 63 | ;;; XEmacs has view-less, while GNU Emacs has view. Joy. |
|
55 | 64 | |
|
56 | (condition-case nil | |
|
57 |
|
|
|
58 | (error nil)) | |
|
59 | (condition-case nil | |
|
60 | (require 'view) | |
|
61 | (error nil)) | |
|
65 | (hg-feature-cond | |
|
66 | (xemacs (require 'view-less)) | |
|
67 | (t (require 'view))) | |
|
62 | 68 | |
|
63 | 69 | |
|
64 | 70 | ;;; Variables accessible through the custom system. |
@@ -147,9 +153,6 b' repository-related commands."' | |||
|
147 | 153 | |
|
148 | 154 | ;;; Other variables. |
|
149 | 155 | |
|
150 | (defconst hg-running-xemacs (string-match "XEmacs" emacs-version) | |
|
151 | "Is mercurial.el running under XEmacs?") | |
|
152 | ||
|
153 | 156 | (defvar hg-mode nil |
|
154 | 157 | "Is this file managed by Mercurial?") |
|
155 | 158 | (make-variable-buffer-local 'hg-mode) |
@@ -167,12 +170,21 b' repository-related commands."' | |||
|
167 | 170 | (make-variable-buffer-local 'hg-root) |
|
168 | 171 | (put 'hg-root 'permanent-local t) |
|
169 | 172 | |
|
173 | (defvar hg-view-mode nil) | |
|
174 | (make-variable-buffer-local 'hg-view-mode) | |
|
175 | (put 'hg-view-mode 'permanent-local t) | |
|
176 | ||
|
177 | (defvar hg-view-file-name nil) | |
|
178 | (make-variable-buffer-local 'hg-view-file-name) | |
|
179 | (put 'hg-view-file-name 'permanent-local t) | |
|
180 | ||
|
170 | 181 | (defvar hg-output-buffer-name "*Hg*" |
|
171 | 182 | "The name to use for Mercurial output buffers.") |
|
172 | 183 | |
|
173 | 184 | (defvar hg-file-history nil) |
|
174 | 185 | (defvar hg-repo-history nil) |
|
175 | 186 | (defvar hg-rev-history nil) |
|
187 | (defvar hg-repo-completion-table nil) ; shut up warnings | |
|
176 | 188 | |
|
177 | 189 | |
|
178 | 190 | ;;; Random constants. |
@@ -183,85 +195,96 b' repository-related commands."' | |||
|
183 | 195 | (defconst hg-commit-message-end |
|
184 | 196 | "--- Files in bold will be committed. Click to toggle selection. ---\n") |
|
185 | 197 | |
|
198 | (defconst hg-state-alist | |
|
199 | '((?M . modified) | |
|
200 | (?A . added) | |
|
201 | (?R . removed) | |
|
202 | (?! . deleted) | |
|
203 | (?C . normal) | |
|
204 | (?I . ignored) | |
|
205 | (?? . nil))) | |
|
186 | 206 | |
|
187 | 207 | ;;; hg-mode keymap. |
|
188 | 208 | |
|
189 | (defvar hg-mode-map (make-sparse-keymap)) | |
|
190 | (define-key hg-mode-map "\C-xv" 'hg-prefix-map) | |
|
191 | ||
|
192 | 209 | (defvar hg-prefix-map |
|
193 |
(let ((map ( |
|
|
194 | (if (functionp 'set-keymap-name) | |
|
195 |
|
|
|
210 | (let ((map (make-sparse-keymap))) | |
|
211 | (hg-feature-cond (xemacs (set-keymap-name map 'hg-prefix-map))) ; XEmacs | |
|
212 | (set-keymap-parent map vc-prefix-map) | |
|
213 | (define-key map "=" 'hg-diff) | |
|
214 | (define-key map "c" 'hg-undo) | |
|
215 | (define-key map "g" 'hg-annotate) | |
|
216 | (define-key map "i" 'hg-add) | |
|
217 | (define-key map "l" 'hg-log) | |
|
218 | (define-key map "n" 'hg-commit-start) | |
|
219 | ;; (define-key map "r" 'hg-update) | |
|
220 | (define-key map "u" 'hg-revert-buffer) | |
|
221 | (define-key map "~" 'hg-version-other-window) | |
|
196 | 222 | map) |
|
197 | 223 | "This keymap overrides some default vc-mode bindings.") |
|
198 | (fset 'hg-prefix-map hg-prefix-map) | |
|
199 | (define-key hg-prefix-map "=" 'hg-diff) | |
|
200 | (define-key hg-prefix-map "c" 'hg-undo) | |
|
201 |
(define-key |
|
|
202 | (define-key hg-prefix-map "l" 'hg-log) | |
|
203 | (define-key hg-prefix-map "n" 'hg-commit-start) | |
|
204 | ;; (define-key hg-prefix-map "r" 'hg-update) | |
|
205 | (define-key hg-prefix-map "u" 'hg-revert-buffer) | |
|
206 | (define-key hg-prefix-map "~" 'hg-version-other-window) | |
|
224 | ||
|
225 | (defvar hg-mode-map | |
|
226 | (let ((map (make-sparse-keymap))) | |
|
227 | (define-key map "\C-xv" hg-prefix-map) | |
|
228 | map)) | |
|
207 | 229 | |
|
208 | 230 | (add-minor-mode 'hg-mode 'hg-mode hg-mode-map) |
|
209 | 231 | |
|
210 | 232 | |
|
211 | 233 | ;;; Global keymap. |
|
212 | 234 | |
|
213 | (global-set-key "\C-xvi" 'hg-add) | |
|
235 | (defvar hg-global-map | |
|
236 | (let ((map (make-sparse-keymap))) | |
|
237 | (define-key map "," 'hg-incoming) | |
|
238 | (define-key map "." 'hg-outgoing) | |
|
239 | (define-key map "<" 'hg-pull) | |
|
240 | (define-key map "=" 'hg-diff-repo) | |
|
241 | (define-key map ">" 'hg-push) | |
|
242 | (define-key map "?" 'hg-help-overview) | |
|
243 | (define-key map "A" 'hg-addremove) | |
|
244 | (define-key map "U" 'hg-revert) | |
|
245 | (define-key map "a" 'hg-add) | |
|
246 | (define-key map "c" 'hg-commit-start) | |
|
247 | (define-key map "f" 'hg-forget) | |
|
248 | (define-key map "h" 'hg-help-overview) | |
|
249 | (define-key map "i" 'hg-init) | |
|
250 | (define-key map "l" 'hg-log-repo) | |
|
251 | (define-key map "r" 'hg-root) | |
|
252 | (define-key map "s" 'hg-status) | |
|
253 | (define-key map "u" 'hg-update) | |
|
254 | map)) | |
|
214 | 255 | |
|
215 | (defvar hg-global-map (make-sparse-keymap)) | |
|
216 | (fset 'hg-global-map hg-global-map) | |
|
217 | (global-set-key hg-global-prefix 'hg-global-map) | |
|
218 | (define-key hg-global-map "," 'hg-incoming) | |
|
219 | (define-key hg-global-map "." 'hg-outgoing) | |
|
220 | (define-key hg-global-map "<" 'hg-pull) | |
|
221 | (define-key hg-global-map "=" 'hg-diff-repo) | |
|
222 | (define-key hg-global-map ">" 'hg-push) | |
|
223 | (define-key hg-global-map "?" 'hg-help-overview) | |
|
224 | (define-key hg-global-map "A" 'hg-addremove) | |
|
225 | (define-key hg-global-map "U" 'hg-revert) | |
|
226 | (define-key hg-global-map "a" 'hg-add) | |
|
227 | (define-key hg-global-map "c" 'hg-commit-start) | |
|
228 | (define-key hg-global-map "f" 'hg-forget) | |
|
229 | (define-key hg-global-map "h" 'hg-help-overview) | |
|
230 | (define-key hg-global-map "i" 'hg-init) | |
|
231 | (define-key hg-global-map "l" 'hg-log-repo) | |
|
232 | (define-key hg-global-map "r" 'hg-root) | |
|
233 | (define-key hg-global-map "s" 'hg-status) | |
|
234 | (define-key hg-global-map "u" 'hg-update) | |
|
235 | ||
|
256 | (global-set-key hg-global-prefix hg-global-map) | |
|
236 | 257 | |
|
237 | 258 | ;;; View mode keymap. |
|
238 | 259 | |
|
239 | 260 | (defvar hg-view-mode-map |
|
240 | (let ((map (copy-keymap (if (boundp 'view-minor-mode-map) | |
|
241 | view-minor-mode-map | |
|
242 | view-mode-map)))) | |
|
243 | (if (functionp 'set-keymap-name) | |
|
244 | (set-keymap-name map 'hg-view-mode-map)); XEmacs | |
|
261 | (let ((map (make-sparse-keymap))) | |
|
262 | (hg-feature-cond (xemacs (set-keymap-name map 'hg-view-mode-map))) ; XEmacs | |
|
263 | (define-key map (hg-feature-cond (xemacs [button2]) | |
|
264 | (t [mouse-2])) | |
|
265 | 'hg-buffer-mouse-clicked) | |
|
245 | 266 | map)) |
|
246 | (fset 'hg-view-mode-map hg-view-mode-map) | |
|
247 |
( |
|
|
248 | (if hg-running-xemacs [button2] [mouse-2]) | |
|
249 | 'hg-buffer-mouse-clicked) | |
|
267 | ||
|
268 | (add-minor-mode 'hg-view-mode "" hg-view-mode-map) | |
|
250 | 269 | |
|
251 | 270 | |
|
252 | 271 | ;;; Commit mode keymaps. |
|
253 | 272 | |
|
254 |
(defvar hg-commit-mode-map |
|
|
255 | (define-key hg-commit-mode-map "\C-c\C-c" 'hg-commit-finish) | |
|
256 |
(define-key |
|
|
257 | (define-key hg-commit-mode-map "\C-xv=" 'hg-diff-repo) | |
|
273 | (defvar hg-commit-mode-map | |
|
274 | (let ((map (make-sparse-keymap))) | |
|
275 | (define-key map "\C-c\C-c" 'hg-commit-finish) | |
|
276 | (define-key map "\C-c\C-k" 'hg-commit-kill) | |
|
277 | (define-key map "\C-xv=" 'hg-diff-repo) | |
|
278 | map)) | |
|
258 | 279 | |
|
259 |
(defvar hg-commit-mode-file-map |
|
|
260 | (define-key hg-commit-mode-file-map | |
|
261 | (if hg-running-xemacs [button2] [mouse-2]) | |
|
280 | (defvar hg-commit-mode-file-map | |
|
281 | (let ((map (make-sparse-keymap))) | |
|
282 | (define-key map (hg-feature-cond (xemacs [button2]) | |
|
283 | (t [mouse-2])) | |
|
262 | 284 | 'hg-commit-mouse-clicked) |
|
263 |
(define-key |
|
|
264 |
(define-key |
|
|
285 | (define-key map " " 'hg-commit-toggle-file) | |
|
286 | (define-key map "\r" 'hg-commit-toggle-file) | |
|
287 | map)) | |
|
265 | 288 | |
|
266 | 289 | |
|
267 | 290 | ;;; Convenience functions. |
@@ -278,9 +301,9 b' replacement.' | |||
|
278 | 301 | |
|
279 | 302 | This function bridges yet another pointless impedance gap between |
|
280 | 303 | XEmacs and GNU Emacs." |
|
281 | (if (fboundp 'replace-in-string) | |
|
282 |
|
|
|
283 | (replace-regexp-in-string regexp newtext str nil literal))) | |
|
304 | (hg-feature-cond | |
|
305 | (xemacs (replace-in-string str regexp newtext literal)) | |
|
306 | (t (replace-regexp-in-string regexp newtext str nil literal)))) | |
|
284 | 307 | |
|
285 | 308 | (defsubst hg-strip (str) |
|
286 | 309 | "Strip leading and trailing blank lines from a string." |
@@ -318,8 +341,8 b' If the command does not exit with a zero' | |||
|
318 | 341 | (cdr res)))) |
|
319 | 342 | |
|
320 | 343 | (defmacro hg-do-across-repo (path &rest body) |
|
321 |
(let ((root-name ( |
|
|
322 |
(buf-name ( |
|
|
344 | (let ((root-name (make-symbol "root-")) | |
|
345 | (buf-name (make-symbol "buf-"))) | |
|
323 | 346 | `(let ((,root-name (hg-root ,path))) |
|
324 | 347 | (save-excursion |
|
325 | 348 | (dolist (,buf-name (buffer-list)) |
@@ -344,29 +367,23 b' all buffers visiting files in the reposi' | |||
|
344 | 367 | "Use the properties of a character to do something sensible." |
|
345 | 368 | (interactive "d") |
|
346 | 369 | (let ((rev (get-char-property pnt 'rev)) |
|
347 | (file (get-char-property pnt 'file)) | |
|
348 | (date (get-char-property pnt 'date)) | |
|
349 | (user (get-char-property pnt 'user)) | |
|
350 | (host (get-char-property pnt 'host)) | |
|
351 | (prev-buf (current-buffer))) | |
|
370 | (file (get-char-property pnt 'file))) | |
|
352 | 371 | (cond |
|
353 | 372 | (file |
|
354 | 373 | (find-file-other-window file)) |
|
355 | 374 | (rev |
|
356 |
(hg-diff hg-view-file-name rev rev |
|
|
375 | (hg-diff hg-view-file-name rev rev)) | |
|
357 | 376 | ((message "I don't know how to do that yet"))))) |
|
358 | 377 | |
|
359 | 378 | (defsubst hg-event-point (event) |
|
360 | 379 | "Return the character position of the mouse event EVENT." |
|
361 | (if hg-running-xemacs | |
|
362 | (event-point event) | |
|
363 | (posn-point (event-start event)))) | |
|
380 | (hg-feature-cond (xemacs (event-point event)) | |
|
381 | (t (posn-point (event-start event))))) | |
|
364 | 382 | |
|
365 | 383 | (defsubst hg-event-window (event) |
|
366 | 384 | "Return the window over which mouse event EVENT occurred." |
|
367 | (if hg-running-xemacs | |
|
368 | (event-window event) | |
|
369 | (posn-window (event-start event)))) | |
|
385 | (hg-feature-cond (xemacs (event-window event)) | |
|
386 | (t (posn-window (event-start event))))) | |
|
370 | 387 | |
|
371 | 388 | (defun hg-buffer-mouse-clicked (event) |
|
372 | 389 | "Translate the mouse clicks in a HG log buffer to character events. |
@@ -377,15 +394,10 b" Handle frickin' frackin' gratuitous even" | |||
|
377 | 394 | (select-window (hg-event-window event)) |
|
378 | 395 | (hg-buffer-commands (hg-event-point event))) |
|
379 | 396 | |
|
380 | (unless (fboundp 'view-minor-mode) | |
|
381 | (defun view-minor-mode (prev-buffer exit-func) | |
|
382 | (view-mode))) | |
|
383 | ||
|
384 | 397 | (defsubst hg-abbrev-file-name (file) |
|
385 | 398 | "Portable wrapper around abbreviate-file-name." |
|
386 | (if hg-running-xemacs | |
|
387 |
|
|
|
388 | (abbreviate-file-name file))) | |
|
399 | (hg-feature-cond (xemacs (abbreviate-file-name file t)) | |
|
400 | (t (abbreviate-file-name file)))) | |
|
389 | 401 | |
|
390 | 402 | (defun hg-read-file-name (&optional prompt default) |
|
391 | 403 | "Read a file or directory name, or a pattern, to use with a command." |
@@ -403,9 +415,9 b" Handle frickin' frackin' gratuitous even" | |||
|
403 | 415 | (and path (file-name-directory path)) |
|
404 | 416 | nil nil |
|
405 | 417 | (and path (file-name-nondirectory path)) |
|
406 |
( |
|
|
407 |
|
|
|
408 | nil)))) | |
|
418 | (hg-feature-cond | |
|
419 | (xemacs (cons (quote 'hg-file-history) nil)) | |
|
420 | (t nil))))) | |
|
409 | 421 | path)))) |
|
410 | 422 | |
|
411 | 423 | (defun hg-read-number (&optional prompt default) |
@@ -477,7 +489,10 b' directory names from the file system. W' | |||
|
477 | 489 | (dolist (path (hg-config-section "paths" (hg-read-config))) |
|
478 | 490 | (setq hg-repo-completion-table |
|
479 | 491 | (cons (cons (car path) t) hg-repo-completion-table)) |
|
480 |
(unless (hg-string-starts-with |
|
|
492 | (unless (hg-string-starts-with (hg-feature-cond | |
|
493 | (xemacs directory-sep-char) | |
|
494 | (t ?/)) | |
|
495 | (cdr path)) | |
|
481 | 496 | (setq hg-repo-completion-table |
|
482 | 497 | (cons (cons (cdr path) t) hg-repo-completion-table)))) |
|
483 | 498 | (completing-read (format "Repository%s: " (or prompt "")) |
@@ -498,8 +513,8 b' directory names from the file system. W' | |||
|
498 | 513 | (if current-prefix-arg |
|
499 | 514 | (let ((revs (split-string |
|
500 | 515 | (hg-chomp |
|
501 |
(hg-run0 "-q" "log" "- |
|
|
502 |
(format " |
|
|
516 | (hg-run0 "-q" "log" "-l" | |
|
517 | (format "%d" hg-rev-completion-limit))) | |
|
503 | 518 | "[\n:]"))) |
|
504 | 519 | (dolist (line (split-string (hg-chomp (hg-run0 "tags")) "\n")) |
|
505 | 520 | (setq revs (cons (car (split-string line "\\s-")) revs))) |
@@ -568,11 +583,12 b' current frame."' | |||
|
568 | 583 | (goto-char (point-min)) |
|
569 | 584 | (set-buffer-modified-p nil) |
|
570 | 585 | (toggle-read-only t) |
|
571 | (view-minor-mode prev-buffer 'hg-exit-view-mode) | |
|
572 | (use-local-map hg-view-mode-map) | |
|
586 | (hg-feature-cond (xemacs (view-minor-mode prev-buffer 'hg-exit-view-mode)) | |
|
587 | (t (view-mode-enter nil 'hg-exit-view-mode))) | |
|
588 | (setq hg-view-mode t) | |
|
573 | 589 | (setq truncate-lines t) |
|
574 | 590 | (when file-name |
|
575 |
(set |
|
|
591 | (setq hg-view-file-name | |
|
576 | 592 | (hg-abbrev-file-name file-name)))) |
|
577 | 593 | |
|
578 | 594 | (defun hg-file-status (file) |
@@ -581,12 +597,9 b' current frame."' | |||
|
581 | 597 | (exit (car s)) |
|
582 | 598 | (output (cdr s))) |
|
583 | 599 | (if (= exit 0) |
|
584 |
(let ((state (a |
|
|
585 | '(("M " . modified) | |
|
586 | ("A " . added) | |
|
587 | ("R " . removed) | |
|
588 | ("! " . deleted) | |
|
589 | ("? " . nil))))) | |
|
600 | (let ((state (and (>= (length output) 2) | |
|
601 | (= (aref output 1) ? ) | |
|
602 | (assq (aref output 0) hg-state-alist)))) | |
|
590 | 603 | (if state |
|
591 | 604 | (cdr state) |
|
592 | 605 | 'normal))))) |
@@ -598,17 +611,11 b' Each entry is a pair (FILE-NAME . STATUS' | |||
|
598 | 611 | result) |
|
599 | 612 | (dolist (entry (split-string (hg-chomp (cdr s)) "\n") (nreverse result)) |
|
600 | 613 | (let (state name) |
|
601 | (if (equal (substring entry 1 2) " ") | |
|
602 |
(setq state ( |
|
|
603 | '(("M " . modified) | |
|
604 | ("A " . added) | |
|
605 | ("R " . removed) | |
|
606 | ("! " . deleted) | |
|
607 | ("C " . normal) | |
|
608 | ("I " . ignored) | |
|
609 | ("? " . nil)))) | |
|
610 | name (substring entry 2)) | |
|
611 | (setq name (substring entry 0 (search ": " entry :from-end t)))) | |
|
614 | (cond ((= (aref entry 1) ? ) | |
|
615 | (setq state (assq (aref entry 0) hg-state-alist) | |
|
616 | name (substring entry 2))) | |
|
617 | ((string-match "\\(.*\\): " entry) | |
|
618 | (setq name (match-string 1 entry)))) | |
|
612 | 619 | (setq result (cons (cons name state) result)))))) |
|
613 | 620 | |
|
614 | 621 | (defmacro hg-view-output (args &rest body) |
@@ -618,7 +625,7 b' minibuffer. Otherwise, the buffer is di' | |||
|
618 | 625 | ARGS is of the form (BUFFER-NAME &optional FILE), where BUFFER-NAME is |
|
619 | 626 | the name of the buffer to create, and FILE is the name of the file |
|
620 | 627 | being viewed." |
|
621 |
(let ((prev-buf ( |
|
|
628 | (let ((prev-buf (make-symbol "prev-buf-")) | |
|
622 | 629 | (v-b-name (car args)) |
|
623 | 630 | (v-m-rest (cdr args))) |
|
624 | 631 | `(let ((view-buf-name ,v-b-name) |
General Comments 0
You need to be logged in to leave comments.
Login now