Skip to content

Instantly share code, notes, and snippets.

Created December 6, 2023 11:34
Show Gist options
  • Save piotrklibert/44801d13513ac1c9aca5b4522bbbde79 to your computer and use it in GitHub Desktop.
Save piotrklibert/44801d13513ac1c9aca5b4522bbbde79 to your computer and use it in GitHub Desktop.
;; -*- mode: emacs-lisp; lexical-binding: t -*-
(require 's)
(require 'use-package)
(require 'my-langs-common)
(require 'outline)
(require 'leaf)
(require 'leaf-keywords)
(require 'xr)
(require 'view)
(require 'ppp)
(require 'elint)
(defconst my-ppp-popup-buffer "*Pretty-Printer*")
(defvar my-ppp-expand-expander 'macroexpand
"The expander to use when expanding macros with `my-ppp-expand-*' commands.
Can be one of: `macroexpand-1', `macroexpand', `macroexpand-all'.")
(defvar my-ppp-expand-display-action
'(display-buffer-pop-up-window . ((window-width . 90))))
;; '(display-buffer-pop-up-frame
;; (pop-up-frame-parameters . ((top . (+ 130))
;; (left . (+ 130))
;; (height . 20)
;; (width . 129))))
(cl-defun my-ppp-expand--expand-form (form)
"Read the sexp at point, recursively expand all macros, pretty-print results"
(kill-buffer my-ppp-popup-buffer))
(with-current-buffer (get-buffer-create my-ppp-popup-buffer)
(insert (with-output-to-string (ppp-sexp (funcall my-ppp-expand-expander form))))
(read-only-mode 1)
(make-local-variable 'view-mode-map)
(define-key view-mode-map (kbd "q") #'View-quit-and-kill-buffer))
(display-buffer my-ppp-popup-buffer my-ppp-expand-display-action))
(cl-defun my-ppp-expand-at-pt (form)
"Read the sexp at point, recursively expand all macros, pretty-print results"
(interactive (list (read (thing-at-point 'sexp))))
(my-ppp-expand--expand-form form))
(cl-defun my-ppp-expand-all-at-pt (form)
"Read the sexp at point, recursively expand all macros, pretty-print results"
(interactive (list (read (thing-at-point 'sexp))))
(let ((my-ppp-expand-expander 'macroexpand-all))
(my-ppp-expand--expand-form form)))
(cl-defun my-ppp-expand-1-at-pt (form)
"Read the sexp at point, expand one level of macros, pretty-print results"
(interactive (list (read (thing-at-point 'sexp))))
(let ((my-ppp-expand-expander 'macroexpand-1))
(my-ppp-expand--expand-form form)))
(cl-defun View-quit-and-kill-buffer ()
(kill-buffer my-ppp-popup-buffer)))
;; (my-ppp-list-insert '(a b c))
(defun my-ppp-list-insert (form)
(goto-char (line-end-position))
(forward-line 1)
(cl-loop for l in (s-split "\n" (ppp-list-to-string form))
do (progn (insert ";; " l)
(defun pp-to-cmd (obj)
(let ((s (->> (pp-to-string obj) (s-replace "\n" ""))))
(replace-regexp-in-string (rx (1+ " ")) " " s t t)))
;; e.g. (my-ppp-list-other-window extended-command-history)
;; e.g. (my-ppp-list-other-window (-iota 10))
(defun my-ppp-list-other-window (obj)
(list (eval-last-sexp nil)))
(if (not (cl-typep obj 'list))
(message "Error: value `%s` is not a list!" obj)
(let ((buf (get-buffer-create "*Pretty-Printer*")))
(with-current-buffer buf
(my-ppp-list-insert obj)
(uncomment-region (point-min) (point-max)))
(display-buffer buf))))
(defun my-list-commands (&optional re)
(interactive "MRegexp: ")
(let ((commands (cl-loop for x being the symbols
if (commandp x)
if (s-matches-p re (symbol-name x))
collect x)))
(if (called-interactively-p 'any)
(my-ppp-list-other-window commands)
(cl-defun my-xr-at-point ()
(let ((form (read (thing-at-point 'sexp t))))
(if (stringp form)
(message "Rx: %s" (xr form))
(message "Not a string: %s" form))))
(cl-defun my-xr-last-sexp ()
(let ((form (eval-last-sexp nil)))
(if (stringp form)
(message "String: %s" (xr form))
(message "Not a string: %s" form))))
;; (ignore-errors
;; (require 'ipretty)
;; (add-hook 'emacs-lisp-mode-hook (lambda () (ipretty-mode))))
(use-package pp+
:after pp
pp-eval-expression pp-display-expression ; pp+
pp pp-buffer pp-eval-expression pp-eval-last-sexp
pp-macroexpand-expression pp-macroexpand-last-sexp
(use-package ppp)
(defun cl-libify (beg end)
"Replace cl symbol names between BEG and END with their cl-lib equivalents."
(interactive "r")
(load "/home/cji/.emacs.d/plugins-forked/cl-libify/cl-libify.el")
(cl-libify beg end))
(use-package elisp-def
:diminish elisp-def-mode
:commands elisp-def-mode
(message "This shouldn't run"))
(use-package easy-escape
:diminish easy-escape-minor-mode
:hook (emacs-lisp-mode . easy-escape-minor-mode))
(leaf eros
:diminish t
:commands eros-mode
(eros-mode 1))
(cl-defun my-eros-format-list (value)
(insert (with-output-to-string (ppp-list value)))
(goto-char (point-min))
(indent-rigidly (point) (point-max) 4)
(cl-defun my-eros-format-value (value)
;; ppp-sexp-to-string tends to add extra newlines at the end of the string
(if (and (listp value) (< (length value) 10))
(my-eros-format-list value)
(ppp-sexp-to-string value))))
;; (-take 11 load-path)
;; (-take 9 load-path)
;; (cl-loop for it below 9 collect it)
(cl-defun my-eros-overlay-format (value point)
(let ((ppp-tail-newline nil)
(formatted (my-eros-format-value value)))
(eros--make-result-overlay formatted :where point :duration 'command)
(define-minor-mode global-multiline-eros-mode
"Override eros overlay format to display multiline results."
:lighter nil
:global t
(if global-multiline-eros-mode
(advice-add 'eros--eval-overlay :override #'my-eros-overlay-format)
(advice-remove 'eros--eval-overlay #'my-eros-overlay-format)))
;; (defun unkillable-scratch-buffer ()
;; (if (equal (buffer-name (current-buffer)) "*scratch*")
;; (progn
;; (delete-region (point-min) (point-max))
;; nil)
;; t))
;; (add-hook 'kill-buffer-query-functions 'unkillable-scratch-buffer)
(defvar eshell-mode-map)
(defvar paredit-mode-map)
(declare-function delete-active-region 'delsel)
(declare-function flycheck-mode 'flycheck))
(put 'pcase 'function-documentation '())
(leaf lisp-extra-font-lock
:require t
:diminish t
(lisp-extra-font-lock-global-mode 1))
(defun my-paredit-space-for-paren-p (endp delim)
(if (and (eq endp nil) (eq delim ?\() (looking-back "#f" nil))
;; (use-package flycheck)
;; (require 'short-lambda)
;; (-each load-path #f(message "%s" %))
(use-package debug
:bind (:map debugger-mode-map
("C-g" . debugger-quit)))
(use-package eieio
:commands eieio-browse)
(use-package data-debug
:commands data-debug-edebug-expr data-debug-eval-expression
(define-key data-debug-mode-map (kbd "q") 'bury-buffer)
(define-key data-debug-mode-map (kbd "<tab>") 'data-debug-expand-or-contract)
(define-key data-debug-mode-map (kbd "<backtab>") 'my-ddebug-expand-all)
(define-key data-debug-mode-map (kbd "C-<up>") 'data-debug-prev-expando)
(define-key data-debug-mode-map (kbd "C-<down>") 'data-debug-next-expando)
(define-key mode-specific-map (kbd "C-M-e") 'my-data-debug-at-pt)
(define-key ctl-x-map (kbd "C-M-e") 'my-data-debug-at-pt))
(declare-function data-debug-expand-or-contract 'data-debug)
(defun my-ddebug-expand-all ()
(goto-char (point-min))
(while (search-forward-regexp "^ >")
(defun my-data-debug-at-pt ()
(data-debug-eval-expression (sexp-at-point)))
;; Make byte-compilation load-path equal the runtime load-path; save the old
;; value. By default the only entry on the path is "./" (current directory)
(defconst my-elisp-flymake-byte-compile-original-path
(setq elisp-flymake-byte-compile-load-path load-path)
(setq emacs-lisp-compilation-search-path elisp-flymake-byte-compile-load-path)
(require 'my-mod-ielm)
(add-hook 'emacs-lisp-mode-hook 'my-elisp-mode-setup)
(with-eval-after-load "elisp-mode"
(define-key lisp-interaction-mode-map (kbd "C-<up>") 'my-paredit-backward-up)
(define-key lisp-interaction-mode-map (kbd "C-<down>") 'my-paredit-forward-down))
;; (use-package highlight-defined
;; :hook ((emacs-lisp-mode . highlight-defined-mode)))
(use-package highlight-function-calls
:disabled t
:hook ((emacs-lisp-mode . highlight-function-calls-mode)))
(require 'lv)
(defun my-eldoc-eval-show-fun (doc-or-1)
(when (not (eq doc-or-1 1))
(lv-message "%s" doc-or-1)))
(use-package eldoc-eval
:commands eldoc-in-minibuffer-mode
:disabled t)
(use-package nameless
:custom ((nameless-prefix ":")
(nameless-private-prefix t)))
(use-package page-break-lines-mode
:commands page-break-lines-mode
:diminish t)
(cl-defun my-macroexpand-full (&optional arg)
"Expand the macro at point and display the resulting code.
If called with a prefix argument, insert the expanded code at point.
Otherwise, display the expanded code in the minibuffer. The expanded code is
pretty-printed using `pp-to-string` and then either inserted or displayed."
(interactive "P")
(cl-letf* ((sexp (thing-at-point 'sexp))
(pretty (pp-to-string (macroexpand (read sexp)))))
(if arg (insert "\n" pretty) (message "%s" pretty))))
(declare-function leaf-convert-region-replace "leaf-convert")
(cl-defun my-use-package->leaf ()
"Place point at the end of use-package sexp - it will be replaced with
equivalent leaf version."
(region-beginning) (region-end))))
(setq completion-cycle-threshold nil)
(declare-function auto-complete-mode "auto-complete")
(declare-function corfu-history-mode "corfu-history")
(declare-function corfu-mode "corfu")
(declare-function corfu-popupinfo-mode "corfu-popupinfo")
(defvar my-eval-last-sexp-last-sexp nil)
(cl-defun my-eval-defun-sexp-collector (&rest _)
(setq my-eval-last-sexp-last-sexp
(s-trim (substring-no-properties (thing-at-point 'defun)))))
(cl-defun my-eval-last-sexp-sexp-collector (&rest _)
(setq my-eval-last-sexp-last-sexp (elisp--preceding-sexp)))
(advice-add 'elisp--eval-last-sexp :before #'my-eval-last-sexp-sexp-collector)
(advice-add 'eval-defun :before #'my-eval-defun-sexp-collector)
(defun my-elisp-mode-setup ()
(require 'flymake)
(require 'flycheck)
(require 'eros)
(require 'paredit)
(require 'xr)
(require 'tablist)
(require 'named-timer)
(require 'ppp)
(require 'data-debug)
(require 'inspector)
(require 'copilot nil t)
(require 'my-elisp-hydra)
(elide-head-mode 1)
(page-break-lines-mode 1)
(push 'my-locate-library-xref-backend xref-backend-functions)
;; (eldoc-in-minibuffer-mode 1)
(eros-mode 1)
;; (elisp-def-mode)
(prettify-symbols-mode 1)
(flycheck-mode -1)
(flymake-mode -1)
(delete 'elisp-flymake-checkdoc flymake-diagnostic-functions)
(auto-complete-mode -1)
(require 'cape)
(require 'corfu)
(require 'corfu-history)
(require 'consult)
(setq-local completion-at-point-functions
(list 'cape-file
(setq-local corfu-popupinfo-delay 0.2)
(corfu-popupinfo-mode 1)
(corfu-history-mode 1)
(setq-local corfu-auto t)
(savehist-mode 1)
(define-key global-map [remap eval-last-sexp] 'my-eval-last-sexp)
(define-key emacs-lisp-mode-map (kbd "C-c <left>") 'hs-cycle)
(define-key mode-specific-map (kbd "C-d") 'helpful-function)
(define-key mode-specific-map (kbd "d") 'helpful-symbol)
(define-key mode-specific-map (kbd "C-b") 'my-interactive-byte-compile)
(define-key mode-specific-map (kbd "C-j") 'eval-print-last-sexp)
(define-key mode-specific-map (kbd "C-f") 'find-function)
(define-key emacs-lisp-mode-map (kbd "C-<up>") 'my-paredit-backward-up)
(define-key emacs-lisp-mode-map (kbd "C-<down>") 'my-paredit-forward-down)
(make-local-variable 'paredit-space-for-delimiter-predicates)
(paredit-mode 1)
:map paredit-mode-map
(";" . my-elisp-semicolon)
("M-S-<left>" . backward-word)
("M-?" . paredit-convolute-sexp)
("M-S-<right>" . forward-word)
("C-c C-j" . eval-print-last-sexp))
(erefactor-highlight-mode +1)
(define-key erefactor-highlight-map (kbd "M-<right>") nil t)
(define-key erefactor-highlight-map (kbd "M-<left>") nil t)
(define-key erefactor-highlight-map (kbd "C-c <right>") 'erefactor-highlight-next-symbol))
(cl-defun my-eval-expression-setup ()
(keymap-set minibuffer-mode-map (kbd ";") 'my-elisp-semicolon))
(add-hook 'eval-expression-minibuffer-setup-hook #'my-eval-expression-setup)
(cl-defun my-paredit-forward-down ()
(condition-case _err
(when (or (looking-at ")") (looking-at "\""))
(forward-char 1))
(error (forward-paragraph))))
(cl-defun my-paredit-backward-up ()
(condition-case _err
(when (or (looking-back "(" 1) (looking-back "\"" 1))
(forward-char -1))
(error (backward-paragraph))))
(cl-defun my-elisp-semicolon ()
(if (looking-back "(require " (line-beginning-position))
(insert "'")
(call-interactively #'paredit-semicolon)))
(defun my-interactive-byte-compile ()
(byte-compile-file (buffer-file-name)))
(defun my-eval-last-sexp (arg)
"Like `eval-last-sexp', but pretty-prints with prefix ARG."
(interactive "P")
((not arg) (call-interactively 'eros-eval-last-sexp))
(t (call-interactively 'pp-eval-last-sexp))))
(defun my-ppp-eval-and-insert-last-sexp ()
(cl-letf* ((pretty (ppp-sexp-to-string (eval (sexp-at-point)))))
(insert "\n")
(insert pretty)))
;; =============================================================================
'((font-lock-add-keywords . 1)
(run-at-time . 2)
(-as-> . 2)
(promise-then . 1)
(define-frame-preference . 1)
(run-with-timer . 2)
(indent/tag-for-modes . 1)
(propertize . 1)
(font-lock-for-modes . 1)
(add-hook . 1)))
(font-lock-add-keywords 'emacs-lisp-mode
`(("\\bwith-eval-after-load\\b" . font-lock-keyword-face)
("eval-after-load" . font-lock-keyword-face)
("\\<autoload " . font-lock-keyword-face)
("my-report-loading" . font-lock-keyword-face)
("cl-defstruct" . font-lock-keyword-face)
("\bfunctionp?" . font-lock-keyword-face)
("promise-then" . font-lock-keyword-face)
("#f" . font-lock-constant-face)
("%[0-9]?" . font-lock-constant-face)
("bl-signal-not-found" . font-lock-warning-face)
(font-lock-add-keywords 'emacs-lisp-mode
`((,(rx "(" (group "load") " ")
(1 font-lock-constant-face))
("(\\(leaf\\)\\_>[ \t']*\\(\\(?:\\sw\\|\\s_\\)+\\)?"
(1 font-lock-keyword-face)
(2 font-lock-constant-face nil t))
;; (font-lock-fontify-buffer)
;; (load "asdasd")
;; (eval-after-load 'helm 'fuck)
;; (with-eval-after-load 'helm 'fuck)
;; (req! fuck asd)
;; (setq font-lock-keywords nil)
;; (ppp-sexp font-lock-defaults)
;; (font-lock-remove-keywords 'emacs-lisp-mode
;; '(("it" . font-lock-builtin-face) ("\bit[\b)]" . font-lock-keyword-face)))
;; =============================================================================
(declare-function helm 'helm)
(declare-function helm-def-source--emacs-functions 'helm-elisp)
(defun helm-apropos-functions (default)
"Preconfigured helm to describe functions."
(interactive (list (thing-at-point 'symbol)))
(helm :sources (list (helm-def-source--emacs-functions))
:history 'helm-apropos-history
:buffer "*helm apropos*"
:input default
:preselect default))
(define-key help-map (kbd "C-f") 'helm-apropos-functions)
(provide 'my-langs-elisp)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment