emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] master cf460aa: packages/arbitools.el: Applied suggestions, impro


From: David Gonzalez Gandara
Subject: [elpa] master cf460aa: packages/arbitools.el: Applied suggestions, improved functions
Date: Sun, 27 Mar 2016 09:02:05 +0000

branch: master
commit cf460aa16706b68f01484dcd4199c4f35dd44b59
Author: David Gonzalez Gandara <address@hidden>
Commit: David Gonzalez Gandara <address@hidden>

    packages/arbitools.el: Applied suggestions, improved functions
---
 packages/arbitools/arbitools.el |  178 ++++++++++++++++++++++----------------
 1 files changed, 103 insertions(+), 75 deletions(-)

diff --git a/packages/arbitools/arbitools.el b/packages/arbitools/arbitools.el
index d365529..0adc5b9 100644
--- a/packages/arbitools/arbitools.el
+++ b/packages/arbitools/arbitools.el
@@ -4,6 +4,7 @@
 
 ;; Author: David Gonzalez Gandara <address@hidden>
 ;; Version: 0.53
+;; Package-Requires: ((cl-lib "0.5"))
 
 ;; This program is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
@@ -89,6 +90,7 @@
 
 ;;; Code:
 
+(eval-when-compile (require 'cl-lib))
 
 (defun arbitools-update (elolist)
   "Update the players ratings in a database file based on a elo list file."
@@ -105,7 +107,7 @@
 (defun arbitools-list-pairing (round)
   "Get the pairings and/or results of the given round"
   (interactive "sround: ")
-  (beginning-of-buffer)
+  (goto-char (point-min))
   (arbitools-list-players)
   (save-excursion
     (re-search-forward "^012" nil t)
@@ -123,6 +125,7 @@
              (linestring (thing-at-point 'line))
              (playerlinestring nil)
              (opponentlinestring nil)
+             opponentstring
              (rankstring (substring linestring 4 8))
              (opponent (substring linestring (+ 91 (* (- (string-to-number 
round) 1)10 )) 
                        (+ 95(* (- (string-to-number round) 1)10 ))))
@@ -136,18 +139,18 @@
            (insert (format "%s\n" (member "   1" paired))))
          (unless (or (member rankstring paired) (member opponent paired))
            (with-current-buffer "List of players"
-               (beginning-of-buffer)
+               (goto-char (point-min))
                (re-search-forward (concat "^" (regexp-quote  rankstring)))
                (setq playerlinestring (thing-at-point 'line))
                (setq namestring (substring playerlinestring 4 37))
-               (beginning-of-buffer)
+               (goto-char (point-min))
                (unless (or (string= opponent "0000") (string= opponent "    "))
                    (re-search-forward (concat "^" (regexp-quote opponent))))
                (setq opponentlinestring (thing-at-point 'line))
                (setq opponentstring (substring opponentlinestring 4 37))
                (when (or (string= opponent "0000")(string= opponent "    "))
                  (setq opponentstring "-"))
-               (add-to-list 'paired rankstring))
+               (cl-pushnew rankstring paired :test #'equal))
            (with-current-buffer "Pairings List"
              (cond ((string= color "w") ;; TODO: change the ranknumber with 
the name
                      (cond ((string= result "1")
@@ -184,7 +187,7 @@
   ;; TODO: the beautiful LaTeX
   (interactive)
   (save-excursion
-   (beginning-of-buffer)
+   (goto-char (point-min))
    (while (re-search-forward "^001" nil t)
      (let* ((linestring (thing-at-point 'line))
            (rankstring (substring linestring 5 8)))
@@ -192,8 +195,7 @@
        (with-current-buffer "List of players"
          (insert (format " %s " rankstring))))
 
-     (let* ((name (thing-at-point 'word))
-           (linestring (thing-at-point 'line))
+     (let* ((linestring (thing-at-point 'line))
            (namestring (substring linestring 14 47)))
        
        (with-current-buffer "List of players"
@@ -231,33 +233,33 @@
   ;; (insert "013 NNNNNNNNNNNNNNNNNNNNNNNNNNNNNNN  0000 0000\n")
 )
 
-(defun aribitools-number-of-rounds ()
-   "Get the number of rounds in the tournament"
+;; (defun aribitools-number-of-rounds ()
+;;   "Get the number of rounds in the tournament"
    ;; FIXME: EXPERIMENTAL
-   (let ((numberofrounds 0))
-     (save-excursion
-      (beginning-of-buffer)
-      (re-search-forward "^132" nil t)
-        (let* ((linestringrounds (thing-at-point 'line))
-            (actualround " ")
-            (beginning-of-round 91)
-            (end-of-round 99)
-            (continue t))
+;;   (let ((numberofrounds 0))
+;;     (save-excursion
+;;      (goto-char (point-min))
+;;      (re-search-forward "^132" nil t)
+;;        (let* ((linestringrounds (thing-at-point 'line))
+            ;; (actualround " ")
+;;            (beginning-of-round 91)
+;;            (end-of-round 99)
+;;            (continue t))
                     
-           (with-current-buffer "Arbitools-output" (insert (format "rounds: 
%s" linestringrounds)))
-           (with-current-buffer "Arbitools-output" (insert (format "length: 
%s" (- (length linestringrounds) 4))))
+           ;; (with-current-buffer "Arbitools-output" (insert (format "rounds: 
%s" linestringrounds)))
+           ;; (with-current-buffer "Arbitools-output" (insert (format "length: 
%s" (- (length linestringrounds) 4))))
            ;; For some reason, the length of the string is 4 characters longer 
than the real line
-           (while continue
-             (if (< end-of-round (length linestringrounds))
+;;           (while continue
+;;             (if (< end-of-round (length linestringrounds))
                 
-               (progn
-                  (setq actualround (substring-no-properties linestringrounds 
beginning-of-round end-of-round))
-                  (setq numberofrounds (+ numberofrounds 1))
-                  (setq beginning-of-round (+ beginning-of-round 10))
-                  (setq end-of-round (+ end-of-round 10)))
+;;               (progn
+                  ;; (setq actualround (substring-no-properties 
linestringrounds beginning-of-round end-of-round))
+;;                  (setq numberofrounds (+ numberofrounds 1))
+;;                  (setq beginning-of-round (+ beginning-of-round 10))
+;;                  (setq end-of-round (+ end-of-round 10)))
                   
-                  (setq continue nil))))))
-     (numberofrounds))
+;;                  (setq continue nil))))))
+;;     (numberofrounds))
 
 (defun arbitools-delete-player (player)
    "Delete a player. Adjust all the rank numbers accordingly."
@@ -266,23 +268,23 @@
          (elo            ""))
     
     (save-excursion
-      (beginning-of-buffer)
+      (goto-char (point-min))
       (re-search-forward "^132" nil t)
         (let* ((linestringrounds   (thing-at-point 'line))
-               (actualround        " ")
+               ;; (actualround        " ")
                (beginning-of-round 91)
                (end-of-round       99)
                (continue           t))
            (while continue
              (if (< end-of-round (length linestringrounds))
                (progn
-                  (setq actualround (substring-no-properties linestringrounds 
beginning-of-round end-of-round))
+                  ;; (setq actualround (substring-no-properties 
linestringrounds beginning-of-round end-of-round))
                   (setq numberofrounds (+ numberofrounds 1))
                   (setq beginning-of-round (+ beginning-of-round 10))
                   (setq end-of-round (+ end-of-round 10)))   
                (setq continue nil)))))
     (save-excursion
-     (beginning-of-buffer)
+     (goto-char (point-min))
      (while (re-search-forward "^001" nil t)
        (let* ((linestring (thing-at-point 'line))
               (rankstring (substring linestring 5 8)))
@@ -298,15 +300,10 @@
            (insert-char ?\s (- 4 (length (format "%s" (- (string-to-number 
rankstring) 1)))))
            (insert (format "%s" (- (string-to-number rankstring) 1)))
            (save-excursion
-             (beginning-of-buffer)
+             (goto-char (point-min))
              (while (re-search-forward "^001" nil t)
-               (let* ((linestring2         (thing-at-point 'line))
-                      (actualroundopponent (string-to-number (substring 
linestring2 91 94)))
-                      (roundcount          1)
-                      (testmessage         ""))
-                  (forward-char (+ 91 (* (- roundcount 1) 10)))
-                  (setq testmessage (thing-at-point 'word))
-                  (while (< roundcount numberofrounds)
+               (let* ((roundcount          1))
+                  (while (<= roundcount numberofrounds)
                     (beginning-of-line)
                     (forward-char (+ 95 (* (- roundcount 1) 10)))
                     (when (string= (format "%s" (string-to-number rankstring)) 
(thing-at-point 'word))
@@ -314,16 +311,30 @@
                       (delete-char 4) ;; remove the original opponent's number
                       (insert-char ?\s (- 4 (length (format "%s" (- 
(string-to-number rankstring) 1)))))
                       (insert (format "%s" (- (string-to-number rankstring) 
1))))
-                    (setq roundcount (+ roundcount 1))))))))))
-     ;;(condition-case nil ;; TODO: fix teams info
-             ;;  (while (re-search-forward "^013")
-             ;;    (let* ((linestringteam (thing-at-point 'line)))
-             ;;      ;; go through team line and read the integrants
-             ;;      ;; when integrant equals rankstring rankstring -1
-             ;;    ))
-             ;;  (error "No teams information"))
+                    (setq roundcount (+ roundcount 1))))
+               ;;(condition-case nil ;; TODO: fix teams info
+                 (save-excursion 
+                   (while (re-search-forward "^013" nil t)
+                    (let* ((linestringteam (thing-at-point 'line))
+                          (actualintegrant (string-to-number (substring 
linestringteam 40 44)))
+                          (integrantcount 0)
+                          (members 0))
+
+                        ;; to find the end of the line, the number is length 
-2, for some reason
+                        (setq members (/ (- (- (length linestringteam) 2) 34) 
5)) ;; calculate number of members
+
+                      (while (< integrantcount members)
+                       (beginning-of-line)
+                       (forward-char (+ 40 (* (- integrantcount 1) 5)))
+                       (when (string= (format "%s" (string-to-number 
rankstring)) (thing-at-point 'word))
+                         (forward-char -4)
+                         (delete-char 4)
+                         (insert-char ?\s (- 4 (length (format "%s" (- 
(string-to-number rankstring) 1)))))
+                         (insert (format "%s" (- (string-to-number rankstring) 
1))))
+                       (setq integrantcount (+ integrantcount 1))))))))))))
+             
      (save-excursion  ;; Actually delete the player's line
-       (beginning-of-buffer)
+       (goto-char (point-min))
        (while (re-search-forward "^001  DEL" nil t)
          (beginning-of-line)
          (let ((beg (point)))
@@ -333,7 +344,7 @@
      ;; TODO change number of players and number of rated players
      (save-excursion
        (with-current-buffer "Arbitools-output" (insert (format "%s" elo)))
-       (beginning-of-buffer)
+       (goto-char (point-min))
        (re-search-forward "^062 ")
        (let* ((linestring      (thing-at-point 'line))
               (numberofplayers (substring linestring 4))) 
@@ -354,7 +365,7 @@
    "Delete a round." ;; FIXME: it breaks when round is the last
    (interactive "sround: ")
    (save-excursion
-    (beginning-of-buffer)
+    (goto-char (point-min))
     (while (re-search-forward "^001" nil t)
      (forward-char (+ 88 (* (- (string-to-number round) 1) 10)))
      (delete-char 10)
@@ -364,39 +375,55 @@
    "Replace non played games with spaces"
    (interactive)
    (save-excursion
-    (replace-string "0000 - 0" "        ")))
+    (goto-char (point-min))
+    (while (search-forward "0000 - 0" nil t)
+      (replace-match "        "))))
 
 (defun arbitools-insert-player (sex title name elo fed idfide year)
    "Insert a player"
-   ;; TODO: automatically insert the rank.
+   ;; TODO: automatically insert the player in a team
    (interactive "ssex: \nstitle: \nsname: \nselo: \nsfed: \nsidfide: \nsyear: 
")
   (let ((playerlinelength nil)
         (thislinelength nil)) 
      (save-excursion
-       (beginning-of-buffer)
+       (goto-char (point-min))
        (re-search-forward "^001 ")
        (let* ((linestring (thing-at-point 'line))) 
          (setq playerlinelength (length linestring))))
-     (insert (format "001 RANK %s" sex))
-     (when (= (length sex) 0) (insert " ")) ;; add extra space if the sex 
string is empty
-     (insert-char ?\s (- 3 (length title)))
-     (insert (format "%s " title))
-     (insert (format "%s" name))
-     (insert-char ?\s (- 34 (length name)))
-     (insert (format "%s " elo))
-     (when (= (length elo) 0) (insert "    ")) ;; add extra space if the elo 
is empty
-     (when (= (length elo) 1) (insert "   ")) ;; add extra space if the elo is 
a "0"
-     (insert (format "%s" fed))
-     (when (= (length fed) 0) (insert "   ")) ;; add extra space if fed is 
empty
-     (insert-char ?\s (- 12 (length idfide)))
-     (insert (format "%s " idfide))
-     (insert (format "%s      " year))
-     (when (= (length year) 0) (insert "    ")) ;; TODO: improve this to make 
it support different data formats
-     (insert (format "  0.0  POS"))
-     (setq thislinelength (length (thing-at-point 'line)))
-     (insert-char ?\s (- playerlinelength thislinelength)))   
+     (save-excursion
+       (goto-char (point-min))
+       (while (re-search-forward "^001" nil t))
+       (let* ((linestring (thing-at-point 'line))
+              (rankstring (substring linestring 5 8)))
+
+         (forward-line 1)
+         (insert "\n")
+         (forward-char -1)
+         (insert (format "001 "))
+         (insert-char ?\s (- 4 (length (format "%s" (+ (string-to-number 
rankstring) 1)))))
+         (insert (format "%s" (+ (string-to-number rankstring) 1)))
+         (insert (format " %s" sex))
+         (when (= (length sex) 0) (insert " ")) ;; add extra space if the sex 
string is empty
+         (insert-char ?\s (- 3 (length title)))
+         (insert (format "%s " title))
+         (insert (format "%s" name))
+         (insert-char ?\s (- 34 (length name)))
+         (insert (format "%s " elo))
+         (when (= (length elo) 0) (insert "    ")) ;; add extra space if the 
elo is empty
+         (when (= (length elo) 1) (insert "   ")) ;; add extra space if the 
elo is a "0"
+         (insert (format "%s" fed))
+         (when (= (length fed) 0) (insert "   ")) ;; add extra space if fed is 
empty
+         (insert-char ?\s (- 12 (length idfide)))
+         (insert (format "%s " idfide))
+         (insert (format "%s      " year))
+         (when (= (length year) 0) (insert "    ")) ;; TODO: improve this to 
make it support different data formats
+         (insert (format "  0.0 "))
+         (insert-char ?\s (- 4 (length (format "%s" (+ (string-to-number 
rankstring) 1)))))
+         (insert (format "%s" (+ (string-to-number rankstring) 1)))
+         (setq thislinelength (length (thing-at-point 'line)))
+         (insert-char ?\s (- playerlinelength thislinelength)))))   
   (save-excursion
-    (beginning-of-buffer)
+    (goto-char (point-min))
     (re-search-forward "^062 ")
     (let* ((linestring (thing-at-point 'line))
            (numberofplayers (substring linestring 4))) 
@@ -417,7 +444,7 @@
    "Insert a result."
    (interactive "sround: \nswhite: \nsblack: \nsresult: ")
    (save-excursion
-     (beginning-of-buffer)
+     (goto-char (point-min))
      (while (re-search-forward "^001" nil t)
        (forward-char 4) ;; rank number
        (when (string= white (thing-at-point 'word))
@@ -481,6 +508,7 @@
     ["New Tournament" arbitools-new-trf]
     "---"
     ["Insert Player" arbitools-insert-player]
+    ["Delete Player" arbitools-delete-player]
     ["Insert Result" arbitools-insert-result]
     ["Delete Round" arbitools-delete-round]
     "---"



reply via email to

[Prev in Thread] Current Thread [Next in Thread]