2021-01-30 19:11:54 +00:00
|
|
|
;;; misc/config-publishing/initialise.el --- common initialisation procudure -*- lexical-binding: t; -*-
|
2021-01-22 21:01:45 +00:00
|
|
|
|
|
|
|
(setq start-time (float-time)
|
|
|
|
exit-code 0)
|
|
|
|
|
2021-01-30 20:49:31 +00:00
|
|
|
(defvar script-root default-directory)
|
2021-01-22 21:01:45 +00:00
|
|
|
(defvar config-root (file-name-directory ; $DOOM_DIR/
|
|
|
|
(directory-file-name
|
|
|
|
(file-name-directory ; $DOOM_DIR/misc
|
|
|
|
(directory-file-name
|
|
|
|
(file-name-directory load-file-name))))))
|
|
|
|
|
2022-12-09 12:02:49 +00:00
|
|
|
(add-to-list 'load-path ; Allow require-ing subconf modules.
|
|
|
|
(expand-file-name "subconf" config-root))
|
2021-01-22 21:01:45 +00:00
|
|
|
|
2021-01-23 14:23:24 +00:00
|
|
|
(defvar log-file "unnamed-log.txt")
|
2021-01-22 21:01:45 +00:00
|
|
|
|
|
|
|
(write-region "" nil log-file)
|
|
|
|
|
2022-12-09 12:02:49 +00:00
|
|
|
(setq print-level nil
|
|
|
|
print-length nil
|
|
|
|
print-escape-newlines t
|
|
|
|
print-quoted t)
|
|
|
|
|
2021-01-23 12:14:39 +00:00
|
|
|
;;; Messaging
|
|
|
|
|
2021-05-16 06:10:44 +00:00
|
|
|
(defvar log-messages t)
|
|
|
|
|
|
|
|
(defun logged-string (str &optional _term)
|
|
|
|
(let ((inhibit-message t)
|
|
|
|
(coding-system-for-write 'utf-8))
|
|
|
|
(append-to-file str nil log-file)))
|
2021-01-22 21:01:45 +00:00
|
|
|
|
2021-05-16 06:10:44 +00:00
|
|
|
(when log-messages
|
|
|
|
(advice-add 'send-string-to-terminal :after #'logged-message))
|
2021-01-22 21:01:45 +00:00
|
|
|
|
2021-05-16 06:10:44 +00:00
|
|
|
(defvar message-colour t)
|
2021-01-22 21:01:45 +00:00
|
|
|
|
|
|
|
(defun red-error (orig-fn &rest args)
|
|
|
|
(message "\033[0;31m" 'unmodified)
|
|
|
|
(apply orig-fn args)
|
|
|
|
(message "\033[0m" 'unmodified)
|
|
|
|
(setq exit-code 1))
|
|
|
|
|
|
|
|
(defun timed-coloured-message (orig-fn format-str &rest args)
|
|
|
|
(cond
|
|
|
|
((eq (car args) 'unmodified)
|
|
|
|
(apply orig-fn format-str (cdr args)))
|
|
|
|
((or (not format-str) (string-match-p "\\[%\\\\4.1fs\\]" format-str))
|
|
|
|
(apply orig-fn format-str args))
|
|
|
|
(t
|
|
|
|
(apply orig-fn
|
|
|
|
(concat (if (string-match-p "^\\[[0-9;]+\\]" format-str)
|
|
|
|
(replace-regexp-in-string
|
|
|
|
"^\\(?:\\[\\([0-9;]+\\)\\] ?\\)?"
|
|
|
|
"\033[\\1m[%4.1fs] "
|
|
|
|
format-str)
|
|
|
|
(concat "[%4.1fs] " format-str))
|
|
|
|
"\033[0;90m")
|
|
|
|
(append (list (- (float-time) start-time))
|
|
|
|
args)))))
|
|
|
|
|
|
|
|
(when message-colour
|
2022-12-09 12:02:49 +00:00
|
|
|
(advice-add 'debug :around #'red-error))
|
|
|
|
;; (advice-add 'message :around #'timed-coloured-message))
|
|
|
|
;; (advice-add 'doom--print :around #'timed-coloured-message))
|
2021-01-22 21:01:45 +00:00
|
|
|
|
2021-01-23 12:14:39 +00:00
|
|
|
;;; Initialisation
|
|
|
|
|
2022-12-09 12:02:49 +00:00
|
|
|
(defun initialise (&optional mode)
|
2021-01-22 21:01:45 +00:00
|
|
|
(advice-add 'theme-magic-from-emacs :override #'ignore)
|
|
|
|
(advice-add 'format-all-buffer :override #'ignore)
|
|
|
|
|
2022-12-09 12:02:49 +00:00
|
|
|
(pcase mode
|
|
|
|
('full
|
|
|
|
(load "~/.config/emacs/early-init.el")
|
|
|
|
(require 'doom-start)
|
|
|
|
(require 'flycheck) ; To avoid issues that crop up with org-flycheck.
|
|
|
|
(defmacro flycheck-prepare-emacs-lisp-form (&rest _)))
|
|
|
|
('light
|
|
|
|
(setq gc-cons-threshold 16777216
|
|
|
|
gcmh-high-cons-threshold 16777216)
|
|
|
|
(load "~/.config/emacs/lisp/doom.el")
|
|
|
|
(require 'doom-cli)
|
|
|
|
(doom-initialize-packages)))
|
2021-01-22 21:01:45 +00:00
|
|
|
|
2021-05-16 06:10:44 +00:00
|
|
|
(setq doom-cli-log-error-file log-file)
|
|
|
|
(write-region "" nil log-file nil :silent)
|
|
|
|
|
2021-01-25 02:19:59 +00:00
|
|
|
(defalias 'y-or-n-p #'ignore)
|
|
|
|
|
2021-01-29 15:25:26 +00:00
|
|
|
(advice-add 'ask-user-about-supersession-threat :override #'ignore)
|
|
|
|
|
2022-12-09 12:02:49 +00:00
|
|
|
(setq debug-on-error t
|
|
|
|
doom-debug-p t)
|
2021-03-03 15:13:45 +00:00
|
|
|
(add-hook! 'doom-debug-mode-hook
|
|
|
|
(explain-pause-mode -1))
|
|
|
|
|
2022-12-09 12:02:49 +00:00
|
|
|
(setq emojify-download-emojis-p nil)
|
2021-03-28 07:55:47 +00:00
|
|
|
(unless (boundp 'image-types) ; why on earth is this needed?
|
|
|
|
(setq image-types '(svg png gif tiff jpeg xpm xbm pbm)))
|
2021-03-28 07:05:01 +00:00
|
|
|
|
2021-01-29 15:25:26 +00:00
|
|
|
(after! undo-tree
|
2021-01-22 21:01:45 +00:00
|
|
|
(global-undo-tree-mode -1)
|
2021-01-29 15:25:26 +00:00
|
|
|
(advice-add 'undo-tree-mode :override #'ignore)
|
|
|
|
(remove-hook 'write-file-functions #'undo-tree-save-history-from-hook)
|
|
|
|
(remove-hook 'kill-buffer-hook #'undo-tree-save-history-from-hook)
|
|
|
|
(remove-hook 'find-file-hook #'undo-tree-load-history-from-hook)))
|
2021-01-23 12:14:39 +00:00
|
|
|
|
|
|
|
;;; Publishing
|
|
|
|
|
|
|
|
(defvar publish-dir (expand-file-name "publish/" config-root))
|
|
|
|
|
|
|
|
(defvar known-existing-dirs (list config-root))
|
|
|
|
(defun ensure-dir-exists (file-or-dir)
|
|
|
|
(let ((dir (file-name-directory (expand-file-name file-or-dir config-root))))
|
|
|
|
(unless (member dir known-existing-dirs)
|
|
|
|
(unless (file-exists-p dir)
|
|
|
|
(make-directory dir t))
|
|
|
|
(push dir known-existing-dirs))))
|
|
|
|
|
2022-12-09 12:02:49 +00:00
|
|
|
(require 'dired)
|
|
|
|
|
2021-01-23 12:14:39 +00:00
|
|
|
(defun publish (&rest files)
|
|
|
|
"Move each file into `publish'.
|
2022-12-09 12:02:49 +00:00
|
|
|
Names containing \"*\" are treated as a glob.
|
|
|
|
In addition to strings, files may also be a (glob . target-dir) cons cell."
|
|
|
|
(message "files: %S" files)
|
|
|
|
(let (uproot)
|
|
|
|
(when (eq (car files) :uproot)
|
|
|
|
(setq uproot t)
|
|
|
|
(pop files))
|
|
|
|
(dolist (file files)
|
|
|
|
(if (consp file)
|
|
|
|
(let ((publish-dir (file-name-as-directory (expand-file-name (cdr file) publish-dir))))
|
|
|
|
(if uproot
|
|
|
|
(publish :uproot (car file))
|
|
|
|
(publish (car file))))
|
|
|
|
(if (string-match-p "\\*" file)
|
|
|
|
(apply #'publish
|
|
|
|
(append
|
|
|
|
(and uproot (list :uproot))
|
|
|
|
(directory-files (expand-file-name (or (file-name-directory file) "./") config-root)
|
|
|
|
t
|
|
|
|
(dired-glob-regexp (file-name-nondirectory file)))))
|
|
|
|
(unless (string-match-p "/\\.\\.?$" file)
|
|
|
|
(let ((target (if uproot
|
|
|
|
(expand-file-name (file-name-nondirectory file) publish-dir)
|
|
|
|
(replace-regexp-in-string (regexp-quote config-root)
|
|
|
|
publish-dir
|
|
|
|
(expand-file-name file config-root)))))
|
|
|
|
(message (concat (when message-colour "[34] ") "Publishing %s -> %s")
|
|
|
|
(replace-regexp-in-string (regexp-quote config-root) "" file)
|
|
|
|
(replace-regexp-in-string (regexp-quote config-root) "" target))
|
|
|
|
(ensure-dir-exists target)
|
|
|
|
(copy-file (expand-file-name file config-root) target t))))))))
|