forked from sbenthall/emacs.d
-
Notifications
You must be signed in to change notification settings - Fork 0
/
psvn.el
2515 lines (2281 loc) · 107 KB
/
psvn.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
;;; psvn.el --- Subversion interface for emacs
;; Copyright (C) 2002-2004 by Stefan Reichoer
;; Author: Stefan Reichoer, <stefan@xsteve.at>
;; $Id: psvn.el 11245 2004-10-05 19:05:05Z xsteve $
;; psvn.el 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 2, or (at your option)
;; any later version.
;; psvn.el 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., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary
;; psvn.el is tested with GNU Emacs 21.3 on windows, debian linux,
;; freebsd5 with svn 1.05
;; psvn.el is an interface for the revision control tool subversion
;; (see http://subversion.tigris.org)
;; psvn.el provides a similar interface for subversion as pcl-cvs for cvs.
;; At the moment the following commands are implemented:
;; M-x svn-status: run 'svn -status -v'
;; and show the result in the *svn-status* buffer. This buffer uses
;; svn-status mode in which the following keys are defined:
;; g - svn-status-update: run 'svn status -v'
;; C-u g - svn-status-update: run 'svn status -vu'
;; = - svn-status-show-svn-diff run 'svn diff'
;; l - svn-status-show-svn-log run 'svn log'
;; i - svn-status-info run 'svn info'
;; r - svn-status-revert run 'svn revert'
;; V - svn-status-resolved run 'svn resolved'
;; U - svn-status-update-cmd run 'svn update'
;; c - svn-status-commit-file run 'svn commit'
;; a - svn-status-add-file run 'svn add --non-recursive'
;; A - svn-status-add-file-recursively run 'svn add'
;; + - svn-status-make-directory run 'svn mkdir'
;; R - svn-status-mv run 'svn mv'
;; C-d - svn-status-rm run 'svn rm'
;; M-c - svn-status-cleanup run 'svn cleanup'
;; b - svn-status-blame run 'svn blame'
;; RET - svn-status-find-file-or-examine-directory
;; ^ - svn-status-examine-parent
;; ~ - svn-status-get-specific-revision
;; E - svn-status-ediff-with-revision
;; s - svn-status-show-process-buffer
;; e - svn-status-toggle-edit-cmd-flag
;; ? - svn-status-toggle-hide-unknown
;; _ - svn-status-toggle-hide-unmodified
;; m - svn-status-set-user-mark
;; u - svn-status-unset-user-mark
;; $ - svn-status-toggle-elide
;; DEL - svn-status-unset-user-mark-backwards
;; * ! - svn-status-unset-all-usermarks
;; * ? - svn-status-mark-unknown
;; * A - svn-status-mark-added
;; * M - svn-status-mark-modified
;; . - svn-status-goto-root-or-return
;; f - svn-status-find-file
;; o - svn-status-find-file-other-window
;; v - svn-status-view-file-other-window
;; I - svn-status-parse-info
;; P l - svn-status-property-list
;; P s - svn-status-property-set
;; P d - svn-status-property-delete
;; P e - svn-status-property-edit-one-entry
;; P i - svn-status-property-ignore-file
;; P I - svn-status-property-ignore-file-extension
;; P C-i - svn-status-property-edit-svn-ignore
;; P k - svn-status-property-set-keyword-list
;; P y - svn-status-property-set-eol-style
;; h - svn-status-use-history
;; q - svn-status-bury-buffer
;; To use psvn.el put the following line in your .emacs:
;; (require 'psvn)
;; Start the svn interface with M-x svn-status
;; The latest version of psvn.el can be found at:
;; http://www.xsteve.at/prg/emacs/psvn.el
;; Or you can check it out from the subversion repository:
;; svn co http://svn.collab.net/repos/svn/trunk/contrib/client-side/psvn psvn
;; TODO:
;; * shortcut for svn propset svn:keywords "Date" psvn.el
;; * docstrings for the functions
;; * perhaps shortcuts for ranges, dates
;; * when editing the command line - offer help from the svn client
;; * finish svn-status-property-set
;; * eventually use the customize interface
;; * interactive svn-status should complete existing directories only;
;; unfortunately `read-directory-name' doesn't exist in Emacs 21.3
;; * Add repository browser
;; * Improve support for svn blame
;; * Support for editing the log file entries, e.g.:
;; svn propedit --revprop -r9821 svn:log
;; * Better logview mode (allow to show the changeset for a given entry)
;; Overview over the implemented/not (yet) implemented svn sub-commands:
;; * add implemented
;; * blame implemented
;; * cat implemented
;; * checkout (co)
;; * cleanup implemented
;; * commit (ci) implemented
;; * copy (cp)
;; * delete (del, remove, rm) implemented
;; * diff (di) implemented
;; * export
;; * help (?, h)
;; * import
;; * info implemented
;; * list (ls)
;; * log implemented
;; * merge
;; * mkdir implemented
;; * move (mv, rename, ren) implemented
;; * propdel (pdel) implemented
;; * propedit (pedit, pe) not needed
;; * propget (pget, pg) used
;; * proplist (plist, pl) implemented
;; * propset (pset, ps) used
;; * resolved implemented
;; * revert implemented
;; * status (stat, st) implemented
;; * switch (sw)
;; * update (up) implemented
;; For the not yet implemented commands you should use the command line
;; svn client. If there are user requests for any missing commands I will
;; probably implement them.
;; Comments / suggestions and bug reports are welcome!
;;; Code:
;;; user setable variables
(defvar svn-log-edit-file-name "++svn-log++" "*Name of a saved log file.")
(defvar svn-log-edit-insert-files-to-commit t "*Insert the filelist to commit in the *svn-log* buffer")
(defvar svn-status-hide-unknown nil "*Hide unknown files in *svn-status* buffer.")
(defvar svn-status-hide-unmodified nil "*Hide unmodified files in *svn-status* buffer.")
(defvar svn-status-directory-history nil "*List of visited svn working directories.")
(defvar svn-status-sort-status-buffer t "Sort the *svn-status* buffer.
Setting this variable to nil speeds up M-x svn-status.
However, it is possible, that the sorting is wrong in this case.")
(defvar svn-status-unmark-files-after-list '(commit revert)
"*List of operations after which all user marks will be removed.
Possible values are: commit, revert.")
;;; default arguments to pass to svn commands
(defvar svn-status-default-log-arguments ""
"*Arguments to pass to svn log.
\(used in `svn-status-show-svn-log'; override these by giving prefixes\).")
;;; hooks
(defvar svn-log-edit-mode-hook nil "Hook run when entering `svn-log-edit-mode'.")
(defvar svn-status-wash-control-M-in-process-buffers
(eq system-type 'windows-nt)
"*Remove any trailing ^M from the *svn-process* buffer.")
;;; Customize group
(defgroup psvn nil
"Subversion interface for Emacs."
:group 'tools)
(defgroup psvn-faces nil
"psvn faces."
:group 'psvn)
(eval-and-compile
(require 'cl)
(defconst svn-xemacsp (featurep 'xemacs))
(if svn-xemacsp
(require 'overlay)
(require 'overlay nil t)))
;; Use the normally used mode for files ending in .~HEAD~, .~BASE~, ...
(add-to-list 'auto-mode-alist '("\\.~?\\(HEAD\\|BASE\\|PREV\\)~?\\'" ignore t))
;;; internal variables
(defvar svn-process-cmd nil)
(defvar svn-status-info nil)
(defvar svn-status-base-info nil)
(defvar svn-status-initial-window-configuration nil)
(defvar svn-status-default-column 23)
(defvar svn-status-default-revision-width 4)
(defvar svn-status-default-author-width 9)
(defvar svn-status-line-format " %c%c %4s %4s %-9s")
(defvar svn-status-short-mod-flag-p t)
(defvar svn-start-of-file-list-line-number 0)
(defvar svn-status-files-to-commit nil)
(defvar svn-status-pre-commit-window-configuration nil)
(defvar svn-status-pre-propedit-window-configuration nil)
(defvar svn-status-head-revision nil)
(defvar svn-status-root-return-info nil)
(defvar svn-status-property-edit-must-match-flag nil)
(defvar svn-status-propedit-property-name nil)
(defvar svn-status-propedit-file-list nil)
(defvar svn-status-mode-line-process "")
(defvar svn-status-mode-line-process-status "")
(defvar svn-status-mode-line-process-edit-flag "")
(defvar svn-status-edit-svn-command nil)
(defvar svn-status-update-previous-process-output nil)
(defvar svn-status-temp-dir
(or
(when (boundp 'temporary-file-directory) temporary-file-directory) ;emacs
(when (boundp 'temp-directory) temp-directory) ;xemacs
"/tmp/"))
(defvar svn-temp-suffix (make-temp-name "."))
(defvar svn-status-temp-file-to-remove nil)
(defvar svn-status-temp-arg-file (concat svn-status-temp-dir "svn.arg" svn-temp-suffix))
(defvar svn-status-options nil)
(defvar svn-status-commit-rev-number nil)
;;; faces
(defface svn-status-marked-face
'((((type tty) (class color)) (:foreground "green" :weight light))
(((class color) (background light)) (:foreground "green3"))
(((class color) (background dark)) (:foreground "palegreen2"))
(t (:weight bold)))
"Face to highlight the mark for user marked files in svn status buffers."
:group 'psvn-faces)
(defface svn-status-modified-external-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 to highlight the phrase \"externally modified\" in *svn-status* buffers."
: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)
(defvar svn-highlight t)
;; stolen from PCL-CVS
(defun svn-add-face (str face &optional keymap)
(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
,@(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)))
; compatibility
; emacs 20
(unless (fboundp 'point-at-eol) (defalias 'point-at-eol 'line-end-position))
(unless (fboundp 'point-at-bol) (defalias 'point-at-bol 'line-beginning-position))
(unless (functionp 'read-directory-name) (defalias 'read-directory-name 'read-file-name))
(eval-when-compile
(if (not (fboundp 'gethash))
(require 'cl-macs)))
(if (not (fboundp 'puthash))
(defalias 'puthash 'cl-puthash))
(defvar svn-status-display-new-status-buffer nil)
;;;###autoload
(defun svn-status (dir &optional arg)
"Examine the status of Subversion working copy in directory DIR.
If ARG then pass the -u argument to `svn status'."
(interactive (list (read-directory-name "SVN status directory: "
nil default-directory nil)))
(unless (file-directory-p dir)
(error "%s is not a directory" dir))
(if (not (file-exists-p (concat dir "/.svn/")))
(when (y-or-n-p
(concat dir
" does not seem to be a Subversion working copy (no .svn directory). "
"Run dired instead? "))
(dired dir))
(setq dir (file-name-as-directory dir))
(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*")
(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*"))
(proc-buf (get-buffer-create "*svn-process*")))
(save-excursion
(set-buffer status-buf)
(setq default-directory dir)
(set-buffer proc-buf)
(setq default-directory dir)
(if arg
(svn-run-svn t t 'status "status" "-vu")
(svn-run-svn t t 'status "status" "-v"))))))
(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)))
(when (file-directory-p dir)
(svn-status dir))))
(defun svn-run-svn (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\"\)"
(if (eq (process-status "svn") nil)
(progn
(when svn-status-edit-svn-command
(setq arglist (append arglist
(split-string
(read-from-minibuffer
(format "svn %s %S " cmdtype arglist)))))
(when (eq svn-status-edit-svn-command t)
(svn-status-toggle-edit-cmd-flag t))
(message "svn-run-svn %s: %S" cmdtype arglist))
(let* ((proc-buf (get-buffer-create "*svn-process*"))
(svn-proc))
(when (listp (car arglist))
(setq arglist (car arglist)))
(save-excursion
(set-buffer proc-buf)
(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
(setq svn-proc (apply 'start-process "svn" proc-buf "svn" arglist))
(set-process-sentinel svn-proc 'svn-process-sentinel))
;;(message "running synchron: svn %S" arglist)
(apply 'call-process "svn" 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 (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")
(if (eq system-type 'windows-nt)
;; convert path separator as UNIX style
(save-excursion
(goto-char (point-min))
(while (search-forward "\\" nil t)
(replace-match "/"))))
(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)
(switch-to-buffer "*svn-status*")))
((eq svn-process-cmd 'log)
(svn-status-show-process-buffer-internal t)
(pop-to-buffer "*svn-process*")
(switch-to-buffer (get-buffer-create "*svn-log*"))
(let ((buffer-read-only nil))
(delete-region (point-min) (point-max))
(insert-buffer-substring "*svn-process*"))
(svn-log-view-mode)
(goto-char (point-min))
(forward-line 3)
(font-lock-fontify-buffer)
(message "svn log finished"))
((eq svn-process-cmd 'info)
(svn-status-show-process-buffer-internal 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-buffer-internal t)
(message "svn blame finished"))
((eq svn-process-cmd 'commit)
(svn-status-remove-temp-file-maybe)
;;(svn-status-show-process-buffer-internal t)
(when (member 'commit svn-status-unmark-files-after-list)
(svn-status-unset-all-usermarks))
;;(svn-status-update)
;;(svn-status-update), svn-status-show-process-buffer-internal should be no longer necessary!
(svn-status-update-with-command-list (svn-status-parse-commit-output))
(message "svn commit finished"))
((eq svn-process-cmd 'update)
(svn-status-show-process-buffer-internal t)
(svn-status-update)
(message "svn update finished"))
((eq svn-process-cmd 'add)
(svn-status-update)
(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)
(message "svn rm finished"))
((eq svn-process-cmd 'cleanup)
(message "svn cleanup finished"))
((eq svn-process-cmd 'proplist)
(svn-status-show-process-buffer-internal 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)
(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-buffer-internal t))))
(defun svn-parse-rev-num (str)
(if (and str (stringp str)
(save-match-data (string-match "^[0-9]+" str)))
(string-to-number str)
-1))
(defun svn-parse-status-result ()
"Parse the *svn-process* buffer.
The results are used to build the `svn-status-info' variable."
(setq svn-status-head-revision nil)
(save-excursion
(let ((old-ui-information (svn-status-ui-information-hash-table))
(line-string)
(user-mark)
(svn-marks)
(svn-file-mark)
(svn-property-mark)
(svn-update-mark)
(local-rev)
(last-change-rev)
(author)
(path)
(user-elide nil)
(ui-status '(nil nil)) ; contains (user-mark user-elide)
(revision-width svn-status-default-revision-width)
(author-width svn-status-default-author-width))
(set-buffer "*svn-process*")
(setq svn-status-info nil)
(goto-char (point-min))
(while (< (point) (point-max))
(cond
((= (point-at-eol) (point-at-bol)) ;skip blank lines
nil)
((looking-at "Status against revision:[ ]+\\([0-9]+\\)")
;; the above message appears for the main listing plus once for each svn:externals entry
(unless svn-status-head-revision
(setq svn-status-head-revision (match-string 1))))
((looking-at "Performing status on external item at '\(.*\)'")
;; The *next* line has info about the directory named in svn:externals
;; we should parse it, and merge the info with what we have already know
;; but for now just ignore the line completely
(forward-line)
)
(t
(setq svn-marks (buffer-substring (point) (+ (point) 8))
svn-file-mark (elt svn-marks 0) ; 1st column
svn-property-mark (elt svn-marks 1) ; 2nd column
;;svn-locked-mark (elt svn-marks 2) ; 3rd column
;;svn-added-with-history-mark (elt svn-marks 3); 4th column
;;svn-switched-mark (elt svn-marks 4) ; 5th column
svn-update-mark (elt svn-marks 7)) ; 8th column
(when (eq svn-property-mark ?\ ) (setq svn-property-mark nil))
(when (eq svn-update-mark ?\ ) (setq svn-update-mark nil))
(forward-char 8)
(skip-chars-forward " ")
(cond
((looking-at "\\([-?]\\|[0-9]+\\) +\\([-?]\\|[0-9]+\\) +\\([^ ]+\\) *\\(.+\\)")
(setq local-rev (svn-parse-rev-num (match-string 1))
last-change-rev (svn-parse-rev-num (match-string 2))
author (match-string 3)
path (match-string 4)))
((looking-at "\\(.*\\)")
(setq path (match-string 1)
local-rev -1
last-change-rev -1
author (if (eq svn-file-mark 88) "" "?"))) ;clear author of svn:externals dirs
(t
(error "Unknown status line format")))
(unless path (setq path "."))
(setq ui-status (or (gethash path old-ui-information) (list user-mark user-elide)))
(setq svn-status-info (cons (list ui-status
svn-file-mark
svn-property-mark
path
local-rev
last-change-rev
author
svn-update-mark)
svn-status-info))
(setq revision-width (max revision-width
(length (number-to-string local-rev))
(length (number-to-string last-change-rev))))
(setq author-width (max author-width (length author)))))
(forward-line 1))
;; With subversion 0.29.0 and above, `svn -u st' returns files in
;; a random order (especially if we have a mixed revision wc)
(setq svn-status-default-column
(+ 6 revision-width revision-width author-width
(if svn-status-short-mod-flag-p 3 0)))
(setq svn-status-line-format (format " %%c%%c %%%ds %%%ds %%-%ds"
revision-width
revision-width
author-width))
(setq svn-status-info (nreverse svn-status-info))
(when svn-status-sort-status-buffer
(setq svn-status-info (sort svn-status-info 'svn-status-sort-predicate))))))
;;(string-lessp "." "%") => nil
;(svn-status-sort-predicate '(t t t ".") '(t t t "%")) => t
(defun svn-status-sort-predicate (a b)
"Return t if A should appear before B in the *svn-status* buffer.
A and B must be line-info's."
(string-lessp (concat (svn-status-line-info->full-path a) "/")
(concat (svn-status-line-info->full-path b) "/")))
(defun svn-status-remove-temp-file-maybe ()
"Remove any (no longer required) temporary files created by psvn.el."
(when svn-status-temp-file-to-remove
(when (file-exists-p svn-status-temp-file-to-remove)
(delete-file svn-status-temp-file-to-remove))
(when (file-exists-p svn-status-temp-arg-file)
(delete-file svn-status-temp-arg-file))
(setq svn-status-temp-file-to-remove nil)))
(defun svn-status-remove-control-M ()
"Remove ^M at end of line in the whole buffer."
(interactive)
(let ((buffer-read-only nil))
(save-match-data
(save-excursion
(goto-char (point-min))
(while (re-search-forward "\r$" (point-max) t)
(replace-match "" nil nil))))))
(condition-case nil
;;(easy-menu-add-item nil '("tools") ["SVN Status" svn-status t] "PCL-CVS")
(easy-menu-add-item nil '("tools") ["SVN Status" svn-status t])
(error (message "psvn: could not install menu")))
(defvar svn-status-mode-map () "Keymap used in `svn-status-mode' buffers.")
(defvar svn-status-mode-property-map ()
"Subkeymap used in `svn-status-mode' for property commands.")
(defvar svn-status-mode-options-map ()
"Subkeymap used in `svn-status-mode' for option commands.")
(when (not svn-status-mode-map)
(setq svn-status-mode-map (make-sparse-keymap))
(suppress-keymap svn-status-mode-map)
;; Don't use (kbd "<return>"); it's unreachable with GNU Emacs 21.3 on a TTY.
(define-key svn-status-mode-map (kbd "RET") 'svn-status-find-file-or-examine-directory)
(define-key svn-status-mode-map (kbd "^") 'svn-status-examine-parent)
(define-key svn-status-mode-map (kbd "s") 'svn-status-show-process-buffer)
(define-key svn-status-mode-map (kbd "f") 'svn-status-find-files)
(define-key svn-status-mode-map (kbd "o") 'svn-status-find-file-other-window)
(define-key svn-status-mode-map (kbd "v") 'svn-status-view-file-other-window)
(define-key svn-status-mode-map (kbd "e") 'svn-status-toggle-edit-cmd-flag)
(define-key svn-status-mode-map (kbd "g") 'svn-status-update)
(define-key svn-status-mode-map (kbd "q") 'svn-status-bury-buffer)
(define-key svn-status-mode-map (kbd "h") 'svn-status-use-history)
(define-key svn-status-mode-map (kbd "m") 'svn-status-set-user-mark)
(define-key svn-status-mode-map (kbd "u") 'svn-status-unset-user-mark)
;; This matches a binding of `dired-unmark-all-files' in `dired-mode-map'
;; of both GNU Emacs and XEmacs. It seems unreachable with XEmacs on
;; TTY, but if that's a problem then its Dired needs fixing too.
;; Or you could just use "*!".
(define-key svn-status-mode-map "\M-\C-?" 'svn-status-unset-all-usermarks)
;; The key that normally deletes characters backwards should here
;; instead unmark files backwards. In GNU Emacs, that would be (kbd
;; "DEL") aka [?\177], but XEmacs treats those as [(delete)] and
;; would bind a key that normally deletes forwards. [(backspace)]
;; is unreachable with GNU Emacs on a tty. Try to recognize the
;; dialect and act accordingly.
;;
;; XEmacs has a `delete-forward-p' function that checks the
;; `delete-key-deletes-forward' option. We don't use those, for two
;; reasons: psvn.el may be loaded before user customizations, and
;; XEmacs allows simultaneous connections to multiple devices with
;; different keyboards.
(define-key svn-status-mode-map
(if (member (kbd "DEL") '([(delete)] [delete]))
[(backspace)] ; XEmacs
(kbd "DEL")) ; GNU Emacs
'svn-status-unset-user-mark-backwards)
(define-key svn-status-mode-map (kbd "$") 'svn-status-toggle-elide)
(define-key svn-status-mode-map (kbd ".") 'svn-status-goto-root-or-return)
(define-key svn-status-mode-map (kbd "I") 'svn-status-parse-info)
(define-key svn-status-mode-map (kbd "?") 'svn-status-toggle-hide-unknown)
(define-key svn-status-mode-map (kbd "_") 'svn-status-toggle-hide-unmodified)
(define-key svn-status-mode-map (kbd "a") 'svn-status-add-file)
(define-key svn-status-mode-map (kbd "A") 'svn-status-add-file-recursively)
(define-key svn-status-mode-map (kbd "+") 'svn-status-make-directory)
(define-key svn-status-mode-map (kbd "R") 'svn-status-mv)
(define-key svn-status-mode-map (kbd "D") 'svn-status-rm)
(define-key svn-status-mode-map (kbd "c") 'svn-status-commit-file)
(define-key svn-status-mode-map (kbd "M-c") 'svn-status-cleanup)
(define-key svn-status-mode-map (kbd "U") 'svn-status-update-cmd)
(define-key svn-status-mode-map (kbd "r") 'svn-status-revert)
(define-key svn-status-mode-map (kbd "l") 'svn-status-show-svn-log)
(define-key svn-status-mode-map (kbd "i") 'svn-status-info)
(define-key svn-status-mode-map (kbd "b") 'svn-status-blame)
(define-key svn-status-mode-map (kbd "=") 'svn-status-show-svn-diff)
;; [(control ?=)] is unreachable on TTY, but you can use "*u" instead.
;; (Is the "u" mnemonic for something?)
(define-key svn-status-mode-map (kbd "C-=") 'svn-status-show-svn-diff-for-marked-files)
(define-key svn-status-mode-map (kbd "~") 'svn-status-get-specific-revision)
(define-key svn-status-mode-map (kbd "E") 'svn-status-ediff-with-revision)
(define-key svn-status-mode-map (kbd "C-n") 'svn-status-next-line)
(define-key svn-status-mode-map (kbd "C-p") 'svn-status-previous-line)
(define-key svn-status-mode-map (kbd "<down>") 'svn-status-next-line)
(define-key svn-status-mode-map (kbd "<up>") 'svn-status-previous-line)
(setq svn-status-mode-mark-map (make-sparse-keymap))
(define-key svn-status-mode-map (kbd "*") svn-status-mode-mark-map)
(define-key svn-status-mode-mark-map (kbd "!") 'svn-status-unset-all-usermarks)
(define-key svn-status-mode-mark-map (kbd "?") 'svn-status-mark-unknown)
(define-key svn-status-mode-mark-map (kbd "A") 'svn-status-mark-added)
(define-key svn-status-mode-mark-map (kbd "M") 'svn-status-mark-modified)
(define-key svn-status-mode-mark-map (kbd "V") 'svn-status-resolved)
(define-key svn-status-mode-mark-map (kbd "u") 'svn-status-show-svn-diff-for-marked-files))
(when (not svn-status-mode-property-map)
(setq svn-status-mode-property-map (make-sparse-keymap))
(define-key svn-status-mode-property-map (kbd "l") 'svn-status-property-list)
(define-key svn-status-mode-property-map (kbd "s") 'svn-status-property-set)
(define-key svn-status-mode-property-map (kbd "d") 'svn-status-property-delete)
(define-key svn-status-mode-property-map (kbd "e") 'svn-status-property-edit-one-entry)
(define-key svn-status-mode-property-map (kbd "i") 'svn-status-property-ignore-file)
(define-key svn-status-mode-property-map (kbd "I") 'svn-status-property-ignore-file-extension)
;; XEmacs 21.4.15 on TTY (vt420) converts `C-i' to `TAB',
;; which [(control ?i)] won't match. Handle it separately.
;; On GNU Emacs, the following two forms bind the same key,
;; reducing clutter in `where-is'.
(define-key svn-status-mode-property-map [(control ?i)] 'svn-status-property-edit-svn-ignore)
(define-key svn-status-mode-property-map (kbd "TAB") 'svn-status-property-edit-svn-ignore)
(define-key svn-status-mode-property-map (kbd "k") 'svn-status-property-set-keyword-list)
(define-key svn-status-mode-property-map (kbd "y") 'svn-status-property-set-eol-style)
(define-key svn-status-mode-property-map (kbd "p") 'svn-status-property-parse)
;; TODO: Why is `svn-status-select-line' in `svn-status-mode-property-map'?
(define-key svn-status-mode-property-map (kbd "RET") 'svn-status-select-line)
(define-key svn-status-mode-map (kbd "P") svn-status-mode-property-map))
(when (not svn-status-mode-options-map)
(setq svn-status-mode-options-map (make-sparse-keymap))
(define-key svn-status-mode-options-map (kbd "s") 'svn-status-save-state)
(define-key svn-status-mode-options-map (kbd "l") 'svn-status-load-state)
(define-key svn-status-mode-options-map (kbd "x") 'svn-status-toggle-sort-status-buffer)
(define-key svn-status-mode-map (kbd "O") svn-status-mode-options-map))
(easy-menu-define svn-status-mode-menu svn-status-mode-map
"'svn-status-mode' menu"
'("SVN"
["svn status" svn-status-update t]
["svn update" svn-status-update-cmd t]
["svn commit" svn-status-commit-file t]
["svn log" svn-status-show-svn-log t]
["svn info" svn-status-info t]
["svn blame" svn-status-blame t]
("Diff"
["svn diff current file" svn-status-show-svn-diff t]
["svn diff marked files" svn-status-show-svn-diff-for-marked-files t]
["svn ediff current file" svn-status-ediff-with-revision t]
)
["svn cat ..." svn-status-get-specific-revision t]
["svn add" svn-status-add-file t]
["svn mkdir..." svn-status-make-directory t]
["svn mv..." svn-status-mv t]
["svn rm..." svn-status-rm t]
["Up Directory" svn-status-examine-parent t]
["Elide Directory" svn-status-toggle-elide t]
["svn revert" svn-status-revert t]
["svn resolved" svn-status-resolved t]
["svn cleanup" svn-status-cleanup t]
["Show Process Buffer" svn-status-show-process-buffer t]
("Property"
["svn proplist" svn-status-property-list t]
["Set Multiple Properties..." svn-status-property-set t]
["Edit One Property..." svn-status-property-edit-one-entry t]
["svn propdel..." svn-status-property-delete t]
"---"
["svn:ignore File..." svn-status-property-ignore-file t]
["svn:ignore File Extension..." svn-status-property-ignore-file-extension t]
["Edit svn:ignore Property" svn-status-property-edit-svn-ignore t]
"---"
["Set svn:keywords List" svn-status-property-set-keyword-list t]
["Set svn:eol-style" svn-status-property-set-eol-style t]
)
("Options"
["Save Options" svn-status-save-state t]
["Load Options" svn-status-load-state t]
["Toggle sorting of *svn-status* buffer" svn-status-toggle-sort-status-buffer
:style toggle :selected svn-status-sort-status-buffer]
)
"---"
["Edit Next SVN Cmd Line" svn-status-toggle-edit-cmd-flag t]
["Work Directory History..." svn-status-use-history t]
["Mark" svn-status-set-user-mark t]
["Unmark" svn-status-unset-user-mark t]
("Mark / Unmark"
["Unmark all" svn-status-unset-all-usermarks t]
["Mark/Unmark unknown" svn-status-mark-unknown t]
["Mark/Unmark added" svn-status-mark-added t]
["Mark/Unmark modified" svn-status-mark-modified t]
)
["Hide Unknown" svn-status-toggle-hide-unknown
:style toggle :selected svn-status-hide-unknown]
["Hide Unmodified" svn-status-toggle-hide-unmodified
:style toggle :selected svn-status-hide-unmodified]
))
(defun svn-status-mode ()
"Major mode used by psvn.el to process the output of \"svn status\".
psvn.el is an interface for the revision control tool subversion
\(see http://subversion.tigris.org).
psvn.el provides a similar interface for subversion as pcl-cvs does for cvs.
At the moment the following commands are implemented:
M-x svn-status: run 'svn -status -v'
and show the result in the *svn-status* buffer, this buffer uses the
svn-status mode. In this mode the following keys are defined:
\\{svn-status-mode-map}"
(interactive)
(kill-all-local-variables)
(use-local-map svn-status-mode-map)
(easy-menu-add svn-status-mode-menu)
(setq major-mode 'svn-status-mode)
(setq mode-name "svn-status")
(setq mode-line-process 'svn-status-mode-line-process)
(let ((view-read-only nil))
(toggle-read-only 1)))
(defun svn-status-update-mode-line ()
(setq svn-status-mode-line-process
(concat svn-status-mode-line-process-edit-flag svn-status-mode-line-process-status))
(force-mode-line-update))
(defun svn-status-bury-buffer (arg)
"Bury the *svn-status* buffer.
When called with a prefix argument, switch back to the window configuration that was
in use before `svn-status' was called."
(interactive "P")
(cond (arg
(when svn-status-initial-window-configuration
(set-window-configuration svn-status-initial-window-configuration)))
(t
(let ((bl '("*svn-log-edit*" "*svn-property-edit*" "*svn-process*")))
(while bl
(when (get-buffer (car bl))
(bury-buffer (car bl)))
(setq bl (cdr bl)))
(when (string= (buffer-name) "*svn-status*")
(bury-buffer))))))
(defun svn-status-find-files ()
"Open selected file(s) for editing.
See `svn-status-marked-files' for what counts as selected."
(interactive)
(let ((fnames (mapcar 'svn-status-line-info->full-path (svn-status-marked-files))))
(mapc 'find-file fnames)))
(defun svn-status-find-file-other-window ()
"Open the file in the other window for editing."
(interactive)
(svn-status-ensure-cursor-on-file)
(find-file-other-window (svn-status-line-info->filename
(svn-status-get-line-information))))
(defun svn-status-view-file-other-window ()
"Open the file in the other window for viewing."
(interactive)
(svn-status-ensure-cursor-on-file)
(view-file-other-window (svn-status-line-info->filename
(svn-status-get-line-information))))
(defun svn-status-find-file-or-examine-directory ()
"If point is on a directory, run `svn-status' on that directory.
Otherwise run `find-file'."
(interactive)
(svn-status-ensure-cursor-on-file)
(let ((line-info (svn-status-get-line-information)))
(if (svn-status-line-info->directory-p line-info)
(svn-status (svn-status-line-info->full-path line-info))
(find-file (svn-status-line-info->filename line-info)))))
(defun svn-status-examine-parent ()
"Run `svn-status' on the parent of the current directory."
(interactive)
(svn-status (expand-file-name "../")))
(defun svn-status-line-info->ui-status (line-info) (nth 0 line-info))
(defun svn-status-line-info->has-usermark (line-info) (nth 0 (nth 0 line-info)))
(defun svn-status-line-info->user-elide (line-info) (nth 1 (nth 0 line-info)))
(defun svn-status-line-info->filemark (line-info) (nth 1 line-info))
(defun svn-status-line-info->propmark (line-info) (nth 2 line-info))
(defun svn-status-line-info->filename (line-info) (nth 3 line-info))
(defun svn-status-line-info->filename-nondirectory (line-info)
(file-name-nondirectory (svn-status-line-info->filename line-info)))
(defun svn-status-line-info->localrev (line-info)
(if (>= (nth 4 line-info) 0)
(nth 4 line-info)
nil))
(defun svn-status-line-info->lastchangerev (line-info)
"Return the last revision in which LINE-INFO was modified."
(if (>= (nth 5 line-info) 0)
(nth 5 line-info)
nil))
(defun svn-status-line-info->author (line-info) (nth 6 line-info))
(defun svn-status-line-info->modified-external (line-info) (nth 7 line-info))
(defun svn-status-line-info->is-visiblep (line-info)
(not (or (svn-status-line-info->hide-because-unknown line-info)
(svn-status-line-info->hide-because-unmodified line-info)
(svn-status-line-info->hide-because-user-elide line-info))))
(defun svn-status-line-info->hide-because-unknown (line-info)
(and svn-status-hide-unknown
(eq (svn-status-line-info->filemark line-info) ??)))
(defun svn-status-line-info->hide-because-unmodified (line-info)
;;(message " %S %S %S %S - %s" svn-status-hide-unmodified (svn-status-line-info->propmark line-info) ?_
;; (svn-status-line-info->filemark line-info) (svn-status-line-info->filename line-info))
(and svn-status-hide-unmodified
(and (or (eq (svn-status-line-info->filemark line-info) ?_)
(eq (svn-status-line-info->filemark line-info) ? ))
(or (eq (svn-status-line-info->propmark line-info) ?_)
(eq (svn-status-line-info->propmark line-info) ? )
(eq (svn-status-line-info->propmark line-info) nil)))))
(defun svn-status-line-info->hide-because-user-elide (line-info)
(eq (svn-status-line-info->user-elide line-info) t))
(defun svn-status-line-info->show-user-elide-continuation (line-info)
(eq (svn-status-line-info->user-elide line-info) 'directory))
;; modify the line-info
(defun svn-status-line-info->set-filemark (line-info value)
(setcar (nthcdr 1 line-info) value))
(defun svn-status-line-info->set-propmark (line-info value)
(setcar (nthcdr 2 line-info) value))
(defun svn-status-line-info->set-localrev (line-info value)
(setcar (nthcdr 4 line-info) value))
(defun svn-status-line-info->set-lastchangerev (line-info value)
(setcar (nthcdr 5 line-info) value))
(defun svn-status-toggle-elide ()
(interactive)
(let ((st-info svn-status-info)
(fname)
(test (svn-status-line-info->filename (svn-status-get-line-information)))
(len-test)
(len-fname)
(new-elide-mark t)
(elide-mark))
(when (string= test ".")
(setq test ""))
(setq len-test (length test))
(while st-info
(setq fname (svn-status-line-info->filename (car st-info)))
(setq len-fname (length fname))
(when (and (>= len-fname len-test)
(string= (substring fname 0 len-test) test))
;;(message "elide: %s %s" fname (svn-status-line-info->user-elide (car st-info)))
(setq elide-mark new-elide-mark)
(when (or (string= fname ".")
(and (= len-fname len-test) (svn-status-line-info->directory-p (car st-info))))
(message "Elide directory %s and all its files." fname)
(setq new-elide-mark (not (svn-status-line-info->user-elide (car st-info))))
(setq elide-mark (if new-elide-mark 'directory nil)))
(setcar (nthcdr 1 (svn-status-line-info->ui-status (car st-info))) elide-mark))
(setq st-info (cdr st-info))))
(svn-status-update-buffer))
(defun svn-status-update-with-command-list (cmd-list)
(save-excursion
(set-buffer "*svn-status*")
(let ((st-info)
(found)
(action))
(setq cmd-list (sort cmd-list '(lambda (item1 item2) (string-lessp (car item1) (car item2)))))
(while cmd-list
(unless st-info (setq st-info svn-status-info))
;;(message "%S" (caar cmd-list))
(setq found nil)
(while (and (not found) st-info)
(setq found (string= (caar cmd-list) (svn-status-line-info->filename (car st-info))))
;;(message "found: %S" found)
(unless found (setq st-info (cdr st-info))))
(unless found
(message "continue to search for %s" (caar cmd-list))
(setq st-info svn-status-info)
(while (and (not found) st-info)
(setq found (string= (caar cmd-list) (svn-status-line-info->filename (car st-info))))
(unless found (setq st-info (cdr st-info)))))
(if found
;;update the info line
(progn
(setq action (cadar cmd-list))
;;(message "found %s, action: %S" (caar cmd-list) action)
(svn-status-annotate-status-buffer-entry action (car st-info)))
(message "did not find %s" (caar cmd-list)))
(setq cmd-list (cdr cmd-list))))))
(defun svn-status-annotate-status-buffer-entry (action line-info)
(let ((tag-string))
(svn-status-goto-file-name (svn-status-line-info->filename line-info))
(cond ((equal action 'committed)