Merge pull request #6 from emacs-languagetool/upgrade

Add upgrade LS command

README.md

@@ -24,6 +24,12 @@
                        (lsp))))  ; or lsp-deferred
 ```
 
+## :card_index: Commands
+
+| Commands            | Description                                           |
+|:--------------------|:------------------------------------------------------|
+| lsp-ltex-upgrade-ls | Upgrade LTEX server, if not found install it instead. |
+
 ## :wrench: Configuration
 
 `lsp-ltex` supports following configuration. Each configuration is described in

github-tags.el

@@ -0,0 +1,93 @@
+;;; github-tags.el --- Retrieve tags information through GitHub API  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021  Shen, Jen-Chieh
+;; Created date 2021-08-08 16:14:37
+
+;; Author: Shen, Jen-Chieh <[email protected]>
+;; Description: Retrieve tags information through GitHub API
+;; Keyword: github tags
+;; Version: 0.1.0
+;; Package-Requires: ((emacs "24.3"))
+;; URL: https://github.com/jcs-elpa/github-tags
+
+;; This file is NOT part of GNU Emacs.
+
+;; 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
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program 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 this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Retrieve tags information through GitHub API
+;;
+
+;;; Code:
+
+(require 'json)
+(require 'url)
+
+(defgroup github-tags nil
+  "Retrieve tags information through GitHub API."
+  :prefix "github-tags-"
+  :group 'tool
+  :link '(url-link :tag "Repository" "https://github.com/jcs-elpa/github-tags"))
+
+(defconst github-tags-api "https://api.github.com/repos/%s/tags"
+  "API url to GitHub tags.")
+
+(defvar url-http-end-of-headers)
+
+(defvar github-tags-names nil)
+(defvar github-tags-zipball-urls nil)
+(defvar github-tags-tarball-urls nil)
+(defvar github-tags-commits nil)
+(defvar github-tags-node-ids nil)
+
+(defun github-tags--url-to-json (url)
+  "Get data by URL and convert it to JSON."
+  (with-current-buffer (url-retrieve-synchronously url)
+    (set-buffer-multibyte t)
+    (goto-char url-http-end-of-headers)
+    (prog1 (let ((json-array-type 'list)) (json-read))
+      (kill-buffer))))
+
+(defun github-tags (path)
+  "Retrive tags data for PATH from GitHub API."
+  (setq github-tags-names nil
+        github-tags-zipball-urls nil
+        github-tags-tarball-urls nil
+        github-tags-commits nil
+        github-tags-node-ids nil)
+  (let* ((url (format github-tags-api path))
+         (data (ignore-errors (github-tags--url-to-json url)))
+         (msg-err (cdr (assoc 'message data))))
+    (when msg-err (user-error "[ERROR] %s, %s" msg-err url))
+    (dolist (tag data)
+      (let ((name (cdr (assoc 'name tag)))
+            (zipball (cdr (assoc 'zipball_url tag)))
+            (tarball (cdr (assoc 'tarball_url tag)))
+            (commit (cdr (assoc 'commit tag)))
+            (nodeId (cdr (assoc 'node_id tag))))
+        (push name github-tags-names)
+        (push zipball github-tags-zipball-urls)
+        (push tarball github-tags-tarball-urls)
+        (push commit github-tags-commits)
+        (push nodeId github-tags-node-ids)))
+    (setq github-tags-names (reverse github-tags-names)
+          github-tags-zipball-urls (reverse github-tags-zipball-urls)
+          github-tags-tarball-urls (reverse github-tags-tarball-urls)
+          github-tags-commits (reverse github-tags-commits)
+          github-tags-node-ids (reverse github-tags-node-ids))
+    data))
+
+(provide 'github-tags)
+;;; github-tags.el ends here

lsp-ltex.el

@@ -6,8 +6,8 @@
 ;; Author: Shen, Jen-Chieh <[email protected]>
 ;; Description: LSP Clients for LTEX.
 ;; Keyword: lsp languagetool checker
-;; Version: 0.1.0
-;; Package-Requires: ((emacs "26.1") (lsp-mode "6.1") (f "0.20.0"))
+;; Version: 0.2.0
+;; Package-Requires: ((emacs "26.1") (lsp-mode "6.1") (f "0.20.0") (s "1.12.0"))
 ;; URL: https://github.com/emacs-languagetool/lsp-ltex
 
 ;; This file is NOT part of GNU Emacs.
@@ -32,8 +32,11 @@
 
 ;;; Code:
 
+(require 'subr-x)
 (require 'lsp-mode)
 (require 'f)
+(require 's)
+(require 'github-tags)
 
 (defgroup lsp-ltex nil
   "Settings for the LTEX Language Server.
@@ -56,7 +59,8 @@ https://github.com/valentjn/ltex-ls"
 (defvar lsp-ltex--extension-name nil "File name of the extension file from language server.")
 (defvar lsp-ltex--server-download-url nil "Automatic download url for lsp-ltex.")
 
-(defcustom lsp-ltex-version "12.3.0"
+(defcustom lsp-ltex-version (or (lsp-ltex--current-version)
+                                (lsp-ltex--latest-version))
   "Version of LTEX language server."
   :type 'string
   :set (lambda (symbol value)
@@ -233,12 +237,19 @@ This must be a positive integer."
                  (const "verbose"))
   :group 'lsp-ltex)
 
+;;
+;; (@* "Util" )
+;;
+
 (defun lsp-ltex--execute (cmd &rest args)
   "Return non-nil if CMD executed succesfully with ARGS."
   (save-window-excursion
     (let ((inhibit-message t) (message-log-max nil))
       (= 0 (shell-command (concat cmd " "
                                   (mapconcat #'shell-quote-argument args " ")))))))
+;;
+;; (@* "Installation and Upgrade" )
+;;
 
 (defun lsp-ltex--downloaded-extension-path ()
   "Return full path of the downloaded extension (compressed file).
@@ -252,6 +263,47 @@ This is use to unzip the language server files."
 This is use to active language server and check if language server's existence."
   (f-join lsp-ltex-server-store-path "latest"))
 
+(defun lsp-ltex--current-version ()
+  "Return the current version of LTEX."
+  (when-let* ((gz-files (ignore-errors
+                          (f--files lsp-ltex-server-store-path (equal (f-ext it) "gz"))))
+              (tar (nth 0 gz-files))
+              (fn (f-filename (s-replace ".tar.gz" "" tar))))
+    (s-replace "ltex-ls-" "" fn)))
+
+(defun lsp-ltex--latest-version ()
+  "Return the latest version from remote repository."
+  (github-tags lsp-ltex-repo-path)
+  (let ((index 0) version ver)
+    ;; Loop through tag name and fine the stable version
+    (while (and (not version) (< index (length github-tags-names)))
+      (setq ver (nth index github-tags-names)
+            index (1+ index))
+      (when (string-match-p "^[0-9.]+$" ver)  ; stable version are only with numbers and dot
+        (setq version ver)))
+    version))
+
+(defun lsp-ltex-upgrade-ls ()
+  "Upgrade LTEXT to latest stable version.
+
+If current server not found, install it then."
+  (interactive)
+  (let* ((latest (lsp-ltex--latest-version))
+         (current (lsp-ltex--current-version)))
+    (if (and current (version<= latest current))
+        (message "[INFO] Current LTEX server is up to date: %s" current)
+      (when current
+        ;; First delete all binary files
+        (delete-directory lsp-ltex-server-store-path t))
+      (setq-default lsp-ltex-version latest)
+      (lsp-install-server t 'ltex-ls)  ; this is async
+      (message "[INFO] %s LTEX server version: %s"
+               (if current "Upgrading" "Installing") lsp-ltex-version))))
+
+;;
+;; (@* "Activation" )
+;;
+
 (defun lsp-ltex--server-entry ()
   "Return the server entry file.