diff options
Diffstat (limited to '.emacs.d/lisp/my/my-buffer.el')
| -rw-r--r-- | .emacs.d/lisp/my/my-buffer.el | 448 |
1 files changed, 0 insertions, 448 deletions
diff --git a/.emacs.d/lisp/my/my-buffer.el b/.emacs.d/lisp/my/my-buffer.el deleted file mode 100644 index 5ff09a7..0000000 --- a/.emacs.d/lisp/my/my-buffer.el +++ /dev/null @@ -1,448 +0,0 @@ -;;; my-buffer.el -- Buffers and windows related extensions for emacs core -*- lexical-binding: t -*- - -;; Copyright (C) 2023 Free Software Foundation. - -;; Author: Yuchen Pei <id@ypei.org> -;; Protesilaos Stavrou <info@protesilaos.com> -;; Maintainer: Yuchen Pei <id@ypei.org> -;; Package-Requires: ((emacs "28.2")) - -;; This file is part of dotfiles. - -;; dotfiles is free software: you can redistribute it and/or modify it under -;; the terms of the GNU Affero General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; dotfiles 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 Affero General -;; Public License for more details. - -;; You should have received a copy of the GNU Affero General Public -;; License along with dotfiles. If not, see <https://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Extensions on buffers and windows. - -;;; Code: - -;; Much of the following is from prot-emacs -(defun my-get-major-mode-for-buffer (buffer) - (buffer-local-value 'major-mode (get-buffer buffer))) - -;;; Copied from mastering emacs -;;; https://www.masteringemacs.org/article/demystifying-emacs-window-manager -(defun my-buffer-make-display-matcher (major-modes) - (lambda (buffer-name action) - (with-current-buffer buffer-name (apply #'derived-mode-p major-modes)))) - -(defun my-get-buffer-modes () - (let ((results)) - (dolist (buffer (buffer-list) results) - (add-to-list 'results (my-get-major-mode-for-buffer buffer))))) - -(defun my-switch-to-buffer-matching-major-mode (mode) - (interactive - (list (intern (completing-read "Major mode: " - (mapcar 'prin1-to-string (my-get-buffer-modes)))))) - (switch-to-buffer - (read-buffer "Switch to buffer: " nil t - (lambda (pair) - (with-current-buffer (cdr pair) - (derived-mode-p mode)))))) - -(defun my--buffer-major-mode-prompt () - "Prompt of `my-buffers-major-mode'." - (let ((major major-mode) - (read-buffer-function nil)) - (read-buffer - (format "Buffer for %s: " major) - nil t - (lambda (pair) ; pair is (name-string . buffer-object) - (with-current-buffer (cdr pair) (derived-mode-p major)))))) - -;;;###autoload -(defun my-buffers-major-mode (&optional arg) - "Select BUFFER matching the current one's major mode. - -With a prefix-arg, prompt for major mode." - (interactive "P") - (if arg - (call-interactively 'my-switch-to-buffer-matching-major-mode) - (switch-to-buffer (my--buffer-major-mode-prompt)))) - -(defun my-buffer-quick-major-mode (mode) - "Switch to the first buffer of a given mode." - (let ((buffers (buffer-list))) - (while (and buffers - (with-current-buffer (car buffers) - (not (derived-mode-p mode)))) - (setq buffers (cdr buffers))) - (if buffers - (pop-to-buffer (car buffers)) - (message "No buffers in %S" mode)))) - -(defun my-buffer-switch-or-create-major-mode (mode) - "Switch to or create a buffer with a chosen major mode. - -Prompt for a major mode, then: -With no prefix: switch to the first buffer of the chosen major mode. -With one prefix: prompt for a buffer of the chosen major mode. -With two prefixes: create a buffer of the chosen major mode." - (interactive (list (my-read-major-mode))) - (pcase (prefix-numeric-value current-prefix-arg) - (16 (my-buffer-create-major-mode mode)) - (4 (my-switch-to-buffer-matching-major-mode (print mode))) - (_ (my-buffer-quick-major-mode mode)))) - -(defvar my-buffer-create-functions nil - "List indicating ways to create new buffer for a function, each - element in the form of (major-mode-name - . buffer-create-function). without specifying, the default - buffer-create-function is `my-buffer-create-scratch'.") - -(defun my-read-major-mode () - (intern - (completing-read - "Major mode: " - (cl-loop for sym symbols of obarray - when (and (functionp sym) - ;; we would like to include all modes - (provided-mode-derived-p - sym - 'text-mode 'prog-mode - 'comint-mode 'special-mode)) - collect sym)))) - -(defun my-buffer-create-major-mode (mode) - (if (alist-get mode my-buffer-create-functions) - (call-interactively (alist-get mode my-buffer-create-functions)) - (my-buffer-scratch-setup "" mode))) - -(defun my-buffer-create-same-mode (&optional arg) - (interactive "P") - (let ((mode (if arg - (my-read-major-mode) - major-mode))) - (my-buffer-create-major-mode mode))) - -(defvar my-buffers-same-mode nil - "Buffers of the same mode for cycling") - -(defun my-buffer-with-same-major-mode-p (other-buffer) - (let ((mode major-mode)) - (with-current-buffer other-buffer - (derived-mode-p mode)))) - -(defun my-buffer-cycle-same-mode () - (interactive) - (unless (and (eq last-command 'my-buffer-create-or-cycle-same-mode) - (= 1 (prefix-numeric-value last-prefix-arg))) - (setq my-buffers-same-mode - (seq-filter 'my-buffer-with-same-major-mode-p (buffer-list)))) - (setq my-buffers-same-mode - (my-list-cycle my-buffers-same-mode)) - (switch-to-buffer (car my-buffers-same-mode))) - -(defun my-buffer-create-or-cycle-same-mode (&optional arg) - "Create or switch to a buffer of the same major mode - -No prefix: cycle -One prefix: switch to buffer with prompt by calling `my-buffers-major-mode' -Two prefixes: create a buffer by calling `my-buffer-create-same-mode' -" - (interactive "P") - (pcase (prefix-numeric-value arg) - (16 (my-buffer-create-same-mode)) - (4 (my-buffers-major-mode)) - (_ (my-buffer-cycle-same-mode)))) - -(defun my-copy-buffer-file-name () - (interactive) - (when buffer-file-name) - (kill-new (abbreviate-file-name buffer-file-name)) - (message "Copied %s" (abbreviate-file-name buffer-file-name))) - -;;;###autoload -(defun my-kill-buffer (&optional arg) - "Kill current buffer. -With optional prefix ARG (\\[universal-argument]) choose which -buffer to kill." - (interactive "P") - (let ((kill-buffer-query-functions nil)) - (if arg - (call-interactively 'kill-buffer) - (kill-buffer)))) - -;;;###autoload -(defun my-rename-file-and-buffer (name) - "Apply NAME to current file and rename its buffer. -Do not try to make a new directory or anything fancy." - (interactive - (list (read-file-name "Rename current file: " (buffer-file-name)))) - (let ((file (buffer-file-name))) - (if (vc-registered file) - (vc-rename-file file name) - (rename-file file name)) - (set-visited-file-name name t t))) - -(defun my--buffer-vc-root-prompt () - "Prompt of `my-buffers-vc-root'." - (let ((root (expand-file-name - (or (vc-root-dir) - (locate-dominating-file "." ".git")))) - (read-buffer-function nil)) - (read-buffer - (format "Buffers in %s: " root) - nil t - (lambda (pair) ; pair is (name-string . buffer-object) - (with-current-buffer (cdr pair) - (string-match-p root default-directory)))))) - -;;; from prot-emacs -;;;###autoload -(defun my-buffers-vc-root () - "Select buffer matching the current one's VC root." - (interactive) - (switch-to-buffer (my--buffer-vc-root-prompt))) - -(defun my-bookmark-save-no-prompt (&rest _) - "Run `bookmark-save' without prompts. - -The intent of this function is to be added as an :after advice to -`bookmark-set-internal'. Concretely, this means that when -`bookmark-set-internal' is called, this function is called right -afterwards. We set this up because there is no hook after -setting a bookmark and we want to automatically save bookmarks at -that point." - (funcall 'bookmark-save)) - -(defun my-cycle-windows () - "Cycle all windows." - (interactive) - (let* ((windows (window-list nil 0)) - (first-window (pop windows)) - (buffer (window-buffer first-window)) - (temp-buffer) - (window)) - (when windows (select-window (car windows))) - (dolist (window windows) - (setq temp-buffer (window-buffer window)) - (set-window-buffer window buffer) - (setq buffer temp-buffer)) - (set-window-buffer first-window buffer))) - -(defun my-focus-write () - "Make the current window the only one centered with width 80." - (interactive) - (delete-other-windows) - (let ((margin (/ (- (window-width) 80) 2))) - (set-window-margins nil margin margin))) - -(defun my-select-new-window-matching-mode (mode) - "Select a new window." - (setq available-windows - (delete (selected-window) (window-list))) - (setq new-window - (or (cl-find-if (lambda (window) - (equal (my-get-major-mode-for-buffer - (window-buffer window)) - mode)) - available-windows) - (car available-windows) - (split-window-sensibly) - (split-window-right))) - (select-window new-window)) - -(defun my-toggle-lock-current-window-to-buffer () - (interactive) - (my-toggle-lock-window-to-buffer (selected-window))) - -(defun my-toggle-lock-window-to-buffer (window) - (if (window-dedicated-p window) - (progn (set-window-dedicated-p window nil) - (message "Window unlocked.")) - (set-window-dedicated-p window t) - (message "Window locked."))) - -;; https://lists.gnu.org/archive/html/help-gnu-emacs/2010-01/msg00058.html -(defun my-increase-default-face-height (&optional steps) - "Increase the height of the default face by STEPS steps. - Each step multiplies the height by 1.2; a negative number of steps - decreases the height by the same amount." - (interactive - (list - (cond ((eq current-prefix-arg '-) -1) - ((numberp current-prefix-arg) current-prefix-arg) - ((consp current-prefix-arg) -1) - (t 1)))) - (let ((frame (selected-frame))) - (set-face-attribute 'default frame - :height (floor - (* (face-attribute 'default :height frame) - (expt 1.05 steps)))))) - -(defun my-decrease-default-face-height (&optional steps) - "Decrease the height of the default face by STEPS steps. - Each step divides the height by 1.2; a negative number of steps - increases the height by the same amount." - (interactive - (list - (cond ((eq current-prefix-arg '-) -1) - ((numberp current-prefix-arg) current-prefix-arg) - ((consp current-prefix-arg) -1) - (t 1)))) - (my-increase-default-face-height (- steps))) - -;; if file link points to the same file, do not open in other window -(defun my-find-file-maybe-other-window (filename) - (if (equal buffer-file-name (expand-file-name filename)) - (find-file filename) - (find-file-other-window filename))) - -(defun my-buffer-empty-p () - "Test whether the buffer is empty." - (or (= (point-min) (point-max)) - (save-excursion - (goto-char (point-min)) - (while (and (looking-at "^\\([a-zA-Z]+: ?\\)?$") - (zerop (forward-line 1)))) - (eobp)))) - -;;;; Scratch buffers -;; The idea is based on the `scratch.el' package by Ian Eure: -;; <https://github.com/ieure/scratch-el>. - -(defun my-buffer-scratch-list-modes () - "List known major modes." - (cl-loop for sym symbols of obarray - when (and (functionp sym) - (or (provided-mode-derived-p sym 'text-mode) - (provided-mode-derived-p sym 'prog-mode))) - collect sym)) - -(defun my-buffer-scratch-setup (region &optional mode) - "Add contents to `scratch' buffer and name it accordingly. - -REGION is added to the contents to the new buffer. - -Use the current buffer's major mode by default. With optional -MODE use that major mode instead." - (unless (provided-mode-derived-p mode 'text-mode 'prog-mode) - (error "Cannot create a scratch with %s which is not derived from -text- or prog-mode." mode)) - (let* ((major (or mode major-mode)) - (string (format "Scratch buffer for: %s\n\n" major)) - (text (concat string region)) - (buf (format "*%s scratch*" major))) - (with-current-buffer (pop-to-buffer buf) - (funcall major) - (if (my-buffer-empty-p) - ;; We could use `save-restriction' for narrowed buffers, but - ;; it is overkill. - (progn - (insert text) - (goto-char (point-min)) - (comment-region (line-beginning-position) (line-end-position)) - (goto-char (point-max))) - (goto-char (point-max)) - (when (my-line-regexp-p 'non-empty) - (insert "\n\n")) - (insert region))))) - -;;;###autoload -(defun my-buffer-create-scratch (&optional arg) - "Produce a scratch buffer matching the current major mode. - -With optional ARG as a prefix argument (\\[universal-argument]), -use `my-scratch-buffer-default-mode'. - -With ARG as a double prefix argument, prompt for a major mode -with completion. Candidates are derivatives of `text-mode' or -`prog-mode'. - -If region is active, copy its contents to the new scratch -buffer. - -Buffers are named as *MAJOR-MODE scratch*. If one already exists -for the given MAJOR-MODE, any text is appended to it." - (interactive "P") - (let* ((default-mode my-scratch-buffer-default-mode) - (modes (my-buffer-scratch-list-modes)) - (region (with-current-buffer (current-buffer) - (if (region-active-p) - (buffer-substring-no-properties - (region-beginning) - (region-end)) - ""))) - mode) - (pcase (prefix-numeric-value arg) - (16 (progn - (setq mode (intern (completing-read "Select major mode: " modes nil t))) - (my-buffer-scratch-setup region mode))) - (4 (my-buffer-scratch-setup region default-mode)) - (_ (my-buffer-scratch-setup region))))) - -(defcustom my-scratch-buffer-default-mode 'org-mode - "Default major mode for `my-buffer-create-scratch'." - :type 'symbol - :group 'my) - -(defun my-base-buffer (&optional buffer) - "Get the base buffer of BUFFER." - (setq buffer (or buffer (current-buffer))) - (unless (bufferp buffer) (error "Not a buffer.")) - (or (buffer-base-buffer buffer) buffer)) - -(defun my-buffer-with-same-base-p (other-buffer &optional buffer) - "Test that buffer has the same base buffer as the current buffer." - (equal (my-base-buffer other-buffer) - (my-base-buffer buffer))) - -(defun my-switch-indirect-buffer () - (interactive) - (let* ((current (current-buffer)) - (buffer - (read-buffer "Switch to indirect buffer: " nil t - (lambda (buffer) - (and - (my-buffer-with-same-base-p - (cdr buffer) current) - (not (equal (cdr buffer) current))))))) - (switch-to-buffer buffer))) - -(defun my-list-cycle (xs) - "Cycle a list." - (cdr (append xs (list (car xs))))) - -(defvar my-indirect-buffer-list nil) - -(defun my-cycle-indirect-buffer () - (interactive) - (unless (and (eq last-command 'my-create-or-switch-indirect-buffers) - (= 1 (prefix-numeric-value last-prefix-arg))) - (setq my-indirect-buffer-list - (seq-filter 'my-buffer-with-same-base-p (buffer-list)))) - (setq my-indirect-buffer-list - (my-list-cycle my-indirect-buffer-list)) - (switch-to-buffer (car my-indirect-buffer-list))) - -(defun my-create-or-switch-indirect-buffers (arg) - "Create or switch to an indirect buffer of the current buffer. - -With no prefix, cycle through indirect buffers. - -With optional ARG as a prefix argument (\\[universal-argument]), -prompt for indirect buffer to choose from. - -With double prefix arguments, create a new indirect buffer." - (interactive "P") - (pcase (prefix-numeric-value arg) - (16 (clone-indirect-buffer nil t)) - (4 (my-switch-indirect-buffer)) - (_ (my-cycle-indirect-buffer)))) - -(provide 'my-buffer) -;;; my-buffer.el ends here |