psvn.el

subversion-1.4.3-1.tar.gz 配置svn的源码

  :group 'psvn-faces)

(defface svn-status-update-available-face
  '((((type tty) (class color)) (:foreground "magenta" :weight light))
    (((class color) (background light)) (:foreground "magenta"))
    (((class color) (background dark)) (:foreground "yellow"))
    (t (:weight bold)))
  "Face used to highlight the 'out of date' mark.
\(i.e., the mark used when there is a newer version in the repository
than the working copy.\)

See also `svn-status-short-mod-flag-p'."
  :group 'psvn-faces)

;based on cvs-filename-face
(defface svn-status-directory-face
  '((((type tty) (class color)) (:foreground "lightblue" :weight light))
    (((class color) (background light)) (:foreground "blue4"))
    (((class color) (background dark)) (:foreground "lightskyblue1"))
    (t (:weight bold)))
  "Face for directories in *svn-status* buffers.
See `svn-status--line-info->directory-p' for what counts as a directory."
  :group 'psvn-faces)

;based on font-lock-comment-face
(defface svn-status-filename-face
  '((((class color) (background light)) (:foreground "chocolate"))
    (((class color) (background dark)) (:foreground "beige")))
  "Face for non-directories in *svn-status* buffers.
See `svn-status--line-info->directory-p' for what counts as a directory."
  :group 'psvn-faces)

;based on font-lock-warning-face
(defface svn-status-locked-face
  '((t
     (:weight bold :foreground "Red")))
  "Face for the phrase \"[ LOCKED ]\" `svn-status-buffer-name' buffers."
  :group 'psvn-faces)

;based on vhdl-font-lock-directive-face
(defface svn-status-switched-face
  '((((class color)
      (background light))
     (:foreground "CadetBlue"))
    (((class color)
      (background dark))
     (:foreground "Aquamarine"))
    (t
     (:bold t :italic t)))
  "Face for the phrase \"(switched)\" non-directories in svn status buffers."
  :group 'psvn-faces)

(defvar svn-highlight t)
;; stolen from PCL-CVS
(defun svn-add-face (str face &optional keymap)
  "Return string STR decorated with the specified FACE.
If `svn-highlight' is nil then just return STR."
  (when svn-highlight
    ;; Do not use `list*'; cl.el might not have been loaded.  We could
    ;; put (require 'cl) at the top but let's try to manage without.
    (add-text-properties 0 (length str)
                         `(face ,face
                                mouse-face highlight)
;; 18.10.2004: the keymap parameter is not used (yet) in psvn.el
;;                           ,@(when keymap
;;                               `(mouse-face highlight
;;                                 local-map ,keymap)))
                         str))
  str)

(defun svn-status-maybe-add-face (condition text face)
  "If CONDITION then add FACE to TEXT.
Else return TEXT unchanged."
  (if condition
      (svn-add-face text face)
    text))

(defun svn-status-choose-face-to-add (condition text face1 face2)
  "If CONDITION then add FACE1 to TEXT, else add FACE2 to TEXT."
  (if condition
      (svn-add-face text face1)
    (svn-add-face text face2)))

(defun svn-status-maybe-add-string (condition string face)
  "If CONDITION then return STRING decorated with FACE.
Otherwise, return \"\"."
  (if condition
      (svn-add-face string face)
    ""))

; compatibility
; emacs 20
(defalias 'svn-point-at-eol
  (if (fboundp 'point-at-eol) 'point-at-eol 'line-end-position))
(defalias 'svn-point-at-bol
  (if (fboundp 'point-at-bol) 'point-at-bol 'line-beginning-position))
(defalias 'svn-read-directory-name
  (if (fboundp 'read-directory-name) 'read-directory-name 'read-file-name))

(eval-when-compile
  (if (not (fboundp 'gethash))
      (require 'cl-macs)))
(defalias 'svn-puthash (if (fboundp 'puthash) 'puthash 'cl-puthash))

; xemacs
;; Evaluate the defsubst at compile time, so that the byte compiler
;; knows the definition and can inline calls.  It cannot detect the
;; defsubst automatically from within the if form.
(eval-and-compile
  (if (fboundp 'match-string-no-properties)
      (defalias 'svn-match-string-no-properties 'match-string-no-properties)
    (defsubst svn-match-string-no-properties (match)
      (buffer-substring-no-properties (match-beginning match) (match-end match)))))

;; XEmacs 21.4.17 does not have an `alist' widget.  Define a replacement.
;; To find out whether the `alist' widget exists, we cannot check just
;; (get 'alist 'widget-type), because GNU Emacs 21.4 defines it in
;; "wid-edit.el", which is not preloaded; it will be autoloaded when
;; `widget-create' is called.  Instead, we call `widgetp', which is
;; also autoloaded from "wid-edit.el".  XEmacs 21.4.17 does not have
;; `widgetp' either, so we check that first.
(if (and (fboundp 'widgetp) (widgetp 'alist))
    (define-widget 'svn-alist 'alist
      "An association list.
Use this instead of `alist', for XEmacs 21.4 compatibility.")
  (define-widget 'svn-alist 'list
    "An association list.
Use this instead of `alist', for XEmacs 21.4 compatibility."
    :convert-widget 'svn-alist-convert-widget
    :tag "Association List"
    :key-type 'sexp
    :value-type 'sexp)
  (defun svn-alist-convert-widget (widget)
    (let* ((value-type (widget-get widget :value-type))
           (option-widgets (loop for option in (widget-get widget :options)
                             collect `(cons :format "%v"
                                            (const :format "%t: %v\n"
                                                   :tag "Key"
                                                   ,option)
                                            ,value-type))))
      (widget-put widget :args
                  `(,@(when option-widgets
                        `((set :inline t :format "%v"
                               ,@option-widgets)))
                    (editable-list :inline t
                                   (cons :format "%v"
                                         ,(widget-get widget :key-type)
                                         ,value-type)))))
    widget))


;;; keymaps

(defvar svn-global-keymap nil "Global keymap for psvn.el.
To bind this to a different key, customize `svn-status-prefix-key'.")
(put 'svn-global-keymap 'risky-local-variable t)
(when (not svn-global-keymap)
  (setq svn-global-keymap (make-sparse-keymap))
  (define-key svn-global-keymap (kbd "s") 'svn-status-this-directory)
  (define-key svn-global-keymap (kbd "l") 'svn-status-show-svn-log)
  (define-key svn-global-keymap (kbd "u") 'svn-status-update-cmd)
  (define-key svn-global-keymap (kbd "=") 'svn-status-show-svn-diff)
  (define-key svn-global-keymap (kbd "c") 'svn-status-commit)
  (define-key svn-global-keymap (kbd "b") 'svn-status-switch-to-status-buffer)
  (define-key svn-global-keymap (kbd "o") 'svn-status-pop-to-status-buffer))

(defvar svn-status-diff-mode-map ()
  "Keymap used in `svn-status-diff-mode' for additional commands that are not defined in diff-mode.")
(put 'svn-status-diff-mode-map 'risky-local-variable t) ;for Emacs 20.7

(when (not svn-status-diff-mode-map)
  (setq svn-status-diff-mode-map (copy-keymap diff-mode-shared-map))
  (define-key svn-status-diff-mode-map [?w] 'svn-status-diff-save-current-defun-as-kill))


(defvar svn-global-trac-map ()
  "Subkeymap used in `svn-global-keymap' for trac issue tracker commands.")
(put 'svn-global-trac-map 'risky-local-variable t) ;for Emacs 20.7
(when (not svn-global-trac-map)
  (setq svn-global-trac-map (make-sparse-keymap))
  (define-key svn-global-trac-map (kbd "t") 'svn-trac-browse-timeline)
  (define-key svn-global-trac-map (kbd "i") 'svn-trac-browse-ticket)
  (define-key svn-global-trac-map (kbd "c") 'svn-trac-browse-changeset)
  (define-key svn-global-keymap (kbd "t") svn-global-trac-map))

;; The setter of `svn-status-prefix-key' makes a binding in the global
;; map refer to the `svn-global-keymap' symbol, rather than directly
;; to the keymap.  Emacs then implicitly uses the symbol-function.
;; This has the advantage that `describe-bindings' (C-h b) can show
;; the name of the keymap and link to its documentation.
(defalias 'svn-global-keymap svn-global-keymap)
;; `defalias' of GNU Emacs 21.4 doesn't allow a docstring argument.
(put 'svn-global-keymap 'function-documentation
     '(documentation-property 'svn-global-keymap 'variable-documentation t))


;; named after SVN_WC_ADM_DIR_NAME in svn_wc.h
(defun svn-wc-adm-dir-name ()
  "Return the name of the \".svn\" subdirectory or equivalent."
  (if (and (eq system-type 'windows-nt)
           (getenv "SVN_ASP_DOT_NET_HACK"))
      "_svn"
    ".svn"))

(defun svn-status-message (level &rest args)
  "If LEVEL is lower than `svn-status-debug-level' print ARGS using `message'.

Guideline for numbers:
1 - error messages, 3 - non-serious error messages, 5 - messages for things
that take a long time, 7 - not very important messages on stuff, 9 - messages
inside loops."
  (if (<= level svn-status-debug-level)
      (apply 'message args)))

(defun svn-status-flatten-list (list)
  "Flatten any lists within ARGS, so that there are no sublists."
  (loop for item in list
        if (listp item) nconc (svn-status-flatten-list item)
        else collect item))



;;;###autoload (defalias 'svn-examine 'svn-status)
(defalias 'svn-examine 'svn-status)

;;;###autoload
(defun svn-status (dir &optional arg)
  "Examine the status of Subversion working copy in directory DIR.
If ARG is -, allow editing of the parameters. One could add -N to
run svn status non recursively to make it faster.
For every other non nil ARG pass the -u argument to `svn status'.

If there is no .svn directory, examine if there is SVN and run
`cvs-examine'. Otherwise ask if to run `dired'."
  (interactive (list (svn-read-directory-name "SVN status directory: "
                                              nil default-directory nil)
                     current-prefix-arg))
  (let ((svn-dir (format "%s%s"
                         (file-name-as-directory dir)
                         (svn-wc-adm-dir-name)))
        (cvs-dir (format "%sCVS" (file-name-as-directory dir))))
    (cond
     ((file-directory-p svn-dir)
      (setq arg (svn-status-possibly-negate-meaning-of-arg arg 'svn-status))
      (svn-status-1 dir arg))
     ((and (file-directory-p cvs-dir)
           (fboundp 'cvs-examine))
      (cvs-examine dir nil))
     (t
      (when (y-or-n-p
             (format
              (concat
               "%s "
               "is not Subversion controlled (missing %s "
               "directory). "
               "Run dired instead? ")
              dir
              (svn-wc-adm-dir-name)))
        (dired dir))))))

(defvar svn-status-display-new-status-buffer nil)
(defun svn-status-1 (dir &optional arg)
  "Examine DIR. See `svn-status' for more information."
  (unless (file-directory-p dir)
    (error "%s is not a directory" dir))
  (setq dir (file-name-as-directory dir))
  (when svn-status-load-state-before-svn-status
    (unless (string= dir (car svn-status-directory-history))
      (svn-status-load-state t)))
  (setq svn-status-directory-history (delete dir svn-status-directory-history))
  (add-to-list 'svn-status-directory-history dir)
  (if (string= (buffer-name) svn-status-buffer-name)
      (setq svn-status-display-new-status-buffer nil)
    (setq svn-status-display-new-status-buffer t)
    ;;(message "psvn: Saving initial window configuration")
    (setq svn-status-initial-window-configuration
          (current-window-configuration)))
  (let* ((status-buf (get-buffer-create svn-status-buffer-name))
         (proc-buf (get-buffer-create "*svn-process*"))
         (want-edit (eq arg '-))
         (status-option (if want-edit
                            (if svn-status-verbose "-v" "")
                          (if svn-status-verbose
                              (if arg "-uv" "-v")
                            (if arg "-u" ""))))
         (svn-status-edit-svn-command