|
| 1 | +;;; pacfiles-automerge.el --- Auto-Merging related functions -*- lexical-binding: t; -*- |
| 2 | +;;; Commentary: |
| 3 | +;; Functions to manage the Auto-Merging functions of pacfiles |
| 4 | +;; |
| 5 | +;;; Code: |
| 6 | + |
| 7 | +(require 'pacfiles-utils) |
| 8 | +(require 'pacfiles-win) |
| 9 | + |
| 10 | +(declare-function pacfiles-revert-buffer-no-confirm "pacfiles-mode" ()) |
| 11 | + |
| 12 | +(defvar pacfiles--automerge-alist |
| 13 | + '((:regexp "/etc/pacman\\.d/mirrorlist\\.pacnew$" |
| 14 | + :mergefn #'pacfiles--automerge-mirrorlist))) |
| 15 | + |
| 16 | +;;;###autoload |
| 17 | +(defun pacfiles--automerge-available (update-file) |
| 18 | + "Return the function that knows how to merge UPDATE-FILE if it exists. |
| 19 | +
|
| 20 | +UPDATE-FILE searches for matches in `pacfiles--automerge-alist'. If a match is |
| 21 | +found, return a function, otherwise return nil." |
| 22 | + (let ((case-fold-search nil) ; do not ignore case with `string-match-p' |
| 23 | + (automerge-alist pacfiles--automerge-alist) |
| 24 | + (merge-available nil)) |
| 25 | + (while (and automerge-alist (not merge-available)) |
| 26 | + (when (string-match-p (plist-get (car automerge-alist) :regexp) update-file) |
| 27 | + (setq merge-available (plist-get (car automerge-alist) :mergefn))) |
| 28 | + (setq automerge-alist (cdr automerge-alist))) |
| 29 | + merge-available)) |
| 30 | + |
| 31 | +;; ----------------------------------------------------------------------- |
| 32 | +;; --- Functions that auto-merge the files in `pacfiles--automerge-alist'. |
| 33 | + |
| 34 | +;;;###autoload |
| 35 | +(defun pacfiles--automerge-mirrorlist (base-file update-file) |
| 36 | + "Automatically merge the mirrorlist in BASE-FILE into UPDATE-FILE." |
| 37 | + (let ((base-buffer (find-file-noselect base-file)) |
| 38 | + (update-buffer (find-file-noselect update-file))) |
| 39 | + ;; Check if reflector was used to generate mirrorlist. |
| 40 | + (if (with-current-buffer base-buffer |
| 41 | + (goto-char (point-min)) |
| 42 | + (search-forward "generated by Reflector" nil t)) |
| 43 | + (message "Automerge not possible. Use reflector to recreate the mirrorlist.") |
| 44 | + ;; Do the merging of the mirrorlist. |
| 45 | + (let ((servers (pacfiles--find-mirrorlist-servers base-buffer))) |
| 46 | + (if (not servers) |
| 47 | + ;; No servers selected, copy the update as is |
| 48 | + (progn |
| 49 | + (with-current-buffer (pacfiles--create-mirrorlist-merge-buffer |
| 50 | + update-file update-buffer) |
| 51 | + (save-buffer)) |
| 52 | + (message "There are no mirrorlist servers to merge. Update copied over.")) |
| 53 | + ;; Servers found, use them in a new file |
| 54 | + (pacfiles--merge-mirrorlist-servers servers update-file update-buffer)) |
| 55 | + (pacfiles-revert-buffer-no-confirm))))) |
| 56 | + |
| 57 | +;;;###autoload |
| 58 | +(defun pacfiles--find-mirrorlist-servers (base-buffer) |
| 59 | + "Find the activated servers (i.e., those uncommented) in BASE-BUFFER." |
| 60 | + (let ((servers '())) |
| 61 | + (with-current-buffer base-buffer |
| 62 | + (save-excursion |
| 63 | + (goto-char (point-min)) |
| 64 | + (while (re-search-forward "^\\([^#\n].*\\)\n" nil t) |
| 65 | + (push (match-string 1) servers)))) |
| 66 | + (reverse servers))) |
| 67 | + |
| 68 | +;;;###autoload |
| 69 | +(defun pacfiles--create-mirrorlist-merge-buffer (mirrorlist-update-file update-buffer) |
| 70 | + "Ready up the merge buffer for the mirrorlist. |
| 71 | +
|
| 72 | +The MIRRORLIST-UPDATE-FILE is the path of the original mirrorlist. UPDATE-BUFFER |
| 73 | +is the buffer with the updated mirrorlist. Return the buffer of the merged file." |
| 74 | + (let* ((merge-file |
| 75 | + (pacfiles--set-remote-path-maybe |
| 76 | + (pacfiles--calculate-merge-file mirrorlist-update-file |
| 77 | + pacfiles-merge-file-tmp-location))) |
| 78 | + (merge-buffer (find-file-noselect merge-file t))) |
| 79 | + (with-current-buffer merge-buffer |
| 80 | + (erase-buffer) |
| 81 | + (insert-buffer-substring update-buffer) |
| 82 | + merge-buffer))) |
| 83 | + |
| 84 | +;;;###autoload |
| 85 | +(defun pacfiles--merge-mirrorlist-servers (servers mirrorlist-update-file update-buffer) |
| 86 | + "Automatically merge the mirrorlist update in MIRRORLIST-UPDATE-FILE. |
| 87 | +
|
| 88 | +Merge the uncommented lines in SERVERS that exist in UPDATE-BUFFER." |
| 89 | + (let ((servers-status-alist '())) |
| 90 | + ;; Search for the status of the old servers in the update mirrorlist. |
| 91 | + (with-current-buffer update-buffer |
| 92 | + (save-excursion |
| 93 | + (while servers |
| 94 | + (let ((server (pop servers))) |
| 95 | + (goto-char (point-min)) |
| 96 | + (push `(,server . ,(re-search-forward server nil t)) servers-status-alist))))) |
| 97 | + (setq servers-status-alist (reverse servers-status-alist)) |
| 98 | + ;; Merge the servers into a merge file. |
| 99 | + (with-current-buffer (pacfiles--create-mirrorlist-merge-buffer |
| 100 | + mirrorlist-update-file update-buffer) |
| 101 | + (erase-buffer) |
| 102 | + (insert-buffer-substring update-buffer) |
| 103 | + (goto-char (point-min)) |
| 104 | + ;; Insert the existing servers after the first blank line. |
| 105 | + (if (not (seq-some (lambda (s) (cdr s)) servers-status-alist)) |
| 106 | + (message "No valid servers were found") |
| 107 | + (re-search-forward "^[[:blank:]]*$") |
| 108 | + (open-line 2) |
| 109 | + (forward-line) |
| 110 | + (insert "## pacfiles: Automerged servers\n") |
| 111 | + (insert |
| 112 | + (string-join |
| 113 | + (mapcar #'car (seq-filter (lambda (s) (cdr s)) servers-status-alist)) |
| 114 | + "\n"))) |
| 115 | + ;; Report about non-existing servers after the first blank line. |
| 116 | + (when (seq-some (lambda (s) (not (cdr s))) servers-status-alist) |
| 117 | + (re-search-forward "^[[:blank:]]*$") |
| 118 | + (open-line 2) |
| 119 | + (forward-line) |
| 120 | + (insert "## pacfiles: Servers no longer available\n") |
| 121 | + (insert |
| 122 | + (string-join |
| 123 | + (mapcar (lambda (s) (concat "#" (car s))) |
| 124 | + (seq-remove (lambda (s) (cdr s)) servers-status-alist)) |
| 125 | + "\n"))) |
| 126 | + (save-buffer)))) |
| 127 | + |
| 128 | +(provide 'pacfiles-automerge) |
| 129 | +;;; pacfiles-automerge.el ends here |
0 commit comments