;;; common.el --- Some common functions -*- lexical-binding: t; -*- ;;;###autoload (defun center-string-in-width (str width) "Add spaces to STR so that it is centered in a box which is WIDTH wide." (let ((len (length str))) (cond ((> len width) (error "String %s longer than %d" str width)) (t (format "%s%s" (make-string (round (- width len) 2) 32) str))))) ;;; jump between the completions buffer and the minibuffer ;;;###autoload (defvar durand-completion-buffer-names (list "Completions" "Embark Collect" "comb") "The list of names that match the names of \"completion buffers\".") ;;;###autoload (defun durand-focus-completion-or-minibuffer (&optional arg) "Jump between the completions buffer and the minibuffer." (interactive "P") (let* ((completion-windows (delq nil (mapcar (lambda (w) (and (consp (delq nil (mapcar (lambda (name) (string-match-p name (buffer-name (window-buffer w)))) durand-completion-buffer-names))) w)) (window-list nil 'nomini)))) (in-completion-p (consp (delq nil (mapcar (lambda (name) (string-match-p name (buffer-name))) durand-completion-buffer-names)))) (minibuffer-active-p (active-minibuffer-window)) (in-minibuffer-p (minibuffer-window-active-p (selected-window)))) (cond ((and minibuffer-active-p (not in-minibuffer-p)) (select-window (active-minibuffer-window))) ((and (consp completion-windows) (not in-completion-p)) (select-window (car completion-windows))) (t (other-window 1))))) ;;;###autoload (defun durand-embark-scroll-down-or-go-to-completions (&optional arg) "Scroll down; if this is not feasible, go to the completions buffer. ARG means do this command ARG times." (interactive "p") (let ((original-point (point)) (left (abs (forward-line arg))) (completion-windows (delq nil (mapcar (lambda (w) (and (consp (delq nil (mapcar (lambda (name) (string-match-p name (buffer-name (window-buffer w)))) durand-completion-buffer-names))) w)) (window-list nil 'nomini)))) (in-completion-p (consp (delq nil (mapcar (lambda (name) (string-match-p name (buffer-name))) durand-completion-buffer-names))))) (cond ((= (point) (point-max)) (setq left (1+ left))) ((get-text-property (point) 'field) (goto-char original-point))) (cond ((and (> left 0) (consp completion-windows) (not in-completion-p)) (select-window (car completion-windows)) (cond ((> arg 0) (goto-char (point-min)) (cond ((derived-mode-p 'completion-list-mode) (next-completion 1)))) ((< arg 0) (goto-char (point-max)) (cond ((derived-mode-p 'completion-list-mode) (next-completion -1))))))))) ;;;###autoload (defun durand-embark-scroll-up-or-go-to-completions (&optional arg) "Scroll up; if this is not feasible, go to the completions buffer. ARG means do this command ARG times." (interactive "p") (durand-embark-scroll-down-or-go-to-completions (- arg))) ;;;###autoload (defun durand-completion-scroll-down-or-go-to-minibuffer (&optional arg) "Scroll down; if this is not feasible, go to the mini-buffer. ARG means do this command ARG times." (interactive "p") (let ((original-point (point)) (left (abs (forward-line arg))) (minibuffer-active-p (active-minibuffer-window)) (in-minibuffer-p (minibuffer-window-active-p (selected-window)))) (cond ((= (point) (point-max)) (setq left (1+ left))) ((get-text-property (point) 'field) (goto-char original-point))) (cond ((and (> left 0) minibuffer-active-p (not in-minibuffer-p)) (select-window (active-minibuffer-window)) (cond ((> arg 0) (goto-char (point-min))) ((< arg 0) (goto-char (point-max)))))))) ;; This can be optimized by not duplicating an element on the stack. ;;;###autoload (fset 'durand-display-in-one-window (make-byte-code #x202 (unibyte-string 192 193 194 32 33 33 195 1 4 34 136 196 1 33 136 197 32 136 135) (vector 'split-window 'frame-root-window 'selected-frame 'set-window-buffer 'select-window 'delete-other-windows) 9 "Display BUFFER in one window. ALIST is an association list of action symbols and values. See Info node `(elisp) Buffer Display Action Alists' for details of such alists. This function pops up a new window and then deletes all other windows. And ALIST is completely ignored. \(fn BUFFER ALIST)")) ;;;###autoload (defvar durand-window-max-height 0.3 "Maximal height of the bottom window. The window is placed at the bottom.") ;;;###autoload (defun durand-fit-window-to-buffer-with-max (window) "Fit WINDOW to its buffer. This is a thin wrapper around `fit-window-to-buffer'. It passes the window to the function with max-height equal to `durand-window-max-height'." (fit-window-to-buffer window (floor (* durand-window-max-height (frame-height (window-frame window)))))) ;; (defun durand-display-in-one-window (buffer _alist) ;; "Display BUFFER in one window. ;; ALIST is an association list of action symbols and values. See ;; Info node `(elisp) Buffer Display Action Alists' for details of ;; such alists. ;; This function pops up a new window and then deletes all other ;; windows. And ALIST is completely ignored." ;; (let ((window (split-window (frame-root-window (selected-frame))))) ;; (set-window-buffer window buffer) ;; (select-window window) ;; (delete-other-windows) ;; window)) ;; This short function is a suitable function for byte codes. ;;;###autoload (fset 'durand-completion-scroll-up-or-go-to-minibuffer (make-byte-code #x100 (unibyte-string 137 132 7 0 192 178 1 193 1 91 33 135) (vector 1 #'durand-completion-scroll-down-or-go-to-minibuffer) 5 "Scroll up; if this is not feasible, go to the mini-buffer. ARG means do this command ARG times." "p")) ;; (defun durand-completion-scroll-up-or-go-to-minibuffer (&optional arg) ;; "Scroll up; if this is not feasible, go to the mini-buffer. ;; ARG means do this command ARG times." ;; (interactive "p") ;; (durand-completion-scroll-down-or-go-to-minibuffer (- arg))) ;;; Use completion to select text that was killed before. ;;;###autoload (defun yank-complete-rotated-kill-ring () "Return the rotated kill ring so that the current kill is at the top." (let* ((tail kill-ring-yank-pointer) (len-tail (length tail)) (len (length kill-ring)) (copied (copy-tree kill-ring)) (head (progn (setcdr (nthcdr (mod (- -1 len-tail) len) copied) nil) copied)) ;; Judged from `current-kill', this can be a list for some ;; reason. (interprogram-paste (and interprogram-paste-function (funcall interprogram-paste-function)))) (append (cond ((listp interprogram-paste) interprogram-paste) ((stringp interprogram-paste) (list interprogram-paste))) tail head))) ;;;###autoload (defvar yank-complete-history nil "The history of `yank-complete'.") ;;;###autoload (defun yank-complete (&optional arg) "Use completion to select text that was killed before. If ARG is a cons cell, then put the point at the beginning, the mark at the end for the first yank." ;; This is largely copied from `yank'. (interactive) (let* ((inhibit-read-only t) (kills (yank-complete-rotated-kill-ring)) (choice (completing-read "Yank: " kills nil t nil 'yank-complete-history))) (setq yank-window-start (window-start)) (setq this-command t) (push-mark) (insert-for-yank choice) (cond ((consp arg) (goto-char (prog1 (mark t) (set-marker (mark-marker) (point) (current-buffer))))))) (cond ((eq this-command t) (setq this-command 'yank)))) ;;; Don't ask me if I want to visit the file again. (require 'register) ;;;###autoload (cl-defmethod register-val-jump-to ((val cons) delete) (cond ((frame-configuration-p (car val)) (set-frame-configuration (car val) (not delete)) (goto-char (cadr val))) ((window-configuration-p (car val)) (set-window-configuration (car val)) (goto-char (cadr val))) ((eq (car val) 'file) (find-file (cdr val))) ((eq (car val) 'file-query) (find-buffer-visiting (nth 1 val)) (find-file (nth 1 val)) (goto-char (nth 2 val))) (t (cl-call-next-method val delete)))) ;;; Intentionally disable some key-bindings. ;; Using byte-code is fun. ;;;###autoload (fset 'intentionally-disabled-bind (make-byte-code 0 (unibyte-string 194 195 193 192 32 33 34 135) (vector 'this-command-keys-vector 'key-description 'user-error "You pressend an intentionally disabled key-binding: %s") 4 "Warn the user that this key-binding is intentionally disabled." nil)) ;; (defun intentionally-disabled-bind (arg) ;; "Warn the user that this key-binding is intentionally disabled." ;; (interactive) ;; (user-error "You pressed an intentionally disabled key-binding: %s, %s" ;; (key-description (this-command-keys-vector)) ;; arg)) ;;; Hide some minor mode from the mode line display. ;;;###autoload (defmacro durand-hide-minor-mode (minor &optional to-require light) "Hide MINOR from the mode line. Require TO-REQUIRE so that we don't have errors. Optional LIGHT means to use the lighter name instead of completely hiding it." ;; (cond (to-require (require to-require))) (cond (to-require `(eval-after-load ',to-require (quote (setcdr (assq ',minor minor-mode-alist) (list (or ,light "")))))) (`(setcdr (assq ',minor minor-mode-alist) (list (or ,light "")))))) (provide 'common) ;;; common.el ends here. ;;; Archives ;; ;;;###autoload ;; (defvar yank-pop-completion-index 0 ;; "The index of the current kill.") ;; ;;;###autoload ;; (defun yank-pop-cycle-candidate (&optional arg) ;; "Cycle the candidates by the offset ARG. ;; This is intended to be bound in the minibuffer-local-completion-map." ;; (interactive "p") ;; (cond ((minibufferp)) ;; ((listp minibuffer-completion-table)) ;; ((error "Function `yank-pop-cycle-candidate' called in a weird place"))) ;; (delete-minibuffer-contents) ;; (let ((len (length minibuffer-completion-table))) ;; (setq yank-pop-completion-index (+ arg yank-pop-completion-index)) ;; (insert (nth (mod yank-pop-completion-index len) ;; minibuffer-completion-table)))) ;; ;;;###autoload ;; (defun yank-pop-completion-previous-candidate (&optional arg) ;; "Go to the previous ARG candidate. ;; This is intended to be bound in the minibuffer-local-completion-map." ;; (interactive "p") ;; (yank-pop-cycle-candidate (- arg))) ;; ;;;###autoload ;; (defun yank-pop-completion-set-minibuffer () ;; "Set up minibuffer for use of `yank-pop-complete'." ;; (setq yank-pop-completion-index 0) ;; (define-key minibuffer-local-completion-map ;; (vector ?\M-p) #'yank-pop-completion-previous-candidate) ;; (define-key minibuffer-local-completion-map ;; (vector ?\M-n) #'yank-pop-cycle-candidate) ;; (add-hook 'minibuffer-exit-hook #'yank-pop-completion-clear)) ;; ;;;###autoload ;; (defun yank-pop-completion-clear () ;; "Clear the traces of `yank-pop-complete'." ;; (setq yank-pop-completion-index 0) ;; (define-key minibuffer-local-completion-map ;; (vector ?\M-p) #'previous-history-element) ;; (define-key minibuffer-local-completion-map ;; (vector ?\M-n) #'next-history-element) ;; (remove-hook 'minibuffer-exit-hook #'yank-pop-completion-clear))