507 lines
17 KiB
EmacsLisp
507 lines
17 KiB
EmacsLisp
;;; dvc-ui.el --- User interface (keybinding, menus) for DVC
|
|
|
|
;; Copyright (C) 2005-2009 by all contributors
|
|
|
|
;; Author: Matthieu Moy <Matthieu.Moy@imag.fr>
|
|
;; Contributions from:
|
|
;; Stefan Reichoer, <stefan@xsteve.at>
|
|
|
|
;; This file is free software; you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation; either version 3, or (at your option)
|
|
;; any later version.
|
|
|
|
;; This file is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with GNU Emacs; see the file COPYING. If not, write to
|
|
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
|
;; Boston, MA 02110-1301, USA.
|
|
|
|
;;; Commentary:
|
|
|
|
;;
|
|
|
|
;;; Code:
|
|
|
|
(eval-and-compile
|
|
(require 'dvc-utils))
|
|
|
|
(require 'dvc-register)
|
|
|
|
;;;###autoload
|
|
(eval-and-compile
|
|
(require 'easymenu))
|
|
|
|
(require 'dvc-register)
|
|
|
|
;; ----------------------------------------------------------------------------
|
|
;; Key bindings
|
|
;; ----------------------------------------------------------------------------
|
|
;;
|
|
;; Conventions
|
|
;;
|
|
;; - Meta Rules:
|
|
;; 0. If you feel a binding odd more than 3 times, report it to dvc dev mailing
|
|
;; list. Especially about some danger functions like undo, merge; and functions
|
|
;; taking longer time to be executed.
|
|
;;
|
|
;; 1. Our key binding should not surprise "general users" even if the
|
|
;; binding is convenience. Instead, provide hooks for customization.
|
|
;; We know it is difficult to define "general users".
|
|
;;
|
|
;; 2. Write the result of discussion here.
|
|
;;
|
|
;; 3. See http://mail.gnu.org/archive/html/emacs-devel/2004-03/msg00608.html
|
|
;;
|
|
;;
|
|
;; - Generic Rules:
|
|
;;
|
|
;; 1. dvc-status should have similar key bindings to pcl-cvs.
|
|
;; If a pcl-cvs's binding is too odd, talk it in dvc dev mailing list.
|
|
;;
|
|
;; 2. Define common prefix for command groups like '>'.
|
|
;; So a key binding for a grouped command has following structure:
|
|
;;
|
|
;; ?{prefix} ?{suffix}
|
|
;;
|
|
;; e.g. `get something commands' should have `>' as prefix.
|
|
;;
|
|
;; About suffix part, ? should show the help for the groups.
|
|
;;
|
|
;; e.g. `help for `get something commands'' is >?.
|
|
;;
|
|
;; BTW, The prefix ? is for help related command.
|
|
;; So `? >' can stand for "show the help for get-something related
|
|
;; command". In other word, prefix and suffix is swappable if
|
|
;; prefix or suffix is `?'.
|
|
;;
|
|
;; 3. Upper case for commands taking longer time to be executed.
|
|
;; 4. Lower case for commands taking shorter time to be executed.
|
|
;; 5. dired's binding is also helpful.
|
|
;;
|
|
;;
|
|
;; - Concrete Rules:
|
|
;;
|
|
|
|
;; t ? list all toggles
|
|
;; c dvc-edit-log
|
|
;; RET Open the thing at point
|
|
;;
|
|
|
|
;;
|
|
;; Definitions for key concrete rules
|
|
;;
|
|
|
|
;; common keys
|
|
;;;###autoload
|
|
(defvar dvc-key-help ??) ; help
|
|
(defvar dvc-key-mark-prefix ?*) ; other mark related command prefix
|
|
(defvar dvc-key-add-bookmark ?b) ; add this to bookmark
|
|
(defvar dvc-key-get ?>) ; prefix for getting something
|
|
(defvar dvc-key-reflect ?<) ; mirror, apply, install...
|
|
(defvar dvc-key-parent ?^) ; visit uppper XXX. e.g. directory
|
|
;;;###autoload
|
|
(defvar dvc-key-diff ?=) ; one shot
|
|
;;;###autoload
|
|
(defvar dvc-key-status ?s) ; one shot
|
|
|
|
(defvar dvc-key-add ?a) ; prefix for adding something
|
|
;;;###autoload
|
|
(defvar dvc-key-show-bookmark ?b) ; show bookmark
|
|
(defvar dvc-key-diff-prefix ?d)
|
|
;;;###autoload
|
|
(defvar dvc-key-file-diff ?d)
|
|
;;;###autoload
|
|
(defvar dvc-key-tree-lint ?l)
|
|
;;;###autoload
|
|
(defvar dvc-key-logs ?L)
|
|
;;;###autoload
|
|
(defvar dvc-key-ediff ?e)
|
|
;;;###autoload
|
|
(defvar dvc-key-log-entry ?a)
|
|
(defvar dvc-key-refresh ?g) ; refresh buffer
|
|
;;;###autoload
|
|
(defvar dvc-key-inventory ?i) ; inventory
|
|
(defvar dvc-key-mark ?m) ; mark
|
|
(defvar dvc-key-next ?n) ; next item
|
|
(defvar dvc-key-previous ?p) ; previous item
|
|
(defvar dvc-key-quit ?q) ; quit
|
|
(defvar dvc-key-remove ?r) ; prefix for remove something
|
|
(defvar dvc-key-move ?R) ; prefix for move/rename something
|
|
(defvar dvc-key-toggle ?t) ; prefix for toggle
|
|
(defvar dvc-key-unmark ?u) ; unmark
|
|
(defvar dvc-key-popup-menu ?\C-j)
|
|
;;;###autoload
|
|
(defvar dvc-key-kill-ring-prefix ?w)
|
|
;;;###autoload
|
|
(defvar dvc-key-commit ?c) ; actually edit-log, but
|
|
; that's what you do when you
|
|
; want to commit.
|
|
;;;###autoload
|
|
(defvar dvc-key-update ?u) ; to run dvc update
|
|
(defvar dvc-key-replay ?r) ; to run dvc replay
|
|
(defvar dvc-key-star-merge ?s) ; to run dvc star-merge
|
|
;;;###autoload
|
|
(defvar dvc-key-missing ?m) ; to run dvc missing
|
|
|
|
;;;###autoload
|
|
(defvar dvc-key-buffer-prefix ?B) ; prefix to switch to XXX buffer
|
|
(defvar dvc-key-view-buffer-prefix ?v) ; prefix to view XXX buffer
|
|
(defvar dvc-key-directory-prefix ?D)
|
|
|
|
;;;###autoload
|
|
(defvar dvc-key-file-prefix ?f) ; file specific functions
|
|
(defvar dvc-key-branch-prefix ?o) ; branch specific functions
|
|
(defvar dvc-key-merge-prefix ?M)
|
|
(defvar dvc-key-tag ?T)
|
|
(defvar dvc-key-revert ?U)
|
|
(defvar dvc-key-working-copy ?W) ; Affecting on working copy
|
|
(defvar dvc-key-partner-file-prefix ?f) ; Only used in the bookmarks buffer
|
|
(defvar dvc-key-tagging-method-prefix ?#)
|
|
(defvar dvc-key-id ?t) ; `t' for `t'ag.
|
|
|
|
;; functions for creating key groups
|
|
;;;###autoload
|
|
(progn
|
|
(defun dvc-key-group (prefix &rest keys)
|
|
(apply 'vector prefix keys)))
|
|
|
|
(defun dvc-prefix-toggle (&rest keys)
|
|
(dvc-key-group dvc-key-toggle keys))
|
|
|
|
(defun dvc-prefix-add (&rest keys)
|
|
(dvc-key-group dvc-key-add keys))
|
|
|
|
(defun dvc-prefix-remove (&rest keys)
|
|
(dvc-key-group dvc-key-remove keys))
|
|
|
|
(defun dvc-prefix-move (&rest keys)
|
|
(dvc-key-group dvc-key-move keys))
|
|
|
|
(defun dvc-prefix-mark (&rest keys)
|
|
(dvc-key-group dvc-key-mark-prefix keys))
|
|
|
|
(defun dvc-prefix-diff (&rest keys)
|
|
(dvc-key-group dvc-key-diff-prefix keys))
|
|
|
|
(defun dvc-prefix-merge (&rest keys)
|
|
(dvc-key-group dvc-key-merge-prefix keys))
|
|
|
|
(defun dvc-prefix-directory (&rest keys)
|
|
(dvc-key-group dvc-key-directory-prefix keys))
|
|
|
|
;;;###autoload
|
|
(progn
|
|
(defun dvc-prefix-file (&rest keys)
|
|
(dvc-key-group dvc-key-file-prefix keys)))
|
|
|
|
;;;###autoload
|
|
(progn
|
|
(defun dvc-prefix-branch (&rest keys)
|
|
(dvc-key-group dvc-key-branch-prefix keys)))
|
|
|
|
;;;###autoload
|
|
(progn
|
|
(defun dvc-prefix-kill-ring (&rest keys)
|
|
(dvc-key-group dvc-key-kill-ring-prefix keys)))
|
|
|
|
;;;###autoload
|
|
(progn
|
|
(defun dvc-prefix-view-buffer (&rest keys)
|
|
(dvc-key-group dvc-key-view-buffer-prefix keys)))
|
|
|
|
;;;###autoload
|
|
(progn
|
|
(defun dvc-prefix-buffer (&rest keys)
|
|
(dvc-key-group dvc-key-buffer-prefix keys)))
|
|
|
|
(defun dvc-prefix-working-copy (&rest keys)
|
|
(dvc-key-group dvc-key-working-copy keys))
|
|
|
|
(defun dvc-prefix-partner-file (&rest keys)
|
|
(dvc-key-group dvc-key-partner-file-prefix keys))
|
|
|
|
(defun dvc-prefix-tag (&rest keys)
|
|
(dvc-key-group dvc-key-tag keys))
|
|
|
|
(defun dvc-prefix-tagging-method (&rest keys)
|
|
(dvc-key-group dvc-key-tagging-method-prefix keys))
|
|
|
|
;; predefined key vectors
|
|
(defvar dvc-keyvec-toggle-set (dvc-prefix-toggle ?+))
|
|
(defvar dvc-keyvec-toggle-reset (dvc-prefix-toggle ?-))
|
|
(defvar dvc-keyvec-toggle-invert (dvc-prefix-toggle ?~))
|
|
|
|
;;;###autoload
|
|
(defvar dvc-keyvec-help (vector dvc-key-help))
|
|
(defvar dvc-keyvec-parent (vector dvc-key-parent))
|
|
(defvar dvc-keyvec-add (vector dvc-key-add))
|
|
(defvar dvc-keyvec-remove (vector dvc-key-remove))
|
|
(defvar dvc-keyvec-get (vector dvc-key-get))
|
|
(defvar dvc-keyvec-refresh (vector dvc-key-refresh))
|
|
|
|
(defvar dvc-keyvec-next (vector dvc-key-next))
|
|
(defvar dvc-keyvec-previous (vector dvc-key-previous))
|
|
|
|
(defvar dvc-keyvec-mark (vector dvc-key-mark))
|
|
(defvar dvc-keyvec-unmark (vector dvc-key-unmark))
|
|
(defvar dvc-keyvec-mark-all (dvc-prefix-mark ?*))
|
|
(defvar dvc-keyvec-unmark-all (dvc-prefix-mark ?!))
|
|
(defvar dvc-keyvec-quit (vector dvc-key-quit))
|
|
(defvar dvc-keyvec-popup-menu (vector dvc-key-popup-menu))
|
|
|
|
|
|
;;;###autoload
|
|
(defvar dvc-keyvec-ediff (vector dvc-key-ediff))
|
|
;;;###autoload
|
|
(defvar dvc-keyvec-tree-lint (vector dvc-key-tree-lint))
|
|
;;;###autoload
|
|
(defvar dvc-keyvec-logs (vector dvc-key-logs))
|
|
;;;###autoload
|
|
(defvar dvc-keyvec-log-entry (vector dvc-key-log-entry))
|
|
;;;###autoload
|
|
(defvar dvc-keyvec-diff (vector dvc-key-diff))
|
|
;;;###autoload
|
|
(defvar dvc-keyvec-status (vector dvc-key-status))
|
|
;;;###autoload
|
|
(defvar dvc-keyvec-file-diff (vector dvc-key-file-diff))
|
|
;;;###autoload
|
|
(defvar dvc-keyvec-file-diff (vector dvc-key-file-diff))
|
|
;;;###autoload
|
|
(defvar dvc-keyvec-commit (vector dvc-key-commit))
|
|
;;;###autoload
|
|
(defvar dvc-keyvec-update (vector dvc-key-update))
|
|
;;;###autoload
|
|
(defvar dvc-keyvec-missing (vector dvc-key-missing))
|
|
(defvar dvc-keyvec-replay (vector dvc-key-replay))
|
|
(defvar dvc-keyvec-star-merge (vector dvc-key-star-merge))
|
|
|
|
(defvar dvc-keyvec-reflect (vector dvc-key-reflect))
|
|
(defvar dvc-keyvec-revert (vector dvc-key-revert))
|
|
|
|
;;;###autoload
|
|
(defvar dvc-keyvec-inventory (vector dvc-key-inventory))
|
|
|
|
;;;###autoload
|
|
(defvar dvc-keyvec-show-bookmark (vector dvc-key-show-bookmark))
|
|
(defvar dvc-keyvec-add-bookmark (vector dvc-key-add-bookmark))
|
|
|
|
(defvar dvc-keyvec-tag (vector dvc-key-tag))
|
|
(defvar dvc-keyvec-kill-ring (vector dvc-key-kill-ring-prefix))
|
|
|
|
(defvar dvc-keyvec-id (vector dvc-key-id))
|
|
(defvar dvc-keyvec-toggle (vector dvc-key-toggle))
|
|
|
|
|
|
;;
|
|
;; Global
|
|
;;
|
|
;; FIXME: replace all those tla-... by dvc-... !!!
|
|
;;;###autoload
|
|
(defvar dvc-global-keymap
|
|
(let ((map (make-sparse-keymap)))
|
|
(define-key map [?U] 'tla-undo)
|
|
(define-key map [?R] 'tla-redo)
|
|
(define-key map [?t] 'tla-tag-insert)
|
|
(define-key map [?r] 'tla-tree-revisions)
|
|
(define-key map [(meta ?l)] 'tla-tree-lint)
|
|
;;(define-key map [(meta ?o)] 'tla-file-view-original)
|
|
(define-key map [?p] 'dvc-submit-patch)
|
|
(define-key map dvc-keyvec-log-entry 'dvc-add-log-entry)
|
|
(define-key map [?A] 'tla-archives)
|
|
(define-key map dvc-keyvec-file-diff 'dvc-file-diff)
|
|
(define-key map dvc-keyvec-ediff 'dvc-file-ediff)
|
|
(define-key map dvc-keyvec-diff 'dvc-diff)
|
|
(define-key map dvc-keyvec-status 'dvc-status)
|
|
(define-key map dvc-keyvec-commit 'dvc-log-edit)
|
|
(define-key map dvc-keyvec-inventory 'dvc-inventory)
|
|
(define-key map dvc-keyvec-logs 'dvc-log)
|
|
;; dvc: l runs changelog, M-l runs tree-lint for Arch
|
|
(define-key map [?l] 'dvc-changelog)
|
|
(define-key map [?I] 'dvc-init)
|
|
(define-key map [?C] 'dvc-clone)
|
|
(define-key map [?F] 'dvc-pull)
|
|
(define-key map [?P] 'dvc-push)
|
|
(define-key map dvc-keyvec-update 'dvc-update)
|
|
(define-key map [?m] 'dvc-missing)
|
|
(define-key map [?M] 'dvc-merge)
|
|
(define-key map dvc-keyvec-show-bookmark 'dvc-bookmarks)
|
|
(define-key map dvc-keyvec-help 'tla-help)
|
|
|
|
;; branch handling
|
|
(define-key map (dvc-prefix-branch ?c) 'dvc-create-branch)
|
|
(define-key map (dvc-prefix-branch ?s) 'dvc-select-branch)
|
|
(define-key map (dvc-prefix-branch ?l) 'dvc-list-branches)
|
|
|
|
;; file specific functionality
|
|
(define-key map (dvc-prefix-file ?a) 'dvc-add-files)
|
|
(define-key map (dvc-prefix-file ?D) 'dvc-remove-files)
|
|
(define-key map (dvc-prefix-file ?R) 'dvc-revert-files)
|
|
(define-key map (dvc-prefix-file ?M) 'dvc-rename)
|
|
(define-key map (dvc-prefix-file ?X) 'dvc-purge-files)
|
|
(define-key map (dvc-prefix-file ?=) 'dvc-file-diff)
|
|
|
|
(define-key map (dvc-prefix-view-buffer
|
|
?p) 'dvc-show-process-buffer)
|
|
(define-key map (dvc-prefix-view-buffer
|
|
?e) 'dvc-show-last-error-buffer)
|
|
(define-key map (dvc-prefix-view-buffer
|
|
?l) 'dvc-open-internal-log-buffer)
|
|
(define-key map (dvc-prefix-view-buffer
|
|
dvc-key-diff) 'tla-changes-goto)
|
|
(define-key map (dvc-prefix-view-buffer
|
|
dvc-key-status) 'baz-status-goto)
|
|
(define-key map (dvc-prefix-view-buffer
|
|
dvc-key-inventory) 'tla-inventory-goto)
|
|
(define-key map (dvc-prefix-view-buffer
|
|
?L) 'tla-tree-lint-goto)
|
|
(define-key map (dvc-prefix-view-buffer ?r) 'tla-tree-revisions-goto)
|
|
|
|
(define-key map (dvc-prefix-kill-ring ?a) 'tla-save-archive-to-kill-ring)
|
|
(define-key map (dvc-prefix-kill-ring ?v) 'tla-save-version-to-kill-ring)
|
|
(define-key map (dvc-prefix-kill-ring ?r) 'tla-save-revision-to-kill-ring)
|
|
|
|
map)
|
|
"Global keymap used by DVC.")
|
|
|
|
|
|
;;;###autoload
|
|
(defcustom dvc-prefix-key [(control x) ?V]
|
|
"Prefix key for the DVC commands in the global keymap.
|
|
|
|
If you wish to disable the prefix key, set this variable to nil."
|
|
:type '(choice (const [(control x) ?V])
|
|
(const [(control x) ?T])
|
|
(const [(control x) ?t])
|
|
(const [(control x) ?v ?t])
|
|
(const [(super v)])
|
|
(const [(hyper v)])
|
|
(const [(super t)])
|
|
(const [(hyper t)])
|
|
(const :tag "None" nil)
|
|
(sexp))
|
|
:group 'tla-bindings
|
|
:set (lambda (var value)
|
|
(if (boundp var)
|
|
(global-unset-key (symbol-value var)))
|
|
(set var value)
|
|
(global-set-key (symbol-value var) dvc-global-keymap)))
|
|
|
|
;;;###autoload
|
|
(defun dvc-enable-prefix-key ()
|
|
"Install the DVC prefix key globally."
|
|
(interactive)
|
|
(when dvc-prefix-key
|
|
(global-set-key dvc-prefix-key dvc-global-keymap)))
|
|
|
|
;;;###autoload
|
|
(dvc-enable-prefix-key)
|
|
|
|
;; It is important that DVC has this key, so steal it from other
|
|
;; programs, but give the user a chance to override this.
|
|
;;;###autoload
|
|
(add-hook 'after-init-hook 'dvc-enable-prefix-key t)
|
|
|
|
;;;###autoload
|
|
(define-key ctl-x-4-map [?T] 'dvc-add-log-entry)
|
|
|
|
(defvar dvc-cmenu-map-template
|
|
(let ((map (make-sparse-keymap)))
|
|
;; TODO: [return], "\C-m" => tla--generic-context-action
|
|
(define-key map dvc-keyvec-help 'describe-mode)
|
|
(define-key map [down-mouse-3] 'dvc-cmenu-popup-by-mouse)
|
|
(define-key map dvc-keyvec-popup-menu 'dvc-cmenu-popup)
|
|
map)
|
|
"Template for keymaps used in items, files, changes, etc.")
|
|
|
|
;;
|
|
;; Global
|
|
;;
|
|
;;;###autoload
|
|
(easy-menu-add-item
|
|
(and (boundp 'menu-bar-tools-menu) (dvc-do-in-gnu-emacs menu-bar-tools-menu))
|
|
(dvc-do-in-xemacs '("Tools"))
|
|
'("DVC"
|
|
["Show Bookmarks" dvc-bookmarks t]
|
|
"---"
|
|
"Tree Commands:"
|
|
["View Diff" dvc-diff t]
|
|
["View Status" dvc-status t]
|
|
["View Missing" dvc-missing t]
|
|
["View Log" dvc-log t]
|
|
["View ChangeLog" dvc-changelog t]
|
|
["Edit Commit Log" dvc-log-edit t]
|
|
"---"
|
|
"File Commands:"
|
|
["Add Files" dvc-add-files t]
|
|
["Revert Files" dvc-revert-files t]
|
|
["Remove Files" dvc-remove-files t]
|
|
["Add Log Entry" dvc-add-log-entry t]
|
|
;; ["Insert Arch Tag" tla-tag-insert t]
|
|
;; ["View File Diff" tla-file-diff t]
|
|
;; ["View File Ediff" tla-file-ediff t]
|
|
;; ["View Original" tla-file-view-original t]
|
|
;; ["View Conflicts" tla-view-conflicts t]
|
|
"---"
|
|
["Initialize repository" dvc-init t]
|
|
)
|
|
"PCL-CVS")
|
|
|
|
|
|
;; Show the selected DVC in the modeline: M-x dvc-show-active-dvc
|
|
(defvar dvc-show-active-dvc nil)
|
|
(defvar dvc-show-active-dvc-string "")
|
|
(make-variable-buffer-local 'dvc-show-active-dvc-string)
|
|
|
|
(add-to-list 'minor-mode-alist '(dvc-show-active-dvc dvc-show-active-dvc-string))
|
|
|
|
(add-hook 'find-file-hooks 'dvc-find-file-hook)
|
|
(add-hook 'dired-mode-hook 'dvc-dired-hook)
|
|
|
|
|
|
(defun dvc-show-active-dvc (arg)
|
|
"Toggle displaying a DVC string in the modeline.
|
|
|
|
If ARG is null, toggle displaying
|
|
If ARG is a number and is greater than zero, turn on visualization; otherwise,
|
|
turn off visualization."
|
|
(interactive "P")
|
|
(setq dvc-show-active-dvc (if arg
|
|
(> (prefix-numeric-value arg) 0)
|
|
(not dvc-show-active-dvc)))
|
|
(when dvc-show-active-dvc
|
|
(dvc-actualize-modeline)))
|
|
|
|
(defun dvc-dvc-file-has-conflict-p (filename)
|
|
nil)
|
|
|
|
(defun dvc-find-file-hook ()
|
|
"Set dvc-show-active-dvc-string, after loading a file. Enter
|
|
smerge mode if the file has conflicts (detected by
|
|
<dvc>-dvc-file-has-conflict-p)."
|
|
(when (dvc-current-active-dvc)
|
|
(dvc-actualize-modeline)
|
|
(when (dvc-call "dvc-file-has-conflict-p" (buffer-file-name))
|
|
(dvc-funcall-if-exists smerge-mode 1)
|
|
(message
|
|
"Conflicts in file%s. Use M-x dvc-resolved RET when done."
|
|
(if (boundp 'smerge-mode) ", entering SMerge mode" "")))))
|
|
|
|
(defun dvc-dired-hook ()
|
|
"Set dvc-show-active-dvc-string for dired buffers."
|
|
(dvc-actualize-modeline))
|
|
|
|
(defun dvc-actualize-modeline ()
|
|
(let ((dvc (dvc-current-active-dvc)))
|
|
;;(when dvc-show-active-dvc (dvc-trace "dvc-actualize-modeline: %S %S" default-directory dvc))
|
|
(setq dvc-show-active-dvc-string (if dvc (concat " DVC:" (symbol-name dvc))
|
|
""))))
|
|
|
|
|
|
(provide 'dvc-ui)
|
|
;;; dvc-ui.el ends here
|