contrib/mercurial.el
changeset 1308 2073e5a71008
parent 1246 ae96c85fb0af
child 1371 68e84563c540
equal deleted inserted replaced
1285:1546c2aa6b30 1308:2073e5a71008
   260 (define-key hg-commit-mode-file-map
   260 (define-key hg-commit-mode-file-map
   261   (if hg-running-xemacs [button2] [mouse-2])
   261   (if hg-running-xemacs [button2] [mouse-2])
   262   'hg-commit-mouse-clicked)
   262   'hg-commit-mouse-clicked)
   263 (define-key hg-commit-mode-file-map " " 'hg-commit-toggle-file)
   263 (define-key hg-commit-mode-file-map " " 'hg-commit-toggle-file)
   264 (define-key hg-commit-mode-file-map "\r" 'hg-commit-toggle-file)
   264 (define-key hg-commit-mode-file-map "\r" 'hg-commit-toggle-file)
   265   
   265 
   266 
   266 
   267 ;;; Convenience functions.
   267 ;;; Convenience functions.
   268 
   268 
   269 (defsubst hg-binary ()
   269 (defsubst hg-binary ()
   270   (if hg-binary
   270   (if hg-binary
   325     (if buf
   325     (if buf
   326 	(with-current-buffer buf
   326 	(with-current-buffer buf
   327 	  (vc-buffer-sync))
   327 	  (vc-buffer-sync))
   328       (hg-do-across-repo path
   328       (hg-do-across-repo path
   329 	(vc-buffer-sync)))))
   329 	(vc-buffer-sync)))))
   330   
   330 
   331 (defun hg-buffer-commands (pnt)
   331 (defun hg-buffer-commands (pnt)
   332   "Use the properties of a character to do something sensible."
   332   "Use the properties of a character to do something sensible."
   333   (interactive "d")
   333   (interactive "d")
   334   (let ((rev (get-char-property pnt 'rev))
   334   (let ((rev (get-char-property pnt 'rev))
   335 	(file (get-char-property pnt 'file))
   335 	(file (get-char-property pnt 'file))
   400       (let* ((left (substring line (match-beginning 1) (match-end 1)))
   400       (let* ((left (substring line (match-beginning 1) (match-end 1)))
   401 	     (right (substring line (match-beginning 2) (match-end 2)))
   401 	     (right (substring line (match-beginning 2) (match-end 2)))
   402 	     (key (split-string left "\\."))
   402 	     (key (split-string left "\\."))
   403 	     (value (hg-replace-in-string right "\\\\n" "\n" t)))
   403 	     (value (hg-replace-in-string right "\\\\n" "\n" t)))
   404 	(setq items (cons (cons (cons (car key) (cadr key)) value) items))))))
   404 	(setq items (cons (cons (cons (car key) (cadr key)) value) items))))))
   405   
   405 
   406 (defun hg-config-section (section config)
   406 (defun hg-config-section (section config)
   407   "Return an alist of (name . value) pairs for SECTION of CONFIG."
   407   "Return an alist of (name . value) pairs for SECTION of CONFIG."
   408   (let (items)
   408   (let (items)
   409     (dolist (item config items)
   409     (dolist (item config items)
   410       (when (equal (caar item) section)
   410       (when (equal (caar item) section)
   520   (use-local-map hg-view-mode-map)
   520   (use-local-map hg-view-mode-map)
   521   (setq truncate-lines t)
   521   (setq truncate-lines t)
   522   (when file-name
   522   (when file-name
   523     (set (make-local-variable 'hg-view-file-name)
   523     (set (make-local-variable 'hg-view-file-name)
   524 	 (hg-abbrev-file-name file-name))))
   524 	 (hg-abbrev-file-name file-name))))
   525   
   525 
   526 (defun hg-file-status (file)
   526 (defun hg-file-status (file)
   527   "Return status of FILE, or nil if FILE does not exist or is unmanaged."
   527   "Return status of FILE, or nil if FILE does not exist or is unmanaged."
   528   (let* ((s (hg-run "status" file))
   528   (let* ((s (hg-run "status" file))
   529 	 (exit (car s))
   529 	 (exit (car s))
   530 	 (output (cdr s)))
   530 	 (output (cdr s)))
   589 to have moved a little, but not really changed."
   589 to have moved a little, but not really changed."
   590   (let ((point-context (hg-position-context (point)))
   590   (let ((point-context (hg-position-context (point)))
   591 	(mark-context (let ((mark (mark-marker)))
   591 	(mark-context (let ((mark (mark-marker)))
   592 			(and mark (hg-position-context mark)))))
   592 			(and mark (hg-position-context mark)))))
   593     (list point-context mark-context)))
   593     (list point-context mark-context)))
   594 	
   594 
   595 (defun hg-find-context (ctx)
   595 (defun hg-find-context (ctx)
   596   "Attempt to find a context in the given buffer.
   596   "Attempt to find a context in the given buffer.
   597 Always returns a valid, hopefully sane, position."
   597 Always returns a valid, hopefully sane, position."
   598   (let ((pos (nth 0 ctx))
   598   (let ((pos (nth 0 ctx))
   599 	(str (nth 1 ctx))
   599 	(str (nth 1 ctx))
   738 	    (message "%s will not be committed"
   738 	    (message "%s will not be committed"
   739 		     (buffer-substring bol (point))))
   739 		     (buffer-substring bol (point))))
   740 	(add-text-properties bol (point) '(face bold))
   740 	(add-text-properties bol (point) '(face bold))
   741 	(message "%s will be committed"
   741 	(message "%s will be committed"
   742 		 (buffer-substring bol (point)))))))
   742 		 (buffer-substring bol (point)))))))
   743 	
   743 
   744 (defun hg-commit-mouse-clicked (event)
   744 (defun hg-commit-mouse-clicked (event)
   745   "Toggle whether or not the file at POS will be committed."
   745   "Toggle whether or not the file at POS will be committed."
   746   (interactive "@e")
   746   (interactive "@e")
   747   (hg-commit-toggle-file (hg-event-point event)))
   747   (hg-commit-toggle-file (hg-event-point event)))
   748 
   748 
   925     (hg-view-output (hg-output-buffer-name)
   925     (hg-view-output (hg-output-buffer-name)
   926       (apply 'call-process (hg-binary) nil t nil (list "forget" path)))
   926       (apply 'call-process (hg-binary) nil t nil (list "forget" path)))
   927     (when update
   927     (when update
   928       (with-current-buffer buf
   928       (with-current-buffer buf
   929 	(hg-mode-line)))))
   929 	(hg-mode-line)))))
   930   
   930 
   931 (defun hg-incoming (&optional repo)
   931 (defun hg-incoming (&optional repo)
   932   "Display changesets present in REPO that are not present locally."
   932   "Display changesets present in REPO that are not present locally."
   933   (interactive (list (hg-read-repo-name " where changes would come from")))
   933   (interactive (list (hg-read-repo-name " where changes would come from")))
   934   (hg-view-output ((format "Mercurial: Incoming from %s to %s"
   934   (hg-view-output ((format "Mercurial: Incoming from %s to %s"
   935 			   (hg-abbrev-file-name (hg-root))
   935 			   (hg-abbrev-file-name (hg-root))