;;; scpaste-stylize.el --- Use a single stylesheet for all your scpastes.

;; Copyright © 2008-2020 Phil Hagelberg and contributors

;; Author: Alex Griffith
;; URL: paste.alexjgriffith.com/scpaste-stylize.el.html
;; Version: 0.1.0
;; Created: 2022-09-25
;; Keywords: convenience hypermedia
;; EmacsWiki: SCPaste
;; Package-Requires: ((htmlize "1.39")(scpaste "0.6.5"))

;; This file is NOT part of GNU Emacs.

;;; Commentary:

;; This package extend Phil Hagelberg's scpaste functionality, replacing
;; styles baked into the individual files with one styles.css in the root.
;; This allows for the user to change the theme of their emacs while
;; having their styles stay consistent online.

;;; Install

;;; Follow the setups for scpaste then add the following
;; (autoload 'scpaste-stylize "scpaste-stylize")
;; (autoload 'scpaste-stylize "scpaste-stylize-region")
;; (autoload 'scpaste-stylize "scpaste-stylize-css")

;;; Usage

;; Before you run spaste-stylize-css iterate through all the modes you normally
;; use. Like org-mode, any specific programing modes etc. This will add
;; their specific fonts to the font-list
;; There may be a better way of doing this that relies on the theme.

;; To define the full suite of CSS
;; M-x scpaste-stylize-css

;; To add a new paste of a whole file
;; M-x scpaste-stylize return filename

;;; License:

;; 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, 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
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Code:

(require 'url)
(require 'htmlize) ;; unlike scpaste, scpaste-stylize depends on htmlize
(require 'scpaste)

;; Use this Generate your own list of faces so you can cross out the
;; troublesome ones
(defun scpaste-stylize-list-faces ()
  (let ((print-length nil))
    (insert (concat "(defvar scpaste-stylize-faces\n'("
                    (mapconcat 'symbol-name (face-list) "\n")
                    "))") )))

;; Overwrite the `htmlize-face-size' function fixing a few issues
;; There is still one issue I am facing, how do we know if a
;; face is a valid face?
(defun htmlize-face-size (face)
  ;; The size (height) of FACE, taking inheritance into account.
  ;; Only works in Emacs 21 and later.
  (let* ((face-list (list face))
         (head face-list)
         (tail face-list))
    (while head
      ;; some faces inherit non existing faces
      ;; we need a way to skip faces that are not
      ;; loaded (like org mode faces)
      (let ((inherit (face-attribute (car head) :inherit)))
        (cond ((listp inherit)
               (setcdr tail (cl-copy-list inherit))
               (setq tail (last tail)))
              ((eq inherit 'unspecified))
              ((consp inherit) ;; they were not handling the case of 'face
               (setcdr tail (list (car inherit)))
               (setq tail (cdr tail))
               (setcdr tail (list inherit))
               (setq tail (cdr tail))
      (setq head (cl-remove-if
                  (lambda (x) (equal (symbol-name x) "quote"))
      (pop head))
    ;; (insert (concat (pp face-list) "\n"))
    (setq face-list (cl-remove-if
                  (lambda (x) (equal (symbol-name x) "quote"))
    (let ((size-list
            for f in face-list
            for h = (and (facep f) (face-attribute f :height))
            collect (if (eq h 'unspecified) nil h))))
      (cl-reduce 'htmlize-merge-size (cons nil size-list)))))

;; replace this with your faces
;; cross out ones that give you errors
;; most errors can be fixed by loading the
;; package the face depends on.
;; Check out paste.alexjgriffith.com/scpaste-stylize-faces.el.html
;; for an example
(defvar scpaste-stylize-faces

;;; Troubleshooting
;; Check htmlize-face-size to ensure the error
;; is with face-attribute and is caused by
;; the face not being loaded yet
;; (htmlize-css-insert-head
;;   scpaste-styleize-faces
;;   (htmlize-make-face-map scpaste-styleize-faces))
;; (htmlize-face-size 'ansi-color-bold)
;; (htmlize-face-size 'magit-reflog-remote)
;; (face-attribute 'org-level-4 :inherit)
;; (htmlize-face-size 'ansi-color-bold)
;; (htmlize-face-size 'org-level-4)

(defun scpaste-stylize-css ()
  "Create a style.css and paste it in your remote directory."
  (let* ((faces scpaste-stylize-faces)
         (face-map (htmlize-make-face-map faces))
         (buffer-faces faces)
         (tmp-file (concat temporary-file-directory "style.css"))
         (full-url (concat scpaste-http-destination
      (htmlize-css-insert-head buffer-faces face-map)
      (goto-char (point-min))
      (delete-region (point-min) (re-search-forward "<!--\n"))
      (goto-char (point-max))
      (re-search-backward "-->")
      (delete-region (point) (point-max))
      (indent-region (point-min) (point-max))
      (write-file tmp-file))
    (let* ((identity (if scpaste-scp-pubkey
                         (concat "-i " scpaste-scp-pubkey) ""))
           (port (if scpaste-scp-port (concat "-P " scpaste-scp-port)))
           (invocation (concat scpaste-scp " -q " identity " " port))
           (command (concat invocation " " tmp-file " "
                            scpaste-scp-destination "/"))
           (error-buffer "*scp-error*")
           (retval (shell-command command nil error-buffer))
           (select-enable-primary t))

      (delete-file tmp-file)
      ;; Notify user and put the URL on the kill ring
      (if (= retval 0)
          (progn (kill-new full-url)
                 (message "Pasted to %s (on kill ring)" full-url))
        (pop-to-buffer error-buffer)

(defun scpaste-stylize (original-name)
  "Paste the current buffer via `scp' to `scpaste-http-destination'.
If ORIGINAL-NAME is an empty string, then the buffer name is used
for the file name."
  (interactive (list (scpaste-read-name)))
  (let* ((b (generate-new-buffer (generate-new-buffer-name "scpaste")))
         (pre-hl-line (and (featurep 'hl-line) hl-line-mode
                           (progn (hl-line-mode -1) t)))
         (hb (funcall scpaste-html-converter))
         (name (replace-regexp-in-string "[/\\%*:|\"<>  ]+" "_"
         ;; add option to replace style with style.css
         (full-url (concat scpaste-http-destination
                           "/" (url-hexify-string name) ".html"))
         (tmp-file (concat temporary-file-directory name))
         (tmp-hfile (concat temporary-file-directory name ".html")))
    (when pre-hl-line
      (hl-line-mode 1))
    ;; Save the files (while adding a footer to html file)
      (copy-to-buffer b (point-min) (point-max))
      (switch-to-buffer b)
      (write-file tmp-file)
      (kill-buffer b)
      (switch-to-buffer hb)
      (goto-char (point-min))
      (search-forward "</body>\n</html>")
      (insert (format (scpaste-footer)
                      (substring full-url 0 -5)))
      ;; replace style from htmlize with <style>
      (goto-char (point-min))
      (let* ((start-string "<style type=\"text/css\">\n *<!--")
            (end-string "\n *-->\n *</style>")
            (end (re-search-forward end-string))
            (start (re-search-backward start-string))
        (delete-region start end)
        (goto-char (point-min))
        (re-search-forward "</title>")
        (insert "\n<link rel=\"stylesheet\" href=\"style.css\">")
      (write-file tmp-hfile)
      (kill-buffer hb))

    (let* ((identity (if scpaste-scp-pubkey
                         (concat "-i " scpaste-scp-pubkey) ""))
           (port (if scpaste-scp-port (concat "-P " scpaste-scp-port)))
           (invocation (concat scpaste-scp " -q " identity " " port))
           (command (concat invocation " " tmp-file " " tmp-hfile " "
                            scpaste-scp-destination "/"))
           (error-buffer "*scp-error*")
           (retval (shell-command command nil error-buffer))
           (select-enable-primary t))

      (delete-file tmp-file)
      (delete-file tmp-hfile)
      ;; Notify user and put the URL on the kill ring
      (if (= retval 0)
          (progn (kill-new full-url)
                 (message "Pasted to %s (on kill ring)" full-url))
        (pop-to-buffer error-buffer)

(defun scpaste-stylize-region (name)
  "Paste the current region via `scpaste'.
NAME is used for the file name."
  (interactive (list (scpaste-read-name (format "-%s-%s" (region-beginning)
  (let ((region-contents (buffer-substring (mark) (point))))
      (insert region-contents)
      (scpaste-stylize name))))

(defun scpaste-stylize-index ()
  "Generate an index of all existing pastes on server on the splash page."
  (let* ((dest-parts (split-string scpaste-scp-destination ":"))
         (files (shell-command-to-string (concat scpaste-ssh " "
                                                 (car dest-parts) " ls "
                                                 (cadr dest-parts))))
         (file-list (split-string files "\n")))
        (insert-file-contents scpaste-el-location)
        (goto-char (point-min))
        (search-forward ";;; Commentary")
        (forward-line -1)
        (insert "\n;;; Pasted Files\n\n")
        (dolist (file file-list)
          (when (and (string-match "\\.html$" file)
                     (not (string-match "private" file)))
            (insert (concat ";; * <" scpaste-http-destination "/" file ">\n"))))
        (if (fboundp 'font-lock-ensure)
            (progn (font-lock-mode nil)
                   (jit-lock-mode t))
          (with-no-warnings ; fallback for Emacs 24
        (rename-buffer "SCPaste")
        (write-file (concat temporary-file-directory "scpaste-index"))
        (scpaste-stylize "index")))))

(provide 'scpaste-stylize)
;;; scpaste-stylize.el ends here

Generated by AlexJGriffith using scpaste at Sun Sep 25 04:52:58 2022. EDT. (original)