;;; jtw-install-and-uninstall.el --- An installer for Java Training Wheels

;; Copyright (C) 2016 Davin Pearson

;; Maintainer: Davin Pearson <http://davin.50webs.com>
;; Keywords: Java Training Wheels installer

;;; Commentary:

;; This program is not part of GNU Emacs

;; This file provides a mechanism for installing and uninstalling
;; J.T.W. code compilation code.  In the code that follows, the d-
;; prefix stands for _D_avin's customisations to elisp.

;;; Limitation of Warranty

;; 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 detail.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs, see the file COPYING.  If not, see:
;;
;; <http://www.gnu.org/licenses/gpl.txt>.

(setq load-path (cons "dlisp" load-path))

(require 'cl)
(require 'diagnose)
(require 'directory-files-deep)

(defun d-shell-command (cmd &optional please-wait)
  (message "About to do: %s" cmd)
  (if (eq please-wait 'PLEASE-WAIT)
      (message "Please wait..."))
  (shell-command cmd)
  )

(defun d-unsplat-file-dir (file)
  (condition-case err
      (when (file-exists-p file) ;; os-type--linux-p
        (message "*** d-unsplat-file-dir on file %s" file)
        (save-excursion
          (find-file file)
          (read-only-mode -1)
          (goto-char (point-min))
          (when (re-search-forward (regexp-quote "J.T.W.") nil t)
            (delete-region (point-at-bol) (1+ (point-at-eol))))
          (while (looking-at "[ \t\r\n]")
            (delete-char 1))
          (save-some-buffers 'NO-QUESTIONS)
          (kill-buffer)))
    (error
     (message "Error: %s" (prin1-to-string err)))))


(defun d-uninstall-to-dir-file ()
  (if os-type--mswindows-p
      (progn
        ;;(message "*** about to do directory-files-no-dotdotdot")
        (setq list1 (directory-files-no-dotdotdot "c:/Program Files (x86)/" t))
        (setq list2 (directory-files-no-dotdotdot "c:/Program Files/" t))
        (setq ptr (append list1 list2))
        (while ptr
          ;;(message "*** operating on file %s" (car ptr))
          (when (string-match "/emacs-[0-9.]+$" (car ptr))
            (setq str (concat (car ptr) "/info/dir"))
            ;;(setq str (safe-expand-file-name str))
            (d-unsplat-file-dir str))
          (setq ptr (cdr ptr))
          ))
    (assert os-type--linux-p)
    (setq str (format "%s/share/info/dir" *prefix*))
    (d-unsplat-file-dir str)
    )
  ;;(message "*** Finished command d-uninstall-to-dir-file")
  )

;; (setq file "c:/Program Files (x86)/emacs-24.5/share/info/dir")
(defun d-splat-file-dir (file)
  (message "*** d-splat-file-dir on file %s" file)
  (condition-case err
      (save-excursion
        (find-file file)
        (read-only-mode -1)
        (goto-char (point-min))
        (when (not (re-search-forward "J.T.W." nil t))
          (goto-char (point-min))
          (when (re-search-forward "\\* Menu:" nil t)
            (forward-line 2)
            (insert "* J.T.W.: (jtw-manual).         Java Training Wheels tutorials.\n"))
          (while (looking-at "[ \t\r\n]")
          (delete-char 1))
          (insert "\n")
          (if os-type--linux-p
              (d-shell-command (format "chmod 666 \"%s\"" file)))
          (save-buffer)
          (kill-buffer)))
      (error
       (message "Error %s" (prin1-to-string err)))))


(defun d-install-to-dir-file ()
  (interactive)
  (let (str list1 list2 ptr info-file file-info)
    (if os-type--mswindows-p
        (progn
          ;;(message "*** about to do directory-files-no-dotdotdot")
          (setq list1 (directory-files-no-dotdotdot "c:/Program Files (x86)/" t))
          (setq list2 (directory-files-no-dotdotdot "c:/Program Files/" t))
          (setq ptr (append list1 list2))
          (while ptr
            ;;(setq str (safe-expand-file-name str))
            ;;(message "*** Working on file %s" str)
            (when (string-match "/emacs-[0-9.]+$" (car ptr))
              (setq str (concat (car ptr) "/info/dir"))
              (when (file-exists-p str)
                (d-unsplat-file-dir str)
                (d-splat-file-dir str)
                )
              (setq str (concat (car ptr) "/share/info/dir"))
              (when (file-exists-p str)
                (d-unsplat-file-dir str)
                (d-splat-file-dir str)
                )
              (setq file-info "documentation/jtw-manual.info")
              (message "*** file-exists-p %s %s" file-info (file-exists-p file-info))
              ;;(debug "Black Sabbath: War of this world")
              (condition-case err
                  (when (file-exists-p file-info)
                    (setq info-file (concat (car ptr) "/info/"))
                    (message "*** #1 copying from %s -> %s" file-info info-file)
                    (copy-file file-info info-file 'OK-IF-ALREADY-EXISTS 'KEEP-TIME)
                    (chmod info-file #o644))
                (error "Internal Error#1: %s" (prin1-to-string err)))
              (condition-case err
                  (progn
                    (setq info-file (concat (car ptr) "/share/info/"))
                    (message "*** #2 copying from %s -> %s" file-info info-file)
                    (copy-file file-info info-file 'OK-IF-ALREADY-EXISTS 'KEEP-TIME)
                    (chmod info-file #o644))
                (error "Internal Error#2: %s" (prin1-to-string err)))
              ;;(message "sod off")
              )
            (setq ptr (cdr ptr)))
          )
      (assert os-type--linux-p)
      (setq str (format "%s/share/info/dir" *prefix*))
      (message "**** splatting file dir=%s" str)
      (when (file-exists-p str)
        (d-unsplat-file-dir str)
        (d-splat-file-dir str)
        ;;(d-shell-command "cp -puv documentation/jtw-manual.info %s/share/info/" *prefix*)
        )
      (setq str (format "%s/info/dir" *prefix*))
      (when (file-exists-p str)
        (d-unsplat-file-dir str)
        (d-splat-file-dir str)
        ;;(d-shell-command "cp -puv documentation/jtw-manual.info %s/info/"       *prefix*)
        ))
    ;;(message "*** Finished command d-install-to-dir-file")
    ))

(progn
  (setq *prefix*    "/usr")
  (setq *folder*    "~/jtw")
  (setq *prefix*    "~/jtw")
  )

(defun d-add-to-dotemacs ()
  (interactive)
  (message "Adding to ~/.emacs")
  (find-file "~/.emacs")
  (goto-char (point-max))
  (while (save-excursion
           (forward-char -1)
           (looking-at "[ \t\r\n]"))
    (backward-delete-char 1))
  (insert "\n\n")
  (when (not (re-search-backward "BEGIN \\(dlisp-stuff\\|java-training-wheels-stuff\\)$" nil t))
    (if *install-just-davins-jtw-mode*
        (progn
          (insert         ";;; BEGIN java-training-wheels-stuff\n")
          (insert (format "(load-file \"%s/share/emacs/site-lisp/dlisp/jtw-mode.el\")\n" *prefix*))
          (insert         ";;; END java-training-wheels-stuff\n")
          )
      (progn
        (insert           ";;; BEGIN dlisp-stuff\n")
        (insert           "(defun d-emergency-set-load-path ()\n")
        (insert (format   "   (setq load-path (cons \"%s/share/emacs/site-lisp/dlisp/\" load-path)))\n" *prefix*))
        (insert           "(d-emergency-set-load-path)\n")
        (insert           "(require 'd-start)\n")
        (insert           ";;; END dlisp-stuff\n")
        )
      )
    )
  (save-buffer)
  (kill-buffer)
  )

(defun d-remove-from-dotemacs ()
  (interactive)
  (find-file "~/.emacs")
  (goto-char (point-max))
  (while (save-excursion
           (forward-char -1)
           (looking-at "[ \t\r\n]"))
    (backward-delete-char 1))
  (insert "\n")
  (while (re-search-backward ";;; BEGIN \\(dlisp-stuff\\|java-training-wheels-stuff\\)$" nil t)
    ;;(d-beeps "found begin")
    (setq name (buffer-substring-no-properties (match-beginning 1) (match-end 1)))
    (beginning-of-line)
    (setq p1 (point))
    (when (re-search-forward (format ";;; END %s$" name))
      ;;(d-beeps "found end")
      (forward-line 1)
      (beginning-of-line)
      (setq p2 (point))
      (assert (/= p1 p2))
      (message "*** deleted-region=%s" (buffer-substring-no-properties p1 p2))
      (delete-region p1 p2)))
  (while (save-excursion
           (forward-char -1)
           (looking-at "[ \t\r\n]"))
    (backward-delete-char 1))
  (save-buffer)
  (kill-buffer)
  )

(defun do-uninstall ()
  (setq *prefix* nil)
  (when os-type--mswindows-p
    (message "Warning MS-Windows detected.")
    (message "Installation is not guaranteed to work without errors ")
    (message "if your shell does not have write access to the c:/Program Files* folders"))
  (when (not *prefix*)
    (if os-type--linux-p
        (progn
          (setq *prefix* (read-from-minibuffer "Enter installation prefix dir (press y or enter for /usr): "))
          (if (or (string= *prefix* "") (string= *prefix* "y"))
              (setq *prefix* "/usr")))
      (assert os-type--mswindows-p)
      (setq *prefix* (read-from-minibuffer "Enter installation prefix dir (press y or enter for c:/java-training-wheels): "))
      (if (or (string= *prefix* "") (string= *prefix* "y"))
          (setq *prefix* "c:/java-training-wheels"))))
  (when (string-match "/$" *prefix*)
    (setq *prefix* (substring *prefix* 0 (match-beginning 0))))
  (message "You chose prefix = `%s'" *prefix*)
  ;; -----------------------------------------------------------------
  (d-shell-command (format "rm -rfv %s/share/emacs/site-lisp/dlisp" *prefix*))
  (d-shell-command         "rm -fv  manual/jtw-manual.info")
  (d-shell-command         "rm -rfv manual/jtw")
  (d-shell-command (format "rm -fv %s/share/info/jtw-manual.info"          *prefix*))
  (d-shell-command (format "rm -rfv %s/share/java-training-wheels"  *prefix*))
  (d-shell-command (format "rm -rfv %s/share/doc/jtw"               *prefix*))
  (d-uninstall-to-dir-file)
  (d-remove-from-dotemacs)
  (message "Finished make uninstall")
  (message "\n")
  )

;;(message "args=%s" args)
;;(setq args "--prefix=~/jtw")
;;(setq *prefix* "~/jtw")
;;(setq *prefix* "/usr")

(defun do-install ()
  (message "foo")
  (message "args=%s" args)
  (setq *prefix* (if (string-match "--prefix=\\([-+a-zA-Z0-9_/.:~]*\\)" args)
                         (substring args (match-beginning 1) (match-end 1))
                       nil))
  (when os-type--mswindows-p
    (message "Warning MS-Windows detected.")
    (message "Installation is not guaranteed to work without errors ")
    (message "if your shell does not have write access to the c:/Program Files* folders"))
  (if os-type--linux-p
      (when (not *prefix*)
        (setq *prefix* (read-from-minibuffer "Enter installation prefix dir (press y or enter for /usr): "))
        (if (or (string= *prefix* "y") (string= *prefix* ""))
            (setq *prefix* "/usr")))
    (assert os-type--mswindows-p)
    (when (not *prefix*)
      (setq *prefix* (read-from-minibuffer "Enter installation prefix dir (press y or enter for c:/java-training-wheels): "))
      (if (or (string= *prefix* "") (string= *prefix* "y"))
          (setq *prefix* "c:/java-training-wheels"))))
  ;; NOTE: patches *prefix* so it doesn't end with a / character
  (if (string-match "/$" *prefix*)
      (setq *prefix* (substring *prefix* 0 -1)))
  (if os-type--mswindows-p
      (setq *prefix* (expand-file-name *prefix*)))
  (message "You chose --prefix='%s'" *prefix*)
  ;; -----------------------------------------------------------------
  (setq *folder* (read-from-minibuffer (format "Enter a folder to keep your *.jtw files (press y or enter for ~/jtw-tutorials): ")))
  (setq home (getenv "HOME"))
  (when (string-match "/$" home)
    (setq home (substring home 0 -1)))
  (cond
   ((or (string= *folder* "") (string= *folder* "y"))
    (setq *folder* (expand-file-name (concat home "/jtw-tutorials"))))
   ((and os-type--mswindows-p (string-match "~/" *folder*))
    (setq *folder* (expand-file-name *folder*)))
   )
  (when os-type--mswindows-p
    (when (not (string-match "^[a-zA-Z]:/" *folder*))
      (setq *option* (y-or-n-p (format "Folder %s does not start with [a-zA-Z]:/  -- Prefix with ~/ ?" *folder*)))
      (if *option*
          (setq *folder* (expand-file-name (concat "~/" *folder*))))))
  (when os-type--linux-p
    (when (and (/= (aref *folder* 0) ?~) (/= (aref *folder* 0) ?/))
      (setq *option* (y-or-n-p (format "Folder %s does not start with ~ or /  -- Prefix with ~/ ?" *folder*)))
      (if *option*
          (setq *folder* (expand-file-name (concat "~/" folder))))))
  (if (string-match "/$" *folder*)
      (setq *folder* (substring *folder* 0 -1)))
  (message "You chose folder: '%s'" *folder*)
  ;; -----------------------------------------------------------------
  (setq *install-just-davins-jtw-mode* (y-or-n-p  "Install just Davin's jtw-mode instead of Davin's full version of Emacs?"))
  (d-shell-command (format "mkdir -p %s" *folder*))
  (message "")
  (save-excursion
    (find-file (concat *folder*    "/Makefile"))
    (erase-buffer)
    (goto-char (point-min))
    (insert                (format "PREFIX = %s\n" *prefix*))
    (insert                        "include $(PREFIX)/share/java-training-wheels/Makefile.jtw\n\n")
    (insert                        "build: clean\n")
    (save-buffer)
    (kill-buffer))
  (d-shell-command         (format "cp -upv install-stuff/MyFirstProgram.jtw %s/" *folder*))
  (d-shell-command         (format "chmod 644 %s/MyFirstProgram.jtw " *folder*))
  (d-shell-command         (format "mkdir -p %s/share/java-training-wheels" *prefix*))
  (d-shell-command         (format "cp -pv install-stuff/Makefile.jtw %s/share/java-training-wheels/Makefile.jtw" *prefix*))
  (save-excursion
    (find-file             (format "%s/share/java-training-wheels/Makefile.jtw" *prefix*))
    (when (not (re-search-forward  "PREFIX=" nil t))
      (forward-line 35)
      (insert              (concat "PREFIX=" *prefix* "\n"))
      (save-buffer)
      (kill-buffer)))
  ;;(error "bang!")
  ;; -----------------------------------------------------------------
  (if *install-just-davins-jtw-mode*
      (progn
        (d-shell-command   (format "mkdir -p %s/share/emacs/site-lisp/dlisp" *prefix*))
        (d-shell-command   (format "cp -puv dlisp/emergency-bindings.el   %s/share/emacs/site-lisp/dlisp/emergency-bindings.el" *prefix*))
        (d-shell-command   (format "cp -puv dlisp/diagnose.el             %s/share/emacs/site-lisp/dlisp/diagnose.el" *prefix*))
        (d-shell-command   (format "cp -puv dlisp/directory-files-deep.el %s/share/emacs/site-lisp/dlisp/directory-files-deep.el" *prefix*))
        (d-shell-command   (format "cp -puv dlisp/jtw-mode.el             %s/share/emacs/site-lisp/dlisp/jtw-mode.el" *prefix*))
        (d-shell-command   (format "cp -puv dlisp/jtw-build-jtw.el        %s/share/emacs/site-lisp/dlisp/jtw-build-jtw.el" *prefix*))
        (d-shell-command   (format "cp -puv dlisp/jtw-javac.el            %s/share/emacs/site-lisp/dlisp/jtw-javac.el" *prefix*))
        (d-shell-command   (format "cp -puv dlisp/jtw-java.el             %s/share/emacs/site-lisp/dlisp/jtw-java.el" *prefix*))
        (when os-type--linux-p
          (d-shell-command (format "chmod 644 %s/share/emacs/site-lisp/dlisp/*.el" *prefix*))
          ))
    (progn
      (d-shell-command     (format "mkdir -p %s/share/emacs/site-lisp/dlisp" *prefix*))
      (d-shell-command     (format "cp -rupv dlisp/* %s/share/emacs/site-lisp/dlisp" *prefix*))
      (d-shell-command     (format "chmod 755 %s/share/emacs/site-lisp/dlisp"                     *prefix*))
      (d-shell-command     (format "chmod 644 %s/share/emacs/site-lisp/dlisp/*.el"                *prefix*))
      (d-shell-command     (format "chmod 755 %s/share/emacs/site-lisp/dlisp/imported-stuff"      *prefix*))
      (d-shell-command     (format "chmod 644 %s/share/emacs/site-lisp/dlisp/imported-stuff/*.el" *prefix*))
      ))
  (d-shell-command                 "cd manual && make info" 'PLEASE-WAIT)
  (d-shell-command                 "cd manual && make html" 'PLEASE-WAIT)
  (d-shell-command         (format "mkdir -p %s/share/info/"                  *prefix*) 'PARENTS)
  (message                         "*** file-exists-p %s %s" "manual/jtw-manual.info" (file-exists-p "manual/jtw-manual.info"))
  (d-shell-command         (format "cp -puv manual/jtw-manual.info %s/share/info"        *prefix*))
  (d-shell-command         (format "gzip -fv %s/share/info/jtw-manual.info"              *prefix*))
  (d-shell-command         (format "mkdir -p %s/info/"                                   *prefix*))
  (d-shell-command         (format "cp -puv manual/jtw-manual.info %s/info"              *prefix*))
  (d-shell-command         (format "gzip -fv %s/info/jtw-manual.info"                    *prefix*))
  (d-shell-command         (format "chmod 755 %s/info"                                   *prefix*))
  (d-shell-command         (format "chmod 644 %s/info/*.*"                               *prefix*))
  (d-shell-command         (format "chmod 755 %s/share/info"                             *prefix*))
  (d-shell-command         (format "chmod 644 %s/share/info/*.*"                         *prefix*))
  ;; -----------------------------------------------------------------
  (d-shell-command         (format "mkdir -p %s/share/doc/jtw"                           *prefix*))
  (d-shell-command         (format "cp -puv manual/jtw-manual/* %s/share/doc/jtw-manual" *prefix*))
  (d-shell-command         (format "chmod 755 %s/share/doc/jtw-manual"                   *prefix*))
  (d-shell-command         (format "chmod 644 %s/share/doc/jtw-manual/*.*"               *prefix*))
  (d-install-to-dir-file)
  (d-remove-from-dotemacs)
  (d-add-to-dotemacs)
  (message                         "Finished configure script")
  (message                         "Note that online help is available in the files:")
  (message                 (format "(1) %s/share/doc/jtw-manual/*.html and"              *prefix*))
  (message                 (format "(2) %s/share/info/jtw-manual.info.gz"                *prefix*))
  (message                 (format "(3) %s/info/jtw-manual.info.gz"                      *prefix*))
  (message                         "\n")
  )

