emacs.d/init.el

;;;; Copyright © 2013-2022 Lily Carpenter
;;;; All rights reserved.
;;;; Web: https://azrazalea.net
;;;; Email: azra-license@azrazalea.net

;;;; This config is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU Lesser General Public License as published by
;;;; the Free Software Foundation, either version 3 of the License, or
;;;; (at your option) any later version.

;;;; This config 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 Lesser General Public License for more details.

;;;; You should have received a copy of the GNU Lesser General Public License
;;;; along with this config.  If not, see <http://www.gnu.org/licenses/>.
;;;;

(package-initialize)

(server-start)
(require 'misc)

(let ((third-party "~/.emacs.d/third-party/"))
  (add-to-list 'load-path third-party)
  (mapcar #'(lambda (path)
              (add-to-list 'load-path (concat third-party path))
              (byte-recompile-directory (concat third-party path)))
          '("diminish" "lfe-mode"))
  (byte-recompile-directory third-party))

(add-hook 'after-init-hook (lambda ()
                             (require 'use-package)
                             (require 'use-package-ensure)
                             (require 'bind-key)
                             (require 'diminish)
                             (require 'lfe-start)
                             (load "~/.emacs.d/packages")
                             (diminish 'whitespace-mode)
                             (diminish 'auto-revert-mode)
                             (light-colors)
                             (scroll-bar-mode -1)))

(add-hook 'emacs-startup-hook (lambda ()
                                (when (file-exists-p "~/.emacs.d/local_vars.el")
                                  (message "Loading local vars")
                                  (load "~/.emacs.d/local_vars"))))

(put 'erase-buffer 'disabled nil)
(require 'recentf)

;;;; Load other configuration files
;;;; May be able to switch to a directory based load if I determine order doesn't matter
(load "~/.emacs.d/config.d/custom")
(load "~/.emacs.d/config.d/keys")
(load "~/.emacs.d/config.d/mac-compat")
(load "~/.emacs.d/config.d/fira-code")

(put 'scroll-left 'disabled nil)

(setenv "PATH"
        (concat  (getenv "HOME") "/bin:" (getenv "PATH")))

(column-number-mode 1)

(blink-cursor-mode 0)
(setenv "MANWIDTH" (number-to-string (fixed-buffer-width)))
(setenv "TERM" "xterm-color")

(defun dark-colors (&optional frame)
  (interactive)
  (package-install? 'solarized-theme)
  (disable-theme 'solarized-light)
  (disable-theme 'cyberpunk)
  (disable-theme 'leuven)
  (load-theme 'solarized-dark))

(defun presentation-font ()
  (interactive)
  (set-frame-font "Fira Code 24"))

(defun dark-colors-presentation (&optional frame)
  (interactive)
  (package-install? 'reverse-theme)
  (disable-theme 'solarized-light)
  (disable-theme 'solarized-dark)
  (disable-theme 'leuven)
  (load-theme 'reverse))

(defun light-colors (&optional frame)
  (interactive)
  (package-install? 'solarized-theme)
  (disable-theme 'solarized-dark)
  (disable-theme 'reverse)
  (disable-theme 'leuven)
  (load-theme 'solarized-light))

(defun light-colors-presentation (&optional frame)
  (interactive)
  (package-install? 'leuven-theme)
  (disable-theme 'solarized-dark)
  (disable-theme 'solarized-light)
  (disable-theme 'reverse)
  (load-theme 'leuven))

(defun ssh (ssh-to)
  (interactive "sSSH to: ")
  (let ((multi-term-program "ssh")
        (multi-term-buffer-name ssh-to)
        (multi-term-program-switches ssh-to))
    (multi-term)))

(defun ssh-proxy (ssh-to port)
  (interactive "sSSH to: \nsPort[9999]: ")
  (if (string= "" port)
    (setq port "9999"))
  (make-comint-in-buffer "ssh-proxy" nil "ssh" nil "-CND" port ssh-to))

(defun ssh-copy-id (ssh-to)
  (interactive "sSSH to: ")
  (make-comint-in-buffer "ssh-copy-id" nil "ssh-copy-id" nil ssh-to))

(defvar hexcolour-keywords
  '(("#[[:xdigit:]]\\{6\\}"
     (0 (put-text-property (match-beginning 0)
                           (match-end 0)
                           'face (list :background
                                       (match-string-no-properties 0)))))))
(defun hexcolour-add-to-font-lock ()
  (font-lock-add-keywords nil hexcolour-keywords))

(add-hook 'less-css-mode-hook 'hexcolour-add-to-font-lock)

(require 'erc-services)
(erc-services-mode 1)
(add-to-list 'erc-modules 'log 'scrolltobottom)
(erc-update-modules)
(erc-spelling-mode 1)

;;; TeX and LaTeX
(add-to-list 'auto-mode-alist '("\\.latex$" . latex-mode))

;;; Git
(add-to-list 'auto-mode-alist '("\\.gitconfig" . conf-mode))

;;; Buffers
(put 'downcase-region 'disabled nil)
(put 'narrow-to-region 'disabled nil)

;;; GPG stuff.
(require 'epa-file)
;; With this, you can find-file something.gpg and it will just work.
(epa-file-enable)

;;; Whitespace mode
(require 'whitespace)
(global-whitespace-mode 0)
(mapc (lambda (mode-hook)
        (add-hook mode-hook 'whitespace-mode))
      '(c-mode-hook
        c++-mode-hook
        emacs-lisp-mode-hook
        lisp-mode-hook
        python-mode-hook
        ruby-mode-hook))
(define-key global-map (kbd "RET") 'newline-and-indent)
(add-hook 'before-save-hook 'delete-trailing-whitespace)

(add-hook 'prog-mode-hook
          (lambda ()
            (font-lock-add-keywords nil
                                    '(("\\<\\(FIXME\\|TODO\\|BUG\\|XXX\\):" 1 font-lock-warning-face prepend)))))

(defun kill-url (url &rest _ignore)
  "Append URL to kill ring, so that user can take appropriate action."
  (interactive)
  (kill-new url))

;;; Custom Functions
;; Originally from stevey, adapted to support moving to a new directory.
;; <http://stackoverflow.com/a/1834038/693712>
(defun rename-file-and-buffer (new-name)
  "Renames both current buffer and file it's visiting to NEW-NAME."
  (interactive
   (progn
     (if (not (buffer-file-name))
         (error "Buffer '%s' is not visiting a file!" (buffer-name)))
     (list (read-file-name (format "Rename %s to: " (file-name-nondirectory
                                                     (buffer-file-name)))))))
  (if (equal new-name "")
      (error "Aborted rename"))
  (setq new-name (if (file-directory-p new-name)
                     (expand-file-name (file-name-nondirectory
                                        (buffer-file-name))
                                       new-name)
                   (expand-file-name new-name)))
  ;; If the file isn't saved yet, skip the file rename, but still update the
  ;; buffer name and visited file.
  (if (file-exists-p (buffer-file-name))
      (rename-file (buffer-file-name) new-name 1))
  (let ((was-modified (buffer-modified-p)))
    ;; This also renames the buffer, and works with uniquify
    (set-visited-file-name new-name)
    (if was-modified
        (save-buffer)
      ;; Clear buffer-modified flag caused by set-visited-file-name
      (set-buffer-modified-p nil))
  (message "Renamed to %s." new-name)))

;; From http://emacsredux.com/blog/2013/04/03/delete-file-and-buffer/
;; License unknown
(defun delete-file-and-buffer ()
  "Kill the current buffer and deletes the file it is visiting."
  (interactive)
  (let ((filename (buffer-file-name)))
    (when filename
      (if (vc-backend filename)
          (vc-delete-file filename)
        (progn
          (delete-file filename)
          (message "Deleted file %s" filename)
          (kill-buffer))))))

;; http://www.emacswiki.org/emacs/ElispCookbook
;; Under Trim Whitespace
(defun chomp (str)
  "Chomp leading and tailing whitespace from STR."
  (replace-regexp-in-string (rx (or (: bos (* (any " \t\n")))
                                    (: (* (any " \t\n")) eos)))
                            ""
                            str))


;; Gets current git top dir
(defun git-top-dir ()
  (projectile-project-root))

;; Run rspecs at root of git
(defun git-run-rspecs ()
  (interactive)
  (let ((default-directory (git-top-dir)))
    (if (and default-directory (file-directory-p default-directory))
        (let ((buffer-name "*rspec output*"))
          (if (get-buffer buffer-name)
              (with-current-buffer buffer-name
                (erase-buffer)))
          (start-process "git-rspec" buffer-name "rspec")
          (display-buffer buffer-name))
      (error "No valid top git directory found"))))

;; Rebase all whitespace seperated branches on top of each other,
;; from left to right. Current branch will be on the bottom
(defun git-tree-rebase (branches)
  (interactive "sWhitespace seperated list of branches: ")
  (let ((branches (split-string branches))
        (prev-branch (magit-get-current-branch)))
    (dolist (cur-branch branches)
      (let ((rc (shell-command (format "git checkout %s; git rebase %s" cur-branch prev-branch))))
        (if (not (equal rc 0))
            (error "Failed to rebase %s on %s" cur-branch prev-branch)))
      (setq prev-branch cur-branch))))

;; Force update all whitespace seperated branches
(defun git-fix-tree (branches)
  (interactive "sWhitespace seperated list of branches: ")
  (let ((branches (split-string branches)))
    (dolist (branch branches)
      (let ((rc (shell-command (format "git push origin :%s; git push origin %s" branch branch))))
        (if (not (equal rc 0))
            (error "Failed to fix branch %s" branch))))))

;; Get current branch
(defun git-current-branch ()
  (let ((default-directory (git-top-dir)))
    (if default-directory
        (chomp (shell-command-to-string "git rev-parse --abbrev-ref HEAD"))
      (error "Failed to get top directory of repo"))))

;; Set experimental to current branch and push
(defun git-set-experimental ()
  (interactive)
  (let* ((current-branch (git-current-branch))
         (rc (shell-command (format "git branch -f experimental %s;" current-branch))))
    (if (not (equal rc 0))
        (error "Failed to move branch experimental to %s" current-branch)))
  (git-fix-tree "experimental"))

;; Check entire git repo's ruby syntax
(require 'find-lisp)
(defun git-check-ruby ()
  (interactive)
  (let ((default-directory (git-top-dir)))
    (if (and default-directory (file-directory-p default-directory))
        (let ((buffer-name "*syntax checker*"))
          (if (get-buffer buffer-name)
              (with-current-buffer buffer-name
                (erase-buffer)))
          (dolist (file (find-lisp-find-files default-directory "\\.rb$"))
              (start-process "ruby-syntax-check" buffer-name "ruby" "-c" file))
          (display-buffer buffer-name))
      (error "Syntax check failed."))))

;; Check whether or not a git repo is dirty
(defun git-dirty? (directory)
  (let* ((default-directory directory)
         (status (shell-command-to-string "git status -s"))
         (good-status '("" " M .gitmodules\n" "M .gitmodules\n"))
         (result t))
    (if (member status good-status)
        (setq result nil))
    result))

;; Update a git repo
;; TODO: Make this work with main or master not just master
(defun update-git (directory)
  (let* ((default-directory directory)
        (orig-branch (magit-get-current-branch))
        rc)
    (setq rc (shell-command "git checkout master && git pull"))
    (if (not (equal rc 0))
        (error "Error: Failed to update repo %s" directory))
    (setq rc (shell-command (format "git checkout %s" orig-branch)))
    (if (not (equal rc 0))
        (error "Error: Failed to checkout original branch %s in repo %s" orig-branch directory))))

;; Update all repos in the home directory
(defun update-all-repos ()
  (interactive)
  (let* ((directory (concat  (getenv "HOME") "/git-repos"))
         (files (directory-files-and-attributes directory t)))
    (dolist (file files)
      (cond
       ;; Ignore . and ..
       ((or (string-match "\\.$" (car file)) (string-match "\\.\\.$" (car file))))
       ;; Directories with non dirty git need to be checked for git info
       ((and (eq t (car (cdr file))) (not (git-dirty? (format "%s/" (car file)))))
        (update-git (format "%s/" (car file))))))))

(defun kill-dired-buffers ()
  (interactive)
  (mapc (lambda (buffer)
          (when (eq 'dired-mode (buffer-local-value 'major-mode buffer))
            (kill-buffer buffer)))
        (buffer-list)))

(defun kill-tramp-buffers ()
  (interactive)
  (tramp-cleanup-all-connections)
  (tramp-cleanup-all-buffers))

(defun git-all-files ()
  (let ((default-directory (git-top-dir)))
    (split-string (shell-command-to-string "git ls-tree -r --name-only --full-name HEAD"))))

;; A proper projectile replace with regex support
(defun git-replace-regexp (from to)
  (interactive "sFrom regexp: \nsTo regexp: ")
  (let ((files '(delq nil (mapcar (lambda (directory)
                                    (let ((file (concat (projectile-project-root) directory)))
                                      (if (file-writable-p file)
                                          file)))
                                  (git-all-files)))))
    (tags-query-replace from to nil files)))

;; From http://stackoverflow.com/a/7250027/693712
(defun smart-line-beginning ()
  "Move point to the beginning of text on the current line; if that is already
the current position of point, then move it to the beginning of the line."
  (interactive)
  (let ((pt (point)))
    (beginning-of-line-text)
    (when (eq pt (point))
      (beginning-of-line))))

(add-hook 'prog-mode-hook (lambda () (local-set-key (kbd "C-a") 'smart-line-beginning)))

;;; Eshell Functions
;; Taken from <http://www.emacswiki.org/emacs/EshellFunctions>
(defun eshell/emacs (&rest args)
  "Open a file in emacs. Some habits die hard."
  (if (null args)
      ;; If I just ran "emacs", I probably expect to be launching
      ;; Emacs, which is rather silly since I'm already in Emacs.
      ;; So just pretend to do what I ask.
      (bury-buffer)
    ;; We have to expand the file names or else naming a directory in an
    ;; argument causes later arguments to be looked for in that directory,
    ;; not the starting directory
    (mapc #'find-file (mapcar #'expand-file-name (eshell-flatten-list (reverse args))))))

(defun format-commands (&rest commands)
  (mapcar (lambda (command)
            (shell-command (apply 'format command)))
          commands))

(defun eshell/git-branch-here (branch)
  (format-commands `("git push origin :%s" ,branch)
                   `("git branch -d %s" ,branch)
                   `("git checkout -b %s" ,branch)
                   `("git push origin %s:%s" ,branch ,branch)))

(defun eshell/git-experimental-here ()
  (eshell/git-branch-here "experimental"))

;;; Spell Checking
(add-hook 'prog-mode-hook 'flyspell-prog-mode)

(mapcar #'(lambda (mode-hook)
            (add-hook mode-hook 'flyspell-mode))
        '(latex-mode-hook
          magit-log-edit-mode-hook
          org-mode-hook
          message-mode-hook))

;;; Maxima
(add-to-list 'load-path "/usr/share/maxima/5.32.1/emacs/")
(autoload 'maxima-mode "maxima" "Maxima mode" t)
(autoload 'imaxima "imaxima" "Frontend for maxima with Image support" t)
(autoload 'maxima "maxima" "Maxima interaction" t)
(autoload 'imath-mode "imath" "Imath mode for math formula input" t)
(setq imaxima-use-maxima-mode-flag t
      imaxima-pt-size 12
      imaxima-fnt-size "large"
      imaxima-max-scale nil
      imaxima-linearize-flag nil)
(add-to-list 'auto-mode-alist '("\\.ma[cx]" . maxima-mode))

(global-prettify-symbols-mode)

(defun bf-pretty-print-xml-region (begin end)
  "Pretty format XML markup in region. You need to have nxml-mode
http://www.emacswiki.org/cgi-bin/wiki/NxmlMode installed to do
this.  The function inserts linebreaks to separate tags that have
nothing but whitespace between them.  It then indents the markup
by using nxml's indentation rules."
  (interactive "r")
  (save-excursion
      (nxml-mode)
      (goto-char begin)
      (while (search-forward-regexp "\>[ \\t]*\<" nil t)
        (backward-char) (insert "\n"))
      (indent-region begin end))
    (message "Ah, much better!"))

;; Only should be used in init, use use-package elsewhere
(defun package-install? (package-name)
  (when (not (package-installed-p package-name))
    (package-install package-name)))

(defun insert-random-uuid ()
  (interactive)
  (lexical-let ((string (replace-regexp-in-string "\n" "" (shell-command-to-string "uuidgen"))))
    (insert string)
    (kill-new string)))

(defun eslint-autofix ()
  (interactive)
  (let ((default-directory (flycheck-eslint--find-working-directory nil)))
    (flycheck-call-checker-process 'javascript-eslint nil nil nil "--fix" buffer-file-name)))

(add-hook 'js-mode-hook
          (lambda ()
            (add-hook 'after-save-hook #'eslint-autofix nil 'make-it-local)))
(add-hook 'web-mode-hook
          (lambda ()
            (when (string-equal "tsx" (file-name-extension buffer-file-name))
              (add-hook 'after-save-hook #'eslint-autofix nil 'make-it-local))))
(add-hook 'typescript-mode-hook
          (lambda ()
            (add-hook 'after-save-hook #'eslint-autofix nil 'make-it-local)))