;;; super-file.el --- GNU Emacs major mode for editing multiple files in one buffer  -*- lexical-binding: t -*-

;; Copyright (C) 2022 John Ankarström

;; Keywords: multiple files
;; Maintainer: John Ankarström <john@ankarstrom.se>
;; Created: 16 Jul 2022
;; Version: 0.1

;; 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 <http://www.gnu.org/licenses/>.

;;; Commentary:

;;; Code:

(defgroup super-file nil
  "Super-file mode."
  :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
  :group 'text
  :prefix "super-file-")

(defvar super-file-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map [(control x) (control s)] #'super-file-save-all)
    (define-key map [(control c) (control s)] #'super-file-save-all)
    (define-key map [(control c) (control r)] #'super-file-revert)
    (define-key map [(control c) (control k)] #'super-file-remove-subfile)
    map)
  "Major mode keymap for `super-file-mode'.")

;; (defvar super-file--subfiles (list)
;;   "Currently edited subfiles in `super-file-mode' buffer.")

(defcustom super-file-font-lock-keywords
  (list "^==> .* <==$")
  "Font-lock highlighting control in `super-file-mode'."
  :type '(repeat regexp))

(defcustom super-file-mode-hook nil
  "Hook run by function `super-file-mode'."
  :type 'hook)

(defface super-file-marker
  '((t :foreground "dark gray"))
  "")

(define-derived-mode super-file-mode text-mode "Super"
  "Major mode for editing simulaneously multiple files in a single buffer."
  (setq-local font-lock-defaults
              '(super-file-font-lock-keywords))
  (setq-local page-delimiter "^==> .* <==$"))

(defun super-file--forward-subfile (&optional count)
  (forward-page (or count 1))
  (when (eql (point) 1)
    (end-of-line)))

(defun super-file--subfile ()
  (save-excursion
    (beginning-of-line)
    (if-let ((file (super-file--subfile-marker-here)))
	file
      (super-file--forward-subfile -1)
      (beginning-of-line)
      (or (super-file--subfile-marker-here)
	  nil))))

(defun super-file--subfile-marker-here ()
  (and (looking-at "^==> \\(.*\\) <==$")
       (match-string-no-properties 1)))

(defun super-file--subfile-beginning ()
  (save-excursion
    (beginning-of-line)
    (if (super-file--subfile-marker-here)
	(end-of-line)
      (super-file--forward-subfile -1))
    (+ (point) 1)))

(defun super-file--subfile-end ()
  (save-excursion
    (super-file--forward-subfile 1)
    (if (eql (point) (point-max))
	(point)
      (beginning-of-line)
      (- (point) 1))))

(defun super-file--save-subfile ()
    (save-excursion
      (let ((super-file-buf (current-buffer))
	    (file (super-file--subfile))
	    (beginning (super-file--subfile-beginning))
	    (end (super-file--subfile-end)))
	(with-temp-buffer
	  (insert-buffer-substring super-file-buf end beginning)
	  (let ((temp-buf (current-buffer))
		(file-buf (find-file-noselect file t)))
	    (with-current-buffer file-buf
	      (replace-buffer-contents temp-buf)
	      (when (buffer-modified-p)
		(save-buffer))))))))

(defmacro super-file--for-subfile (&rest body)
  `(save-excursion
     (goto-char (point-min))
     ;; Go to first subfile.
     (progn ,@body)
     ;; Go to remaining subfiles.
     (while (progn (super-file--forward-subfile) (not (eql (point) (point-max))))
       (progn ,@body))))

(defun super-file--insert-subfile (path)
  (super-file--for-subfile
   (when (string-equal path (super-file--subfile))
     (user-error "%s is already in super file" path)))
  (let* ((super-file-buf (current-buffer))
	 (file-buf (find-file-noselect path t))
	 (super-file-buf-modified-p (buffer-modified-p))
	 (file-buf-modified-p (with-current-buffer file-buf
				(buffer-modified-p))))
    (when (with-current-buffer file-buf buffer-read-only)
      (user-error "%s is read-only" poath))
    (when (or (not file-buf-modified-p)
	      (y-or-n-p (concat path " has been modified. Continue? ")))
      (save-excursion
	(goto-char (point-max))
	(when (not (eql (point) (point-min)))
	  (insert "\n"))
	(insert "==> " path " <==\n")
	(insert-buffer-substring file-buf)
	(if file-buf-modified-p
	    (set-buffer-modified-p file-buf-modified-p)
	  (set-buffer-modified-p super-file-buf-modified-p))))))

(defun super-file-save-all ()
  "Save all files open in current `super-file-mode' buffer."
  (interactive)
  (when (not (eq major-mode 'super-file-mode))
    (user-error "Super-file-mode not active"))
  (let (failed)
    (super-file--for-subfile
     (condition-case nil
	 (super-file--save-subfile)
       (user-error (push (super-file--subfile) failed))))
    ;; (set-buffer-modified-p nil)
    ;; Notify user about unsaved subfiles.
    (when failed
      (user-error "Some files could not be saved: %s" (string-join failed ", ")))))

(defun super-file-revert ()
  "Revert all changes in `super-file-mode' buffer."
  (interactive)
  (when (not (eq major-mode 'super-file-mode))
    (user-error "Super-file-mode not active"))
  (when (or (not (buffer-modified-p))
	    (yes-or-no-p "Discard changes? "))
    (let ((directory default-directory)
	  subfiles)
      (super-file--for-subfile
       (push (super-file--subfile) subfiles))
      (ignore-errors (kill-buffer-and-window))
      (let ((default-directory directory))
	(dolist (file (nreverse subfiles))
	  (super-file-open file))))))

(defun super-file-remove-subfile ()
  "Remove subfile at point from `super-file-mode' buffer."
  (interactive)
  (when (not (eq major-mode 'super-file-mode))
    (user-error "Super-file-mode not active"))
  (let ((buffer-modified-p (buffer-modified-p)))
    (when (if buffer-modified-p
	      (yes-or-no-p (concat "Super file has been modified. Really remove "
				   (super-file--subfile)
				   "? "))
	    (y-or-n-p (concat "Remove " (super-file--subfile) " from super file? ")))
      (super-file--forward-subfile -1)
      (beginning-of-line)
      (let ((end (save-excursion
		   (super-file--forward-subfile)
		   (beginning-of-line)
		   (point))))
	(delete-region (point) end)
	(set-buffer-modified-p buffer-modified-p)))))

;;;###autoload
(defun super-file-open (file &optional keep-window)
  "Add FILE to `super-file-mode' buffer."
  (interactive "fAdd file to super file: ")
  (let ((old-win (selected-window))
	(buf (get-buffer-create "*super-file*")))
    (with-current-buffer buf
      (let ((path (string-remove-prefix default-directory (file-truename file)))
	    (point (point)))
	(super-file-mode)
	(super-file--insert-subfile path)
	(goto-char point))
      (pop-to-buffer buf)
      (when keep-window
	(select-window old-win)))))

;;;###autoload
(defun super-file-add-current ()
  "Add file associated with current buffer to `super-file-mode' buffer."
  (interactive)
  (if-let ((file (buffer-file-name)))
      (super-file-open (buffer-file-name) t)
    (user-error "No file associated with current buffer")))

;;;#autoload
(defun super-file-add-from-dired ()
  "Add file(s) from `dired' to `super-file-mode' buffer."
  (interactive)
  (when (not (eq major-mode 'dired-mode))
    (user-error "Super-file-mode not active"))
  (let (files)
    (dired-map-over-marks
     (with-demoted-errors "%s" (super-file-open (dired-get-filename) t))
     nil)))

(provide 'super-file-mode)

;;; super-file-mode.el ends here