psvn.el

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

          (or want-edit svn-status-edit-svn-command)))
    (save-excursion
      (set-buffer status-buf)
      (setq default-directory dir)
      (set-buffer proc-buf)
      (setq default-directory dir
            svn-status-remote (when arg t))
      (svn-run t t 'status "status" status-option))))

(defun svn-status-this-directory (arg)
  "Run `svn-status' for the `default-directory'"
  (interactive "P")
  (svn-status default-directory arg))

(defun svn-status-use-history ()
  (interactive)
  (let* ((hist svn-status-directory-history)
         (dir (read-from-minibuffer "svn-status on directory: "
                              (cadr svn-status-directory-history)
                              nil nil 'hist)))
    (if (file-directory-p dir)
        (svn-status dir)
      (error "%s is not a directory" dir))))

(defun svn-had-user-input-since-asynch-run ()
  (not (equal (recent-keys) svn-pre-run-asynch-recent-keys)))

(defun svn-process-environment ()
  "Construct the environment for the svn process.
It is a combination of `svn-status-svn-environment-var-list' and
the usual `process-environment'."
  ;; If there are duplicate elements in `process-environment', then GNU
  ;; Emacs 21.4 guarantees that the first one wins; but GNU Emacs 20.7
  ;; and XEmacs 21.4.17 don't document what happens.  We'll just remove
  ;; any duplicates ourselves, then.  This also gives us an opportunity
  ;; to handle the "VARIABLE" syntax that none of them supports.
  (loop with found = '()
        for elt in (append svn-status-svn-environment-var-list
                           process-environment)
        for has-value = (string-match "=" elt)
        for name = (substring elt 0 has-value)
        unless (member name found)
          do (push name found)
          and when has-value
            collect elt))

(defun svn-run (run-asynchron clear-process-buffer cmdtype &rest arglist)
  "Run svn with arguments ARGLIST.

If RUN-ASYNCHRON is t then run svn asynchronously.

If CLEAR-PROCESS-BUFFER is t then erase the contents of the
*svn-process* buffer before commencing.

CMDTYPE is a symbol such as 'mv, 'revert, or 'add, representing the
command to run.

ARGLIST is a list of arguments \(which must include the command name,
for example: '(\"revert\" \"file1\"\)
ARGLIST is flattened and any every nil value is discarded.

If the variable `svn-status-edit-svn-command' is non-nil then the user
can edit ARGLIST before running svn."
  (setq arglist (svn-status-flatten-list arglist))
  (if (eq (process-status "svn") nil)
      (progn
        (when svn-status-edit-svn-command
          (setq arglist (append
                         (list (car arglist))
                         (split-string
                          (read-from-minibuffer
                           (format "svn %s flags: " (car arglist))
                           (mapconcat 'identity (cdr arglist) " ")))))
          (when (eq svn-status-edit-svn-command t)
            (svn-status-toggle-edit-cmd-flag t))
          (message "svn-run %s: %S" cmdtype arglist))
        (let* ((proc-buf (get-buffer-create "*svn-process*"))
               (svn-exe svn-status-svn-executable)
               (svn-proc))
          (when (listp (car arglist))
            (setq arglist (car arglist)))
          (save-excursion
            (set-buffer proc-buf)
            (when svn-status-coding-system
              (setq buffer-file-coding-system svn-status-coding-system))
            (setq buffer-read-only nil)
            (fundamental-mode)
            (if clear-process-buffer
                (delete-region (point-min) (point-max))
              (goto-char (point-max)))
            (setq svn-process-cmd cmdtype)
            (setq svn-status-mode-line-process-status (format " running %s" cmdtype))
            (svn-status-update-mode-line)
            (sit-for 0.1)
            (if run-asynchron
                (progn
                  ;;(message "running asynchron: %s %S" svn-exe arglist)
                  (setq svn-pre-run-asynch-recent-keys (recent-keys))
                  (let ((process-environment (svn-process-environment))
                        (process-connection-type nil))
                    ;; Communicate with the subprocess via pipes rather
                    ;; than via a pseudoterminal, so that if the svn+ssh
                    ;; scheme is being used, SSH will not ask for a
                    ;; passphrase via stdio; psvn.el is currently unable
                    ;; to answer such prompts.  Instead, SSH will run
                    ;; x11-ssh-askpass if possible.  If Emacs is being
                    ;; run on a TTY without $DISPLAY, this will fail; in
                    ;; such cases, the user should start ssh-agent and
                    ;; then run ssh-add explicitly.
                    (setq svn-proc (apply 'start-process "svn" proc-buf svn-exe arglist)))
                  (set-process-sentinel svn-proc 'svn-process-sentinel)
                  (when svn-status-track-user-input
                    (set-process-filter svn-proc 'svn-process-filter)))
              ;;(message "running synchron: %s %S" svn-exe arglist)
              (let ((process-environment (svn-process-environment)))
                ;; `call-process' ignores `process-connection-type' and
                ;; never opens a pseudoterminal.
                (apply 'call-process svn-exe nil proc-buf nil arglist))
              (setq svn-status-mode-line-process-status "")
              (svn-status-update-mode-line)))))
    (error "You can only run one svn process at once!")))

(defun svn-process-sentinel-fixup-path-seperators ()
    "Convert all path separators to UNIX style.
\(This is a no-op unless `system-type' is windows-nt\)"
  (when (eq system-type 'windows-nt)
      (save-excursion
        (goto-char (point-min))
        (while (search-forward "\\" nil t)
          (replace-match "/")))))

(defun svn-process-sentinel (process event)
  ;;(princ (format "Process: %s had the event `%s'" process event)))
  ;;(save-excursion
  (let ((act-buf (current-buffer)))
    (set-buffer (process-buffer process))
    (setq svn-status-mode-line-process-status "")
    (svn-status-update-mode-line)
    (cond ((string= event "finished\n")
           (cond ((eq svn-process-cmd 'status)
                  ;;(message "svn status finished")
                  (svn-process-sentinel-fixup-path-seperators)
                  (svn-parse-status-result)
                  (set-buffer act-buf)
                  (svn-status-update-buffer)
                  (when svn-status-update-previous-process-output
                    (set-buffer (process-buffer process))
                    (delete-region (point-min) (point-max))
                    (insert "Output from svn command:\n")
                    (insert svn-status-update-previous-process-output)
                    (goto-char (point-min))
                    (setq svn-status-update-previous-process-output nil))
                  (when svn-status-display-new-status-buffer
                    (set-window-configuration svn-status-initial-window-configuration)
                    (if (svn-had-user-input-since-asynch-run)
                        (message "svn status finished")
                      (switch-to-buffer svn-status-buffer-name))))
                 ((eq svn-process-cmd 'log)
                  (svn-status-show-process-output 'log t)
                  (pop-to-buffer svn-status-last-output-buffer-name)
                  (svn-log-view-mode)
                  (forward-line 3)
                  (font-lock-fontify-buffer)
                  (message "svn log finished"))
                 ((eq svn-process-cmd 'info)
                  (svn-status-show-process-output 'info t)
                  (message "svn info finished"))
                 ((eq svn-process-cmd 'parse-info)
                  (svn-status-parse-info-result))
                 ((eq svn-process-cmd 'blame)
                  (svn-status-show-process-output 'blame t)
                  (message "svn blame finished"))
                 ((eq svn-process-cmd 'commit)
                  (svn-process-sentinel-fixup-path-seperators)
                  (svn-status-remove-temp-file-maybe)
                  (when (member 'commit svn-status-unmark-files-after-list)
                    (svn-status-unset-all-usermarks))
                  (svn-status-update-with-command-list (svn-status-parse-commit-output))
                  (run-hooks 'svn-log-edit-done-hook)
                  (setq svn-status-files-to-commit nil
                        svn-status-recursive-commit nil)
                  (message "svn commit finished"))
                 ((eq svn-process-cmd 'update)
                  (svn-status-show-process-output 'update t)
                  (svn-status-update)
                  (message "svn update finished"))
                 ((eq svn-process-cmd 'add)
                  (svn-status-update-with-command-list (svn-status-parse-ar-output))
                  (message "svn add finished"))
                 ((eq svn-process-cmd 'mkdir)
                  (svn-status-update)
                  (message "svn mkdir finished"))
                 ((eq svn-process-cmd 'revert)
                  (when (member 'revert svn-status-unmark-files-after-list)
                    (svn-status-unset-all-usermarks))
                  (svn-status-update)
                  (message "svn revert finished"))
                 ((eq svn-process-cmd 'resolved)
                  (svn-status-update)
                  (message "svn resolved finished"))
                 ((eq svn-process-cmd 'mv)
                  (svn-status-update)
                  (message "svn mv finished"))
                 ((eq svn-process-cmd 'rm)
                  (svn-status-update-with-command-list (svn-status-parse-ar-output))
                  (message "svn rm finished"))
                 ((eq svn-process-cmd 'cleanup)
                  (message "svn cleanup finished"))
                 ((eq svn-process-cmd 'proplist)
                  (svn-status-show-process-output 'proplist t)
                  (message "svn proplist finished"))
                 ((eq svn-process-cmd 'proplist-parse)
                  (svn-status-property-parse-property-names))
                 ((eq svn-process-cmd 'propset)
                  (svn-status-remove-temp-file-maybe)
                  (if (member svn-status-propedit-property-name '("svn:keywords"))
                      (svn-status-update-with-command-list (svn-status-parse-property-output))
                    (svn-status-update)))
                 ((eq svn-process-cmd 'propdel)
                  (svn-status-update))))
          ((string= event "killed\n")
           (message "svn process killed"))
          ((string-match "exited abnormally" event)
           (while (accept-process-output process 0 100))
           ;; find last error message and show it.
           (goto-char (point-max))
           (message "svn failed: %s"
                    (if (re-search-backward "^svn: \\(.*\\)" nil t)
                        (match-string 1)
                      event)))
          (t
           (message "svn process had unknown event: %s" event))
          (svn-status-show-process-output nil t))))

(defun svn-process-filter (process str)
  (save-window-excursion
    (set-buffer "*svn-process*")
    ;;(message "svn-process-filter: %s" str)
    (goto-char (point-max))
    (insert str)
    (save-excursion
      (goto-char (svn-point-at-bol))
      (when (looking-at "Password for '\\(.+\\)': ")
        ;(svn-status-show-process-buffer)
        (let ((passwd (read-passwd
                       (format "Enter svn password for %s: " (match-string 1)))))
          (svn-process-send-string (concat passwd "\n") t)))
      (when (looking-at "Username: ")
        (let ((user-name (read-string "Username for svn operation: ")))
          (svn-process-send-string (concat user-name "\n")))))))

(defun svn-parse-rev-num (str)
  (if (and str (stringp str)
           (save-match-data (string-match "^[0-9]+" str)))
      (string-to-number str)
    -1))

(defsubst svn-status-make-ui-status ()
  "Make a ui-status structure for a file in a svn working copy.
The initial values in the structure returned by this function
are good for a file or directory that the user hasn't seen before.

The ui-status structure keeps track of how the file or directory
should be displayed in svn-status mode.  Updating the svn-status
buffer from the working copy preserves the ui-status if possible.
User commands modify this structure; each file or directory must
thus have its own copy.

Currently, the ui-status is a list (USER-MARK USER-ELIDE).
USER-MARK is non-nil iff the user has marked the file or directory,
  typically with `svn-status-set-user-mark'.  To read USER-MARK,
  call `svn-status-line-info->has-usermark'.
USER-ELIDE is non-nil iff the user has elided the file or directory
  from the svn-status buffer, typically with `svn-status-toggle-elide'.
  To read USER-ELIDE, call `svn-status-line-info->user-elide'.

Call `svn-status-line-info->ui-status' to access the whole ui-status
structure."
  (list nil nil))

(defun svn-status-make-dummy-dirs (dir-list old-ui-information)
  (append (mapcar (lambda (dir)
                    (list (or (gethash dir old-ui-information)
                              (svn-status-make-ui-status))
                          32 nil dir -1 -1 "?" nil nil nil nil))
                  dir-list)