[elpa] externals/hyperbole 1687b112b7 1/3: hypb:installation-type-test - Support all install types

[ELPA Syncer]

branch: externals/hyperbole
commit 1687b112b7d6d329c49cf560dfd20713cb49d240
Author: Bob Weiner <rsw@gnu.org>
Commit: Bob Weiner <rsw@gnu.org>

    hypb:installation-type-test - Support all install types
    
    Rename hypb--installation-type to hypb:installation-type.
---
 ChangeLog          | 10 ++++++++++
 hmail.el           |  4 ++--
 hypb.el            | 57 ++++++++++++++++++++++++++++++++++++++++--------------
 test/hypb-tests.el | 42 +++++++++++++++++++++++++++++++++-------
 4 files changed, 89 insertions(+), 24 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 2aeab08ffa..454786e769 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,15 @@
 2022-02-05  Bob Weiner  <rsw@gnu.org>
 
+* hypb.el (hypb:straight-package-plist): Add and use in tests.
+          (hypb:installation-type): Support all install types.
+  test/hypb-tests.el (hypb:installation-type-test): Support all install types.
+
+* hmail.el (hmail:compose): Clarify subject line use even more.
+  hypb.el (hypb:configuration): Removed unneeded InfoDock clause and use
+    emacs-version variable rather than (emacs-version) function.
+          (hypb--installation-type): Rename to 'hypb:installation-type' and
+    expand to handle all installation types.
+
 * kotl/kexport.el (kexport:buffer): Rename to 'kexport:koutline'.
   test/kexport-tests.el (kexport:buffer-calls-kexport:html): Rename to
     'kexport:koutline-calls-kexport:html'.
diff --git a/hmail.el b/hmail.el
index 993fa7c31d..2ae070aee0 100644
--- a/hmail.el
+++ b/hmail.el
@@ -3,7 +3,7 @@
 ;; Author:       Bob Weiner
 ;;
 ;; Orig-Date:     9-Oct-91 at 18:38:05
-;; Last-Mod:     24-Jan-22 at 00:18:46 by Bob Weiner
+;; Last-Mod:      5-Feb-22 at 17:59:17 by Bob Weiner
 ;;
 ;; Copyright (C) 1991-2021  Free Software Foundation, Inc.
 ;; See the HY-COPY (Hyperbole) or BR-COPY (OO-Browser) file for license
@@ -115,7 +115,7 @@ Optional SUBJECT and HELP message may also be given."
   (interactive "sDeliver e-mail to: \nSubject: ")
   (require 'hactypes) ;; Needed in case EXPR calls hact.
   (unless (or (stringp help) (stringp subject))
-    (setq subject "Be explicit here.  Make a statement or ask a question."))
+    (setq subject "Delete this text but write a detailed subject.  Make a 
statement or ask a question."))
   (hmail:invoke address nil subject)
   (eval expr)
   (when (re-search-backward "^Subject: " nil t)
diff --git a/hypb.el b/hypb.el
index fe1c92ed2c..16233beff0 100644
--- a/hypb.el
+++ b/hypb.el
@@ -3,7 +3,7 @@
 ;; Author:       Bob Weiner
 ;;
 ;; Orig-Date:     6-Oct-91 at 03:42:38
-;; Last-Mod:     28-Jan-22 at 23:49:07 by Mats Lidell
+;; Last-Mod:      5-Feb-22 at 20:53:31 by Bob Weiner
 ;;
 ;; Copyright (C) 1991-2022  Free Software Foundation, Inc.
 ;; See the "HY-COPY" file for license information.
@@ -107,20 +107,43 @@ Global keymap is used unless optional KEYMAP is given."
                "}"))
     (error "(hypb:cmd-key-string): Invalid cmd-sym arg: %s" cmd-sym)))
 
-(defun hypb--installation-type ()
-  "Return type of Hyperbole installation."
-  (let ((hypb-dir-name (file-name-nondirectory (directory-file-name 
hyperb:dir))))
+(defun hypb:installation-type ()
+  "Return a list of (hyperbole-installation-type-string 
hyperbole-install-version-number-string).
+If no matching installation type is found, return a list of (\"unknown\" 
hyperb:dir)."
+  (let ((hypb-dir-name (file-name-nondirectory (directory-file-name 
hyperb:dir)))
+       (dir-sep-string (substring (file-name-as-directory ".") -1)))
     (cond
-     ;; elpa-devel install -- hyperbole-8.0.0pre0.20220126.1138
-     ((string-match "hyperbole-\\([.[:digit:]]+pre[.[:digit:]]+\\).*" 
hypb-dir-name)
+     ;; straight.el package install -- hyperbole gnu-elpa-mirror master 
56cd3d8 2022-02-05
+     ((string-match (concat dir-sep-string "straight" dir-sep-string
+                           "build" dir-sep-string "hyperbole") hyperb:dir)
+      (let* ((plist (hypb:straight-package-plist "hyperbole"))
+            (pkg-version (plist-get plist :version))
+            (git-commit (when (string-match " \\([a-f0-9]+\\) " pkg-version)
+                          (match-string 1 pkg-version))))
+       (list "straight" git-commit)))
+     ;; elpa-devel package install -- hyperbole-8.0.0pre0.20220126.1138
+     ((string-match "hyperbole-\\([.[:digit:]]+pre[.[:digit:]]+\\)" 
hypb-dir-name)
       (list "elpa-devel" (match-string 1 hypb-dir-name)))
-     ;; git
+     ;; melpa/quelpa package install -- hyperbole-20220205.1429
+     ((string-match 
"hyperbole-\\([1-9][0-9][0-9][0-9][0-1][0-9][0-3][0-9]\\.[0-9]+\\)"
+                   hypb-dir-name)
+      (list "melpa" (match-string 1 hypb-dir-name)))
+     ;; git install -- hyperbole d27f4c5197
      ((file-exists-p (expand-file-name ".git" hyperb:dir))
       (ignore-errors
         (let ((default-directory hyperb:dir))
           (list
            "git"
-           (substring (shell-command-to-string "git rev-parse HEAD") 0 
10))))))))
+           (substring (shell-command-to-string "git rev-parse HEAD") 0 10)))))
+     ;; elpa package install -- /elpa/hyperbole-8.0.0"
+     ((and (string-match-p (concat dir-sep-string "elpa" dir-sep-string) 
hyperb:dir)
+          (string-match "hyperbole-\\([.[:digit:]]+\\)" hypb-dir-name))
+      (list "elpa" (match-string 1 hypb-dir-name)))
+     ;; tarball archive install -- hyperbole-8.0.0
+     ((string-match "hyperbole-\\([.[:digit:]]+\\)" hypb-dir-name)
+      (list "archive" (match-string 1 hypb-dir-name)))
+     ;; unknown -- hyperbole
+     (t (list "unknown" hyperb:dir)))))
 
 ;;;###autoload
 (defun hypb:configuration (&optional out-buf)
@@ -133,12 +156,8 @@ Global keymap is used unless optional KEYMAP is given."
       (goto-char (point-max)))
     (delete-blank-lines) (delete-blank-lines)
     (let ((start (point)))
-      (insert (format "I use:\tEditor:      %s\n\tHyperbole:   %s\n"
-                     (cond ((boundp 'infodock-version)
-                            infodock-version)
-                           (t (hypb:replace-match-string
-                               " of .+" (emacs-version) "" t)))
-                      hyperb:version))
+      (insert (format "I use:\tEditor:      GNU Emacs %s\n\tHyperbole:   %s\n"
+                     emacs-version hyperb:version))
       (when (and (boundp 'br-version) (stringp br-version))
        (insert (format "\tOO-Browser:  %s\n" br-version)))
       (when (and (boundp 'system-configuration) (stringp system-configuration))
@@ -162,7 +181,7 @@ Global keymap is used unless optional KEYMAP is given."
                                (concat "PIEmail " pm-version))))))
       (when (and (boundp 'hnews:reader) (boundp 'gnus-version) hnews:reader)
         (insert (format "\tNews Reader: %s\n" gnus-version)))
-      (let ((install-type (hypb--installation-type)))
+      (let ((install-type (hypb:installation-type)))
         (when install-type
           (insert (format "\tInstall:     %s, %s" (car install-type) (cadr 
install-type)))))
       (insert "\n")
@@ -710,6 +729,14 @@ Syntax tables are char-tables whose values are encoded as 
raw
 descriptors."
   (aset (or syntax-table (syntax-table)) char raw-descriptor))
 
+(defun hypb:straight-package-plist (pkg-string)
+  "Return a property list of package-name, package-download-source and 
pckage-version for PKG-STRING, else return nil.
+This is for the straight.el package manager."
+  (when (fboundp #'straight-bug-report-package-info)
+    (car (delq nil (mapcar (lambda (pkg-plist)
+                            (when (equal (plist-get pkg-plist :package) 
pkg-string) pkg-plist))
+                          (straight-bug-report-package-info))))))
+
 (defun hypb:string-count-matches (regexp str &optional start end)
   "Count occurrences of REGEXP in STR, limited to optional START and END 
positions.
 
diff --git a/test/hypb-tests.el b/test/hypb-tests.el
index 853fdc2f00..3cff5a3f9a 100644
--- a/test/hypb-tests.el
+++ b/test/hypb-tests.el
@@ -3,7 +3,7 @@
 ;; Author:       Mats Lidell <matsl@gnu.org>
 ;;
 ;; Orig-Date:     5-Apr-21 at 18:53:10
-;; Last-Mod:     28-Jan-22 at 23:49:07 by Mats Lidell
+;; Last-Mod:      5-Feb-22 at 21:21:59 by Bob Weiner
 ;;
 ;; Copyright (C) 2022  Free Software Foundation, Inc.
 ;; See the "HY-COPY" file for license information.
@@ -92,19 +92,47 @@
     (should (equal (hypb:replace-match-string "\\`\\|x" "--xx--" "z")
                    "z--zz--"))))
 
-(ert-deftest hypb--installation-type-test ()
+(ert-deftest hypb:installation-type-test ()
   "Verify installation type alternatives."
+  ;; straight.el package install -- hyperbole gnu-elpa-mirror master 56cd3d8 
2022-02-05
+  (require 'package)
+  (unless package--initialized
+    (package-initialize))
+  (when (featurep 'straight)
+    (let* ((hyperb:dir (expand-file-name "straight/build/hyperbole" 
user-emacs-directory))
+          (default-directory (expand-file-name "straight/repos/hyperbole" 
user-emacs-directory))
+          (package-installed-p 'straight)
+          (plist (hypb:straight-package-plist "hyperbole"))
+          (install-type-list (when plist (hypb:installation-type)))
+          (commit (nth 1 install-type-list)))
+      (when plist
+       (should (and (equal (nth 0 install-type-list) "straight")
+                    commit
+                    (string-match-p "\\`[a-f0-9]+\\'" commit)
+                    t)))))
+  ;; elpa-devel package install -- hyperbole-8.0.0pre0.20220126.1138
   (let ((hyperb:dir 
"/home/user/.emacs.d/elpa/hyperbole-8.0.0pre0.20220126.1138"))
-    (should (equal (hypb--installation-type) '("elpa-devel" 
"8.0.0pre0.20220126.1138"))))
+    (should (equal (hypb:installation-type) '("elpa-devel" 
"8.0.0pre0.20220126.1138"))))
+  ;; melpa/quelpa package instball -- hyperbole-20220205.1429
+  (let ((hyperb:dir "/home/user/.emacs.d/elpa/hyperbole-20220126.1138"))
+    (should (equal (hypb:installation-type) '("melpa" "20220126.1138"))))
+  ;; git install -- hyperbole d43d05a097
   (let ((hyperb:dir "/a_git_folder"))
     (with-mock
       (mock (file-exists-p "/a_git_folder/.git") => t)
       (mock (shell-command-to-string "git rev-parse HEAD") => 
"d43d05a0973e8adcbfdd8c85681dac5de669aaa9")
-      (should (equal (hypb--installation-type) '("git" "d43d05a097")))))
-  (let ((hyperb:dir "/a_git_folder"))
+      (should (equal (hypb:installation-type) '("git" "d43d05a097")))))
+  ;; elpa package install -- /elpa/hyperbole-8.0.0"
+  (let ((hyperb:dir "/home/user/.emacs.d/elpa/hyperbole-8.0.0"))
+    (should (equal (hypb:installation-type) '("elpa" "8.0.0"))))
+  ;; tarball archive install -- hyperbole-8.0.0
+  (let ((hyperb:dir "/home/user/hyperbole-8.0.0"))
+    (should (equal (hypb:installation-type) '("archive" "8.0.0"))))
+  ;; unknown
+  (let ((hyperb:dir "/home/user/hyperbole"))
     (with-mock
-      (mock (file-exists-p "/a_git_folder/.git") => nil)
-      (should-not (hypb--installation-type)))))
+      (mock (file-exists-p "/home/user/hyperbole/.git") => nil)
+      (should (equal (car (hypb:installation-type)) "unknown")))))
 
 ;; This file can't be byte-compiled without the `el-mock' package (because of
 ;; the use of the `with-mock' macro), which is not a dependency of Hyperbole.