165 |
168 |
166 (defvar hg-root nil) |
169 (defvar hg-root nil) |
167 (make-variable-buffer-local 'hg-root) |
170 (make-variable-buffer-local 'hg-root) |
168 (put 'hg-root 'permanent-local t) |
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 (defvar hg-output-buffer-name "*Hg*" |
181 (defvar hg-output-buffer-name "*Hg*" |
171 "The name to use for Mercurial output buffers.") |
182 "The name to use for Mercurial output buffers.") |
172 |
183 |
173 (defvar hg-file-history nil) |
184 (defvar hg-file-history nil) |
174 (defvar hg-repo-history nil) |
185 (defvar hg-repo-history nil) |
175 (defvar hg-rev-history nil) |
186 (defvar hg-rev-history nil) |
|
187 (defvar hg-repo-completion-table nil) ; shut up warnings |
176 |
188 |
177 |
189 |
178 ;;; Random constants. |
190 ;;; Random constants. |
179 |
191 |
180 (defconst hg-commit-message-start |
192 (defconst hg-commit-message-start |
181 "--- Enter your commit message. Type `C-c C-c' to commit. ---\n") |
193 "--- Enter your commit message. Type `C-c C-c' to commit. ---\n") |
182 |
194 |
183 (defconst hg-commit-message-end |
195 (defconst hg-commit-message-end |
184 "--- Files in bold will be committed. Click to toggle selection. ---\n") |
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 ;;; hg-mode keymap. |
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 (defvar hg-prefix-map |
209 (defvar hg-prefix-map |
193 (let ((map (copy-keymap vc-prefix-map))) |
210 (let ((map (make-sparse-keymap))) |
194 (if (functionp 'set-keymap-name) |
211 (hg-feature-cond (xemacs (set-keymap-name map 'hg-prefix-map))) ; XEmacs |
195 (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 map) |
222 map) |
197 "This keymap overrides some default vc-mode bindings.") |
223 "This keymap overrides some default vc-mode bindings.") |
198 (fset 'hg-prefix-map hg-prefix-map) |
224 |
199 (define-key hg-prefix-map "=" 'hg-diff) |
225 (defvar hg-mode-map |
200 (define-key hg-prefix-map "c" 'hg-undo) |
226 (let ((map (make-sparse-keymap))) |
201 (define-key hg-prefix-map "g" 'hg-annotate) |
227 (define-key map "\C-xv" hg-prefix-map) |
202 (define-key hg-prefix-map "l" 'hg-log) |
228 map)) |
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) |
|
207 |
229 |
208 (add-minor-mode 'hg-mode 'hg-mode hg-mode-map) |
230 (add-minor-mode 'hg-mode 'hg-mode hg-mode-map) |
209 |
231 |
210 |
232 |
211 ;;; Global keymap. |
233 ;;; Global keymap. |
212 |
234 |
213 (global-set-key "\C-xvi" 'hg-add) |
235 (defvar hg-global-map |
214 |
236 (let ((map (make-sparse-keymap))) |
215 (defvar hg-global-map (make-sparse-keymap)) |
237 (define-key map "," 'hg-incoming) |
216 (fset 'hg-global-map hg-global-map) |
238 (define-key map "." 'hg-outgoing) |
217 (global-set-key hg-global-prefix 'hg-global-map) |
239 (define-key map "<" 'hg-pull) |
218 (define-key hg-global-map "," 'hg-incoming) |
240 (define-key map "=" 'hg-diff-repo) |
219 (define-key hg-global-map "." 'hg-outgoing) |
241 (define-key map ">" 'hg-push) |
220 (define-key hg-global-map "<" 'hg-pull) |
242 (define-key map "?" 'hg-help-overview) |
221 (define-key hg-global-map "=" 'hg-diff-repo) |
243 (define-key map "A" 'hg-addremove) |
222 (define-key hg-global-map ">" 'hg-push) |
244 (define-key map "U" 'hg-revert) |
223 (define-key hg-global-map "?" 'hg-help-overview) |
245 (define-key map "a" 'hg-add) |
224 (define-key hg-global-map "A" 'hg-addremove) |
246 (define-key map "c" 'hg-commit-start) |
225 (define-key hg-global-map "U" 'hg-revert) |
247 (define-key map "f" 'hg-forget) |
226 (define-key hg-global-map "a" 'hg-add) |
248 (define-key map "h" 'hg-help-overview) |
227 (define-key hg-global-map "c" 'hg-commit-start) |
249 (define-key map "i" 'hg-init) |
228 (define-key hg-global-map "f" 'hg-forget) |
250 (define-key map "l" 'hg-log-repo) |
229 (define-key hg-global-map "h" 'hg-help-overview) |
251 (define-key map "r" 'hg-root) |
230 (define-key hg-global-map "i" 'hg-init) |
252 (define-key map "s" 'hg-status) |
231 (define-key hg-global-map "l" 'hg-log-repo) |
253 (define-key map "u" 'hg-update) |
232 (define-key hg-global-map "r" 'hg-root) |
254 map)) |
233 (define-key hg-global-map "s" 'hg-status) |
255 |
234 (define-key hg-global-map "u" 'hg-update) |
256 (global-set-key hg-global-prefix hg-global-map) |
235 |
|
236 |
257 |
237 ;;; View mode keymap. |
258 ;;; View mode keymap. |
238 |
259 |
239 (defvar hg-view-mode-map |
260 (defvar hg-view-mode-map |
240 (let ((map (copy-keymap (if (boundp 'view-minor-mode-map) |
261 (let ((map (make-sparse-keymap))) |
241 view-minor-mode-map |
262 (hg-feature-cond (xemacs (set-keymap-name map 'hg-view-mode-map))) ; XEmacs |
242 view-mode-map)))) |
263 (define-key map (hg-feature-cond (xemacs [button2]) |
243 (if (functionp 'set-keymap-name) |
264 (t [mouse-2])) |
244 (set-keymap-name map 'hg-view-mode-map)); XEmacs |
265 'hg-buffer-mouse-clicked) |
245 map)) |
266 map)) |
246 (fset 'hg-view-mode-map hg-view-mode-map) |
267 |
247 (define-key hg-view-mode-map |
268 (add-minor-mode 'hg-view-mode "" hg-view-mode-map) |
248 (if hg-running-xemacs [button2] [mouse-2]) |
|
249 'hg-buffer-mouse-clicked) |
|
250 |
269 |
251 |
270 |
252 ;;; Commit mode keymaps. |
271 ;;; Commit mode keymaps. |
253 |
272 |
254 (defvar hg-commit-mode-map (make-sparse-keymap)) |
273 (defvar hg-commit-mode-map |
255 (define-key hg-commit-mode-map "\C-c\C-c" 'hg-commit-finish) |
274 (let ((map (make-sparse-keymap))) |
256 (define-key hg-commit-mode-map "\C-c\C-k" 'hg-commit-kill) |
275 (define-key map "\C-c\C-c" 'hg-commit-finish) |
257 (define-key hg-commit-mode-map "\C-xv=" 'hg-diff-repo) |
276 (define-key map "\C-c\C-k" 'hg-commit-kill) |
258 |
277 (define-key map "\C-xv=" 'hg-diff-repo) |
259 (defvar hg-commit-mode-file-map (make-sparse-keymap)) |
278 map)) |
260 (define-key hg-commit-mode-file-map |
279 |
261 (if hg-running-xemacs [button2] [mouse-2]) |
280 (defvar hg-commit-mode-file-map |
262 'hg-commit-mouse-clicked) |
281 (let ((map (make-sparse-keymap))) |
263 (define-key hg-commit-mode-file-map " " 'hg-commit-toggle-file) |
282 (define-key map (hg-feature-cond (xemacs [button2]) |
264 (define-key hg-commit-mode-file-map "\r" 'hg-commit-toggle-file) |
283 (t [mouse-2])) |
|
284 'hg-commit-mouse-clicked) |
|
285 (define-key map " " 'hg-commit-toggle-file) |
|
286 (define-key map "\r" 'hg-commit-toggle-file) |
|
287 map)) |
265 |
288 |
266 |
289 |
267 ;;; Convenience functions. |
290 ;;; Convenience functions. |
268 |
291 |
269 (defsubst hg-binary () |
292 (defsubst hg-binary () |
342 |
365 |
343 (defun hg-buffer-commands (pnt) |
366 (defun hg-buffer-commands (pnt) |
344 "Use the properties of a character to do something sensible." |
367 "Use the properties of a character to do something sensible." |
345 (interactive "d") |
368 (interactive "d") |
346 (let ((rev (get-char-property pnt 'rev)) |
369 (let ((rev (get-char-property pnt 'rev)) |
347 (file (get-char-property pnt 'file)) |
370 (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))) |
|
352 (cond |
371 (cond |
353 (file |
372 (file |
354 (find-file-other-window file)) |
373 (find-file-other-window file)) |
355 (rev |
374 (rev |
356 (hg-diff hg-view-file-name rev rev prev-buf)) |
375 (hg-diff hg-view-file-name rev rev)) |
357 ((message "I don't know how to do that yet"))))) |
376 ((message "I don't know how to do that yet"))))) |
358 |
377 |
359 (defsubst hg-event-point (event) |
378 (defsubst hg-event-point (event) |
360 "Return the character position of the mouse event EVENT." |
379 "Return the character position of the mouse event EVENT." |
361 (if hg-running-xemacs |
380 (hg-feature-cond (xemacs (event-point event)) |
362 (event-point event) |
381 (t (posn-point (event-start event))))) |
363 (posn-point (event-start event)))) |
|
364 |
382 |
365 (defsubst hg-event-window (event) |
383 (defsubst hg-event-window (event) |
366 "Return the window over which mouse event EVENT occurred." |
384 "Return the window over which mouse event EVENT occurred." |
367 (if hg-running-xemacs |
385 (hg-feature-cond (xemacs (event-window event)) |
368 (event-window event) |
386 (t (posn-window (event-start event))))) |
369 (posn-window (event-start event)))) |
|
370 |
387 |
371 (defun hg-buffer-mouse-clicked (event) |
388 (defun hg-buffer-mouse-clicked (event) |
372 "Translate the mouse clicks in a HG log buffer to character events. |
389 "Translate the mouse clicks in a HG log buffer to character events. |
373 These are then handed off to `hg-buffer-commands'. |
390 These are then handed off to `hg-buffer-commands'. |
374 |
391 |
375 Handle frickin' frackin' gratuitous event-related incompatibilities." |
392 Handle frickin' frackin' gratuitous event-related incompatibilities." |
376 (interactive "e") |
393 (interactive "e") |
377 (select-window (hg-event-window event)) |
394 (select-window (hg-event-window event)) |
378 (hg-buffer-commands (hg-event-point event))) |
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 (defsubst hg-abbrev-file-name (file) |
397 (defsubst hg-abbrev-file-name (file) |
385 "Portable wrapper around abbreviate-file-name." |
398 "Portable wrapper around abbreviate-file-name." |
386 (if hg-running-xemacs |
399 (hg-feature-cond (xemacs (abbreviate-file-name file t)) |
387 (abbreviate-file-name file t) |
400 (t (abbreviate-file-name file)))) |
388 (abbreviate-file-name file))) |
|
389 |
401 |
390 (defun hg-read-file-name (&optional prompt default) |
402 (defun hg-read-file-name (&optional prompt default) |
391 "Read a file or directory name, or a pattern, to use with a command." |
403 "Read a file or directory name, or a pattern, to use with a command." |
392 (save-excursion |
404 (save-excursion |
393 (while hg-prev-buffer |
405 (while hg-prev-buffer |
596 Each entry is a pair (FILE-NAME . STATUS)." |
609 Each entry is a pair (FILE-NAME . STATUS)." |
597 (let ((s (apply 'hg-run "--cwd" root "status" "-marduc" paths)) |
610 (let ((s (apply 'hg-run "--cwd" root "status" "-marduc" paths)) |
598 result) |
611 result) |
599 (dolist (entry (split-string (hg-chomp (cdr s)) "\n") (nreverse result)) |
612 (dolist (entry (split-string (hg-chomp (cdr s)) "\n") (nreverse result)) |
600 (let (state name) |
613 (let (state name) |
601 (if (equal (substring entry 1 2) " ") |
614 (cond ((= (aref entry 1) ? ) |
602 (setq state (cdr (assoc (substring entry 0 2) |
615 (setq state (assq (aref entry 0) hg-state-alist) |
603 '(("M " . modified) |
616 name (substring entry 2))) |
604 ("A " . added) |
617 ((string-match "\\(.*\\): " entry) |
605 ("R " . removed) |
618 (setq name (match-string 1 entry)))) |
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)))) |
|
612 (setq result (cons (cons name state) result)))))) |
619 (setq result (cons (cons name state) result)))))) |
613 |
620 |
614 (defmacro hg-view-output (args &rest body) |
621 (defmacro hg-view-output (args &rest body) |
615 "Execute BODY in a clean buffer, then quickly display that buffer. |
622 "Execute BODY in a clean buffer, then quickly display that buffer. |
616 If the buffer contains one line, its contents are displayed in the |
623 If the buffer contains one line, its contents are displayed in the |
617 minibuffer. Otherwise, the buffer is displayed in view-mode. |
624 minibuffer. Otherwise, the buffer is displayed in view-mode. |
618 ARGS is of the form (BUFFER-NAME &optional FILE), where BUFFER-NAME is |
625 ARGS is of the form (BUFFER-NAME &optional FILE), where BUFFER-NAME is |
619 the name of the buffer to create, and FILE is the name of the file |
626 the name of the buffer to create, and FILE is the name of the file |
620 being viewed." |
627 being viewed." |
621 (let ((prev-buf (gensym "prev-buf-")) |
628 (let ((prev-buf (make-symbol "prev-buf-")) |
622 (v-b-name (car args)) |
629 (v-b-name (car args)) |
623 (v-m-rest (cdr args))) |
630 (v-m-rest (cdr args))) |
624 `(let ((view-buf-name ,v-b-name) |
631 `(let ((view-buf-name ,v-b-name) |
625 (,prev-buf (current-buffer))) |
632 (,prev-buf (current-buffer))) |
626 (get-buffer-create view-buf-name) |
633 (get-buffer-create view-buf-name) |