;;; custom-buffer-file.el --- Custom Buffer and File Operations -*- coding: utf-8; lexical-binding: t; -*-
;;
;;; Commentary:
;; This module provides custom buffer and file operations including PostScript
;; printing capabilities.
;;
;; Functions include:
;; - printing buffers or regions as PostScript to the default printer (with color support)
;; - moving/renaming/deleting buffer files
;; - diffing buffer contents with saved file version
;; - copying file paths and file:// links to the kill ring
;; - copying buffer contents (whole buffer, to top of buffer, to bottom of buffer)
;; - clearing buffer contents from point to top or bottom.
;;
;; The PostScript printing auto-detects the system print spooler (lpr or lp)
;; and prints with face/syntax highlighting.
;;
;; Keybindings under ~C-; b~:
;; - ~C-; b k~ kill buffer and window (delete window, kill/bury buffer)
;; - Copy buffer content submenu at ~C-; b c~
;;   - ~C-; b c w~ copy whole buffer
;;   - ~C-; b c t~ copy from beginning to point
;;   - ~C-; b c b~ copy from point to end
;;
;;; Code:

;; cj/custom-keymap defined in keybindings.el
(eval-when-compile (defvar cj/custom-keymap))
(eval-when-compile (require 'ps-print)) ;; for ps-print variables
(declare-function ps-print-buffer-with-faces "ps-print")
(declare-function ps-print-region-with-faces "ps-print")

;; mm-decode for email viewing (mm-handle-type is a macro, needs early require)
(require 'mm-decode)

;; cj/kill-buffer-and-window defined in undead-buffers.el
(declare-function cj/kill-buffer-and-window "undead-buffers")

;; ------------------------- Print Buffer As Postscript ------------------------

(defvar cj/print-spooler-command 'auto
  "Command used to send PostScript to the system print spooler.
Set to a string to force a specific command (e.g., lpr or lp). Set to `auto' to
auto-detect once per session.")

(defvar cj/print--spooler-cache nil
  "Cached spooler command detected for the current Emacs session.")

(defun cj/print--resolve-spooler ()
  "Return the spooler command to use, auto-detecting and caching if needed."
  (cond
   ;; User-specified command
   ((and (stringp cj/print-spooler-command)
         (> (length cj/print-spooler-command) 0))
    (or (executable-find cj/print-spooler-command)
        (user-error "Cannot print: spooler command '%s' not found in PATH"
                    cj/print-spooler-command))
    cj/print-spooler-command)
   ;; Auto-detect once per session
   ((eq cj/print-spooler-command 'auto)
    (or cj/print--spooler-cache
        (let ((cmd (or (and (executable-find "lpr") "lpr")
                       (and (executable-find "lp")  "lp"))))
          (unless cmd
            (user-error "Cannot print: neither 'lpr' nor 'lp' found in PATH"))
          (setq cj/print--spooler-cache cmd)
          cmd)))
   (t
    (user-error "Invalid value for cj/print-spooler-command: %S"
                cj/print-spooler-command))))

(defun cj/print-buffer-ps (&optional color)
  "Print the buffer (or active region) as PostScript to the default printer.
With prefix argument COLOR, print in color and skip confirmation; otherwise
print in monochrome with confirmation prompt.
Sends directly to the system spooler with no header."
  (interactive "P")
  (unless (require 'ps-print nil t)
    (user-error "Cannot print: ps-print library not found"))
  (let* ((spooler (cj/print--resolve-spooler))
         (want-color (not (null color)))
         (have-region (use-region-p))
         (skip-confirm color))  ; C-u skips confirmation
    ;; Confirm unless C-u was used
    (when (and (not skip-confirm)
               (not (y-or-n-p (format "Send %s to printer? "
                                     (if have-region "region" "buffer")))))
      (user-error "Printing cancelled"))
    (let ((ps-lpr-command spooler)
          (ps-printer-name nil)      ; default system printer
          (ps-lpr-switches nil)
          (ps-print-color-p want-color)
          (ps-use-face-background want-color)
          (ps-print-header nil))     ; no headers
      (if have-region
          (ps-print-region-with-faces (region-beginning) (region-end))
        (ps-print-buffer-with-faces)))
    (message "Sent %s to default printer via %s (%s)"
             (if have-region "region" "buffer")
             spooler
             (if want-color "color" "monochrome"))))

;; ------------------------- Buffer And File Operations ------------------------

(defun cj/--move-buffer-and-file (dir &optional ok-if-exists)
  "Internal implementation: Move buffer and file to DIR.
If OK-IF-EXISTS is nil and target exists, signal an error.
If OK-IF-EXISTS is non-nil, overwrite existing file.
Returns t on success, nil if buffer not visiting a file."
  (let* ((name (buffer-name))
         (filename (buffer-file-name))
         (dir (expand-file-name dir))
         (dir
          (if (string-match "[/\\\\]$" dir)
              (substring dir 0 -1) dir))
         (newname (concat dir "/" name)))
    (if (not filename)
        (progn
          (message "Buffer '%s' is not visiting a file!" name)
          nil)
      (progn  (copy-file filename newname ok-if-exists)
              (delete-file filename)
              (set-visited-file-name newname)
              (set-buffer-modified-p nil)
              t))))

(defun cj/move-buffer-and-file (dir)
  "Move both current buffer and the file it visits to DIR.
When called interactively, prompts for confirmation if target file exists."
  (interactive (list (read-directory-name "Move buffer and file (to new directory): ")))
  (let* ((target (expand-file-name (buffer-name) (expand-file-name dir))))
    (condition-case _
        (cj/--move-buffer-and-file dir nil)
      (file-already-exists
       (if (yes-or-no-p (format "File %s exists; overwrite? " target))
           (cj/--move-buffer-and-file dir t)
         (message "File not moved"))))))

(defun cj/--rename-buffer-and-file (new-name &optional ok-if-exists)
  "Internal implementation: Rename buffer and file to NEW-NAME.
NEW-NAME can be just a basename or a full path to move to different directory.
If OK-IF-EXISTS is nil and target exists, signal an error.
If OK-IF-EXISTS is non-nil, overwrite existing file.
Returns t on success, nil if buffer not visiting a file."
  (let ((filename (buffer-file-name))
        (new-basename (file-name-nondirectory new-name)))
    (if (not filename)
        (progn
          (message "Buffer '%s' is not visiting a file!" (buffer-name))
          nil)
      ;; Check if a buffer with the new name already exists
      (when (and (get-buffer new-basename)
                 (not (eq (get-buffer new-basename) (current-buffer))))
        (error "A buffer named '%s' already exists" new-basename))
      ;; Expand new-name to absolute path (preserves directory if just basename)
      (let ((expanded-name (expand-file-name new-name
                                              (file-name-directory filename))))
        (rename-file filename expanded-name ok-if-exists)
        (rename-buffer new-basename)
        (set-visited-file-name expanded-name)
        (set-buffer-modified-p nil)
        t))))

(defun cj/rename-buffer-and-file (new-name)
  "Rename both current buffer and the file it visits to NEW-NAME.
When called interactively, prompts for confirmation if target file exists."
  (interactive
   (list (if (not (buffer-file-name))
             (user-error "Buffer '%s' is not visiting a file!" (buffer-name))
           (read-string "Rename buffer and file (to new name): "
                        (file-name-nondirectory (buffer-file-name))))))
  (condition-case err
      (cj/--rename-buffer-and-file new-name nil)
    (file-already-exists
     (if (yes-or-no-p (format "File %s exists; overwrite? " new-name))
         (cj/--rename-buffer-and-file new-name t)
       (message "File not renamed")))
    (error
     ;; Handle buffer-already-exists and other errors
     (message "%s" (error-message-string err)))))

(defun cj/delete-buffer-and-file ()
  "Kill the current buffer and delete the file it visits."
  (interactive)
  (let ((filename (buffer-file-name)))
    (when filename
      (if (vc-backend filename)
          (vc-delete-file filename)
        (progn
          (delete-file filename t)
          (message "Deleted file %s" filename)
          (kill-buffer))))))

(defun cj/copy-link-to-buffer-file ()
  "Copy the full file:// path of the current buffer's source file to the kill ring."
  (interactive)
  (let ((file-path (buffer-file-name)))
    (when file-path
      (setq file-path (concat "file://" file-path))
      (kill-new file-path)
      (message "Copied file link to kill ring: %s" file-path))))

(defun cj/copy-path-to-buffer-file-as-kill ()
  "Copy the full path of the current buffer's file to the kill ring.
Signal an error if the buffer is not visiting a file."
  (interactive)
  (let ((path (buffer-file-name)))
    (if (not path)
        (user-error "Current buffer is not visiting a file")
      (kill-new path)
      (message "Copied file path: %s" path)
      path)))

(defun cj/copy-whole-buffer ()
  "Copy the entire contents of the current buffer to the kill ring.
Point and mark are left exactly where they were.  No transient region
is created.  A message is displayed when done."
  (interactive)
  (let ((contents (buffer-substring-no-properties (point-min) (point-max))))
    (kill-new contents)
    (message "Buffer contents copied to kill ring")))

(defun cj/copy-to-bottom-of-buffer ()
  "Copy text from point to the end of the buffer to the kill ring.
Point and mark are left exactly where they were.  No transient region
is created.  A message is displayed when done."
  (interactive)
  (let ((contents (buffer-substring-no-properties (point) (point-max))))
    (kill-new contents)
    (message "Copied from point to end of buffer")))

(defun cj/copy-to-top-of-buffer ()
  "Copy text from the beginning of the buffer to point to the kill ring.
Point and mark are left exactly where they were.  No transient region
is created.  A message is displayed when done."
  (interactive)
  (let ((contents (buffer-substring-no-properties (point-min) (point))))
    (kill-new contents)
    (message "Copied from beginning of buffer to point")))

(defun cj/clear-to-bottom-of-buffer ()
  "Delete all text from point to the end of the current buffer.
This does not save the deleted text in the kill ring."
  (interactive)
  (delete-region (point) (point-max))
  (message "Buffer contents removed to the end of the buffer."))

(defun cj/clear-to-top-of-buffer ()
  "Delete all text from point to the beginning of the current buffer.
Do not save the deleted text in the kill ring."
  (interactive)
  (delete-region (point) (point-min))
  (message "Buffer contents removed to the beginning of the buffer."))

(defun cj/copy-buffer-name ()
  "Copy current buffer name to kill ring."
  (interactive)
  (kill-new (buffer-name))
  (message "Copied: %s" (buffer-name)))

(require 'system-lib)
(declare-function ansi-color-apply-on-region "ansi-color")

(defun cj/--diff-with-difftastic (file1 file2 buffer)
  "Run difftastic on FILE1 and FILE2, output to BUFFER.
Applies ANSI color and sets up special-mode for navigation."
  (with-current-buffer buffer
    (let ((inhibit-read-only t))
      (erase-buffer)
      (insert (format "Difftastic diff: %s (saved) vs buffer (modified)\n\n"
                      (file-name-nondirectory file1)))
      (call-process "difft" nil t nil
                    "--color" "always"
                    "--display" "side-by-side-show-both"
                    file1 file2)
      (require 'ansi-color)
      (ansi-color-apply-on-region (point-min) (point-max))
      (special-mode)
      (goto-char (point-min)))))

(defun cj/--diff-with-regular-diff (file1 file2 buffer)
  "Run regular unified diff on FILE1 and FILE2, output to BUFFER.
Sets up diff-mode for navigation."
  (with-current-buffer buffer
    (let ((inhibit-read-only t))
      (erase-buffer)
      (insert (format "Unified diff: %s (saved) vs buffer (modified)\n\n"
                      (file-name-nondirectory file1)))
      (call-process "diff" nil t nil "-u" file1 file2)
      (diff-mode)
      (goto-char (point-min)))))

(defun cj/diff-buffer-with-file ()
  "Compare the current modified buffer with the saved version.
Uses difftastic if available for syntax-aware diffing, otherwise
falls back to regular unified diff.  Shows output in a separate buffer.
Signals an error if the buffer is not visiting a file."
  (interactive)
  (unless (buffer-file-name)
    (user-error "Current buffer is not visiting a file"))
  (let* ((file (buffer-file-name))
         (file-ext (file-name-extension file t))  ; includes the dot
         (temp-file (make-temp-file "buffer-diff-" nil file-ext))
         (buffer-content (buffer-string)))  ; Capture BEFORE with-temp-file!
    (unwind-protect
        (progn
          ;; Write current buffer content to temp file
          (with-temp-file temp-file
            (insert buffer-content))
          ;; Check if there are any differences first
          (if (zerop (call-process "diff" nil nil nil "-q" file temp-file))
              (message "No differences between buffer and file")
            ;; Run diff/difftastic and display in buffer
            (let* ((using-difftastic (cj/executable-exists-p "difft"))
                   (buffer-name (if using-difftastic
                                    "*Diff (difftastic)*"
                                  "*Diff (unified)*"))
                   (diff-buffer (get-buffer-create buffer-name)))
              (if using-difftastic
                  (cj/--diff-with-difftastic file temp-file diff-buffer)
                (cj/--diff-with-regular-diff file temp-file diff-buffer))
              (display-buffer diff-buffer))))
      ;; Clean up temp file
      (when (file-exists-p temp-file)
        (delete-file temp-file)))))

(defun cj/view-buffer-in-eww ()
  "Render the current buffer's file in EWW (Emacs Web Wowser).

Opens the file associated with the current buffer in EWW for rendered
viewing.  Useful for previewing HTML, XML, or other markup files with
proper formatting instead of viewing raw source.

Bound to \\`C-; b w'.

Signals an error if the buffer is not visiting a file."
  (interactive)
  (if buffer-file-name
      (eww-open-file buffer-file-name)
    (user-error "Buffer is not visiting a file")))

(defun cj/--email-handle-is-type-p (handle type)
  "Return non-nil if HANDLE is a MIME part of TYPE (e.g., \"text/html\").
TYPE matching is a prefix match, so \"text/html\" matches
\"text/html; charset=utf-8\"."
  (when (and handle (listp handle))
    (let ((content-type (mm-handle-type handle)))
      (and content-type
           (listp content-type)
           (stringp (car content-type))
           (string-prefix-p type (car content-type))))))

(defun cj/--email-find-displayable-part (handle)
  "Find a displayable part (text/html or text/plain) in HANDLE.
Prefers text/html over text/plain.  HANDLE can be a leaf handle or
a multipart structure.  Returns the handle for the displayable part, or nil."
  (cond
   ;; Leaf handle that's HTML
   ((cj/--email-handle-is-type-p handle "text/html")
    handle)
   ;; Leaf handle that's plain text - save it but keep looking for HTML
   ((cj/--email-handle-is-type-p handle "text/plain")
    handle)
   ;; Multipart - search children
   ((and (listp handle) (listp (car handle)))
    (let ((html-part nil)
          (text-part nil))
      (dolist (part handle)
        (when (listp part)
          (let ((found (cj/--email-find-displayable-part part)))
            (when found
              (if (cj/--email-handle-is-type-p found "text/html")
                  (setq html-part found)
                (unless html-part
                  (setq text-part found)))))))
      (or html-part text-part)))
   ;; Multipart container (string content-type as car)
   ((and (listp handle) (stringp (car handle)))
    ;; This is a multipart with type info - search the cdr
    (cj/--email-find-displayable-part (cdr handle)))
   (t nil)))

(defun cj/view-email-in-buffer ()
  "Render an .eml email file with proper MIME decoding.

Parses the MIME structure of the current buffer's .eml file, extracts
the text/html part (falling back to text/plain if no HTML), and renders
it using shr (Simple HTML Renderer) in a dedicated buffer.

The rendered email is displayed in a buffer named \"*Email: <filename>*\"
in `special-mode' for easy navigation and dismissal with \\`q'.

Bound to \\`C-; b e'.

Signals an error if:
- The buffer is not visiting a file
- No displayable content (text/html or text/plain) is found"
  (interactive)
  (unless buffer-file-name
    (user-error "Buffer is not visiting a file"))
  (require 'mm-decode)
  (require 'shr)
  (let* ((handle (mm-dissect-buffer t))
         (displayable-part (cj/--email-find-displayable-part handle))
         (buffer-name (format "*Email: %s*" (file-name-nondirectory buffer-file-name))))
    (unless displayable-part
      (user-error "No displayable content found in email"))
    (with-current-buffer (get-buffer-create buffer-name)
      (let ((inhibit-read-only t))
        (erase-buffer)
        (mm-insert-part displayable-part)
        (goto-char (point-min))
        (when (cj/--email-handle-is-type-p displayable-part "text/html")
          (shr-render-region (point-min) (point-max)))
        (goto-char (point-min))
        (special-mode)))
    (mm-destroy-parts handle)
    (switch-to-buffer buffer-name)))

;; --------------------------- Buffer And File Keymap --------------------------

;; Copy buffer content sub-keymap
(defvar-keymap cj/copy-buffer-content-map
  :doc "Keymap for copy buffer content operations."
  "w" #'cj/copy-whole-buffer
  "b" #'cj/copy-to-bottom-of-buffer
  "t" #'cj/copy-to-top-of-buffer)

;; Buffer & file operations prefix and keymap
(defvar-keymap cj/buffer-and-file-map
  :doc "Keymap for buffer and file operations."
  "m" #'cj/move-buffer-and-file
  "r" #'cj/rename-buffer-and-file
  "p" #'cj/copy-path-to-buffer-file-as-kill
  "d" #'cj/delete-buffer-and-file
  "D" #'cj/diff-buffer-with-file
  "c" cj/copy-buffer-content-map
  "n" #'cj/copy-buffer-name
  "l" #'cj/copy-link-to-buffer-file
  "k" #'cj/kill-buffer-and-window
  "P" #'cj/print-buffer-ps
  "t" #'cj/clear-to-top-of-buffer
  "b" #'cj/clear-to-bottom-of-buffer
  "x" #'erase-buffer
  "s" #'mark-whole-buffer
  "S" #'write-file ;; save as
  "g" #'revert-buffer
  "w" #'cj/view-buffer-in-eww
  "e" #'cj/view-email-in-buffer)
(keymap-set cj/custom-keymap "b" cj/buffer-and-file-map)

(with-eval-after-load 'which-key
  (which-key-add-key-based-replacements
    "C-; b" "buffer and file menu"
    "C-; b m" "move file"
    "C-; b r" "rename file"
    "C-; b p" "copy file path"
    "C-; b d" "delete file"
    "C-; b D" "diff buffer with file"
    "C-; b c" "buffer copy menu"
    "C-; b c w" "copy whole buffer"
    "C-; b c b" "copy to bottom"
    "C-; b c t" "copy to top"
    "C-; b n" "copy buffer name"
    "C-; b l" "copy file link"
    "C-; b k" "kill buffer and window"
    "C-; b P" "print to PS"
    "C-; b t" "clear to top"
    "C-; b b" "clear to bottom"
    "C-; b x" "erase buffer"
    "C-; b s" "select whole buffer"
    "C-; b S" "save as"
    "C-; b g" "revert buffer"
    "C-; b w" "view in EWW"
    "C-; b e" "view email"))


(provide 'custom-buffer-file)
;;; custom-buffer-file.el ends here.