;; dont ask if file doesn't exist (setq confirm-nonexistent-file-or-buffer nil) ;; dont ask for comfirmation when killing a buffer with a process in it (setq kill-buffer-query-functions (remq 'process-kill-buffer-query-function kill-buffer-query-functions)) (unless (getenv "LC_ALL") (setenv "LC_ALL" "en_US.utf8") (setenv "LANG" "en_US.utf8")) (defun my-path-join* (rest) (if (cdr rest) (concat (file-name-as-directory (car rest)) (my-path-join* (cdr rest))) (car rest))) (defun my-path-join (&rest args) (my-path-join* args)) (defconst emacs-root-init-dir (file-name-directory load-file-name)) (defun emacs-root-join (&rest args) (apply 'my-path-join (cons emacs-root-init-dir args))) (defconst user-home-dir (getenv "HOME")) (defun user-home-join (&rest args) (apply 'my-path-join (cons user-home-dir args))) ;; Tmp dir for saving backups (defconst my-emacs-backups-dir (emacs-root-join "backups~")) (setq backup-directory-alist `((".*" . ,my-emacs-backups-dir))) (setq auto-save-file-name-transforms `((".*" ,my-emacs-backups-dir t))) (setq auto-save-list-file-prefix my-emacs-backups-dir) ;; Don't disable downcase (put 'downcase-region 'disabled nil) ;;;;;;;;;;;;; ;; HELPERS ;; ;;;;;;;;;;;;; (defun sh (proc &rest args) (string-trim-right (car (apply 'call-process-with-output (cons proc args))))) (defun set-in-alist (alist key value) (let ((cur alist) (ret nil) (repl (cons key value)) (foundq nil)) (while cur (let* ((cell (car cur)) (iseq (equal key (car cell))) (new (if iseq repl cell))) (if iseq (setq foundq t)) (setq ret (cons new ret))) (setq cur (cdr cur))) (unless foundq (setq ret (cons repl ret))) ret)) (defmacro set-in-alist! (alist key value) `(setq ,alist (set-in-alist ,alist ,key ,value))) (defun cl--mapcar-many (cl-func cl-seqs &optional acc) (if (cdr (cdr cl-seqs)) (let* ((cl-res nil) (cl-n (apply 'min (mapcar 'length cl-seqs))) (cl-i 0) (cl-args (copy-sequence cl-seqs)) cl-p1 cl-p2) (setq cl-seqs (copy-sequence cl-seqs)) (while (< cl-i cl-n) (setq cl-p1 cl-seqs cl-p2 cl-args) (while cl-p1 (setcar cl-p2 (if (consp (car cl-p1)) (prog1 (car (car cl-p1)) (setcar cl-p1 (cdr (car cl-p1)))) (aref (car cl-p1) cl-i))) (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2))) (if acc (push (apply cl-func cl-args) cl-res) (apply cl-func cl-args)) (setq cl-i (1+ cl-i))) (and acc (nreverse cl-res))) (let ((cl-res nil) (cl-x (car cl-seqs)) (cl-y (nth 1 cl-seqs))) (let ((cl-n (min (length cl-x) (length cl-y))) (cl-i -1)) (while (< (setq cl-i (1+ cl-i)) cl-n) (let ((val (funcall cl-func (if (consp cl-x) (pop cl-x) (aref cl-x cl-i)) (if (consp cl-y) (pop cl-y) (aref cl-y cl-i))))) (when acc (push val cl-res))))) (and acc (nreverse cl-res))))) (defun zip-with (cl-func cl-x &rest cl-rest) "Apply FUNCTION to each element of SEQ, and make a list of the results. If there are several SEQs, FUNCTION is called with that many arguments, and mapping stops as soon as the shortest list runs out. With just one SEQ, this is like `mapcar'. With several, it is like the Common Lisp `mapcar' function extended to arbitrary sequence types. \n(fn FUNCTION SEQ...)" (if cl-rest (if (or (cdr cl-rest) (nlistp cl-x) (nlistp (car cl-rest))) (cl--mapcar-many cl-func (cons cl-x cl-rest) 'accumulate) (let ((cl-res nil) (cl-y (car cl-rest))) (while (and cl-x cl-y) (push (funcall cl-func (pop cl-x) (pop cl-y)) cl-res)) (nreverse cl-res))) (mapcar cl-func cl-x))) (defun repeat-n (n f) (funcall f) (if (> n 0) (repeat-n (- n 1) f))) (defun list-to-string (list) (mapconcat 'string list "")) ;;;; scrolling (defun window-half-height () (max 1 (/ (1- (window-height (selected-window))) 4))) (defun scroll-up-half () (interactive) (scroll-up (window-half-height)) ) (defun scroll-down-half () (interactive) (scroll-down (window-half-height)) ) ;;;; buffers (defun my-save-buffer-force () (let ((save-silently t) (inhibit-message t)) (basic-save-buffer-1))) (defun my-save-buffer (buf) (when (and (buffer-file-name buf) (buffer-modified-p buf)) (with-current-buffer buf (make-thread 'my-save-buffer-force)))) (defun my-save-current-buffer () (my-save-buffer (current-buffer))) (defun my-save-current-buffer-sync () (let ((maybe-thread (my-save-current-buffer))) (and maybe-thread (thread-join maybe-thread)))) (defun kill-buffer-fast () "Saves and kills CURRENT buffer." (interactive) (when (and buffer-file-name (file-writable-p buffer-file-name)) (my-save-current-buffer-sync)) (kill-buffer (current-buffer))) ;;;; editor (defun move-line-up () "Move up the current line." (interactive) (transpose-lines 1) (forward-line -2) (indent-according-to-mode) ) (defun move-line-down () "Move down the current line." (interactive) (forward-line 1) (transpose-lines 1) (forward-line -1) (indent-according-to-mode) ) ;;;; other (defun my-grep () (interactive) (let ((arg (read-shell-command "grep: " nil 'grep-history))) (let ((command (concat grep-command " " arg))) (compilation-start command 'grep-mode)))) (defun program-resolve-path (program) (string-trim (car (call-process-with-output "which" "fish")))) (defun call-process-with-output (proc &rest args) (let ((return-code -1)) (list (with-output-to-string (with-current-buffer standard-output (setq return-code (apply 'call-process (append (list proc nil t nil) args))))) return-code))) (defun my-git-save () (interactive) (my-save-current-buffer) (let ((out (call-process-with-output "gcma" "save"))) (message "%s" (string-trim (car out))))) (defun my-git-status () (interactive) (my-save-current-buffer) (let ((out (sh "git" "status" "--short"))) (when (string-empty-p out) (setq out (sh "git" "status"))) (message "%s" out))) (defun my-revert-buffer () (interactive) (message (if (revert-buffer nil t nil) "I reverted buffer :)" "I failed you, sensei"))) ;;;;;;;;;; ;; KEYS ;; ;;;;;;;;;; (global-set-key (kbd "M-e") 'forward-paragraph) (global-set-key (kbd "M-a") 'backward-paragraph) (global-set-key (kbd "C-{") 'shrink-window-horizontally) (global-set-key (kbd "C-}") 'enlarge-window-horizontally) (global-set-key (kbd "C-^") 'enlarge-window) (global-set-key (kbd "M-") 'move-line-up) (global-set-key (kbd "M-") 'move-line-down) (global-set-key (kbd "C-z") nil) ;; for terminal compatibilty (global-set-key (kbd "C-x ;") 'comment-line) ;; transient keymap used once cycling starts (setq buffer-flip-map (let ((map (make-sparse-keymap))) (define-key map (kbd "M-p") 'buffer-flip-forward) (define-key map (kbd "M-n") 'buffer-flip-backward) (define-key map (kbd "M-g") 'buffer-flip-abort) map)) (defmacro my-bind-all (&rest pairs) `(progn ,@(mapcar (lambda (p) (let ((key (car p)) (val (cdr p))) (if (consp (car val)) `(define-key keymap (kbd ,key) (lambda () (interactive) ,@val)) `(define-key keymap (kbd ,key) (quote ,(car val)))))) pairs))) (setq my-window-map (let ((keymap (make-sparse-keymap))) (my-bind-all ("M-b" split-window-below) ("M-v" split-window-right) ("M-q" delete-window) ("M-S-q" (quit-window 1)) ("M-k" kill-buffer-fast) ("M-a" windmove-left) ("M-s" windmove-down) ("M-w" windmove-up) ("M-d" windmove-right) ("e" buffer-menu) ("M-e" switch-to-buffer) ("M-i" (find-file ".")) ("M-x" (save-buffers-kill-terminal t)) ("M-f" projectile-find-file) ("M-g" my-grep) ("r" my-revert-buffer) ("M-r" query-replace) ("M--" my-default-font-size-dec!) ("M-=" my-default-font-size-inc!) ("M-j" my-git-save) ("M-h" my-git-status) ("M-p" buffer-flip) ("M-n" (buffer-flip) (buffer-flip-forward) (buffer-flip-forward) (buffer-flip-forward)) ("M-c" shell-command) ("c" my-term-exe) ("M-t" my-term) ("M-y" my-term-taged)) ;; terminal for each number (defmacro macr (z) `(define-key keymap (kbd (format "M-%d" ,z)) (lambda () (interactive) (my-term-indexed ,z)))) (mapc #'(lambda (i) (eval `(macr ,i))) (list 1 2 3 4 5 6 7 8 9)) keymap)) (global-set-key (kbd "M-o") my-window-map) ;;;;;;;;;;;;;; ;; AUTOSAVE ;; ;;;;;;;;;;;;;; (defun my-select-window-advice (orig-fun &rest args) (let ((old (current-buffer))) (apply orig-fun args) (unless (or (= ? (elt (buffer-name (current-buffer)) 0)) ; internal? (equal old (current-buffer))) (my-save-buffer old)))) (advice-add 'select-window :around 'my-select-window-advice) (advice-add 'switch-to-buffer :around 'my-select-window-advice) (add-function :after after-focus-change-function #'my-save-current-buffer) ;;;;;;;;;; ;; LOOK ;; ;;;;;;;;;; (font-lock-add-keywords 'scheme-mode '(("\\('\\([^] (){}[]+\\)\\|\\b[0-9]+\\b\\)" . font-lock-constant-face))) (setq-default frame-title-format '("%b")) (defun my-default-font-size-set! (size) (set-face-attribute 'default nil :height size)) (defun my-default-font-size () (interactive) (face-attribute 'default :height nil)) (defun my-default-font-size-inc! () (interactive) (my-default-font-size-set! (round (* 1.1 (my-default-font-size))))) (defun my-default-font-size-dec! () (interactive) (my-default-font-size-set! (round (* 0.9 (my-default-font-size))))) (my-default-font-size-set! 180) (setq whitespace-style '(face trailing tab-mark)) (setq-default truncate-lines 1) (defun my-prog-mode-hook () (whitespace-mode 1) (line-number-mode t) (column-number-mode t) (setq buffer-face-mode-remapping (face-remap-add-relative 'default '(:family "Fira Code"))) (set-input-method "TeX")) (add-hook 'prog-mode-hook 'my-prog-mode-hook) (defconst initial-scroll-preserve-screen-position scroll-preserve-screen-position) (defconst initial-scroll-conservatively scroll-conservatively) (defconst initial-maximum-scroll-margin maximum-scroll-margin) (defconst initial-scroll-margin scroll-margin) (define-minor-mode my-centered-cursor-mode "Major mode for editing Work Time pseudocode" :lighter " Centered" :after-hook (if my-centered-cursor-mode (setq-local scroll-preserve-screen-position t scroll-conservatively 1 maximum-scroll-margin 0.5 scroll-margin 99999) (setq-local scroll-preserve-screen-position initial-scroll-preserve-screen-position scroll-conservatively initial-scroll-conservatively maximum-scroll-margin initial-maximum-scroll-margin scroll-margin initial-scroll-margin))) ;;;;;;;;;;;;;;; ;; LOOK/TABS ;; ;;;;;;;;;;;;;;; ;; Make the backspace properly erase the tab instead of ;; removing 1 space at a time. (setq backward-delete-char-untabify-method 'hungry) ;; tab width (defconst my-default-tab-width 4) (setq-default tab-width my-default-tab-width) (setq custom--width 4) (setq indent-tabs-mode t) (setq-default indent-tabs-mode t) (setq my-global-tab-mode t) (defun disable-tabs () (interactive) (setq-local indent-tabs-mode nil)) (defun enable-tabs () (interactive) (local-set-key (kbd "TAB") 'self-insert-command) (setq-local indent-tabs-mode t)) (defun global-disable-tabs () (interactive) (setq my-global-tab-mode nil) (tabs-reset-defaults-local)) (defun global-enable-tabs () (interactive) (setq my-global-tab-mode t) (tabs-reset-defaults-local)) (defun tabs-reset-defaults-local () (setq-local tab-width my-default-tab-width) (if (or (not my-global-tab-mode) (memq major-mode '(lisp-mode emacs-lisp-mode racket-mode scheme-mode guile-mode agda-mode agda2-mode))) (disable-tabs) (enable-tabs))) (add-hook 'prog-mode-hook 'tabs-reset-defaults-local) ;; (defun reset-local-tab-with () ;; (setq-local tab-width my-default-tab-width)) ;; (add-hook 'haskell-mode-hook 'reset-local-tab-width) ;;;;;;;;;;;;;;;;;;;;;; ;; BUILTIN PACKAGES ;; ;;;;;;;;;;;;;;;;;;;;;; ;; always use minimal dired (add-hook 'dired-mode-hook 'dired-hide-details-mode) (set-in-alist! auto-mode-alist "\\.jsx\\'" 'javascript-mode) (set-in-alist! auto-mode-alist "\\.ts\\'" 'javascript-mode) (set-in-alist! auto-mode-alist "\\.tsx\\'" 'javascript-mode) ;; (mode (latex ;; (disable latex autoindent (defun JH/remove-electric-indent-mode () (electric-indent-local-mode -1)) (add-hook 'LaTeX-mode-hook 'JH/remove-electric-indent-mode) (add-hook 'tex-mode-hook 'JH/remove-electric-indent-mode) ;; disable latex autoindent) ;; latex) mode) ;; ido mode ;; alternatives are `iswitchb-mode' (obsolete but faster) and `icomplete-mode' ;; remaps `switch-to-buffer' only ;; use `ido-find-file' command for ido files (ido-mode 'buffer) (setq-default grep-command "grep --color -HRIn") (setq grep-command "grep --color -HRIn") (defun my-c-mode-hook () (c-set-style "user")) (add-hook 'c-mode-hook 'my-c-mode-hook) (setq-default c-syntactic-indentation nil) (defun my-haskell-mode-hook () (haskell-tab-indent-mode)) (add-hook 'haskell-mode-hook 'my-haskell-mode-hook) (global-set-key (kbd "C-x g") 'magit-status) (defun my-text-mode-hook () (visual-line-mode 1) (my-centered-cursor-mode 1)) (add-hook 'text-mode-hook 'my-text-mode-hook) ;;;;;;;;;;;; ;; CUSTOM ;; ;;;;;;;;;;;; (defun my-temp-project () (interactive) (let* ((name (make-temp-name "my-emacs-")) (dir (temporary-file-directory)) (s (my-path-join dir name))) (mkdir s) (find-file (my-path-join s "main.scm"))))