code.delx.au - gnu-emacs-elpa/blob - packages/arbitools/arbitools.el

   1 ;;; arbitools.el --- Package for chess tournaments administration
   2
   3 ;; Copyright 2016 Free Software Foundation, Inc.
   4
   5 ;; Author: David Gonzalez Gandara <dggandara@member.fsf.org>
   6 ;; Version: 0.70
   7 ;; Package-Requires: ((cl-lib "0.5"))
   8
   9 ;; This program is free software: you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13 ;;
  14 ;; This program is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18 ;;
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;;; Commentary:
  23
  24 ;; REQUIRES:
  25 ;; ---------------------------
  26 ;; Some functions require the arbitools python package, you can install
  27 ;; it by: "pip3 install arbitools"
  28 ;; "pdflatex" is necessary in case you want to get pdfs.
  29 ;;
  30 ;; USAGE:
  31 ;; ---------------------------
  32 ;; arbitools.el is an interface for the python package "arbitools",
  33 ;; designed to manage chess tournament reports.  If you don't install the
  34 ;; python package you can still have the syntax colouring and some native
  35 ;; functions. In the future, all the functions will be translated to ELISP.
  36 ;;
  37 ;; FEATURES:
  38 ;; ----------------------------
  39 ;; - Syntax colouring for the official trf FIDE files.  This facilitates
  40 ;; manual edition of the files.
  41 ;;
  42 ;; - Updating the players ratings. - with python
  43 ;;
  44 ;; - Adding players to an existing file. - with python
  45 ;;
  46 ;; - Getting standings from a tournament file. -with python
  47 ;;
  48 ;; - Getting IT3 Tournament report form. - with python
  49 ;;
  50 ;; - Deleting a round. - Native
  51 ;;
  52 ;; - Insert result. - Native
  53 ;;
  54 ;; - Insert player. - Native
  55 ;;
  56 ;; - Get the pairing or results of a round - Native
  57 ;;
  58 ;; - Get the list of the players - Native
  59 ;;
  60 ;; - Delete player. Adjust all rank numbers - Native
  61 ;;
  62 ;; - Adjust points for each player, according to results of rounds - Native
  63 ;;
  64 ;; - Print standings - Native
  65 ;;
  66 ;; TODO:
  67 ;; ---------------------------------
  68 ;;
  69 ;; - Automatically purge all players who didn't play any games.
  70 ;;
  71 ;; - Insert results from a results file created with a pairing program.
  72 ;;   Add the date in the "132" line and the results in the "001" lines.
  73 ;;
  74 ;; - Add empty round. Ask for date create empty space in the players lines.
  75 ;;   Add the date in the "132" line.
  76 ;;
  77 ;; - Add the rank number and the position automatically when adding players.
  78 ;;
  79 ;; - Add team.
  80 ;;
  81 ;; - Add player to team. Prompt for team and player number.
  82 ;;
  83 ;; - Generate pgn file for a round or the whole tournament.
  84 ;;
  85 ;; - Reorder the ranking
  86 ;;
  87 ;; - Reorder the players list
  88 ;;
  89 ;; You will find more information in www.ourenxadrez.org/arbitools.htm
  90
  91 ;;; Code:
  92
  93 (eval-when-compile (require 'cl-lib))
  94
  95 (defun arbitools-prepare-feda ()
  96   "Prepare file to FEDA: add carriage return at the end of lines."
  97   (interactive)
  98   (save-excursion
  99     (goto-char (point-min))
 100     (while (search-forward "\n" nil t)
 101       (replace-match "\r\n"))))
 102
 103 (defun arbitools-update (elolist)
 104   "Update the players ratings in a database file based on a elo list file."
 105   (interactive "selolist:")
 106   ;; FIXME: What if `list' is "foo; bar"?
 107   (call-process "arbitools-run.py" nil "Arbitools-output" nil "update" buffer-file-name "-l" elolist))
 108
 109 (defun arbitools-add (addfile)
 110   "Add players to an existing database file."
 111   (interactive "faddfile: ")
 112   ;; FIXME: What if `addlist' is "foo; bar"?
 113   (call-process "arbitools-add.py" nil "Arbitools-output" nil "-a" addfile "-i" buffer-file-name))
 114
 115 (defun arbitools-list-pairing (round)
 116   "Get the pairings and/or results of the given round"
 117   (interactive "sround: ")
 118   (goto-char (point-min))
 119   (arbitools-list-players)
 120   (save-excursion
 121     (re-search-forward "^012" nil t)
 122     (let* ((linestring (thing-at-point 'line))
 123           (tournamentnamestring (substring linestring 4)))
 124       (with-current-buffer "Pairings List"
 125         (erase-buffer)
 126         (insert (format "%s" tournamentnamestring)))))
 127   (with-current-buffer "Pairings List"
 128    (insert (format "Pairings for round %s\n\n" round)) )
 129   (let* ((paired '()))
 130
 131     (while (re-search-forward "^001" nil t)
 132        (let* ((namestring nil)
 133              (linestring (thing-at-point 'line))
 134              (playerlinestring nil)
 135              (opponentlinestring nil)
 136              opponentstring
 137              (rankstring (substring linestring 4 8))
 138              (opponent (substring linestring (+ 91 (* (- (string-to-number round) 1)10 ))
 139                        (+ 95(* (- (string-to-number round) 1)10 ))))
 140              (color (substring linestring (+ 96 (* (- (string-to-number round) 1)10 ))
 141                        (+ 97(* (- (string-to-number round) 1)10 ))))
 142              (result (substring linestring (+ 98 (* (- (string-to-number round) 1)10 ))
 143                        (+ 99(* (- (string-to-number round) 1)10 )))))
 144          (with-current-buffer "Arbitools-output"
 145            (insert (format "%s\n" paired))
 146            (insert (format "-%s-" rankstring))
 147            (insert (format "%s\n" (member "   1" paired))))
 148          (unless (or (member rankstring paired) (member opponent paired))
 149            (with-current-buffer "List of players"
 150                (goto-char (point-min))
 151                (re-search-forward (concat "^" (regexp-quote  rankstring)))
 152                (setq playerlinestring (thing-at-point 'line))
 153                (setq namestring (substring playerlinestring 4 37))
 154                (goto-char (point-min))
 155                (unless (or (string= opponent "0000") (string= opponent "    "))
 156                    (re-search-forward (concat "^" (regexp-quote opponent))))
 157                (setq opponentlinestring (thing-at-point 'line))
 158                (setq opponentstring (substring opponentlinestring 4 37))
 159                (when (or (string= opponent "0000")(string= opponent "    "))
 160                  (setq opponentstring "-"))
 161                (cl-pushnew rankstring paired :test #'equal))
 162            (with-current-buffer "Pairings List"
 163              (cond ((string= color "w") ;; TODO: change the ranknumber with the name
 164                      (cond ((string= result "1")
 165                            (insert (format "%s 1-0 %s\n" namestring opponentstring)))
 166                           ((string= result "0")
 167                            (insert (format "%s 0-1 %s\n" namestring opponentstring)))
 168                           ((string= result "+")
 169                            (insert (format "%s + - %s\n" namestring opponentstring)))
 170                           ((string= result "-")
 171                            (insert (format "%s - + %s\n" namestring opponentstring)))
 172                           ((string= result "=")
 173                            (insert (format "%s 1/2 %s\n" namestring opponentstring)))))
 174                    ((string= color "b")
 175                      (cond ((string= result "1")
 176                            (insert (format "%s 0-1 %s\n" opponentstring namestring)))
 177                           ((string= result "0")
 178                            (insert (format "%s 1-0 %s\n" opponentstring namestring)))
 179                           ((string= result "+")
 180                            (insert (format "%s - + %s\n" opponentstring namestring)))
 181                           ((string= result "-")
 182                            (insert (format "%s + - %s\n" opponentstring namestring)))
 183                           ((string= result "=")
 184                            (insert (format "%s 1/2 %s\n" opponentstring namestring))))))))))))
 185
 186
 187 (defun arbitools-standings ()
 188   "Get standings and report files from a tournament file."
 189   (interactive)
 190   ;; (shell-command (concat (expand-file-name "arbitools-standings.py") " -i " buffer-file-name))) ;this is to use the actual path
 191   (call-process "arbitools-run.py" nil "Arbitools-output" nil "standings" buffer-file-name))
 192
 193 (defun arbitools-list-players ()
 194   "Put the list of players in two buffers, one in plain text and another in a beautiful LaTeX"
 195   ;; TODO: the beautiful LaTeX
 196   (interactive)
 197   (save-excursion
 198    (goto-char (point-min))
 199    (while (re-search-forward "^001" nil t)
 200      (let* ((linestring (thing-at-point 'line))
 201            (rankstring (substring linestring 5 8)))
 202
 203        (with-current-buffer "List of players"
 204          (insert (format " %s " rankstring))))
 205
 206      (let* ((linestring (thing-at-point 'line))
 207            (namestring (substring linestring 14 47)))
 208
 209        (with-current-buffer "List of players"
 210          (insert (format "%s " namestring))))
 211
 212      (let* ((linestring (thing-at-point 'line))
 213             (elostring (substring linestring 48 52)))
 214
 215        (with-current-buffer "List of players"
 216          (insert (format "%s\n" elostring))))))
 217   (with-current-buffer "List of players"
 218     (remove-text-properties (point-min)(point-max) '(face nil))))
 219
 220 (defun arbitools-new-trf ()
 221   "Create an empty trf file"
 222   (interactive)
 223   (generate-new-buffer "New trf")
 224   (switch-to-buffer "New trf")
 225   (set-buffer "New trf")
 226   (arbitools-mode)
 227   (insert "012 NAME OF THE TOURNAMENT\n")
 228   (insert "022 PLACE\n")
 229   (insert "032 FEDERATION\n")
 230   (insert "042 STARTING DATE (YYYY/MM/DD)\n")
 231   (insert "052 ENDING DATE (YYYY/MM/DD)\n")
 232   (insert "062 NUMBER OF PLAYERS\n")
 233   (insert "072 NUMBER OF RATED PLAYERS\n")
 234   (insert "082 NUMBER OF TEAMS\n")
 235   (insert "092 TYPE OF TOURNAMENT\n")
 236   (insert "102 CHIEF ARBITER\n")
 237   (insert "112 DEPUTY CHIEF ARBITER\n")
 238   (insert "122 ALLOTED TIMES PER MOVE/GAME\n")
 239   (insert "132 DATES                                                                                  YY/MM/DD  YY/MM/DD\n")
 240   ;; (insert "001  000 GTIT NNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNN RAT. FED   0000000000 YYYY/MM/DD 00.0  RNK  0000 C R  0000 C R\n")
 241   ;; (insert "013 NNNNNNNNNNNNNNNNNNNNNNNNNNNNNNN  0000 0000\n")
 242 )
 243
 244  (defun arbitools-number-of-rounds ()
 245    "Get the number of rounds in the tournament. It has to be executed in the principal buffer."
 246    (let* ((numberofrounds 0))
 247      (save-excursion
 248       (goto-char (point-min))
 249       (re-search-forward "^132" nil t)
 250         (let* ((linestringrounds (thing-at-point 'line))
 251             ;; (actualround " ")
 252             (beginning-of-round 91)
 253             (end-of-round 99)
 254             (continue t))
 255
 256             ;; (with-current-buffer "Arbitools-output" (insert (format "rounds: %s" linestringrounds)))
 257             ;; (with-current-buffer "Arbitools-output" (insert (format "length: %s" (- (length linestringrounds) 4))))
 258            ;; For some reason, the length of the string is 4 characters longer than the real line
 259            (while continue
 260              (if (< end-of-round (length linestringrounds))
 261
 262                (progn
 263                   ;; (setq actualround (substring-no-properties linestringrounds beginning-of-round end-of-round))
 264                   (setq numberofrounds (+ numberofrounds 1))
 265                   (setq beginning-of-round (+ beginning-of-round 10))
 266                   (setq end-of-round (+ end-of-round 10)))
 267
 268                   (setq continue nil)))))
 269      numberofrounds))
 270
 271 (defun arbitools-calculate-points ()
 272   "Automatically calculate the points of each player"
 273   (interactive)
 274   (save-excursion
 275     (let ( (numberofrounds (arbitools-number-of-rounds))
 276            (points         0.0)
 277            (pointstosum    0.0)
 278            (roundcount     1))
 279       (goto-char (point-min))
 280       (while (re-search-forward "^001" nil t)
 281         (setq points 0.0)
 282         (setq roundcount 1)
 283         (while (<= roundcount numberofrounds)
 284           (beginning-of-line)
 285           (forward-char (+ 98 (* (- roundcount 1) 10))) ;; go to where the result is for each round
 286           ;; FIXME: Use pcase?
 287           (cond ((string= (thing-at-point 'symbol) "1") (setq pointstosum 1.0))
 288                 ((string= (thing-at-point 'symbol) "+") (setq pointstosum 1.0))
 289                 ((string= (thing-at-point 'symbol) "=") (setq pointstosum 0.5))
 290                 ((string= (thing-at-point 'symbol) "0") (setq pointstosum 0.0))
 291                 ((string= (thing-at-point 'symbol) "-") (setq pointstosum 0.0))
 292                 ((string= (thing-at-point 'symbol) nil) (setq pointstosum 0.0)))
 293           (setq points (+ points pointstosum))
 294           (setq roundcount (+ roundcount 1)))
 295         (beginning-of-line)
 296         (forward-char 84)
 297         (forward-char -3)
 298         (delete-char 3)
 299         (insert-char ?\s (- 3 (length (format "%s" points))))
 300         (insert (format "%s" points))))))
 301
 302 (defun arbitools-calculate-standings ()
 303   "Write the standings in the Standings buffer"
 304   (interactive)
 305   (arbitools-calculate-points) ;; make sure the points of each player are correct
 306   (save-excursion
 307     (with-current-buffer "Standings"
 308       (erase-buffer))
 309     (let ((datachunk ""))
 310       (goto-char (point-min))
 311       (while (re-search-forward "^001" nil t)
 312         (let* () ;; (linestring (thing-at-point 'line))
 313           (beginning-of-line)
 314           (forward-char 89) ;; get the POS field
 315           (setq datachunk (thing-at-point 'word))
 316           (with-current-buffer "Standings"
 317             (insert (format "%s" datachunk))
 318             (insert-char ?\s (- 3 (length datachunk)))
 319             (insert " "))
 320           (setq datachunk (substring-no-properties (thing-at-point 'line) 14 47)) ;; get name
 321           (with-current-buffer "Standings"
 322             (insert (format "%s " datachunk))
 323             (insert-char ?\s (- 33 (length datachunk))))
 324           (beginning-of-line)
 325           (forward-char 68)
 326           (setq datachunk (thing-at-point 'word)) ;; get idfide
 327           (with-current-buffer "Standings"
 328             (insert (format "%s " datachunk))
 329             (insert-char ?\s (- 10 (length datachunk))))
 330           (setq datachunk (substring-no-properties (thing-at-point 'line) 80 84)) ;; get points
 331           (with-current-buffer "Standings"
 332             (insert (format "%s " datachunk))
 333             (insert-char ?\s (- 4 (length datachunk))))
 334           (with-current-buffer "Standings"
 335             (insert "\n")
 336             (sort-columns 1 49 (- (point-max) 1))))))
 337     (let ((newpos 0)
 338           (idfide ""))
 339       (goto-char (point-min))
 340       (while (re-search-forward "^001" nil t)
 341         (beginning-of-line)
 342         (forward-char 68)
 343         (setq idfide (thing-at-point 'word))
 344         (with-current-buffer "Standings"
 345           (goto-char (point-min))
 346           (search-forward idfide nil t)
 347           (setq newpos (line-number-at-pos))) ;; the POS is in the beginning of the line in Standings
 348         (with-current-buffer "Arbitools-output"
 349           (insert (format "%s" newpos))
 350           (insert "\n"))
 351         (beginning-of-line)
 352         (forward-char 89) ;; go to POS field
 353         (forward-char -3)
 354         (delete-char 3)
 355         (insert-char ?\s (- 3 (length (format "%s" newpos))))
 356         (insert (format "%s" newpos))))))
 357
 358 (defun arbitools-delete-player (player)
 359    "Delete a player. Adjust all the rank numbers accordingly."
 360    (interactive "splayer: ")
 361    (let ((numberofrounds 0)
 362          (elo            ""))
 363
 364     (save-excursion
 365       (goto-char (point-min))
 366       (re-search-forward "^132" nil t)
 367         (let* ((linestringrounds   (thing-at-point 'line))
 368                ;; (actualround        " ")
 369                (beginning-of-round 91)
 370                (end-of-round       99)
 371                (continue           t))
 372            (while continue
 373              (if (< end-of-round (length linestringrounds))
 374                (progn
 375                   ;; (setq actualround (substring-no-properties linestringrounds beginning-of-round end-of-round))
 376                   (setq numberofrounds (+ numberofrounds 1))
 377                   (setq beginning-of-round (+ beginning-of-round 10))
 378                   (setq end-of-round (+ end-of-round 10)))
 379                (setq continue nil)))))
 380     (save-excursion
 381      (goto-char (point-min))
 382      (while (re-search-forward "^001" nil t)
 383        (let* ((linestring (thing-at-point 'line))
 384               (rankstring (substring linestring 5 8)))
 385          (when (= (string-to-number rankstring) (string-to-number player))
 386            (forward-char 1)
 387            (delete-char 4)
 388            (insert " DEL")
 389            (setq elo (substring linestring 48 52))
 390            (with-current-buffer "Arbitools-output" (insert (format "%s" elo))))
 391          (when (> (string-to-number rankstring)(string-to-number player))
 392            (forward-char 1)
 393            (delete-char 4)
 394            (insert-char ?\s (- 4 (length (format "%s" (- (string-to-number rankstring) 1)))))
 395            (insert (format "%s" (- (string-to-number rankstring) 1)))
 396            (save-excursion
 397              (goto-char (point-min))
 398              (while (re-search-forward "^001" nil t)
 399                (let* ((roundcount          1))
 400                   (while (<= roundcount numberofrounds)
 401                     (beginning-of-line)
 402                     (forward-char (+ 95 (* (- roundcount 1) 10)))
 403                     (when (string= (format "%s" (string-to-number rankstring)) (thing-at-point 'word))
 404                       (forward-char -4) ;; go back to the beginning of the opponent's number
 405                       (delete-char 4) ;; remove the original opponent's number
 406                       (insert-char ?\s (- 4 (length (format "%s" (- (string-to-number rankstring) 1)))))
 407                       (insert (format "%s" (- (string-to-number rankstring) 1))))
 408                     (setq roundcount (+ roundcount 1))))
 409                ;;(condition-case nil ;; TODO: fix teams info
 410                  (save-excursion
 411                    (while (re-search-forward "^013" nil t)
 412                     (let* ((linestringteam (thing-at-point 'line))
 413                           (integrantcount 0)
 414                           (members 0))
 415
 416                         ;; to find the end of the line, the number is length -2, for some reason
 417                         (setq members (/ (- (- (length linestringteam) 2) 34) 5)) ;; calculate number of members
 418
 419                       (while (< integrantcount members)
 420                        (beginning-of-line)
 421                        (forward-char (+ 40 (* (- integrantcount 1) 5)))
 422                        (when (string= (format "%s" (string-to-number rankstring)) (thing-at-point 'word))
 423                          (forward-char -4)
 424                          (delete-char 4)
 425                          (insert-char ?\s (- 4 (length (format "%s" (- (string-to-number rankstring) 1)))))
 426                          (insert (format "%s" (- (string-to-number rankstring) 1))))
 427                        (setq integrantcount (+ integrantcount 1))))))))))))
 428
 429      (save-excursion  ;; Actually delete the player's line
 430        (goto-char (point-min))
 431        (while (re-search-forward "^001  DEL" nil t)
 432          (beginning-of-line)
 433          (let ((beg (point)))
 434            (forward-line 1)
 435            (delete-region beg (point)))))
 436      ;; TODO delete the rank from teams section
 437      ;; TODO change number of players and number of rated players
 438      (save-excursion
 439        (with-current-buffer "Arbitools-output" (insert (format "%s" elo)))
 440        (goto-char (point-min))
 441        (re-search-forward "^062 ")
 442        (let* ((linestring      (thing-at-point 'line))
 443               (numberofplayers (substring linestring 4)))
 444         (delete-char (length numberofplayers))
 445         (setq numberofplayers (string-to-number numberofplayers))
 446         (setq numberofplayers (- numberofplayers 1))
 447         (insert (concat (number-to-string numberofplayers) "\n")))
 448        (re-search-forward "^072 ")
 449        (let* ((linestring           (thing-at-point 'line))
 450               (numberofratedplayers (substring linestring 4)))
 451         (unless (< (length elo) 2) ;; if elo is 0 or nonexistent
 452           (delete-char (length numberofratedplayers))
 453           (setq numberofratedplayers (string-to-number numberofratedplayers))
 454           (setq numberofratedplayers (- numberofratedplayers 1))
 455           (insert (concat (number-to-string numberofratedplayers) "\n")))))))
 456
 457 (defun arbitools-delete-round (round)
 458    "Delete a round." ;; FIXME: it breaks when round is the last
 459    (interactive "sround: ")
 460    (save-excursion
 461     (goto-char (point-min))
 462     (while (re-search-forward "^001" nil t)
 463      (forward-char (+ 88 (* (- (string-to-number round) 1) 10)))
 464      (delete-char 8)
 465      (insert "        "))))
 466
 467 (defun arbitools-replace-empty ()
 468    "Replace non played games with spaces"
 469    (interactive)
 470    (save-excursion
 471     (goto-char (point-min))
 472     (while (search-forward "0000 - 0" nil t)
 473       (replace-match "        "))))
 474
 475 (defun arbitools-insert-player (sex title name elo fed idfide year)
 476    "Insert a player"
 477    ;; TODO: automatically insert the player in a team
 478    (interactive "ssex: \nstitle: \nsname: \nselo: \nsfed: \nsidfide: \nsyear: ")
 479   (let ((playerlinelength nil)
 480         (thislinelength nil))
 481      (save-excursion
 482        (goto-char (point-min))
 483        (re-search-forward "^001 ")
 484        (let* ((linestring (thing-at-point 'line)))
 485          (setq playerlinelength (length linestring))))
 486      (save-excursion
 487        (goto-char (point-min))
 488        (while (re-search-forward "^001" nil t))
 489        (let* ((linestring (thing-at-point 'line))
 490               (rankstring (substring linestring 5 8)))
 491
 492          (forward-line 1)
 493          (insert "\n")
 494          (forward-char -1)
 495          (insert (format "001 "))
 496          (insert-char ?\s (- 4 (length (format "%s" (+ (string-to-number rankstring) 1)))))
 497          (insert (format "%s" (+ (string-to-number rankstring) 1)))
 498          (insert (format " %s" sex))
 499          (when (= (length sex) 0) (insert " ")) ;; add extra space if the sex string is empty
 500          (insert-char ?\s (- 3 (length title)))
 501          (insert (format "%s " title))
 502          (insert (format "%s" name))
 503          (insert-char ?\s (- 34 (length name)))
 504          (when (= (length elo) 4) (insert (format "%s " elo)))
 505          (when (= (length elo) 0) (insert "     ")) ;; add extra space if the elo is empty
 506          (when (= (length elo) 1) (insert "   0 ")) ;; add extra space if the elo is a "0"
 507          (insert (format "%s" fed))
 508          (when (= (length fed) 0) (insert "   ")) ;; add extra space if fed is empty
 509          (insert-char ?\s (- 12 (length idfide)))
 510          (insert (format "%s " idfide))
 511          (insert (format "%s      " year))
 512          (when (= (length year) 0) (insert "    ")) ;; TODO: improve this to make it support different data formats
 513          (insert (format "  0.0 "))
 514          (insert-char ?\s (- 4 (length (format "%s" (+ (string-to-number rankstring) 1)))))
 515          (insert (format "%s" (+ (string-to-number rankstring) 1)))
 516          (setq thislinelength (length (thing-at-point 'line)))
 517          (insert-char ?\s (- playerlinelength thislinelength)))))
 518   (save-excursion
 519     (goto-char (point-min))
 520     (re-search-forward "^062 ")
 521     (let* ((linestring (thing-at-point 'line))
 522            (numberofplayers (substring linestring 4)))
 523       (delete-char (length numberofplayers))
 524       (setq numberofplayers (string-to-number numberofplayers))
 525       (setq numberofplayers (+ 1 numberofplayers))
 526       (insert (concat (number-to-string numberofplayers) "\n")))
 527     (re-search-forward "^072 ")
 528     (let* ((linestring (thing-at-point 'line))
 529         (numberofratedplayers (substring linestring 4)))
 530       (unless (< (length elo) 2)
 531         (delete-char (length numberofratedplayers))
 532         (setq numberofratedplayers (string-to-number numberofratedplayers))
 533         (setq numberofratedplayers (+ 1 numberofratedplayers))
 534         (insert (concat (number-to-string numberofratedplayers) "\n"))))))
 535
 536 (defun arbitools-insert-result (round white black result)
 537    "Insert a result."
 538    (interactive "sround: \nswhite: \nsblack: \nsresult: ")
 539    (save-excursion
 540      (goto-char (point-min))
 541      (while (re-search-forward "^001" nil t)
 542        (forward-char 4) ;; rank number
 543        (when (string= white (thing-at-point 'word))
 544          ;;go to first round taking into account the cursor is in the rank number
 545          (forward-char (+ 85 (* (- (string-to-number round) 1) 10)))
 546          (insert "  ") ;; replace the first positions with spaces
 547          (delete-char 2) ;; delete the former characters
 548          ;; make room for bigger numbers
 549          (cond ((= 2 (length black))
 550            (backward-char 1))
 551            ((= 3 (length black))
 552            (backward-char 2)))
 553          (insert (format "%s w %s" black result))
 554          (delete-char 5)
 555          ;; adjust when numbers are longer
 556          (cond ((= 2 (length black)) (delete-char 1))
 557            ((= 3 (length black)) (delete-char 2))))
 558        (when (string= black (thing-at-point 'word))
 559          ;; go to first round taking into account the cursor is in the rank number
 560          (forward-char (+ 85 (* (- (string-to-number round) 1) 10)))
 561          (insert "  ") ;; replace the first positions with spaces
 562          (delete-char 2) ;; delete the former characters
 563          ;; make room for bigger numbers
 564          (cond ((= 2 (length white)) (backward-char 1))
 565            ((= 3 (length white)) (backward-char 2)))
 566          (cond ((string= "1" result) (insert (format "%s b 0" white)))
 567            ((string= "=" result) (insert (format "%s b =" white)))
 568            ((string= "+" result) (insert (format "%s b +" white)))
 569            ((string= "-" result) (insert (format "%s b -" white)))
 570            ((string= "0" result) (insert (format "%s b 1" white))))
 571          (delete-char 5)
 572          ;; adjust when numbers are longer
 573          (cond ((= 2 (length white)) (delete-char 1))
 574            ((= 3 (length white)) (delete-char 2)))))))
 575
 576 (defun arbitools-it3 ()
 577    "Get the IT3 tournament report. You will get a .tex file, and a pdf
 578     if you have pdflatex installed."
 579    (interactive)
 580    (call-process "arbitools-run.py" nil "Arbitools-output" nil "it3" buffer-file-name))
 581
 582 ;; TODO: New It3 function, usint it3.tex from home directory, replacing the data and pdflatex it
 583
 584 (defun arbitools-fedarating ()
 585    "Get the FEDA rating admin file."
 586    (interactive)
 587    (call-process "arbitools-run.py" nil "Arbitools-output" nil "fedarating" buffer-file-name))
 588
 589 (defvar arbitools-mode-map
 590   (let ((map (make-sparse-keymap)))
 591     (define-key map (kbd "C-c i") 'arbitools-it3)
 592     (define-key map (kbd "C-c r") 'arbitools-insert-result)
 593     (define-key map (kbd "C-c p") 'arbitools-insert-player)
 594     map)
 595   "Keymap for Arbitools major mode.")
 596
 597
 598 (easy-menu-define arbitools-mode-menu arbitools-mode-map
 599   "Menu for Arbitools mode"
 600   '("Arbitools"
 601     ["New Tournament" arbitools-new-trf]
 602     "---"
 603     ["Insert Player" arbitools-insert-player]
 604     ["Delete Player" arbitools-delete-player]
 605     ["Insert Result" arbitools-insert-result]
 606     ["Delete Round" arbitools-delete-round]
 607     "---"
 608     ["List Players" arbitools-list-players]
 609     ["List Pairings" arbitools-list-pairing]
 610     "---"
 611     ["Update Elo" arbitools-update]
 612     ["Get It3 form Report" arbitools-it3]
 613     ["Get FEDA Rating file" arbitools-fedarating]
 614     "---"
 615     ["Prepare for FEDA" arbitools-prepare-feda]
 616     ))
 617
 618
 619 (defvar arbitools-highlights
 620  '(("^001" . font-lock-function-name-face) ; name of the tournament
 621     ("^012.*" . font-lock-comment-face)
 622     ("\\(^022\\|^032\\|^042\\|^052\\|^062\\|^072\\|^082\\|^092\\|^102\\|^112\\|^122\\).*" . font-lock-constant-face)
 623     ("^132.*" . font-lock-warning-face) ;dates
 624     ("^013" . font-lock-warning-face) ;teams
 625     ("\\(^013.\\{1\\}\\)\\(.\\{31\\}\\)" 2 font-lock-comment-face) ;; teams
 626     ;; (" [0-9]\\{6,\\} " . font-lock-variable-name-face) ;FIDE ID
 627     ("\\(^001.\\{11\\}\\)\\(.\\{32\\}\\)" 2 font-lock-string-face)  ;; Name of the player (by position)
 628     ("\\(^001.\\{55\\}\\)\\(.\\{10\\}\\)" 2 font-lock-function-name-face) ;; FIDE ID
 629     ("\\(^001.\\{88\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face) ;; round 1 opponent
 630     ;; ("\\(^132.\\{88\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face) ;; round 1 date line
 631     ("\\(^001.\\{93\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face) ;; round 1 colour
 632     ("\\(^001.\\{95\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face) ;; round 1 result
 633     ;; rest of rounds
 634     ("\\(^001.\\{98\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face)
 635     ;; ("\\(^132.\\{98\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face)
 636     ("\\(^001.\\{103\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face)
 637     ("\\(^001.\\{105\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face)
 638     ("\\(^001.\\{108\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face)
 639     ;; ("\\(^132.\\{108\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face)
 640     ("\\(^001.\\{113\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face)
 641     ("\\(^001.\\{115\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face)
 642     ("\\(^001.\\{118\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face)
 643     ;; ("\\(^132.\\{118\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face)
 644     ("\\(^001.\\{123\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face)
 645     ("\\(^001.\\{125\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face)
 646     ("\\(^001.\\{128\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face)
 647     ;; ("\\(^132.\\{128\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face)
 648     ("\\(^001.\\{133\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face)
 649     ("\\(^001.\\{135\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face)
 650     ("\\(^001.\\{138\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face)
 651     ;; ("\\(^132.\\{138\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face)
 652     ("\\(^001.\\{143\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face)
 653     ("\\(^001.\\{145\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face)
 654     ("\\(^001.\\{148\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face)
 655     ;; ("\\(^132.\\{148\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face)
 656     ("\\(^001.\\{153\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face)
 657     ("\\(^001.\\{155\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face)
 658     ("\\(^001.\\{158\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face)
 659     ;; ("\\(^132.\\{158\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face)
 660     ("\\(^001.\\{163\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face)
 661     ("\\(^001.\\{165\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face)
 662     ("\\(^001.\\{168\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face)
 663     ;; ("\\(^132.\\{168\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face)
 664     ("\\(^001.\\{173\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face)
 665     ("\\(^001.\\{175\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face)
 666     ("\\(^001.\\{178\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face)
 667     ;; ("\\(^132.\\{178\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face)
 668     ("\\(^001.\\{183\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face)
 669     ("\\(^001.\\{185\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face)
 670     ("\\(^001.\\{188\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face)
 671     ;; ("\\(^132.\\{188\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face)
 672     ("\\(^001.\\{193\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face)
 673     ("\\(^001.\\{195\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face)
 674     ("\\(^001.\\{198\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face)
 675     ;; ("\\(^132.\\{198\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face)
 676     ("\\(^001.\\{203\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face)
 677     ("\\(^001.\\{205\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face)))
 678
 679 ;;;###autoload
 680 (define-derived-mode arbitools-mode
 681   fundamental-mode
 682   "Arbitools"
 683   "Major mode for Chess Tournament Management."
 684   ;(setq font-lock-defaults '(arbitools-highlights))
 685   (use-local-map arbitools-mode-map)
 686   (generate-new-buffer "Arbitools-output")
 687   (generate-new-buffer "List of players")
 688   (generate-new-buffer "Pairings List")
 689   (generate-new-buffer "Standings")
 690   (column-number-mode)
 691   (set (make-local-variable 'font-lock-defaults) '(arbitools-highlights)))
 692
 693 ;;;###autoload
 694 (add-to-list 'auto-mode-alist '("\\.trf?\\'" . arbitools-mode))
 695
 696 (provide 'arbitools)
 697
 698 ;;; arbitools.el ends here