Archived
1
0
Fork 0

elpa updates

This commit is contained in:
KemoNine 2024-07-28 12:03:37 -04:00
parent cb49eaf0af
commit c8dc9e9f02
574 changed files with 59173 additions and 22972 deletions

View file

@ -1,6 +1,6 @@
(define-package "all-the-icons" "20240108.559" "A library for inserting Developer icons"
(define-package "all-the-icons" "20240623.1800" "A library for inserting Developer icons"
'((emacs "24.3"))
:commit "ee414384938ccf2ce93c77d717b85dc5538a257d" :authors
:commit "39ef44f810c34e8900978788467cc675870bcd19" :authors
'(("Dominic Charlesworth" . "dgc336@gmail.com"))
:maintainers
'(("Dominic Charlesworth" . "dgc336@gmail.com"))

View file

@ -168,6 +168,12 @@
("dll" all-the-icons-faicon "cogs" :face all-the-icons-silver)
("ds_store" all-the-icons-faicon "cogs" :face all-the-icons-silver)
;; Source Codes
("ada" all-the-icons-fileicon "ada" :v-adjust 0.0 :face all-the-icons-blue)
("adb" all-the-icons-fileicon "ada" :v-adjust 0.0 :face all-the-icons-blue)
("adc" all-the-icons-fileicon "ada" :v-adjust 0.0 :face all-the-icons-blue)
("ads" all-the-icons-fileicon "ada" :v-adjust 0.0 :face all-the-icons-blue)
("gpr" all-the-icons-fileicon "ada" :v-adjust 0.0 :face all-the-icons-green)
("cgpr" all-the-icons-fileicon "ada" :v-adjust 0.0 :face all-the-icons-green)
("scpt" all-the-icons-fileicon "apple" :face all-the-icons-pink)
("aup" all-the-icons-fileicon "audacity" :face all-the-icons-yellow)
("elm" all-the-icons-fileicon "elm" :face all-the-icons-blue)
@ -184,7 +190,6 @@
("eclass" all-the-icons-fileicon "gentoo" :face all-the-icons-blue)
("go" all-the-icons-fileicon "go" :height 1.0 :face all-the-icons-blue)
("jl" all-the-icons-fileicon "julia" :face all-the-icons-purple :v-adjust 0.0)
("magik" all-the-icons-faicon "magic" :face all-the-icons-blue)
("matlab" all-the-icons-fileicon "matlab" :face all-the-icons-orange)
("nix" all-the-icons-fileicon "nix" :face all-the-icons-blue)
("pl" all-the-icons-alltheicon "perl" :face all-the-icons-lorange)
@ -683,6 +688,8 @@ for performance sake.")
(perl-mode all-the-icons-alltheicon "perl" :face all-the-icons-lorange)
(cperl-mode all-the-icons-alltheicon "perl" :face all-the-icons-lorange)
(php-mode all-the-icons-fileicon "php" :face all-the-icons-lsilver)
(php-ts-mode all-the-icons-fileicon "php" :face all-the-icons-lsilver)
(phps-mode all-the-icons-fileicon "php" :face all-the-icons-lsilver)
(prolog-mode all-the-icons-alltheicon "prolog" :height 1.1 :face all-the-icons-lmaroon)
(python-mode all-the-icons-alltheicon "python" :height 1.0 :face all-the-icons-dblue)
(python-ts-mode all-the-icons-alltheicon "python" :height 1.0 :face all-the-icons-dblue)
@ -695,6 +702,10 @@ for performance sake.")
(scheme-mode all-the-icons-fileicon "scheme" :height 1.2 :face all-the-icons-red)
(swift-mode all-the-icons-alltheicon "swift" :height 1.0 :v-adjust -0.1 :face all-the-icons-green)
(svelte-mode all-the-icons-fileicon "svelte" :v-adjust 0.0 :face all-the-icons-red)
(ada-mode all-the-icons-fileicon "ada" :v-adjust 0.0 :face all-the-icons-blue)
(ada-ts-mode all-the-icons-fileicon "ada" :v-adjust 0.0 :face all-the-icons-blue)
(gpr-mode all-the-icons-fileicon "ada" :v-adjust 0.0 :face all-the-icons-green)
(gpr-ts-mode all-the-icons-fileicon "ada" :v-adjust 0.0 :face all-the-icons-green)
(c-mode all-the-icons-alltheicon "c-line" :face all-the-icons-blue)
(c-ts-mode all-the-icons-alltheicon "c-line" :face all-the-icons-blue)
(c++-mode all-the-icons-alltheicon "cplusplus-line" :v-adjust -0.2 :face all-the-icons-blue)
@ -773,8 +784,6 @@ for performance sake.")
(emms-tag-editor-mode all-the-icons-faicon "music" :face all-the-icons-silver)
(emms-playlist-mode all-the-icons-faicon "music" :face all-the-icons-silver)
(lilypond-mode all-the-icons-faicon "music" :face all-the-icons-green)
(magik-session-mode all-the-icons-alltheicon "terminal" :face all-the-icons-blue)
(magik-cb-mode all-the-icons-faicon "book" :face all-the-icons-blue)
(meson-mode all-the-icons-fileicon "meson" :face all-the-icons-purple)
(man-common all-the-icons-fileicon "man-page" :face all-the-icons-blue)
(ess-r-mode all-the-icons-fileicon "R" :face all-the-icons-lblue)))

File diff suppressed because it is too large Load diff

View file

@ -138,6 +138,11 @@ Same as `byte-compile-file' but asynchronous.
(fn FILE)" t)
(register-definition-prefixes "async-bytecomp" '("async-"))
;;; Generated autoloads from async-package.el
(register-definition-prefixes "async-package" '("async-package-"))
;;; Generated autoloads from dired-async.el

View file

@ -60,19 +60,11 @@ all packages are always compiled asynchronously."
(defvar async-bytecomp-load-variable-regexp "\\`load-path\\'"
"The variable used by `async-inject-variables' when (re)compiling async.")
;;;###autoload
(defun async-byte-recompile-directory (directory &optional quiet)
"Compile all *.el files in DIRECTORY asynchronously.
All *.elc files are systematically deleted before proceeding."
(cl-loop with dir = (directory-files directory t "\\.elc\\'")
unless dir return nil
for f in dir
when (file-exists-p f) do (delete-file f))
;; Ensure async is reloaded when async.elc is deleted.
;; This happen when recompiling its own directory.
(load "async")
(let ((call-back
(lambda (&optional _ignore)
(defun async-bytecomp--file-to-comp-buffer (file-or-dir &optional quiet type)
(let ((bn (file-name-nondirectory file-or-dir))
(action-name (pcase type
('file "File")
('directory "Directory"))))
(if (file-exists-p async-byte-compile-log-file)
(let ((buf (get-buffer-create byte-compile-log-buffer))
(n 0))
@ -89,10 +81,26 @@ All *.elc files are systematically deleted before proceeding."
(while (re-search-forward "^.*:Error:" nil t)
(cl-incf n)))
(if (> n 0)
(message "Failed to compile %d files in directory `%s'" n directory)
(message "Directory `%s' compiled asynchronously with warnings" directory)))))
(message "Failed to compile %d files in directory `%s'" n bn)
(message "%s `%s' compiled asynchronously with warnings"
action-name bn)))))
(unless quiet
(message "Directory `%s' compiled asynchronously with success" directory))))))
(message "%s `%s' compiled asynchronously with success" action-name bn)))))
;;;###autoload
(defun async-byte-recompile-directory (directory &optional quiet)
"Compile all *.el files in DIRECTORY asynchronously.
All *.elc files are systematically deleted before proceeding."
(cl-loop with dir = (directory-files directory t "\\.elc\\'")
unless dir return nil
for f in dir
when (file-exists-p f) do (delete-file f))
;; Ensure async is reloaded when async.elc is deleted.
;; This happen when recompiling its own directory.
(load "async")
(let ((call-back
(lambda (&optional _ignore)
(async-bytecomp--file-to-comp-buffer directory quiet 'directory))))
(async-start
`(lambda ()
(require 'bytecomp)
@ -140,13 +148,10 @@ All *.elc files are systematically deleted before proceeding."
(memq cur-package (async-bytecomp--get-package-deps
async-bytecomp-allowed-packages)))
(progn
;; FIXME: Why do we use (eq cur-package 'async) once
;; and (string= cur-package "async") afterwards?
(when (eq cur-package 'async)
(fmakunbound 'async-byte-recompile-directory))
(fmakunbound 'async-byte-recompile-directory)
;; Add to `load-path' the latest version of async and
;; reload it when reinstalling async.
(when (string= cur-package "async")
(cl-pushnew pkg-dir load-path)
(load "async-bytecomp"))
;; `async-byte-recompile-directory' will add directory
@ -173,28 +178,13 @@ Same as `byte-compile-file' but asynchronous."
(interactive "fFile: ")
(let ((call-back
(lambda (&optional _ignore)
(let ((bn (file-name-nondirectory file)))
(if (file-exists-p async-byte-compile-log-file)
(let ((buf (get-buffer-create byte-compile-log-buffer))
start)
(with-current-buffer buf
(goto-char (setq start (point-max)))
(let ((inhibit-read-only t))
(insert-file-contents async-byte-compile-log-file)
(compilation-mode))
(display-buffer buf)
(delete-file async-byte-compile-log-file)
(save-excursion
(goto-char start)
(if (re-search-forward "^.*:Error:" nil t)
(message "Failed to compile `%s'" bn)
(message "`%s' compiled asynchronously with warnings" bn)))))
(message "`%s' compiled asynchronously with success" bn))))))
(async-bytecomp--file-to-comp-buffer file nil 'file))))
(async-start
`(lambda ()
(require 'bytecomp)
,(async-inject-variables async-bytecomp-load-variable-regexp)
(let ((default-directory ,(file-name-directory file)))
(let ((default-directory ,(file-name-directory file))
error-data)
(add-to-list 'load-path default-directory)
(byte-compile-file ,file)
(when (get-buffer byte-compile-log-buffer)

View file

@ -0,0 +1,132 @@
;;; async-package.el --- Fetch packages asynchronously -*- lexical-binding: t -*-
;; Copyright (C) 2014-2022 Free Software Foundation, Inc.
;; Author: Thierry Volpiatto <thievol@posteo.net>
;; Keywords: dired async byte-compile package
;; X-URL: https://github.com/jwiegley/emacs-async
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program 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 General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Provide the function `async-package-do-action' to
;; (re)install/upgrade packages asynchronously.
;;; Code:
(eval-when-compile (require 'cl-lib))
(require 'async-bytecomp)
(require 'dired-async)
(require 'package)
(define-minor-mode async-package--modeline-mode
"Notify mode-line that an async process run."
:group 'async
:global t
:lighter (:eval (propertize (format " [%s async job Installing package(s)]"
(length (dired-async-processes
'async-pkg-install)))
'face 'async-package-message))
(unless async-package--modeline-mode
(let ((visible-bell t)) (ding))))
(defface async-package-message
'((t (:foreground "yellow")))
"Face used for mode-line message.")
(defun async-package-do-action (action packages error-file)
"Execute ACTION asynchronously on PACKAGES.
Argument ACTION can be one of \\='install, \\='upgrade, \\='reinstall.
Argument PACKAGES is a list of packages (symbols).
Argument ERROR-FILE is the file where errors are logged, if some."
(require 'async-bytecomp)
(let ((fn (pcase action
('install 'package-install)
('upgrade 'package-upgrade)
('reinstall 'package-reinstall)))
(action-string (pcase action
('install "Installing")
('upgrade "Upgrading")
('reinstall "Reinstalling"))))
(message "%s %s package(s)..." action-string (length packages))
(process-put
(async-start
`(lambda ()
(require 'bytecomp)
(setq package-archives ',package-archives
package-pinned-packages ',package-pinned-packages
package-archive-contents ',package-archive-contents
package-alist ',package-alist
load-path ',load-path)
(prog1
(condition-case err
(mapc ',fn ',packages)
(error
(with-temp-file ,error-file
(insert
(format
"%S:\n Please refresh package list before %s"
err ,action-string)))))
(let (error-data)
(when (get-buffer byte-compile-log-buffer)
(setq error-data (with-current-buffer byte-compile-log-buffer
(buffer-substring-no-properties
(point-min) (point-max))))
(unless (string= error-data "")
(with-temp-file ,async-byte-compile-log-file
(erase-buffer)
(insert error-data)))))))
(lambda (result)
(if (file-exists-p error-file)
(let ((buf (find-file-noselect error-file)))
(pop-to-buffer
buf '(nil . ((window-height . fit-window-to-buffer))))
(special-mode)
(delete-file error-file)
(async-package--modeline-mode -1))
(when result
(let ((pkgs (if (listp result) result (list result))))
(when (eq action 'install)
(customize-save-variable
'package-selected-packages
(delete-dups (append pkgs package-selected-packages))))
(package-load-all-descriptors) ; refresh package-alist.
(mapc #'package-activate pkgs) ; load packages.
(async-package--modeline-mode -1)
(message "%s %s packages done" action-string (length packages))
(run-with-timer
0.1 nil
(lambda (lst str)
(dired-async-mode-line-message
"%s %d package(s) done"
'async-package-message
str (length lst)))
packages action-string)
(when (file-exists-p async-byte-compile-log-file)
(let ((buf (get-buffer-create byte-compile-log-buffer)))
(with-current-buffer buf
(goto-char (point-max))
(let ((inhibit-read-only t))
(insert-file-contents async-byte-compile-log-file)
(compilation-mode))
(display-buffer buf)
(delete-file async-byte-compile-log-file)))))))))
'async-pkg-install t)
(async-package--modeline-mode 1)))
(provide 'async-package)
;;; async-package.el ends here

View file

@ -1,6 +1,6 @@
(define-package "async" "20240312.1716" "Asynchronous processing in Emacs"
(define-package "async" "20240719.640" "Asynchronous processing in Emacs"
'((emacs "24.4"))
:commit "a368df08d34ae0c0a36fc3e90b1ecda252915257" :authors
:commit "93957f5b0f2ed22aeef02972de860fb9c45b4422" :authors
'(("John Wiegley" . "jwiegley@gmail.com"))
:maintainers
'(("Thierry Volpiatto" . "thievol@posteo.net"))

View file

@ -50,6 +50,13 @@ When this is nil child Emacs will hang forever when a user interaction
for password is required unless a password is stored in a \".authinfo\" file."
:type 'boolean)
(defvar async-process-noquery-on-exit nil
"Used as the :noquery argument to `make-process'.
Intended to be let-bound around a call to `async-start' or
`async-start-process'. If non-nil, the child Emacs process will
be silently killed if the user exits the parent Emacs.")
(defvar async-debug nil)
(defvar async-send-over-pipe t)
(defvar async-in-child-emacs nil)
@ -110,14 +117,17 @@ is returned unmodified."
collect elm))
(t object)))
(defvar async-inject-variables-exclude-regexps '("-syntax-table\\'")
"A list of regexps that `async-inject-variables' should ignore.")
(defun async-inject-variables
(include-regexp &optional predicate exclude-regexp noprops)
"Return a `setq' form that replicates part of the calling environment.
It sets the value for every variable matching INCLUDE-REGEXP and
also PREDICATE. It will not perform injection for any variable
matching EXCLUDE-REGEXP (if present) or representing a `syntax-table'
i.e. ending by \"-syntax-table\".
matching EXCLUDE-REGEXP (if present) and variables matching one of
`async-inject-variables-exclude-regexps'.
When NOPROPS is non nil it tries to strip out text properties of each
variable's value with `async-variables-noprops-function'.
@ -136,14 +146,16 @@ It is intended to be used as follows:
,@(let (bindings)
(mapatoms
(lambda (sym)
(let* ((sname (and (boundp sym) (symbol-name sym)))
(value (and sname (symbol-value sym))))
(let ((sname (and (boundp sym) (symbol-name sym)))
value)
(when (and sname
(or (null include-regexp)
(string-match include-regexp sname))
(or (null exclude-regexp)
(not (string-match exclude-regexp sname)))
(not (string-match "-syntax-table\\'" sname)))
(cl-loop for re in async-inject-variables-exclude-regexps
never (string-match-p re sname)))
(setq value (symbol-value sym))
(unless (or (stringp value)
(memq value '(nil t))
(numberp value)
@ -426,7 +438,8 @@ working directory."
:name name
:buffer buf
:stderr buf-err
:command (cons program program-args)))))
:command (cons program program-args)
:noquery async-process-noquery-on-exit))))
(set-process-sentinel
(get-buffer-process buf-err)
(lambda (proc _change)

View file

@ -387,6 +387,7 @@ ESC or `q' to not overwrite any of the remaining files,
(dired-copy-preserve-time
,dired-copy-preserve-time)
(dired-create-destination-dirs ',create-dir)
(dired-vc-rename-file ,dired-vc-rename-file)
auth-source-save-behavior)
(setq overwrite-backup-query nil)
;; Inline `backup-file' as long as it is not

View file

@ -1,865 +0,0 @@
;;; centaur-tabs-elements.el --- centaur-tabs visual components and customizations -*- lexical-binding: t; -*-
;; Copyright (C) 2019-2020 Emmanuel Bustos
;; Package-Requires: ((emacs "24.4") (powerline "2.4") (cl-lib "0.5"))
;; This file is not part of GNU Emacs.
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2, or
;; (at your option) any later version.
;;
;; This program 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
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
;; Floor, Boston, MA 02110-1301, USA.
;;
;;; Commentary:
;; This file contains the visual components of centaur-tabs
;;; Code:
;;
;;; Requires
;;
(require 'color)
(require 'powerline)
;;; Faces
;;
(defface centaur-tabs-default
'((t
(:background "black" :foreground "black")))
"Default face used in the tab bar."
:group 'centaur-tabs)
(defface centaur-tabs-unselected
'((t
(:background "#3D3C3D" :foreground "grey50")))
"Face used for unselected tabs."
:group 'centaur-tabs)
(defface centaur-tabs-selected
'((t (:background "#31343E" :foreground "white")))
"Face used for the selected tab."
:group 'centaur-tabs)
(defface centaur-tabs-unselected-modified
'((t
(:background "#3D3C3D" :foreground "grey50")))
"Face used for unselected-modified tabs."
:group 'centaur-tabs)
(defface centaur-tabs-selected-modified
'((t (:background "#31343E" :foreground "white")))
"Face used for the selected-modified tab."
:group 'centaur-tabs)
(defface centaur-tabs-close-unselected
'((t
(:inherit centaur-tabs-unselected)))
"Face used for unselected close button."
:group 'centaur-tabs)
(defface centaur-tabs-close-selected
'((t (:inherit centaur-tabs-selected)))
"Face used for selected close button."
:group 'centaur-tabs)
(defface centaur-tabs-name-mouse-face
'((t nil))
"Face used for tab name when hovered with the mouse."
:group 'centaur-tabs)
(defface centaur-tabs-close-mouse-face
'((t (:inherit underline)))
"Face used for close button when hovered with the mouse."
:group 'centaur-tabs)
(defface centaur-tabs-modified-marker-selected
`((t (:inherit centaur-tabs-selected)))
"Face used for selected modified marker."
:group 'centaur-tabs)
(defface centaur-tabs-modified-marker-unselected
`((t (:inherit centaur-tabs-unselected)))
"Face used for unselected modified marker."
:group 'centaur-tabs)
(defface centaur-tabs-active-bar-face
'((t (:background "cyan")))
"Face used for selected tab bar."
:group 'centaur-tabs)
(defface centaur-tabs-jump-identifier-selected
'((t (:inherit centaur-tabs-modified-marker-selected :weight extra-bold)))
"Face used for selected tab identifiers when centaur-tabs-ace-jump is invoked."
:group 'centaur-tabs)
(defface centaur-tabs-jump-identifier-unselected
'((t (:inherit centaur-tabs-modified-marker-unselected :weight extra-bold)))
"Face used for unselected tab identifiers when centaur-tabs-ace-jump is invoked."
:group 'centaur-tabs)
(defface centaur-tabs-dim-buffer-face
'((t (:foreground "gray40")))
"Face for the buffer when centaur-tabs-ace-jump is invoked.")
;;; Tabs' display line
;;
(defvar centaur-tabs-display-line
(if (boundp 'tab-line-format)
'tab-line
'header-line))
(defvar centaur-tabs-display-line-format
(if (boundp 'tab-line-format)
'tab-line-format
'header-line-format))
;;; Tabs' characteristics
;;
(defcustom centaur-tabs-style "bar"
"The style of tab."
:group 'centaur-tabs
:type 'string)
(defcustom centaur-tabs-label-fixed-length 0
"Fixed length of label. Set to 0 if dynamic."
:group 'centaur-tabs
:type 'int)
(defcustom centaur-tabs-background-color
(face-background 'centaur-tabs-default nil 'default)
"*Background color of the tab bar.
By default, use the background color specified for the
`centaur-tabs-default' face (or inherited from another face), or the
background color of the `default' face otherwise."
:group 'centaur-tabs
:type 'face)
(defcustom centaur-tabs-height 22
"The height of tab."
:group 'centaur-tabs
:type 'int)
(defcustom centaur-tabs-bar-height (+ 8 centaur-tabs-height)
"The height of bar."
:group 'centaur-tabs
:type 'int)
(defcustom centaur-tabs-mouse-pointer 'hand
"Cursor to display when hovering the tabs.
Default is 'hand. The following scopes are possible:
- arrow
- hand
- vdrag
- hdrag
- modeline
- hourglass"
:group 'centaur-tabs
:type 'variable)
;;; Icons
;;
(defcustom centaur-tabs-set-icons nil
"When non nil, display an icon based on `centaur-tabs-icon-type' alongside the tab name."
:group 'centaur-tabs
:type 'boolean)
(defcustom centaur-tabs-icon-type (and centaur-tabs-set-icons
(or (require 'all-the-icons nil t)
(require 'nerd-icons nil t)))
"Icon type. It should be one of `all-the-icons' and `nerd-icons'."
:group 'centaur-tabs
:type 'symbol
:set
(lambda (k v)
(pcase v
('all-the-icons
(unless (require 'all-the-icons nil t)
(setq v nil)))
('nerd-icons
(unless (require 'nerd-icons nil t)
(setq v nil)))
(type
(if (require 'all-the-icons nil t)
(setq v 'all-the-icons)
(setq v nil))))
(set k v)))
(defvar centaur-tabs-icon-scale-factor
1.0
"The base scale factor for the `height' face property of tab icons.")
(defvar centaur-tabs-icon-v-adjust
0.01
"The vertical adjust for tab icons.")
(defcustom centaur-tabs-gray-out-icons nil
"When non nil, enable gray icons for unselected buffer."
:group 'centaur-tabs
:type '(choice :tag "Gray out icons for unselected..."
(const :tag "Buffer" buffer)))
(defcustom centaur-tabs-plain-icons nil
"When non nil, tab icons' color will be the same as tabs' foreground color."
:group 'centaur-tabs
:type 'boolean)
(defun centaur-tabs--icon-for-file (file &rest args)
"Get the formatted icon for FILE.
ARGS should be a plist containing `:height', `:v-adjust', or `:face' properties."
(pcase centaur-tabs-icon-type
('all-the-icons (apply #'all-the-icons-icon-for-file file args))
('nerd-icons (apply #'nerd-icons-icon-for-file file args))))
(defun centaur-tabs--icon-for-mode (mode &rest args)
"Get the formatted icon for MODE.
ARG-OVERRIDES should be a plist containining `:height',
`:v-adjust' or `:face' properties like in the normal icon
inserting functions."
(pcase centaur-tabs-icon-type
('all-the-icons (apply #'all-the-icons-icon-for-mode mode args))
('nerd-icons (apply #'nerd-icons-icon-for-mode mode args))))
(defun centaur-tabs--auto-mode-match? (&optional file)
"Whether or not FILE's `major-mode' match against its `auto-mode-alist'."
(pcase centaur-tabs-icon-type
('all-the-icons (apply #'all-the-icons-auto-mode-match? file))
('nerd-icons (apply #'nerd-icons-auto-mode-match? file))))
(defun centaur-tabs-icon (tab face selected)
"Generate icon for TAB using FACE's background.
If icon gray out option enabled, gray out icon if not SELECTED."
(if centaur-tabs-icon-type
(with-current-buffer (car tab)
(let* ((icon
(if (and (buffer-file-name)
(centaur-tabs--auto-mode-match?))
(centaur-tabs--icon-for-file
(file-name-nondirectory (buffer-file-name))
:v-adjust centaur-tabs-icon-v-adjust
:height centaur-tabs-icon-scale-factor)
(centaur-tabs--icon-for-mode
major-mode
:v-adjust centaur-tabs-icon-v-adjust
:height centaur-tabs-icon-scale-factor)))
(background (face-background face nil 'default))
(inactive (cond ((and (not selected)
(eq centaur-tabs-gray-out-icons 'buffer))
(face-foreground 'mode-line-inactive nil 'default))
(centaur-tabs-plain-icons
(face-foreground 'centaur-tabs-selected nil 'default))
(t 'unspecified)))
(underline (and (eq (if (display-graphic-p) centaur-tabs-set-bar) 'under)
(face-attribute face :underline)))
(overline (and (eq (if (display-graphic-p) centaur-tabs-set-bar) 'over)
(face-attribute face :overline))))
(if (stringp icon)
(progn
(propertize icon 'face `(:inherit ,(get-text-property 0 'face icon)
:foreground ,inactive
:background ,background
:underline ,underline
:overline ,overline)))
"")))
""))
;;; Ace-window style tab switching
;;
(defcustom centaur-tabs-show-jump-identifier 'prompted
"Whether to show the tab identifier for centaur-tabs-ace-jump.
It has 3 options:
- 'nil, never show the jump identifier.
- 'prompted, only show it when using centaur-tabs-ace-jump.
- 'always, always show it regardless of the status."
:group 'centaur-tabs
:type '(choice :tag "show identifier when..."
(const :tag "Never" nil)
(const :tag "Only when prompted" prompted)
(const :tag "Always" always)))
(defcustom centaur-tabs-ace-jump-dim-buffer t
"Whether to dim the current buffer when centaur-ace-jump is activated.")
(defvar centaur-tabs-ace-jump-keys
'(?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)
"Buffer jump keys used by centaur-tabs-ace-jump.")
(defvar centuar-tabs-ace-dispatch-alist
'((?q exit "Exit")
(?\C-g exit "Exit")
(?j jump-to-tab "Jump to tab")
(?x close-tab "Close tab")
(?s swap-tab "Swap tab")
(?\[ backward-group "Previous group")
(?\] forward-group "Next group")
(?? show-help "Show dispatch help"))
"Action keys used by centaur-tabs-ace-jump.
The value of each element must be in the form:
\(key keyword docstring), where keyword must be one of the follows:
\(exit, jump-to-tab, close-tab, swap-tab, backward-group,
forward-group, show-help).")
;;; Close buttons, modified marker and edges' margins
;;
(defcustom centaur-tabs-set-close-button t
"When non nil, display a clickable close button on the right side of the tabs."
:group 'centaur-tabs
:type 'boolean)
(defcustom centaur-tabs-set-left-close-button nil
"When non nil, display a clickable close button on the left side of the tabs."
:group 'centaur-tabs
:type 'boolean)
(defcustom centaur-tabs-close-button (make-string 1 #x00D7)
"Display appearance of the close buttons, if enabled."
:group 'centaur-tabs
:type 'string)
(defcustom centaur-tabs-set-modified-marker nil
"When non nil, display a marker when the buffer is modified."
:group 'centaur-tabs
:type 'boolean)
(defcustom centaur-tabs-modified-marker (make-string 1 #x23FA)
"Display appearance of the modified marker, if enabled."
:group 'centaur-tabs
:type 'string)
(defcustom centaur-tabs-left-edge-margin " "
"Text to display at the left edge of the tabs, or nil for no added margin."
:group 'centaur-tabs
:type 'string)
(defcustom centaur-tabs-right-edge-margin " "
"Text to display at the right edge of the tabs, or nil for no added margin."
:group 'centaur-tabs
:type 'string)
;;; Selected tab bar
;;
(defcustom centaur-tabs-set-bar nil
"When non nil, display a bar to show the currently selected tab.
There are three options:
- 'left: displays the bar at the left of the currently selected tab.
- 'under: displays the bar under the currently selected tab.
- 'over: displays the bar over the currently selected tab."
:group 'centaur-tabs
:type '(choice :tag "Display bar at..."
(const :tag "Put bar on the left" left)
(const :tag "Put bar as an underline" under)
(const :tag "Put bar as an overline" over)))
(defun centaur-tabs--make-xpm (face width height)
"Create an XPM bitmap via FACE WIDTH and HEIGHT.
Taken from `doom-modeline'."
(when (and (display-graphic-p)
(image-type-available-p 'xpm))
(propertize
" " 'display
(let ((data (make-list height (make-list width 1)))
(color (or (face-background face nil t) "None")))
(ignore-errors
(create-image
(concat
(format
"/* XPM */\nstatic char * percent[] = {\n\"%i %i 2 1\",\n\". c %s\",\n\" c %s\","
(length (car data)) (length data) color color)
(apply #'concat
(cl-loop with idx = 0
with len = (length data)
for dl in data
do (cl-incf idx)
collect
(concat
"\""
(cl-loop for d in dl
if (= d 0) collect (string-to-char " ")
else collect (string-to-char "."))
(if (eq idx len) "\"};" "\",\n")))))
'xpm t :ascent 'center))))))
(defvar centaur-tabs-active-bar
(centaur-tabs--make-xpm 'centaur-tabs-active-bar-face
2
centaur-tabs-bar-height))
;;; Navigation buttons
;;
(defcustom centaur-tabs-show-navigation-buttons nil
"When non-nil, show the buttons for backward/forward tabs."
:group 'centaur-tabs
:type 'boolean)
(defcustom centaur-tabs-down-tab-text ""
"Text icon to show in the down button tab."
:group 'centaur-tabs
:type 'string)
(defcustom centaur-tabs-backward-tab-text ""
"Text icon to show in the backward button tab."
:group 'centaur-tabs
:type 'string)
(defcustom centaur-tabs-forward-tab-text ""
"Text icon to show in the forward button tab."
:group 'centaur-tabs
:type 'string)
(defcustom centaur-tabs-show-count nil
"When non-nil, show the current index and count of tabs in the current group."
:group 'centaur-tabs
:type 'boolean)
;;; New tab button
;;
(defcustom centaur-tabs-show-new-tab-button t
"When non-nil, show the button to create a new tab."
:group 'centaur-tabs
:type 'boolean)
(defcustom centaur-tabs-new-tab-text " + "
"Text icon to show in the new-tab button."
:group 'centaur-tabs
:type 'string)
;;; Separators
;;
(defvar centaur-tabs-style-left nil)
(defvar centaur-tabs-style-right nil)
(defvar ns-use-srgb-colorspace)
(defvar centaur-tabs-image-apple-rgb
(and (eq (window-system) 'ns)
ns-use-srgb-colorspace
(< 11
(string-to-number
(and (string-match "darwin\\([0-9]+\\)" system-configuration)
(match-string-no-properties 1 system-configuration)))))
"Boolean variable to determine whether to use Apple RGB colorspace.
used to render images.
t on macOS 10.7+ and `ns-use-srgb-colorspace' is t, nil otherwise.
This variable is automatically set, there's no need to modify it.")
(defun centaur-tabs-separator-interpolate (color1 color2)
"Interpolate between COLOR1 and COLOR2.
COLOR1 and COLOR2 must be supplied as hex strings with a leading #."
(let* ((c1 (color-name-to-rgb color1))
(c2 (color-name-to-rgb color2))
(red (/ (+ (nth 0 c1) (nth 0 c2)) 2))
(green (/ (+ (nth 1 c1) (nth 1 c2)) 2))
(blue (/ (+ (nth 2 c1) (nth 2 c2)) 2)))
(color-rgb-to-hex red green blue)))
(defun centaur-tabs-separator-color-xyz-to-apple-rgb (X Y Z)
"Convert CIE X Y Z colors to Apple RGB color space."
(let ((r (+ (* 3.2404542 X) (* -1.5371385 Y) (* -0.4985314 Z)))
(g (+ (* -0.9692660 X) (* 1.8760108 Y) (* 0.0415560 Z)))
(b (+ (* 0.0556434 X) (* -0.2040259 Y) (* 1.0572252 Z))))
(list (expt r (/ 1.8)) (expt g (/ 1.8)) (expt b (/ 1.8)))))
(defun centaur-tabs-separator-color-srgb-to-apple-rgb (red green blue)
"Convert RED GREEN BLUE colors from sRGB color space to Apple RGB.
RED, GREEN and BLUE should be between 0.0 and 1.0, inclusive."
(apply #'centaur-tabs-separator-color-xyz-to-apple-rgb (color-srgb-to-xyz red green blue)))
(defun centaur-tabs-separator-hex-color (color)
"Get the hexadecimal value of COLOR."
(when color
(let ((srgb-color (color-name-to-rgb color)))
(if centaur-tabs-image-apple-rgb
(apply #'color-rgb-to-hex (apply #'centaur-tabs-separator-color-srgb-to-apple-rgb srgb-color))
(apply #'color-rgb-to-hex srgb-color)))))
(defun centaur-tabs-separator-pattern (lst)
"Turn LST into an infinite pattern."
(when lst
(let ((pattern (cl-copy-list lst)))
(setcdr (last pattern) pattern))))
(defun centaur-tabs-separator-pattern-to-string (pattern)
"Convert a PATTERN into a string that can be used in an XPM."
(concat "\"" (mapconcat #'number-to-string pattern "") "\","))
(defun centaur-tabs-separator-reverse-pattern (pattern)
"Reverse each line in PATTERN."
(cl-mapcar 'reverse pattern))
(defun centaur-tabs-separator-row-pattern (fill total &optional fade)
"Make a list that has FILL 0s out of TOTAL 1s with FADE 2s to the right of the fill."
(unless fade
(setq fade 0))
(let ((fill (min fill total))
(fade (min fade (max (- total fill) 0))))
(append (make-list fill 0)
(make-list fade 2)
(make-list (- total fill fade) 1))))
(defun centaur-tabs-separator-pattern-bindings-body (patterns height-exp pattern-height-sym
second-pattern-height-sym)
"Create let-var bindings and a function body from PATTERNS.
The `car' and `cdr' parts of the result can be passed to the
function `centaur-tabs-separator-wrap-defun' as its `let-vars'
and `body' arguments,respectively. HEIGHT-EXP is an expression
calculating the image height and it should contain a free variable `height'.
PATTERN-HEIGHT-SYM and SECOND-PATTERN-HEIGHT-SYM are symbols used
for let-var binding variables."
(let* ((pattern (centaur-tabs-separator-pattern (cl-mapcar 'centaur-tabs-separator-pattern-to-string (car patterns))))
(header (cl-mapcar 'centaur-tabs-separator-pattern-to-string (nth 1 patterns)))
(footer (cl-mapcar 'centaur-tabs-separator-pattern-to-string (nth 2 patterns)))
(second-pattern (centaur-tabs-separator-pattern (cl-mapcar 'centaur-tabs-separator-pattern-to-string (nth 3 patterns))))
(center (cl-mapcar 'centaur-tabs-separator-pattern-to-string (nth 4 patterns)))
(reserve (+ (length header) (length footer) (length center))))
(when pattern
(cons `((,pattern-height-sym (max (- ,height-exp ,reserve) 0))
(,second-pattern-height-sym (/ ,pattern-height-sym 2))
(,pattern-height-sym ,(if second-pattern `(ceiling ,pattern-height-sym 2) `,pattern-height-sym)))
(list (when header `(mapconcat 'identity ',header ""))
`(mapconcat 'identity
(cl-subseq ',pattern 0 ,pattern-height-sym) "")
(when center `(mapconcat 'identity ',center ""))
(when second-pattern
`(mapconcat 'identity
(cl-subseq ',second-pattern
0 ,second-pattern-height-sym) ""))
(when footer `(mapconcat 'identity ',footer "")))))))
(defun centaur-tabs-separator-pattern-defun (name dir width &rest patterns)
"Create a powerline function of NAME in DIR with WIDTH for PATTERNS.
PATTERNS is of the form (PATTERN HEADER FOOTER SECOND-PATTERN CENTER
PATTERN-2X HEADER-2X FOOTER-2X SECOND-PATTERN-2X CENTER-2X).
PATTERN is required, all other components are optional.
The first 5 components are for the standard resolution image.
The remaining ones are for the high resolution image where both
width and height are doubled. If PATTERN-2X is nil or not given,
then the remaining components are ignored and the standard
resolution image with magnification and interpolation will be
used in high resolution environments
All generated functions generate the form:
HEADER
PATTERN ...
CENTER
SECOND-PATTERN ...
FOOTER
PATTERN and SECOND-PATTERN repeat infinitely to fill the space needed to
generate a full height XPM.
PATTERN, HEADER, FOOTER, SECOND-PATTERN, CENTER are of the form
\((COLOR ...) (COLOR ...) ...).
COLOR can be one of 0, 1, or 2, where 0 is the source color, 1 is the
destination color, and 2 is the interpolated color between 0 and 1."
(when (eq dir 'right)
(setq patterns (cl-mapcar 'centaur-tabs-separator-reverse-pattern patterns)))
(let ((bindings-body (centaur-tabs-separator-pattern-bindings-body patterns
'height
'pattern-height
'second-pattern-height))
(bindings-body-2x (centaur-tabs-separator-pattern-bindings-body (nthcdr 5 patterns)
'(* height 2)
'pattern-height-2x
'second-pattern-height-2x)))
(centaur-tabs-separator-wrap-defun name dir width
(append (car bindings-body) (car bindings-body-2x))
(cdr bindings-body) (cdr bindings-body-2x))))
(defun centaur-tabs-separator-background-color (face)
"Set the separator background color using FACE."
(face-attribute face
(if (face-attribute face :inverse-video nil 'default)
:foreground
:background)
nil
'default))
(defun centaur-tabs-separator-wrap-defun (name dir width let-vars body &optional body-2x)
"Generate a powerline function of name NAME in dir DIR.
This is made with WIDTH using LET-VARS and BODY.
BODY-2X is an optional argument."
(let* ((src-face (if (eq dir 'left) 'face1 'face2))
(dst-face (if (eq dir 'left) 'face2 'face1)))
`(defun ,(intern (format "powerline-%s-%s" name (symbol-name dir)))
(face1 face2 &optional height)
(when window-system
(unless height (setq height centaur-tabs-height))
(let* ,(append `((color1 (when ,src-face
(centaur-tabs-separator-hex-color (centaur-tabs-separator-background-color ,src-face))))
(color2 (when ,dst-face
(centaur-tabs-separator-hex-color (centaur-tabs-separator-background-color ,dst-face))))
(colori (when (and color1 color2) (centaur-tabs-separator-interpolate color1 color2)))
(color1 (or color1 "None"))
(color2 (or color2 "None"))
(colori (or colori "None")))
let-vars)
(apply #'create-image
,(append `(concat (format "/* XPM */ static char * %s_%s[] = { \"%s %s 3 1\", \"0 c %s\", \"1 c %s\", \"2 c %s\","
,(replace-regexp-in-string "-" "_" name)
(symbol-name ',dir)
,width
height
color1
color2
colori))
body
'("};"))
'xpm t
:ascent 'center
:face (when (and face1 face2)
,dst-face)
,(and body-2x
`(and (featurep 'mac)
(list :data-2x
,(append `(concat (format "/* XPM */ static char * %s_%s_2x[] = { \"%s %s 3 1\", \"0 c %s\", \"1 c %s\", \"2 c %s\","
,(replace-regexp-in-string "-" "_" name)
(symbol-name ',dir)
(* ,width 2)
(* height 2)
color1
color2
colori))
body-2x
'("};")))))))))))
(defun centaur-tabs-separator-alternate (dir)
"Generate an alternating pattern XPM function for DIR."
(centaur-tabs-separator-pattern-defun "alternate" dir 4
'((2 2 1 1)
(0 0 2 2))
nil nil nil nil
;; 2x
'((2 2 2 2 1 1 1 1)
(2 2 2 2 1 1 1 1)
(0 0 0 0 2 2 2 2)
(0 0 0 0 2 2 2 2))))
(defun centaur-tabs-separator-bar (dir)
"Generate a bar XPM function for DIR."
(centaur-tabs-separator-pattern-defun "bar" dir 2
'((2 2))))
(defun centaur-tabs-separator-box (dir)
"Generate a box XPM function for DIR."
(centaur-tabs-separator-pattern-defun "box" dir 2
'((0 0)
(0 0)
(1 1)
(1 1))
nil nil nil nil
;; 2x
'((0 0 0 0)
(0 0 0 0)
(0 0 0 0)
(0 0 0 0)
(1 1 1 1)
(1 1 1 1)
(1 1 1 1)
(1 1 1 1))))
(defun centaur-tabs-separator-chamfer (dir)
"Generate a chamfer XPM function for DIR."
(centaur-tabs-separator-pattern-defun "chamfer" dir 3
'((0 0 0))
'((1 1 1)
(0 1 1)
(0 0 1))
nil nil nil
;; 2x
'((0 0 0 0 0 0))
'((1 1 1 1 1 1)
(0 1 1 1 1 1)
(0 0 1 1 1 1)
(0 0 0 1 1 1)
(0 0 0 0 1 1)
(0 0 0 0 0 1))))
(defun centaur-tabs-separator-rounded (dir)
"Generate a rounded XPM function for DIR."
(centaur-tabs-separator-pattern-defun "rounded" dir 6
'((0 0 0 0 0 0))
'((2 1 1 1 1 1)
(0 0 2 1 1 1)
(0 0 0 0 1 1)
(0 0 0 0 2 1)
(0 0 0 0 0 1)
(0 0 0 0 0 2))
nil nil nil
;; 2x
'((0 0 0 0 0 0 0 0 0 0 0 0))
'((1 1 1 1 1 1 1 1 1 1 1 1)
(0 0 2 1 1 1 1 1 1 1 1 1)
(0 0 0 0 1 1 1 1 1 1 1 1)
(0 0 0 0 0 0 1 1 1 1 1 1)
(0 0 0 0 0 0 0 2 1 1 1 1)
(0 0 0 0 0 0 0 0 1 1 1 1)
(0 0 0 0 0 0 0 0 0 1 1 1)
(0 0 0 0 0 0 0 0 0 0 1 1)
(0 0 0 0 0 0 0 0 0 0 1 1)
(0 0 0 0 0 0 0 0 0 0 2 1)
(0 0 0 0 0 0 0 0 0 0 0 1)
(0 0 0 0 0 0 0 0 0 0 0 1))))
(defun centaur-tabs-separator-slant (dir)
"Generate a slant XPM function for DIR."
(let* ((row-modifier (if (eq dir 'left) 'identity 'reverse)))
(centaur-tabs-separator-wrap-defun "slant" dir 'width
'((width (1- (ceiling height 2))))
`((cl-loop for i from 0 to (1- height)
concat (centaur-tabs-separator-pattern-to-string (,row-modifier (centaur-tabs-separator-row-pattern (/ i 2) width)))))
`((cl-loop for i from 0 to (1- (* height 2))
concat (centaur-tabs-separator-pattern-to-string (,row-modifier (centaur-tabs-separator-row-pattern (/ i 2) (* width 2)))))))))
(defun centaur-tabs-separator-wave (dir)
"Generate a wave XPM function for DIR."
(centaur-tabs-separator-pattern-defun "wave" dir 11
'((0 0 0 0 0 0 1 1 1 1 1))
'((2 1 1 1 1 1 1 1 1 1 1)
(0 0 1 1 1 1 1 1 1 1 1)
(0 0 0 1 1 1 1 1 1 1 1)
(0 0 0 2 1 1 1 1 1 1 1)
(0 0 0 0 1 1 1 1 1 1 1)
(0 0 0 0 2 1 1 1 1 1 1)
(0 0 0 0 0 1 1 1 1 1 1)
(0 0 0 0 0 1 1 1 1 1 1)
(0 0 0 0 0 2 1 1 1 1 1))
'((0 0 0 0 0 0 2 1 1 1 1)
(0 0 0 0 0 0 0 1 1 1 1)
(0 0 0 0 0 0 0 1 1 1 1)
(0 0 0 0 0 0 0 2 1 1 1)
(0 0 0 0 0 0 0 0 1 1 1)
(0 0 0 0 0 0 0 0 2 1 1)
(0 0 0 0 0 0 0 0 0 0 2))
nil nil
;; 2x
'((0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1))
'((1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
(0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
(0 0 0 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
(0 0 0 0 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
(0 0 0 0 0 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
(0 0 0 0 0 0 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
(0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
(0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
(0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
(0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
(0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1)
(0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1)
(0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1)
(0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1)
(0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1)
(0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1)
(0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1)
(0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1))
'((0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1)
(0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1)
(0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1)
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1)
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1)
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1)
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1)
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1)
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1)
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1)
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2 1 1 1 1 1)
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2 1 1 1 1)
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1)
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0))))
(defun centaur-tabs-separator-zigzag (dir)
"Generate a zigzag pattern XPM function for DIR."
(centaur-tabs-separator-pattern-defun "zigzag" dir 3
'((1 1 1)
(0 1 1)
(0 0 1)
(0 0 0)
(0 0 1)
(0 1 1))
nil nil nil nil
;; 2x
'((1 1 1 1 1 1)
(0 1 1 1 1 1)
(0 0 1 1 1 1)
(0 0 0 1 1 1)
(0 0 0 0 1 1)
(0 0 0 0 0 1)
(0 0 0 0 0 0)
(0 0 0 0 0 1)
(0 0 0 0 1 1)
(0 0 0 1 1 1)
(0 0 1 1 1 1)
(0 1 1 1 1 1))))
(defun centaur-tabs-separator-memoize (func)
"Memoize FUNC.
If argument is a symbol then install the memoized function over
the original function. Use frame-local memoization."
(cl-typecase func
(symbol (fset func (centaur-tabs-separator-memoize-wrap-frame-local (symbol-function func))) func)
(function (centaur-tabs-separator-memoize-wrap-frame-local func))))
(defun centaur-tabs-separator-memoize-wrap-frame-local (func)
"Return the memoized version of FUNC.
The memoization cache is frame-local."
(let ((funcid (cl-gensym)))
`(lambda (&rest args)
,(concat (documentation func) (format "\n(memoized function %s)" funcid))
(let* ((cache (centaur-tabs-separator-create-or-get-cache))
(key (cons ',funcid args))
(val (gethash key cache)))
(if val
val
(puthash key (apply ,func args) cache))))))
(defun centaur-tabs-separator-create-or-get-cache ()
"Return a frame-local hash table that acts as a memoization cache.
The cache is for the powerline.
Create one if the frame doesn't have one yet."
(let ((table (frame-parameter nil 'powerline-cache)))
(if (hash-table-p table) table (centaur-tabs-separator-reset-cache))))
(defun centaur-tabs-separator-reset-cache ()
"Reset and return the frame-local hash table used for a memoization cache."
(let ((table (make-hash-table :test 'equal)))
;; Store it as a frame-local variable
(modify-frame-parameters nil `((powerline-cache . ,table)))
table))
(centaur-tabs-separator-memoize (centaur-tabs-separator-alternate 'left))
(centaur-tabs-separator-memoize (centaur-tabs-separator-alternate 'right))
(centaur-tabs-separator-memoize (centaur-tabs-separator-bar 'left))
(centaur-tabs-separator-memoize (centaur-tabs-separator-bar 'right))
(centaur-tabs-separator-memoize (centaur-tabs-separator-box 'left))
(centaur-tabs-separator-memoize (centaur-tabs-separator-box 'right))
(centaur-tabs-separator-memoize (centaur-tabs-separator-chamfer 'left))
(centaur-tabs-separator-memoize (centaur-tabs-separator-chamfer 'right))
(centaur-tabs-separator-memoize (centaur-tabs-separator-rounded 'left))
(centaur-tabs-separator-memoize (centaur-tabs-separator-rounded 'right))
(centaur-tabs-separator-memoize (centaur-tabs-separator-slant 'left))
(centaur-tabs-separator-memoize (centaur-tabs-separator-slant 'right))
(centaur-tabs-separator-memoize (centaur-tabs-separator-wave 'left))
(centaur-tabs-separator-memoize (centaur-tabs-separator-wave 'right))
(centaur-tabs-separator-memoize (centaur-tabs-separator-zigzag 'left))
(centaur-tabs-separator-memoize (centaur-tabs-separator-zigzag 'right))
(defun centaur-tabs-select-separator-style (tab-style)
"Set the separator style to TAB-STYLE."
(setq centaur-tabs-style-left (funcall (intern (format "powerline-%s-right" tab-style)) 'centaur-tabs-default nil centaur-tabs-height))
(setq centaur-tabs-style-right (funcall (intern (format "powerline-%s-left" tab-style)) nil 'centaur-tabs-default centaur-tabs-height)))
(provide 'centaur-tabs-elements)
;;; centaur-tabs-elements.el ends here

View file

@ -1,14 +0,0 @@
(define-package "centaur-tabs" "20230607.1501" "Aesthetic, modern looking customizable tabs plugin"
'((emacs "24.4")
(powerline "2.4")
(cl-lib "0.5"))
:commit "0bb1aa18d475319df85f192dce3327802866c3c3" :authors
'(("Emmanuel Bustos" . "ema2159@gmail.com"))
:maintainers
'(("Emmanuel Bustos" . "ema2159@gmail.com"))
:maintainer
'("Emmanuel Bustos" . "ema2159@gmail.com")
:url "https://github.com/ema2159/centaur-tabs")
;; Local Variables:
;; no-byte-compile: t
;; End:

View file

@ -1,12 +1,14 @@
;;; centaur-tabs-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*-
;;
;;; centaur-tabs-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*-
;; Generated by the `loaddefs-generate' function.
;; This file is part of GNU Emacs.
;;; Code:
(add-to-list 'load-path (directory-file-name
(or (file-name-directory #$) (car load-path))))
(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path)))
;;;### (autoloads nil "centaur-tabs" "centaur-tabs.el" (0 0 0 0))
;;; Generated autoloads from centaur-tabs.el
(autoload 'centaur-tabs-local-mode "centaur-tabs" "\
@ -18,8 +20,7 @@ the tab bar. The tab bar is locally hidden otherwise. When turned
off, if a local header line is hidden or the tab bar is locally
hidden, it is shown again. Signal an error if Centaur-Tabs mode is off.
\(fn &optional ARG)" t nil)
(fn &optional ARG)" t)
(defvar centaur-tabs-mode nil "\
Non-nil if Centaur-Tabs mode is enabled.
See the `centaur-tabs-mode' command
@ -27,9 +28,7 @@ for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `centaur-tabs-mode'.")
(custom-autoload 'centaur-tabs-mode "centaur-tabs" nil)
(autoload 'centaur-tabs-mode "centaur-tabs" "\
Toggle display of a tab bar in the header line.
With prefix argument ARG, turn on if positive, otherwise off.
@ -37,67 +36,50 @@ Returns non-nil if the new state is enabled.
\\{centaur-tabs-mode-map}
\(fn &optional ARG)" t nil)
(fn &optional ARG)" t)
(register-definition-prefixes "centaur-tabs" '("centaur-tabs-"))
;;;***
;;;### (autoloads nil "centaur-tabs-elements" "centaur-tabs-elements.el"
;;;;;; (0 0 0 0))
;;; Generated autoloads from centaur-tabs-elements.el
(register-definition-prefixes "centaur-tabs-elements" '("cent"))
(register-definition-prefixes "centaur-tabs-elements" '("centaur-tabs-"))
;;;***
;;;### (autoloads nil "centaur-tabs-functions" "centaur-tabs-functions.el"
;;;;;; (0 0 0 0))
;;; Generated autoloads from centaur-tabs-functions.el
(autoload 'centaur-tabs-backward "centaur-tabs-functions" "\
Select the previous available tab.
Depend on the setting of the option `centaur-tabs-cycle-scope'." t nil)
Depend on the setting of the option `centaur-tabs-cycle-scope'." t)
(autoload 'centaur-tabs-forward "centaur-tabs-functions" "\
Select the next available tab.
Depend on the setting of the option `centaur-tabs-cycle-scope'." t nil)
Depend on the setting of the option `centaur-tabs-cycle-scope'." t)
(autoload 'centaur-tabs-backward-group "centaur-tabs-functions" "\
Go to selected tab in the previous available group." t nil)
Go to selected tab in the previous available group." t)
(autoload 'centaur-tabs-forward-group "centaur-tabs-functions" "\
Go to selected tab in the next available group." t nil)
Go to selected tab in the next available group." t)
(autoload 'centaur-tabs-backward-tab "centaur-tabs-functions" "\
Select the previous visible tab." t nil)
Select the previous visible tab." t)
(autoload 'centaur-tabs-forward-tab "centaur-tabs-functions" "\
Select the next visible tab." t nil)
Select the next visible tab." t)
(register-definition-prefixes "centaur-tabs-functions" '("centaur-tabs-"))
;;;***
;;;### (autoloads nil "centaur-tabs-interactive" "centaur-tabs-interactive.el"
;;;;;; (0 0 0 0))
;;; Generated autoloads from centaur-tabs-interactive.el
(autoload 'centaur-tabs-counsel-switch-group "centaur-tabs-interactive" "\
Display a list of current buffer groups using Counsel." t nil)
Display a list of current buffer groups using Counsel." t)
(register-definition-prefixes "centaur-tabs-interactive" '("centaur-tabs-"))
;;;***
;;;### (autoloads nil nil ("centaur-tabs-pkg.el") (0 0 0 0))
;;; End of scraped data
(provide 'centaur-tabs-autoloads)
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; coding: utf-8
;; no-native-compile: t
;; coding: utf-8-emacs-unix
;; End:
;;; centaur-tabs-autoloads.el ends here

View file

@ -0,0 +1,891 @@
;;; centaur-tabs-elements.el --- centaur-tabs visual components and customizations -*- lexical-binding: t; -*-
;; Copyright (C) 2019-2024 Emmanuel Bustos
;; Copyright (C) 2024 Jen-Chieh Shen
;; This file is not part of GNU Emacs.
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2, or
;; (at your option) any later version.
;;
;; This program 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
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
;; Floor, Boston, MA 02110-1301, USA.
;;; Commentary:
;;
;; This file contains the visual components of centaur-tabs
;;
;;; Code:
(require 'custom)
(require 'color)
(require 'powerline)
;; Compiler pacifier
(declare-function all-the-icons-icon-for-file "ext:all-the-icons.el" t t)
(declare-function all-the-icons-icon-for-mode "ext:all-the-icons.el" t t)
(declare-function nerd-icons-icon-for-file "ext:nerd-icons.el" t t)
(declare-function nerd-icons-icon-for-mode "ext:nerd-icons.el" t t)
;;
;;; Faces
(defface centaur-tabs-default
'((t (:background "black" :foreground "black")))
"Default face used in the tab bar."
:group 'centaur-tabs)
(defface centaur-tabs-unselected
'((t (:background "#3D3C3D" :foreground "grey50")))
"Face used for unselected tabs."
:group 'centaur-tabs)
(defface centaur-tabs-selected
'((t (:background "#31343E" :foreground "white")))
"Face used for the selected tab."
:group 'centaur-tabs)
(defface centaur-tabs-unselected-modified
'((t (:background "#3D3C3D" :foreground "grey50")))
"Face used for unselected-modified tabs."
:group 'centaur-tabs)
(defface centaur-tabs-selected-modified
'((t (:background "#31343E" :foreground "white")))
"Face used for the selected-modified tab."
:group 'centaur-tabs)
(defface centaur-tabs-close-unselected
'((t (:inherit centaur-tabs-unselected)))
"Face used for unselected close button."
:group 'centaur-tabs)
(defface centaur-tabs-close-selected
'((t (:inherit centaur-tabs-selected)))
"Face used for selected close button."
:group 'centaur-tabs)
(defface centaur-tabs-name-mouse-face
'((t nil))
"Face used for tab name when hovered with the mouse."
:group 'centaur-tabs)
(defface centaur-tabs-close-mouse-face
'((t (:inherit underline)))
"Face used for close button when hovered with the mouse."
:group 'centaur-tabs)
(defface centaur-tabs-modified-marker-selected
`((t (:inherit centaur-tabs-selected)))
"Face used for selected modified marker."
:group 'centaur-tabs)
(defface centaur-tabs-modified-marker-unselected
`((t (:inherit centaur-tabs-unselected)))
"Face used for unselected modified marker."
:group 'centaur-tabs)
(defface centaur-tabs-active-bar-face
'((t (:background "cyan")))
"Face used for selected tab bar."
:group 'centaur-tabs)
(defface centaur-tabs-jump-identifier-selected
'((t (:inherit centaur-tabs-modified-marker-selected :weight extra-bold)))
"Face used for selected tab identifiers when centaur-tabs-ace-jump is invoked."
:group 'centaur-tabs)
(defface centaur-tabs-jump-identifier-unselected
'((t (:inherit centaur-tabs-modified-marker-unselected :weight extra-bold)))
"Face used for unselected tab identifiers when centaur-tabs-ace-jump is invoked."
:group 'centaur-tabs)
(defface centaur-tabs-dim-buffer-face
'((t (:foreground "gray40")))
"Face for the buffer when centaur-tabs-ace-jump is invoked."
:group 'centaur-tabs)
;;
;;; Tabs' display line
(defvar centaur-tabs-display-line
(if (boundp 'tab-line-format)
'tab-line
'header-line))
(defvar centaur-tabs-display-line-format
(if (boundp 'tab-line-format)
'tab-line-format
'header-line-format))
;;
;;; Tabs' characteristics
(defcustom centaur-tabs-style "bar"
"The style of tab."
:group 'centaur-tabs
:type 'string)
(defcustom centaur-tabs-label-fixed-length 0
"Fixed length of label. Set to 0 if dynamic."
:group 'centaur-tabs
:type 'int)
(defcustom centaur-tabs-background-color
(face-background 'centaur-tabs-default nil 'default)
"*Background color of the tab bar.
By default, use the background color specified for the
`centaur-tabs-default' face (or inherited from another face), or the
background color of the `default' face otherwise."
:group 'centaur-tabs
:type 'face)
(defcustom centaur-tabs-height 22
"The height of tab."
:group 'centaur-tabs
:type 'int)
(defcustom centaur-tabs-bar-height (+ 8 centaur-tabs-height)
"The height of bar."
:group 'centaur-tabs
:type 'int)
(defcustom centaur-tabs-mouse-pointer 'hand
"Cursor to display when hovering the tabs.
Default is `'hand'. The following scopes are possible:
- arrow
- hand
- vdrag
- hdrag
- modeline
- hourglass"
:group 'centaur-tabs
:type 'variable)
(defcustom centaur-tabs-set-bar nil
"When non nil, display a bar to show the currently selected tab.
There are three options:
- `'left': displays the bar at the left of the currently selected tab.
- `'under': displays the bar under the currently selected tab.
- `'over': displays the bar over the currently selected tab."
:group 'centaur-tabs
:type '(choice :tag "Display bar at..."
(const :tag "Put bar on the left" left)
(const :tag "Put bar as an underline" under)
(const :tag "Put bar as an overline" over)))
;;
;;; Icons
(defcustom centaur-tabs-set-icons nil
"When non nil, display an icon based on `centaur-tabs-icon-type' alongside
the tab name."
:group 'centaur-tabs
:type 'boolean)
(defcustom centaur-tabs-icon-type (and centaur-tabs-set-icons
(or (require 'all-the-icons nil t)
(require 'nerd-icons nil t)))
"Icon type; it should be one of `all-the-icons' and `nerd-icons'."
:group 'centaur-tabs
:type 'symbol
:set
(lambda (k v)
(pcase v
('all-the-icons
(unless (require 'all-the-icons nil t)
(setq v nil)))
('nerd-icons
(unless (require 'nerd-icons nil t)
(setq v nil)))
('type
(if (require 'all-the-icons nil t)
(setq v 'all-the-icons)
(setq v nil))))
(set k v)))
(defvar centaur-tabs-icon-scale-factor 1.0
"The base scale factor for the `height' face property of tab icons.")
(defvar centaur-tabs-icon-v-adjust 0.01
"The vertical adjust for tab icons.")
(defcustom centaur-tabs-gray-out-icons nil
"When non nil, enable gray icons for unselected buffer."
:group 'centaur-tabs
:type '(choice :tag "Gray out icons for unselected..."
(const :tag "Buffer" buffer)))
(defcustom centaur-tabs-plain-icons nil
"When non nil, tab icons' color will be the same as tabs' foreground color."
:group 'centaur-tabs
:type 'boolean)
(defcustom centaur-tabs-icons-prefix " "
"Prefix string before icons."
:group 'centaur-tabs
:type 'string)
(defun centaur-tabs--icon-for-file (file &rest args)
"Get the formatted icon for FILE.
ARGS should be a plist containing `:height', `:v-adjust', or `:face' properties."
(pcase centaur-tabs-icon-type
('all-the-icons (apply #'all-the-icons-icon-for-file file args))
('nerd-icons (apply #'nerd-icons-icon-for-file file args))))
(defun centaur-tabs--icon-for-mode (mode &rest args)
"Get the formatted icon for MODE.
ARGS should be a plist containining `:height', `:v-adjust' or `:face' properties
like in the normal icon inserting functions."
(pcase centaur-tabs-icon-type
('all-the-icons (apply #'all-the-icons-icon-for-mode mode args))
('nerd-icons (apply #'nerd-icons-icon-for-mode mode args))))
(defun centaur-tabs-icon (tab face selected)
"Generate icon for TAB using FACE's background.
If icon gray out option enabled, gray out icon if not SELECTED."
(if centaur-tabs-icon-type
(with-current-buffer (car tab)
(let* ((icon
(or (ignore-errors
(centaur-tabs--icon-for-file
(file-name-nondirectory (buffer-file-name))
:v-adjust centaur-tabs-icon-v-adjust
:height centaur-tabs-icon-scale-factor))
(ignore-errors
(centaur-tabs--icon-for-mode
major-mode
:v-adjust centaur-tabs-icon-v-adjust
:height centaur-tabs-icon-scale-factor))))
(background (face-background face nil 'default))
(inactive (cond ((and (not selected)
(eq centaur-tabs-gray-out-icons 'buffer))
(face-foreground 'mode-line-inactive nil 'default))
(centaur-tabs-plain-icons
(face-foreground 'centaur-tabs-selected nil 'default))
(t 'unspecified)))
(underline (and (eq (if (display-graphic-p) centaur-tabs-set-bar) 'under)
(face-attribute face :underline)))
(overline (and (eq (if (display-graphic-p) centaur-tabs-set-bar) 'over)
(face-attribute face :overline))))
(if (stringp icon)
(progn
(propertize icon 'face `(:inherit ,(get-text-property 0 'face icon)
:foreground ,inactive
:background ,background
:underline ,underline
:overline ,overline)))
"")))
""))
;;
;;; Ace-window style tab switching
(defcustom centaur-tabs-show-jump-identifier 'prompted
"Whether to show the tab identifier for centaur-tabs-ace-jump.
It has 3 options:
- `'nil', never show the jump identifier.
- `'prompted', only show it when using centaur-tabs-ace-jump.
- `'always', always show it regardless of the status."
:group 'centaur-tabs
:type '(choice :tag "show identifier when..."
(const :tag "Never" nil)
(const :tag "Only when prompted" prompted)
(const :tag "Always" always)))
(defcustom centaur-tabs-ace-jump-dim-buffer t
"Whether to dim the current buffer when centaur-ace-jump is activated."
:type 'boolean
:group 'centaur-tabs)
(defvar centaur-tabs-ace-jump-keys
'(?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)
"Buffer jump keys used by centaur-tabs-ace-jump.")
(defvar centaur-tabs-ace-dispatch-alist
'((?q exit "Exit")
(?\C-g exit "Exit")
(?j jump-to-tab "Jump to tab")
(?x close-tab "Close tab")
(?s swap-tab "Swap tab")
(?\[ backward-group "Previous group")
(?\] forward-group "Next group")
(?? show-help "Show dispatch help"))
"Action keys used by centaur-tabs-ace-jump.
The value of each element must be in the form:
\(key keyword docstring), where keyword must be one of the follows:
\(exit, jump-to-tab, close-tab, swap-tab, backward-group,
forward-group, show-help).")
;;
;;; Close buttons, modified marker and edges' margins
(defcustom centaur-tabs-set-close-button t
"When non nil, display a clickable close button on the right side of the tabs."
:group 'centaur-tabs
:type 'boolean)
(defcustom centaur-tabs-set-left-close-button nil
"When non nil, display a clickable close button on the left side of the tabs."
:group 'centaur-tabs
:type 'boolean)
(defcustom centaur-tabs-close-button (make-string 1 #x00D7)
"Display appearance of the close buttons, if enabled."
:group 'centaur-tabs
:type 'string)
(defcustom centaur-tabs-set-modified-marker nil
"When non nil, display a marker when the buffer is modified."
:group 'centaur-tabs
:type 'boolean)
(defcustom centaur-tabs-modified-marker (make-string 1 #x23FA)
"Display appearance of the modified marker, if enabled."
:group 'centaur-tabs
:type 'string)
(defcustom centaur-tabs-left-edge-margin " "
"Text to display at the left edge of the tabs, or nil for no added margin."
:group 'centaur-tabs
:type 'string)
(defcustom centaur-tabs-right-edge-margin " "
"Text to display at the right edge of the tabs, or nil for no added margin."
:group 'centaur-tabs
:type 'string)
;;
;;; Selected tab bar
(defun centaur-tabs--make-xpm (face width height)
"Create an XPM bitmap via FACE WIDTH and HEIGHT.
Taken from `doom-modeline'."
(when (and (display-graphic-p)
(image-type-available-p 'xpm))
(propertize
" " 'display
(let ((data (make-list height (make-list width 1)))
(color (or (face-background face nil t) "None")))
(ignore-errors
(create-image
(concat
(format
"/* XPM */\nstatic char * percent[] = {\n\"%i %i 2 1\",\n\". c %s\",\n\" c %s\","
(length (car data)) (length data) color color)
(apply #'concat
(cl-loop with idx = 0
with len = (length data)
for dl in data
do (cl-incf idx)
collect
(concat
"\""
(cl-loop for d in dl
if (= d 0) collect (string-to-char " ")
else collect (string-to-char "."))
(if (eq idx len) "\"};" "\",\n")))))
'xpm t :ascent 'center))))))
(defvar centaur-tabs-active-bar
(centaur-tabs--make-xpm 'centaur-tabs-active-bar-face
2
centaur-tabs-bar-height))
;;
;;; Navigation buttons
(defcustom centaur-tabs-show-navigation-buttons nil
"When non-nil, show the buttons for backward/forward tabs."
:group 'centaur-tabs
:type 'boolean)
(defcustom centaur-tabs-down-tab-text ""
"Text icon to show in the down button tab."
:group 'centaur-tabs
:type 'string)
(defcustom centaur-tabs-backward-tab-text ""
"Text icon to show in the backward button tab."
:group 'centaur-tabs
:type 'string)
(defcustom centaur-tabs-forward-tab-text ""
"Text icon to show in the forward button tab."
:group 'centaur-tabs
:type 'string)
(defcustom centaur-tabs-show-count nil
"When non-nil, show the current index and count of tabs in the current group."
:group 'centaur-tabs
:type 'boolean)
(defcustom centaur-tabs-count-format " [%d/%d] "
"Format text to display count."
:group 'centaur-tabs
:type 'string)
;;
;;; New tab button
(defcustom centaur-tabs-show-new-tab-button t
"When non-nil, show the button to create a new tab."
:group 'centaur-tabs
:type 'boolean)
(defcustom centaur-tabs-new-tab-text " + "
"Text icon to show in the new-tab button."
:group 'centaur-tabs
:type 'string)
;;
;;; Separators
(defvar centaur-tabs-style-left nil)
(defvar centaur-tabs-style-right nil)
(defvar ns-use-srgb-colorspace)
(defvar centaur-tabs-image-apple-rgb
(and (eq (window-system) 'ns)
ns-use-srgb-colorspace
(< 11
(string-to-number
(and (string-match "darwin\\([0-9]+\\)" system-configuration)
(match-string-no-properties 1 system-configuration)))))
"Boolean variable to determine whether to use Apple RGB colorspace.
used to render images.
t on macOS 10.7+ and `ns-use-srgb-colorspace' is t, nil otherwise.
This variable is automatically set, there's no need to modify it.")
(defun centaur-tabs-separator-interpolate (color1 color2)
"Interpolate between COLOR1 and COLOR2.
COLOR1 and COLOR2 must be supplied as hex strings with a leading #."
(let* ((c1 (color-name-to-rgb color1))
(c2 (color-name-to-rgb color2))
(red (/ (+ (nth 0 c1) (nth 0 c2)) 2))
(green (/ (+ (nth 1 c1) (nth 1 c2)) 2))
(blue (/ (+ (nth 2 c1) (nth 2 c2)) 2)))
(color-rgb-to-hex red green blue)))
(defun centaur-tabs-separator-color-xyz-to-apple-rgb (X Y Z)
"Convert CIE X Y Z colors to Apple RGB color space."
(let ((r (+ (* 3.2404542 X) (* -1.5371385 Y) (* -0.4985314 Z)))
(g (+ (* -0.9692660 X) (* 1.8760108 Y) (* 0.0415560 Z)))
(b (+ (* 0.0556434 X) (* -0.2040259 Y) (* 1.0572252 Z))))
(list (expt r (/ 1.8)) (expt g (/ 1.8)) (expt b (/ 1.8)))))
(defun centaur-tabs-separator-color-srgb-to-apple-rgb (red green blue)
"Convert RED GREEN BLUE colors from sRGB color space to Apple RGB.
RED, GREEN and BLUE should be between 0.0 and 1.0, inclusive."
(apply #'centaur-tabs-separator-color-xyz-to-apple-rgb (color-srgb-to-xyz red green blue)))
(defun centaur-tabs-separator-hex-color (color)
"Get the hexadecimal value of COLOR."
(when color
(let ((srgb-color (color-name-to-rgb color)))
(if centaur-tabs-image-apple-rgb
(apply #'color-rgb-to-hex (apply #'centaur-tabs-separator-color-srgb-to-apple-rgb srgb-color))
(apply #'color-rgb-to-hex srgb-color)))))
(defun centaur-tabs-separator-pattern (lst)
"Turn LST into an infinite pattern."
(when lst
(let ((pattern (cl-copy-list lst)))
(setcdr (last pattern) pattern))))
(defun centaur-tabs-separator-pattern-to-string (pattern)
"Convert a PATTERN into a string that can be used in an XPM."
(concat "\"" (mapconcat #'number-to-string pattern "") "\","))
(defun centaur-tabs-separator-reverse-pattern (pattern)
"Reverse each line in PATTERN."
(mapcar 'reverse pattern))
(defun centaur-tabs-separator-row-pattern (fill total &optional fade)
"Make a list that has FILL 0s out of TOTAL 1s with FADE 2s to the right of
the fill."
(unless fade (setq fade 0))
(let ((fill (min fill total))
(fade (min fade (max (- total fill) 0))))
(append (make-list fill 0)
(make-list fade 2)
(make-list (- total fill fade) 1))))
(defun centaur-tabs-separator-pattern-bindings-body (patterns height-exp pattern-height-sym
second-pattern-height-sym)
"Create let-var bindings and a function body from PATTERNS.
The `car' and `cdr' parts of the result can be passed to the
function `centaur-tabs-separator-wrap-defun' as its `let-vars'
and `body' arguments,respectively. HEIGHT-EXP is an expression
calculating the image height and it should contain a free variable `height'.
PATTERN-HEIGHT-SYM and SECOND-PATTERN-HEIGHT-SYM are symbols used
for let-var binding variables."
(let* ((pattern (centaur-tabs-separator-pattern (mapcar 'centaur-tabs-separator-pattern-to-string (car patterns))))
(header (mapcar 'centaur-tabs-separator-pattern-to-string (nth 1 patterns)))
(footer (mapcar 'centaur-tabs-separator-pattern-to-string (nth 2 patterns)))
(second-pattern (centaur-tabs-separator-pattern (mapcar 'centaur-tabs-separator-pattern-to-string (nth 3 patterns))))
(center (mapcar 'centaur-tabs-separator-pattern-to-string (nth 4 patterns)))
(reserve (+ (length header) (length footer) (length center))))
(when pattern
(cons `((,pattern-height-sym (max (- ,height-exp ,reserve) 0))
(,second-pattern-height-sym (/ ,pattern-height-sym 2))
(,pattern-height-sym ,(if second-pattern `(ceiling ,pattern-height-sym 2) `,pattern-height-sym)))
(list (when header `(mapconcat 'identity ',header ""))
`(mapconcat 'identity
(cl-subseq ',pattern 0 ,pattern-height-sym) "")
(when center `(mapconcat 'identity ',center ""))
(when second-pattern
`(mapconcat 'identity
(cl-subseq ',second-pattern
0 ,second-pattern-height-sym) ""))
(when footer `(mapconcat 'identity ',footer "")))))))
(defun centaur-tabs-separator-pattern-defun (name dir width &rest patterns)
"Create a powerline function of NAME in DIR with WIDTH for PATTERNS.
PATTERNS is of the form (PATTERN HEADER FOOTER SECOND-PATTERN CENTER
PATTERN-2X HEADER-2X FOOTER-2X SECOND-PATTERN-2X CENTER-2X).
PATTERN is required, all other components are optional.
The first 5 components are for the standard resolution image.
The remaining ones are for the high resolution image where both
width and height are doubled. If PATTERN-2X is nil or not given,
then the remaining components are ignored and the standard
resolution image with magnification and interpolation will be
used in high resolution environments
All generated functions generate the form:
HEADER
PATTERN ...
CENTER
SECOND-PATTERN ...
FOOTER
PATTERN and SECOND-PATTERN repeat infinitely to fill the space needed to
generate a full height XPM.
PATTERN, HEADER, FOOTER, SECOND-PATTERN, CENTER are of the form
\((COLOR ...) (COLOR ...) ...).
COLOR can be one of 0, 1, or 2, where 0 is the source color, 1 is the
destination color, and 2 is the interpolated color between 0 and 1."
(when (eq dir 'right)
(setq patterns (mapcar 'centaur-tabs-separator-reverse-pattern patterns)))
(let ((bindings-body (centaur-tabs-separator-pattern-bindings-body patterns
'height
'pattern-height
'second-pattern-height))
(bindings-body-2x (centaur-tabs-separator-pattern-bindings-body (nthcdr 5 patterns)
'(* height 2)
'pattern-height-2x
'second-pattern-height-2x)))
(centaur-tabs-separator-wrap-defun name dir width
(append (car bindings-body) (car bindings-body-2x))
(cdr bindings-body) (cdr bindings-body-2x))))
(defun centaur-tabs-separator-background-color (face)
"Set the separator background color using FACE."
(face-attribute face
(if (face-attribute face :inverse-video nil 'default)
:foreground
:background)
nil
'default))
(defun centaur-tabs-separator-wrap-defun (name dir width let-vars body &optional body-2x)
"Generate a powerline function of name NAME in dir DIR.
This is made with WIDTH using LET-VARS and BODY.
BODY-2X is an optional argument."
(let* ((src-face (if (eq dir 'left) 'face1 'face2))
(dst-face (if (eq dir 'left) 'face2 'face1)))
`(defun ,(intern (format "powerline-%s-%s" name (symbol-name dir)))
(face1 face2 &optional height)
(when window-system
(unless height (setq height centaur-tabs-height))
(let* ,(append `((color1 (when ,src-face
(centaur-tabs-separator-hex-color (centaur-tabs-separator-background-color ,src-face))))
(color2 (when ,dst-face
(centaur-tabs-separator-hex-color (centaur-tabs-separator-background-color ,dst-face))))
(colori (when (and color1 color2) (centaur-tabs-separator-interpolate color1 color2)))
(color1 (or color1 "None"))
(color2 (or color2 "None"))
(colori (or colori "None")))
let-vars)
(apply #'create-image
,(append `(concat (format "/* XPM */ static char * %s_%s[] = { \"%s %s 3 1\", \"0 c %s\", \"1 c %s\", \"2 c %s\","
,(replace-regexp-in-string "-" "_" name)
(symbol-name ',dir)
,width
height
color1
color2
colori))
body
'("};"))
'xpm t
:ascent 'center
:face (when (and face1 face2)
,dst-face)
,(and body-2x
`(and (featurep 'mac)
(list :data-2x
,(append `(concat (format "/* XPM */ static char * %s_%s_2x[] = { \"%s %s 3 1\", \"0 c %s\", \"1 c %s\", \"2 c %s\","
,(replace-regexp-in-string "-" "_" name)
(symbol-name ',dir)
(* ,width 2)
(* height 2)
color1
color2
colori))
body-2x
'("};")))))))))))
(defun centaur-tabs-separator-alternate (dir)
"Generate an alternating pattern XPM function for DIR."
(centaur-tabs-separator-pattern-defun "alternate" dir 4
'((2 2 1 1)
(0 0 2 2))
nil nil nil nil
;; 2x
'((2 2 2 2 1 1 1 1)
(2 2 2 2 1 1 1 1)
(0 0 0 0 2 2 2 2)
(0 0 0 0 2 2 2 2))))
(defun centaur-tabs-separator-bar (dir)
"Generate a bar XPM function for DIR."
(centaur-tabs-separator-pattern-defun "bar" dir 2
'((2 2))))
(defun centaur-tabs-separator-box (dir)
"Generate a box XPM function for DIR."
(centaur-tabs-separator-pattern-defun "box" dir 2
'((0 0)
(0 0)
(1 1)
(1 1))
nil nil nil nil
;; 2x
'((0 0 0 0)
(0 0 0 0)
(0 0 0 0)
(0 0 0 0)
(1 1 1 1)
(1 1 1 1)
(1 1 1 1)
(1 1 1 1))))
(defun centaur-tabs-separator-chamfer (dir)
"Generate a chamfer XPM function for DIR."
(centaur-tabs-separator-pattern-defun "chamfer" dir 3
'((0 0 0))
'((1 1 1)
(0 1 1)
(0 0 1))
nil nil nil
;; 2x
'((0 0 0 0 0 0))
'((1 1 1 1 1 1)
(0 1 1 1 1 1)
(0 0 1 1 1 1)
(0 0 0 1 1 1)
(0 0 0 0 1 1)
(0 0 0 0 0 1))))
(defun centaur-tabs-separator-rounded (dir)
"Generate a rounded XPM function for DIR."
(centaur-tabs-separator-pattern-defun "rounded" dir 6
'((0 0 0 0 0 0))
'((2 1 1 1 1 1)
(0 0 2 1 1 1)
(0 0 0 0 1 1)
(0 0 0 0 2 1)
(0 0 0 0 0 1)
(0 0 0 0 0 2))
nil nil nil
;; 2x
'((0 0 0 0 0 0 0 0 0 0 0 0))
'((1 1 1 1 1 1 1 1 1 1 1 1)
(0 0 2 1 1 1 1 1 1 1 1 1)
(0 0 0 0 1 1 1 1 1 1 1 1)
(0 0 0 0 0 0 1 1 1 1 1 1)
(0 0 0 0 0 0 0 2 1 1 1 1)
(0 0 0 0 0 0 0 0 1 1 1 1)
(0 0 0 0 0 0 0 0 0 1 1 1)
(0 0 0 0 0 0 0 0 0 0 1 1)
(0 0 0 0 0 0 0 0 0 0 1 1)
(0 0 0 0 0 0 0 0 0 0 2 1)
(0 0 0 0 0 0 0 0 0 0 0 1)
(0 0 0 0 0 0 0 0 0 0 0 1))))
(defun centaur-tabs-separator-slant (dir)
"Generate a slant XPM function for DIR."
(let* ((row-modifier (if (eq dir 'left) 'identity 'reverse)))
(centaur-tabs-separator-wrap-defun "slant" dir 'width
'((width (1- (ceiling height 2))))
`((cl-loop for i from 0 to (1- height)
concat (centaur-tabs-separator-pattern-to-string (,row-modifier (centaur-tabs-separator-row-pattern (/ i 2) width)))))
`((cl-loop for i from 0 to (1- (* height 2))
concat (centaur-tabs-separator-pattern-to-string (,row-modifier (centaur-tabs-separator-row-pattern (/ i 2) (* width 2)))))))))
(defun centaur-tabs-separator-wave (dir)
"Generate a wave XPM function for DIR."
(centaur-tabs-separator-pattern-defun "wave" dir 11
'((0 0 0 0 0 0 1 1 1 1 1))
'((2 1 1 1 1 1 1 1 1 1 1)
(0 0 1 1 1 1 1 1 1 1 1)
(0 0 0 1 1 1 1 1 1 1 1)
(0 0 0 2 1 1 1 1 1 1 1)
(0 0 0 0 1 1 1 1 1 1 1)
(0 0 0 0 2 1 1 1 1 1 1)
(0 0 0 0 0 1 1 1 1 1 1)
(0 0 0 0 0 1 1 1 1 1 1)
(0 0 0 0 0 2 1 1 1 1 1))
'((0 0 0 0 0 0 2 1 1 1 1)
(0 0 0 0 0 0 0 1 1 1 1)
(0 0 0 0 0 0 0 1 1 1 1)
(0 0 0 0 0 0 0 2 1 1 1)
(0 0 0 0 0 0 0 0 1 1 1)
(0 0 0 0 0 0 0 0 2 1 1)
(0 0 0 0 0 0 0 0 0 0 2))
nil nil
;; 2x
'((0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1))
'((1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
(0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
(0 0 0 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
(0 0 0 0 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
(0 0 0 0 0 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
(0 0 0 0 0 0 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
(0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
(0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
(0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
(0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
(0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1)
(0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1)
(0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1)
(0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1)
(0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1)
(0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1)
(0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1)
(0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1))
'((0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1)
(0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1)
(0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1)
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1)
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1)
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1)
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1)
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1)
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1)
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1)
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2 1 1 1 1 1)
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2 1 1 1 1)
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1)
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0))))
(defun centaur-tabs-separator-zigzag (dir)
"Generate a zigzag pattern XPM function for DIR."
(centaur-tabs-separator-pattern-defun "zigzag" dir 3
'((1 1 1)
(0 1 1)
(0 0 1)
(0 0 0)
(0 0 1)
(0 1 1))
nil nil nil nil
;; 2x
'((1 1 1 1 1 1)
(0 1 1 1 1 1)
(0 0 1 1 1 1)
(0 0 0 1 1 1)
(0 0 0 0 1 1)
(0 0 0 0 0 1)
(0 0 0 0 0 0)
(0 0 0 0 0 1)
(0 0 0 0 1 1)
(0 0 0 1 1 1)
(0 0 1 1 1 1)
(0 1 1 1 1 1))))
(defun centaur-tabs-separator-memoize (func)
"Memoize FUNC.
If argument is a symbol then install the memoized function over
the original function. Use frame-local memoization."
(cl-typecase func
(symbol (fset func (centaur-tabs-separator-memoize-wrap-frame-local (symbol-function func))) func)
(function (centaur-tabs-separator-memoize-wrap-frame-local func))))
(defun centaur-tabs-separator-memoize-wrap-frame-local (func)
"Return the memoized version of FUNC.
The memoization cache is frame-local."
(let ((funcid (cl-gensym)))
`(lambda (&rest args)
,(concat (documentation func) (format "\n(memoized function %s)" funcid))
(let* ((cache (centaur-tabs-separator-create-or-get-cache))
(key (cons ',funcid args))
(val (gethash key cache)))
(or val
(puthash key (apply ,func args) cache))))))
(defun centaur-tabs-separator-create-or-get-cache ()
"Return a frame-local hash table that acts as a memoization cache.
The cache is for the powerline.
Create one if the frame doesn't have one yet."
(if-let* ((table (frame-parameter nil 'powerline-cache))
((hash-table-p table)))
table
(centaur-tabs-separator-reset-cache)))
(defun centaur-tabs-separator-reset-cache ()
"Reset and return the frame-local hash table used for a memoization cache."
(let ((table (make-hash-table :test 'equal)))
;; Store it as a frame-local variable
(modify-frame-parameters nil `((powerline-cache . ,table)))
table))
(centaur-tabs-separator-memoize (centaur-tabs-separator-alternate 'left))
(centaur-tabs-separator-memoize (centaur-tabs-separator-alternate 'right))
(centaur-tabs-separator-memoize (centaur-tabs-separator-bar 'left))
(centaur-tabs-separator-memoize (centaur-tabs-separator-bar 'right))
(centaur-tabs-separator-memoize (centaur-tabs-separator-box 'left))
(centaur-tabs-separator-memoize (centaur-tabs-separator-box 'right))
(centaur-tabs-separator-memoize (centaur-tabs-separator-chamfer 'left))
(centaur-tabs-separator-memoize (centaur-tabs-separator-chamfer 'right))
(centaur-tabs-separator-memoize (centaur-tabs-separator-rounded 'left))
(centaur-tabs-separator-memoize (centaur-tabs-separator-rounded 'right))
(centaur-tabs-separator-memoize (centaur-tabs-separator-slant 'left))
(centaur-tabs-separator-memoize (centaur-tabs-separator-slant 'right))
(centaur-tabs-separator-memoize (centaur-tabs-separator-wave 'left))
(centaur-tabs-separator-memoize (centaur-tabs-separator-wave 'right))
(centaur-tabs-separator-memoize (centaur-tabs-separator-zigzag 'left))
(centaur-tabs-separator-memoize (centaur-tabs-separator-zigzag 'right))
(defun centaur-tabs-select-separator-style (tab-style)
"Set the separator style to TAB-STYLE."
(let* ((theme (or (car custom-enabled-themes) "default"))
(name (intern (format "centaur-tabs--%s-%s-face" theme tab-style)))
(face (copy-face 'centaur-tabs-default name)))
(setq centaur-tabs-style-left
(funcall (intern (format "powerline-%s-right" tab-style))
face nil centaur-tabs-height))
(setq centaur-tabs-style-right
(funcall (intern (format "powerline-%s-left" tab-style))
nil face centaur-tabs-height))))
(provide 'centaur-tabs-elements)
;;; centaur-tabs-elements.el ends here

View file

@ -1,10 +1,10 @@
;;; centaur-tabs-functions.el --- centaur-tabs logic components -*- lexical-binding: t; -*-
;; Copyright (C) 2019-2020 Emmanuel Bustos
;; Copyright (C) 2019-2024 Emmanuel Bustos
;; Copyright (C) 2024 Jen-Chieh Shen
;; This file is not part of GNU Emacs.
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2, or
@ -19,33 +19,32 @@
;; along with this program; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
;; Floor, Boston, MA 02110-1301, USA.
;;
;;; Commentary:
;;
;; This file contains functions that control the logic of centaur-tabs
;;
;;; Code:
;;; Require
(require 'cl-lib)
(require 'seq)
(require 'centaur-tabs-elements)
;; Compiler pacifier
(declare-function ivy-read "ext:ivy.el" t t)
(declare-function helm-build-sync-source "ext:helm-source.el" t t)
(declare-function all-the-icons-match? "ext:all-the-icons.el" t t)
(declare-function all-the-icons-auto-mode-match? "ext:all-the-icons.el" t t)
(declare-function all-the-icons-icon-for-file "ext:all-the-icons.el" t t)
(declare-function all-the-icons-icon-for-mode "ext:all-the-icons.el" t t)
(declare-function nerd-icons-match? "ext:nerd-icons.el" t t)
(declare-function nerd-icons-auto-mode-match? "ext:nerd-icons.el" t t)
(declare-function nerd-icons-icon-for-file "ext:nerd-icons.el" t t)
(declare-function nerd-icons-icon-for-mode "ext:nerd-icons.el" t t)
(declare-function projectile-project-root "ext:projectile.el" t t)
(declare-function projectile-project-name "ext:projectile.el" t t)
(defvar helm-source-centaur-tabs-group)
(declare-function vterm "ext:vterm.el")
(declare-function centaur-tabs-move-current-tab-to-right "nerd-icons.el")
(declare-function centaur-tabs-move-current-tab-to-left "nerd-icons.el")
(defvar centaur-tabs--buffer-show-groups)
(defvar centaur-tabs-ace-jump-active)
(declare-function centaur-tabs-mode "centaur-tabs.el")
;;; Customs
;;
;;; Customs
(defcustom centaur-tabs-cycle-scope nil
"*Specify the scope of cyclic navigation through tabs.
The following scopes are possible:
@ -71,7 +70,8 @@ visible."
:type 'boolean)
(defcustom centaur-tabs-common-group-name "Common"
"If the current buffer does not belong to any project the group name uses the name of this variable."
"If the current buffer does not belong to any project the group name uses the
name of this variable."
:group 'centaur-tabs
:type 'string)
@ -95,6 +95,9 @@ visible."
"*Helm"
" *which"
"*Compile-Log*"
"*Choices"
"*Process"
"*Calc"
"*lsp"
"*LSP"
"*company"
@ -103,15 +106,17 @@ visible."
"*ediff"
"*tramp"
" *Mini"
"*help"
"*straight"
" *temp"
"*Help")
" *temp")
"List of prefixes that indicates which buffers should not be included as tabs.
Buffers that have names that start with any of these strings will be ignored."
:type '(repeat string)
:group 'centaur-tabs)
(defvar centaur-tabs-hide-predicate #'ignore
"Predicate function to hide the entire tab line.
Ths tab line will hide if this function returns t.")
(defvar centaur-tabs-hide-tab-function 'centaur-tabs-hide-tab
"Function to hide tabs.
This function filters tabs. The tab will hide if this function returns t.")
@ -168,10 +173,10 @@ tab(B), move A to the left of B" t)
(defun centaur-tabs-headline-match ()
"Make headline use centaur-tabs-default-face."
(set-face-attribute centaur-tabs-display-line nil :background (face-background 'centaur-tabs-unselected nil 'default)
:box nil
:overline nil
:underline nil))
(set-face-attribute
centaur-tabs-display-line nil
:background (face-background 'centaur-tabs-unselected nil 'default)
:box nil :overline nil :underline nil))
;; Change the font and height for all tab faces
(defun centaur-tabs-change-fonts (family height)
@ -241,13 +246,8 @@ When not specified, ELLIPSIS defaults to ...."
(define-key map (vector centaur-tabs-display-line 'mouse-4 ) 'centaur-tabs-backward)
(define-key map (vector centaur-tabs-display-line 'wheel-down) 'centaur-tabs-forward )
(define-key map (vector centaur-tabs-display-line 'wheel-up ) 'centaur-tabs-backward)
;;; Use right click to show the rest of groups
(define-key map (vector centaur-tabs-display-line 'mouse-3) 'centaur-tabs--tab-menu )
;;; Use double click to maximize window
(define-key map (vector centaur-tabs-display-line 'double-mouse-1) 'delete-other-windows)
map)
"Keymap to use in Centaur-Tabs mode.")
@ -294,87 +294,9 @@ When not specified, ELLIPSIS defaults to ...."
map)
"Keymap used for setting mouse events for new tab button.")
;;; Events and event functions
;;
(defun centaur-tabs-buffer-close-tab (tab)
"Function for closing TAB."
(let ((buffer (centaur-tabs-tab-value tab)))
(with-current-buffer buffer
(kill-buffer buffer))
(centaur-tabs-display-update)))
(defun centaur-tabs-get-tab-from-event (event)
"Given a mouse EVENT, extract the tab at the mouse point."
(let ((pos (posn-string (event-start event))))
(get-text-property (cdr pos) 'centaur-tabs-tab (car pos))))
(defun centaur-tabs-do-select (event)
"Given a mouse EVENT, select the tab at the mouse point."
(interactive "e")
(select-window (posn-window (event-start event)))
(centaur-tabs-buffer-select-tab `,(centaur-tabs-get-tab-from-event event)))
(defun centaur-tabs-do-close (event)
"Given a mouse EVENT, close the tab at the mouse point."
(interactive "e")
(let ((window (posn-window (event-start event))))
(with-selected-window window
(select-window window)
(let ((foreground-buffer-name (buffer-name)))
(centaur-tabs-buffer-select-tab `,(centaur-tabs-get-tab-from-event event))
(let* ((buffer (window-buffer window))
(target-buffer-name (buffer-name))
(same-target-check (string-equal foreground-buffer-name target-buffer-name))
(window-num (- (length (get-buffer-window-list buffer))
(if same-target-check 0 1))))
(if (> window-num 1)
(delete-window window)
(centaur-tabs-buffer-close-tab `,(centaur-tabs-get-tab-from-event event))))))))
(defun centaur-tabs-backward--button (event)
"Same as centaur-tabs-backward, but changing window to EVENT source."
(interactive "e")
(select-window (posn-window (event-start event)))
(centaur-tabs-backward))
(defun centaur-tabs-forward--button (event)
"Same as centaur-tabs-forward, but changing window to EVENT source."
(interactive "e")
(select-window (posn-window (event-start event)))
(centaur-tabs-forward))
(defun centaur-tabs-new-tab--button (event)
"Same as centaur-tabs--create-new-tab, but changing window to EVENT source."
(interactive "e")
(select-window (posn-window (event-start event)))
(centaur-tabs--create-new-tab))
(defun centaur-tabs-move-current-tab-to-left--button (evt)
"Same as centaur-tabs-move-current-tab-to-left, but ensuring the tab will remain visible. The active window will the the EVT source."
(interactive "e")
(centaur-tabs-move-current-tab-to-left)
(centaur-tabs--button-ensure-selected-tab-is-visible evt))
(defun centaur-tabs-move-current-tab-to-right--button (evt)
"Same as centaur-tabs-move-current-tab-to-right, but ensuring the tab will remain visible. The active window will the the EVT source."
(interactive "e")
(centaur-tabs-move-current-tab-to-right)
(centaur-tabs--button-ensure-selected-tab-is-visible evt))
(defun centaur-tabs--button-ensure-selected-tab-is-visible (evt)
"This is a nasty trick to make the current tab visible, since centaur-tabs--track-selected or centaur-tabs-auto-scroll-flag seems not to work. EVT is used to change the active window."
;;; This works if the tab has not reached the last position
(centaur-tabs-forward--button evt)
(centaur-tabs-backward--button evt)
;;; Just in case the tab has the tab reached the last position
(centaur-tabs-backward--button evt)
(centaur-tabs-forward--button evt))
;;; Tab and tab sets
;;
(defsubst centaur-tabs-make-tab (object tabset)
"Return a new tab with value OBJECT.
TABSET is the tab set the tab belongs to."
@ -402,6 +324,9 @@ TABSET is the tab set the tab belongs to."
"Hook run after tab bar data has been initialized.
You should use this hook to initialize dependent data.")
(defvar centaur-tabs-display-hash (make-hash-table :test 'equal)
"Display format cache.")
(defsubst centaur-tabs-init-tabsets-store ()
"Initialize the tab set store."
(setq centaur-tabs-tabsets (make-vector 31 0)
@ -439,14 +364,15 @@ The result is a list just as long as the number of existing tab sets."
(defun centaur-tabs-make-tabset (name &rest objects)
"Make a new tab set whose name is the string NAME.
It is initialized with tabs build from the list of OBJECTS."
(when name ; some buffers don't have a tabset (e.g. org-agenda)
(let* ((tabset (intern name centaur-tabs-tabsets))
(tabs (cl-mapcar #'(lambda (object)
(tabs (mapcar #'(lambda (object)
(centaur-tabs-make-tab object tabset))
objects)))
(set tabset tabs)
(centaur-tabs-put-cache tabset 'select (car tabs))
(put tabset 'start 0)
tabset))
tabset)))
(defsubst centaur-tabs-get-tabset (name)
"Return the tab set whose name is the string NAME.
@ -464,22 +390,22 @@ That is, remove it from the tab sets store."
(defsubst centaur-tabs-tab-values (tabset)
"Return the list of tab values in TABSET."
(cl-mapcar 'centaur-tabs-tab-value (centaur-tabs-tabs tabset)))
(mapcar 'centaur-tabs-tab-value (centaur-tabs-tabs tabset)))
(defun centaur-tabs-get-cache (cache key)
"Return the per-frame cached value of KEY in CACHE."
(let
((cached-hash (frame-parameter nil cache)))
(if (hash-table-p cached-hash)
(gethash key cached-hash nil))))
"Return the cached value of KEY in CACHE."
(when-let* ((cache (format "%s" cache))
(cached-hash (gethash cache centaur-tabs-display-hash))
((hash-table-p cached-hash)))
(gethash key cached-hash nil)))
(defun centaur-tabs-put-cache (cache key value)
"Set the per-frame cached value of KEY in CACHE to VALUE."
(let*
((cached-hash (frame-parameter nil cache))
"Set the cached value of KEY in CACHE to VALUE."
(let* ((cache (format "%s" cache))
(cached-hash (gethash cache centaur-tabs-display-hash))
(hash (if (hash-table-p cached-hash) cached-hash (make-hash-table))))
(puthash key value hash)
(set-frame-parameter nil cache hash))
(puthash cache hash centaur-tabs-display-hash))
value)
(defsubst centaur-tabs-get-tab (object tabset)
@ -494,14 +420,14 @@ Return the tab found, or nil if not found."
(defsubst centaur-tabs-template (tabset)
"Return the cached visual representation of TABSET.
That is, a `centaur-tabs-display-line-format' template, or nil if the cache is
empty."
That is, a `centaur-tabs-display-line-format' template, or nil if
the cache is empty."
(centaur-tabs-get-cache tabset 'template))
(defsubst centaur-tabs-set-template (tabset template)
"Set the cached visual representation of TABSET to TEMPLATE.
TEMPLATE must be a valid `centaur-tabs-display-line-format' template, or nil to
cleanup the cache."
TEMPLATE must be a valid `centaur-tabs-display-line-format' template,
or nil to cleanup the cache."
(centaur-tabs-put-cache tabset 'template template))
(defsubst centaur-tabs-selected-tab (tabset)
@ -551,7 +477,7 @@ Otherwise insert it."
tabs
(let* ((tab (centaur-tabs-make-tab object tabset))
(selected (centaur-tabs-selected-tab tabset))
(selected-index (cl-position (car selected) (cl-mapcar 'car tabs))))
(selected-index (cl-position (car selected) (mapcar 'car tabs))))
(centaur-tabs-set-template tabset nil)
(set tabset (centaur-tabs-insert-at tabs selected-index tab))))))
@ -616,26 +542,132 @@ current cached copy."
(centaur-tabs-set-template centaur-tabs-tabsets-tabset nil)
centaur-tabs-tabsets-tabset)
(defun centaur-tabs-after-focus (&rest _)
"Focus hook."
(when (frame-focus-state)
(ignore-errors (centaur-tabs-buffer-update-groups))
(ignore-errors (centaur-tabs-display-update))))
(defun centaur-tabs-on-window-buffer-change (frame &rest _)
"Function to be run after window buffer is changed in FRAME."
(unless (frame-parent frame)
(ignore-errors (centaur-tabs-buffer-update-groups))))
;; Functions for modification hooks and advices
(defun centaur-tabs-on-saving-buffer ()
"Function to be run after the buffer is saved."
(centaur-tabs-set-template centaur-tabs-current-tabset nil)
(centaur-tabs-display-update))
(defun centaur-tabs-on-modifying-buffer ()
(defun centaur-tabs-on-modifying-buffer (&rest _)
"Function to be run after the buffer is first changed."
(set-buffer-modified-p (buffer-modified-p))
(centaur-tabs-set-template centaur-tabs-current-tabset nil)
(centaur-tabs-display-update))
(defun centaur-tabs-after-modifying-buffer (&rest _)
"Function to be run after the buffer is changed.
BEGIN, END and LENGTH are just standard arguments for after-changes-function
hooked functions"
(set-buffer-modified-p (buffer-modified-p))
(centaur-tabs-set-template centaur-tabs-current-tabset nil)
(centaur-tabs-display-update))
;;; Tabs display
(defun centaur-tabs-re-enable ()
"Re-enable `centaur-tabs-mode'."
(centaur-tabs-mode -1)
(centaur-tabs-mode 1))
(defun centaur-tabs--after-load-theme (&rest _)
"Function to be run after the theme changed."
(setq centaur-tabs-style-right nil
centaur-tabs-style-left nil)
;; XXX: Dirty hack, is there a way to improve this?
(centaur-tabs-re-enable))
;;
;;; Events and event functions
(defun centaur-tabs-buffer-close-tab (tab)
"Function for closing TAB."
(let ((buffer (centaur-tabs-tab-value tab)))
(kill-buffer buffer)
(centaur-tabs-buffer-update-groups)
(centaur-tabs-display-update)))
(defun centaur-tabs-get-tab-from-event (event)
"Given a mouse EVENT, extract the tab at the mouse point."
(let ((pos (posn-string (event-start event))))
(get-text-property (cdr pos) 'centaur-tabs-tab (car pos))))
(defun centaur-tabs-do-select (event)
"Given a mouse EVENT, select the tab at the mouse point."
(interactive "e")
(select-window (posn-window (event-start event)))
(centaur-tabs-buffer-select-tab `,(centaur-tabs-get-tab-from-event event)))
(defun centaur-tabs-do-close (event)
"Given a mouse EVENT, close the tab at the mouse point."
(interactive "e")
(let ((window (posn-window (event-start event))))
(with-selected-window window
(select-window window)
(let ((foreground-buffer-name (buffer-name)))
(centaur-tabs-buffer-select-tab `,(centaur-tabs-get-tab-from-event event))
(let* ((buffer (window-buffer window))
(target-buffer-name (buffer-name))
(same-target-check (string-equal foreground-buffer-name target-buffer-name))
(window-num (- (length (get-buffer-window-list buffer))
(if same-target-check 0 1))))
(if (> window-num 1)
(delete-window window)
(centaur-tabs-buffer-close-tab `,(centaur-tabs-get-tab-from-event event))))))))
(defun centaur-tabs-backward--button (event)
"Same as centaur-tabs-backward, but changing window to EVENT source."
(interactive "e")
(select-window (posn-window (event-start event)))
(centaur-tabs-backward))
(defun centaur-tabs-forward--button (event)
"Same as centaur-tabs-forward, but changing window to EVENT source."
(interactive "e")
(select-window (posn-window (event-start event)))
(centaur-tabs-forward))
(defun centaur-tabs-new-tab--button (event)
"Same as centaur-tabs--create-new-tab, but changing window to EVENT source."
(interactive "e")
(select-window (posn-window (event-start event)))
(centaur-tabs--create-new-tab))
(defun centaur-tabs-move-current-tab-to-left--button (evt)
"Same as centaur-tabs-move-current-tab-to-left, but ensuring the tab will
remain visible. The active window will the the EVT source."
(interactive "e")
(centaur-tabs-move-current-tab-to-left)
(centaur-tabs--button-ensure-selected-tab-is-visible evt))
(defun centaur-tabs-move-current-tab-to-right--button (evt)
"Same as centaur-tabs-move-current-tab-to-right, but ensuring the tab will
remain visible. The active window will the the EVT source."
(interactive "e")
(centaur-tabs-move-current-tab-to-right)
(centaur-tabs--button-ensure-selected-tab-is-visible evt))
(defun centaur-tabs--button-ensure-selected-tab-is-visible (evt)
"This is a nasty trick to make the current tab visible, since
`centaur-tabs--track-selected' or `centaur-tabs-auto-scroll-flag' seems not
to work. EVT is used to change the active window."
;; This works if the tab has not reached the last position
(centaur-tabs-forward--button evt)
(centaur-tabs-backward--button evt)
;; Just in case the tab has the tab reached the last position
(centaur-tabs-backward--button evt)
(centaur-tabs-forward--button evt))
(defun centaur-tabs-refill-tabs ()
"Refill current tab line."
(centaur-tabs-buffer-update-groups)
(force-window-update (selected-window))
(centaur-tabs--button-ensure-selected-tab-is-visible nil))
;;
;;; Tabs display
(defsubst centaur-tabs-line-tab (tab)
"Return the display representation of tab TAB.
That is, a propertized string used as an `centaur-tabs-display-line-format'
@ -676,23 +708,20 @@ Call `centaur-tabs-tab-label-function' to obtain a label for TAB."
(when (or (not centaur-tabs-style-left)
(not centaur-tabs-style-right))
(centaur-tabs-select-separator-style centaur-tabs-style))
(concat
(centaur-tabs-separator-render centaur-tabs-style-left face)
(concat (centaur-tabs-separator-render centaur-tabs-style-left face)
bar
;; left margin
(if centaur-tabs-left-edge-margin
(propertize
centaur-tabs-left-edge-margin
(when centaur-tabs-left-edge-margin
(propertize centaur-tabs-left-edge-margin
'face face
'centaur-tabs-tab tab
'pointer centaur-tabs-mouse-pointer
'local-map centaur-tabs-default-map))
;; left close button
(if centaur-tabs-set-left-close-button
(propertize
centaur-tabs-close-button
(when centaur-tabs-set-left-close-button
(propertize centaur-tabs-close-button
'face (if selected-p
'centaur-tabs-close-selected
'centaur-tabs-close-unselected)
@ -704,9 +733,7 @@ Call `centaur-tabs-tab-label-function' to obtain a label for TAB."
;; icon
(if (= (length icon) 0) ""
(concat
(propertize
" "
(concat (propertize centaur-tabs-icons-prefix
'face face
'centaur-tabs-tab tab
'pointer centaur-tabs-mouse-pointer
@ -714,8 +741,7 @@ Call `centaur-tabs-tab-label-function' to obtain a label for TAB."
icon))
;; tab name
(propertize
(concat
(propertize (concat
(if centaur-tabs-tab-label-function
(funcall centaur-tabs-tab-label-function tab)
(buffer-name buf))
@ -729,22 +755,24 @@ Call `centaur-tabs-tab-label-function' to obtain a label for TAB."
;; tab identifier
(when centaur-tabs-show-jump-identifier
(when (or (eq centaur-tabs-show-jump-identifier 'always) centaur-tabs-ace-jump-active)
(when (or (eq centaur-tabs-show-jump-identifier 'always)
centaur-tabs-ace-jump-active)
(when-let ((position (nth (cl-position tab (centaur-tabs-view (centaur-tabs-current-tabset t)))
centaur-tabs-ace-jump-keys)))
(propertize
(format "%c" (nth (cl-position tab (centaur-tabs-view (centaur-tabs-current-tabset t))) centaur-tabs-ace-jump-keys))
(format "%c" position)
'centaur-tabs-tab tab
'face (if selected-p
'centaur-tabs-jump-identifier-selected
'centaur-tabs-jump-identifier-unselected)
'pointer centaur-tabs-mouse-pointer
'help-echo buf-file-name
'local-map centaur-tabs-default-map)))
'local-map centaur-tabs-default-map))))
;; close button and/or modified marker
(unless centaur-tabs-ace-jump-active
(if centaur-tabs-set-close-button
(propertize
(if use-mod-mark-p
(propertize (if use-mod-mark-p
centaur-tabs-modified-marker
centaur-tabs-close-button)
'face (if use-mod-mark-p
@ -758,8 +786,7 @@ Call `centaur-tabs-tab-label-function' to obtain a label for TAB."
'mouse-face 'centaur-tabs-close-mouse-face
'local-map centaur-tabs-close-map)
(if (and centaur-tabs-set-modified-marker modified-p)
(propertize
centaur-tabs-modified-marker
(propertize centaur-tabs-modified-marker
'face mod-mark-face
'pointer centaur-tabs-mouse-pointer
'centaur-tabs-tab tab
@ -768,9 +795,8 @@ Call `centaur-tabs-tab-label-function' to obtain a label for TAB."
"" )))
;; right margin
(if centaur-tabs-right-edge-margin
(propertize
centaur-tabs-right-edge-margin
(when centaur-tabs-right-edge-margin
(propertize centaur-tabs-right-edge-margin
'face face
'centaur-tabs-tab tab
'pointer centaur-tabs-mouse-pointer
@ -783,9 +809,7 @@ Call `centaur-tabs-tab-label-function' to obtain a label for TAB."
That is, a propertized string used as an `centaur-tabs-display-line-format'
template element."
(let* ((face 'centaur-tabs-unselected))
(concat
(propertize
button
(concat (propertize button
'face face
'mouse-face 'highlight))))
@ -796,7 +820,7 @@ template element."
(padcolor centaur-tabs-background-color)
(all-tabs (centaur-tabs-tabs tabset))
(total-tabs (length all-tabs))
(sel-index (+ (cl-position (car sel) (cl-mapcar 'car all-tabs)) 1))
(sel-index (+ (cl-position (car sel) (mapcar 'car all-tabs)) 1))
atsel elts)
;; Track the selected tab to ensure it is always visible.
(when centaur-tabs--track-selected
@ -827,7 +851,7 @@ template element."
(apply #'insert elts)
(goto-char (point-min))
(> (vertical-motion 1) 0)))
(centaur-tabs-scroll tabset 1)
(centaur-tabs-scroll tabset -1)
(setq elts (cdr elts))))))
(setq elts (nreverse elts))
(setq centaur-tabs--track-selected nil))
@ -845,13 +869,14 @@ template element."
(propertize "% "
'face (list :background padcolor)
'pointer 'arrow)
(centaur-tabs-line-format--new-button)))
))
(centaur-tabs-line-format--new-button)))))
(defun centaur-tabs-count (index count)
"Return a centaur-tabs-button-tab with the current tab INDEX and the total tabs COUNT."
"Return a centaur-tabs-button-tab with the current tab INDEX and the total
tabs COUNT."
(if centaur-tabs-show-count
(propertize (centaur-tabs-button-tab (format " [%d/%d] " index count))
(propertize (centaur-tabs-button-tab (format centaur-tabs-count-format
index count))
'help-echo "Tabs count")
""))
@ -883,8 +908,9 @@ template element."
"Return the header line templates that represent the tab bar.
Inhibit display of the tab bar in current window where
`centaur-tabs-hide-tab-function' return t."
(cond
((centaur-tabs-hide-tab-cached (current-buffer))
(cond ((or (centaur-tabs-hide-tab-cached (current-buffer))
(and centaur-tabs-hide-predicate
(funcall centaur-tabs-hide-predicate)))
;; Don't show the tab bar.
(set centaur-tabs-display-line-format nil))
((centaur-tabs-current-tabset t)
@ -895,8 +921,9 @@ Inhibit display of the tab bar in current window where
(defconst centaur-tabs-header-line-format '(:eval (centaur-tabs-line))
"The tab bar header line format.")
;;; Cyclic navigation through tabs
;;
;;; Cyclic navigation through tabs
(defun centaur-tabs-cycle (&optional backward)
"Cycle to the next available tab.
The scope of the cyclic navigation through tabs is specified by the
@ -922,8 +949,7 @@ instead."
;; to the first/last visible tab.
(unless tab
(setq tabset (centaur-tabs-tabs tabset)
tab (car (if backward (last tabset) tabset))))
)
tab (car (if backward (last tabset) tabset)))))
;; Cycle through tab groups only.
((eq cycle 'groups)
(setq tab (centaur-tabs-tab-next ttabset selected backward))
@ -931,8 +957,7 @@ instead."
;; to the first/last available group.
(unless tab
(setq tabset (centaur-tabs-tabs ttabset)
tab (car (if backward (last tabset) tabset))))
)
tab (car (if backward (last tabset) tabset)))))
(t
;; Cycle through visible tabs then tab groups.
(setq tab (centaur-tabs-tab-next tabset selected backward))
@ -947,8 +972,7 @@ instead."
tab (car (if backward (last tabset) tabset))))
;; Select the first/last visible tab of the new group.
(setq tabset (centaur-tabs-tabs (centaur-tabs-tab-tabset tab))
tab (car (if backward (last tabset) tabset))))
))
tab (car (if backward (last tabset) tabset))))))
(centaur-tabs-buffer-select-tab tab))))
;;;###autoload
@ -997,32 +1021,23 @@ Depend on the setting of the option `centaur-tabs-cycle-scope'."
(let ((centaur-tabs-cycle-scope 'tabs))
(centaur-tabs-cycle)))
;;; Buffer tabs
;;
;;; Buffer tabs
(defgroup centaur-tabs-buffer nil
"Display buffers in the tab bar."
:group 'centaur-tabs)
(defun centaur-tabs-filter-out (condp lst)
"Filter list LST with using CONDP as the filtering condition."
(delq nil
(cl-mapcar (lambda (x) (if (funcall condp x) nil x)) lst)))
(defun centaur-tabs-buffer-list ()
"Return the list of buffers to show in tabs.
Exclude buffers whose name starts with a space, when they are not
visiting a file. The current buffer is always included."
(centaur-tabs-filter-out
'centaur-tabs-hide-tab-cached
(delq nil
(cl-mapcar #'(lambda (b)
(cond
;; Always include the current buffer.
((eq (current-buffer) b) b)
visiting a file."
(seq-filter (lambda (b)
(cond ((eq (current-buffer) b) b)
((buffer-file-name b) b)
((char-equal ?\ (aref (buffer-name b) 0)) nil)
((buffer-live-p b) b)))
(buffer-list)))))
(buffer-list)))
(defun centaur-tabs-buffer-mode-derived-p (mode parents)
"Return non-nil if MODE derives from a mode in PARENTS."
@ -1033,15 +1048,20 @@ visiting a file. The current buffer is always included."
(setq mode (get mode 'derived-mode-parent))))
derived))
;;; Group buffers in tab sets.
;;
;;; Group buffers in tab sets.
(defvar centaur-tabs--buffers nil)
(defun centaur-tabs-buffer-groups-result ()
"Return the first group the current buffer belongs to."
(car (nth 2 (assq (current-buffer) centaur-tabs--buffers))))
(defun centaur-tabs-buffer-update-groups ()
"Update tabsets from groups of existing buffers.
Return the the first group where the current buffer is."
(let ((bl (sort
(cl-mapcar
(mapcar
#'(lambda (b)
(with-current-buffer b
(list (current-buffer)
@ -1075,19 +1095,25 @@ Return the the first group where the current buffer is."
(dolist (tab (centaur-tabs-tabs tabset))
(let ((e (assq (centaur-tabs-tab-value tab) bl)))
(or (and e (memq tabset
(cl-mapcar 'centaur-tabs-get-tabset
(mapcar 'centaur-tabs-get-tabset
(nth 2 e))))
(centaur-tabs-delete-tab tab))))
;; Return empty tab sets
(unless (centaur-tabs-tabs tabset)
tabset))))
;; The new cache becomes the current one.
(setq centaur-tabs--buffers bl)))
;; Return the first group the current buffer belongs to.
(car (nth 2 (assq (current-buffer) centaur-tabs--buffers))))
(setq centaur-tabs--buffers bl))))
(defun centaur-tabs-buffer-update-groups-cache ()
"Don't call function `centaur-tabs-buffer-update-groups' too often."
(let ((result (centaur-tabs-buffer-groups-result)))
(when (or (null result)
(null centaur-tabs--buffers))
(centaur-tabs-buffer-update-groups))
(centaur-tabs-buffer-groups-result)))
;;; Tab bar callbacks
;;
;;; Tab bar callbacks
(defsubst centaur-tabs-buffer-show-groups (flag)
"Set display of tabs for groups of buffers to FLAG."
@ -1095,7 +1121,7 @@ Return the the first group where the current buffer is."
(defun centaur-tabs-buffer-tabs ()
"Return the buffers to display on the tab bar, in a tab set."
(let ((tabset (centaur-tabs-get-tabset (centaur-tabs-buffer-update-groups))))
(let ((tabset (centaur-tabs-get-tabset (centaur-tabs-buffer-update-groups-cache))))
(centaur-tabs-select-tab-value (current-buffer) tabset)
(when centaur-tabs--buffer-show-groups
(setq tabset (centaur-tabs-get-tabsets-tabset))
@ -1120,10 +1146,8 @@ That is, a string used to represent it on the tab bar."
(defun centaur-tabs-separator-render (item face)
"Render ITEM using FACE."
(cond
((and (listp item) (eq 'image (car item)))
(propertize " " 'display item
'face face))
(cond ((and (listp item) (eq 'image (car item)))
(propertize " " 'display item 'face face))
(t item)))
(defvar centaur-tabs-last-focused-buffer nil
@ -1139,9 +1163,8 @@ That is, a string used to represent it on the tab bar."
(switch-to-buffer buffer)
(setq centaur-tabs-last-focused-buffer buffer)
(setq centaur-tabs-last-focused-buffer-group group)
;; (centaur-tabs-buffer-show-groups nil)
(centaur-tabs-display-update)
))
;;(centaur-tabs-buffer-show-groups nil)
(centaur-tabs-display-update)))
(defun centaur-tabs-buffer-track-killed ()
"Hook run just before actually killing a buffer.
@ -1185,7 +1208,8 @@ first."
(nreverse (centaur-tabs-insert-after (nreverse list) bef-el el)))
(defun centaur-tabs-adjust-buffer-order ()
"Put the two buffers switched to the adjacent position after current buffer changed."
"Put the two buffers switched to the adjacent position after current
buffer changed."
;; Don't trigger by centaur-tabs command, it's annoying.
;; This feature should be trigger by search plugins, such as ibuffer, helm or ivy.
(unless (or (string-prefix-p "centaur-tabs" (format "%s" this-command))
@ -1206,7 +1230,7 @@ first."
(when (string= current-group centaur-tabs-last-focused-buffer-group)
(let* ((bufset (centaur-tabs-get-tabset current-group))
(current-group-tabs (centaur-tabs-tabs bufset))
(current-group-buffers (cl-mapcar 'car current-group-tabs))
(current-group-buffers (mapcar 'car current-group-tabs))
(current-buffer-index (cl-position current current-group-buffers))
(previous-buffer-index (cl-position previous current-group-buffers)))
@ -1230,8 +1254,7 @@ first."
(setq new-group-tabs (centaur-tabs-insert-before base-group-tabs previous-tab current-tab)))))
(set bufset new-group-tabs)
(centaur-tabs-set-template bufset nil)
(centaur-tabs-display-update)
))))
(centaur-tabs-display-update)))))
;; Update the group name of the last accessed tab.
(setq centaur-tabs-last-focused-buffer-group current-group)))))
@ -1253,10 +1276,10 @@ first."
;; Just continue if two buffers are in the same group.
(when (string= current-group centaur-tabs-last-focused-buffer-group)
(let* ((bufset (centaur-tabs-get-tabset current-group))
(current-group-tabs (centaur-tabs-tabs bufset)))
(setq new-group-tabs (sort current-group-tabs
(current-group-tabs (centaur-tabs-tabs bufset))
(new-group-tabs (sort current-group-tabs
(lambda (x y)
(string< (buffer-name (car x)) (buffer-name (car y))))))
(string< (buffer-name (car x)) (buffer-name (car y)))))))
(set bufset new-group-tabs)
(centaur-tabs-set-template bufset nil)
(centaur-tabs-display-update)))
@ -1271,17 +1294,17 @@ first."
(setq centaur-tabs-adjust-buffer-order-function 'centaur-tabs-adjust-buffer-order-alphabetically)
(add-hook 'post-command-hook centaur-tabs-adjust-buffer-order-function))
;;; Buffer grouping and tab hiding
;;
;;; Buffer grouping and tab hiding
(defun centaur-tabs-project-name ()
"Get project name for tabs."
(let* ((project-current (project-current))
(when-let* (((buffer-file-name))
(project-current (project-current))
(project-name (if (proper-list-p project-current)
(car (last project-current))
(cdr project-current))))
(if project-name
(format "Project: %s" (expand-file-name project-name))
centaur-tabs-common-group-name)))
(format "Project: %s" (expand-file-name project-name))))
;; Rules to control buffer's group rules.
(defvar centaur-tabs-groups-hash (make-hash-table :test 'equal))
@ -1291,14 +1314,8 @@ first."
"Get group name of buffer BUF."
(let ((group-name (gethash buf centaur-tabs-groups-hash)))
;; Return group name cache if it exists for improve performance.
(if group-name
group-name
;; Otherwise try get group name with `project-current'.
;; `project-current' is very slow, it will slow down Emacs if you call it when switch buffer.
(with-current-buffer buf
(let ((project-name (centaur-tabs-project-name)))
(puthash buf project-name centaur-tabs-groups-hash)
project-name)))))
(or group-name
centaur-tabs-common-group-name)))
(defun centaur-tabs-buffer-groups ()
"`centaur-tabs-buffer-groups' control buffers' group rules.
@ -1309,24 +1326,22 @@ All buffer name start with * will group to \"Emacs\".
Other buffer group by `centaur-tabs-get-group-name' with project name."
(list
(cond
((when-let ((project-name (centaur-tabs-project-name)))
project-name))
((or (string-equal "*" (substring (buffer-name) 0 1))
(memq major-mode '(magit-process-mode
(memq major-mode '( magit-process-mode
magit-status-mode
magit-diff-mode
magit-log-mode
magit-file-mode
magit-blob-mode
magit-blame-mode
)))
magit-blame-mode)))
"Emacs")
((derived-mode-p 'eshell-mode)
"EShell")
((derived-mode-p 'emacs-lisp-mode)
"Elisp")
((derived-mode-p 'dired-mode)
"Dired")
((memq major-mode '(org-mode org-agenda-mode diary-mode))
"OrgMode")
((derived-mode-p 'shell-mode) "Shell")
((derived-mode-p 'eshell-mode) "EShell")
((derived-mode-p 'emacs-lisp-mode) "Elisp")
((derived-mode-p 'dired-mode) "Dired")
((memq major-mode '( org-mode org-agenda-mode diary-mode)) "OrgMode")
(t
(centaur-tabs-get-group-name (current-buffer))))))
@ -1368,8 +1383,7 @@ Other buffer group by `centaur-tabs-get-group-name' with project name."
;; Is not magit buffer.
(and (string-prefix-p "magit" name)
(not (file-name-extension name)))
)))
(not (file-name-extension name))))))
(defun centaur-tabs-hide-tab-cached (buf)
"Cached vesion of `centaur-tabs-hide-tab' to improve performance.
@ -1384,7 +1398,7 @@ Operates over buffer BUF"
(defun centaur-tabs-get-groups ()
"Refresh tabs groups."
(set centaur-tabs-tabsets-tabset (centaur-tabs-map-tabsets 'centaur-tabs-selected-tab))
(cl-mapcar #'(lambda (group)
(mapcar #'(lambda (group)
(format "%s" (cdr group)))
(centaur-tabs-tabs centaur-tabs-tabsets-tabset)))
@ -1396,13 +1410,13 @@ Operates over buffer BUF"
(with-current-buffer buffer
(when (string-equal 'current-group-name (cdr (centaur-tabs-selected-tab (centaur-tabs-current-tabset t))))
(when (buffer-file-name buffer)
(add-to-list 'extension-names (file-name-extension (buffer-file-name buffer))))
)))
(add-to-list 'extension-names (file-name-extension (buffer-file-name buffer)))))))
(buffer-list))
extension-names))
(defcustom centaur-tabs-enable-ido-completion t
"Non-nil means use `ido-completing-read' for completing reads else `completing-read'."
"Non-nil means use `ido-completing-read' for completing reads
else `completing-read'."
:group 'centaur-tabs
:type 'boolean)
@ -1420,10 +1434,8 @@ Refer to the variable `centaur-tabs-enable-ido-completion'."
(add-hook hook (lambda ()
(if (boundp 'tab-line-format)
(setq-local tab-line-format nil)
(setq-local header-line-format nil))
)))
(setq-local header-line-format nil)))))
centaur-tabs-hide-tabs-hooks)
(provide 'centaur-tabs-functions)
;;; centaur-tabs-functions.el ends here

View file

@ -1,10 +1,10 @@
;;; centaur-tabs-interactive.el --- centaur-tabs interactive functions and plugins support lexical-binding: t; -*-
;; Copyright (C) 2019-2020 Emmanuel Bustos
;; Copyright (C) 2019-2024 Emmanuel Bustos
;; Copyright (C) 2024 Jen-Chieh Shen
;; This file is not part of GNU Emacs.
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2, or
@ -19,20 +19,60 @@
;; along with this program; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
;; Floor, Boston, MA 02110-1301, USA.
;;
;;; Commentary:
;;
;; This file contains centaur-tabs interactive functions and plugins support
;;
;;; Code:
;;; Requires
(require 'cl-lib)
(require 'centaur-tabs-elements)
(require 'centaur-tabs-functions)
;; Compiler pacifier
(declare-function ivy-read "ext:ivy.el" t t)
(declare-function helm-build-sync-source "ext:helm-source.el" t t)
(defvar helm-source-centaur-tabs-group)
(declare-function projectile-project-root "ext:projectile.el" t t)
(declare-function projectile-project-name "ext:projectile.el" t t)
(declare-function centaur-tabs-do-select "centaur-tabs-functions.el")
(declare-function centaur-tabs-get-tab-from-event "centaur-tabs-functions.el")
(declare-function centaur-tabs-tab-value "centaur-tabs-functions.el")
(declare-function centaur-tabs-get-tabset "centaur-tabs-functions.el")
(declare-function centaur-tabs-buffer-show-groups "centaur-tabs-functions.el")
(declare-function centaur-tabs-buffer-close-tab "centaur-tabs-functions.el")
(declare-function centaur-tabs-view "centaur-tabs-functions.el")
(declare-function centaur-tabs-get-extensions "centaur-tabs-functions.el")
(declare-function centaur-tabs-selected-tab "centaur-tabs-functions.el")
(declare-function centaur-tabs-display-update "centaur-tabs-functions.el")
(declare-function centaur-tabs-set-template "centaur-tabs-functions.el")
(declare-function centaur-tabs-buffer-select-tab "centaur-tabs-functions.el")
(declare-function centaur-tabs-tabs "centaur-tabs-functions.el")
(declare-function centaur-tabs-tab-tabset "centaur-tabs-functions.el")
(declare-function centaur-tabs-get-tabsets-tabset "centaur-tabs-functions.el")
(declare-function centaur-tabs-current-tabset "centaur-tabs-functions.el")
(declare-function centaur-tabs-completing-read "centaur-tabs-functions.el")
(declare-function centaur-tabs-get-groups "centaur-tabs-functions.el")
(declare-function centaur-tabs-forward-group "centaur-tabs-functions.el")
(declare-function centaur-tabs-backward-group "centaur-tabs-functions.el")
(declare-function centaur-tabs-forward-tab "centaur-tabs-functions.el")
(declare-function centaur-tabs-backward-tab "centaur-tabs-functions.el")
(defvar centaur-tabs-cycle-scope)
(defvar centaur-tabs-current-tabset)
(defvar centaur-tabs-last-focused-buffer-group)
(defvar centaur-tabs-buffer-list-function)
(defvar centaur-tabs-buffer-groups-function)
(defvar centaur-tabs--buffer-show-groups)
;;;;;;;;;;;;;;;;;;;;;;; Interactive functions ;;;;;;;;;;;;;;;;;;;;;;;
(defun centaur-tabs-switch-group (&optional groupname)
"Switch tab groups using ido. GROUPNAME can optionaly be provided."
(interactive)
(let* ((tab-buffer-list (cl-mapcar
(let* ((tab-buffer-list (mapcar
#'(lambda (b)
(with-current-buffer b
(list (current-buffer)
@ -42,8 +82,7 @@
(groups (centaur-tabs-get-groups))
(group-name (or groupname (centaur-tabs-completing-read "Groups: " groups))) )
(catch 'done
(mapc
#'(lambda (group)
(mapc #'(lambda (group)
(when (equal group-name (car (car (cdr (cdr group)))))
(throw 'done (switch-to-buffer (car (cdr group))))))
tab-buffer-list) )))
@ -72,7 +111,8 @@ TYPE is default option."
(defun centaur-tabs-backward-tab-other-window (&optional reversed)
"Move to left tab in other window.
Optional argument REVERSED default is move backward, if reversed is non-nil move forward."
Optional argument REVERSED default is move backward, if reversed is non-nil
move forward."
(interactive)
(other-window 1)
(if reversed
@ -147,8 +187,7 @@ Optional argument REVERSED default is move backward, if reversed is non-nil move
(with-current-buffer buffer
(when (string-equal current-group-name (cdr (centaur-tabs-selected-tab (centaur-tabs-current-tabset t))))
(when (funcall ,match-rule buffer)
(kill-buffer buffer))
)))
(kill-buffer buffer)))))
(buffer-list))))
(defun centaur-tabs-kill-all-buffers-in-current-group ()
@ -159,8 +198,7 @@ Optional argument REVERSED default is move backward, if reversed is non-nil move
(centaur-tabs-kill-buffer-match-rule
(lambda (_buffer) t))
;; Switch to next group.
(centaur-tabs-forward-group)
))
(centaur-tabs-forward-group)))
(defun centaur-tabs-kill-other-buffers-in-current-group ()
"Kill all buffers except current buffer in current group."
@ -169,8 +207,7 @@ Optional argument REVERSED default is move backward, if reversed is non-nil move
(currentbuffer (current-buffer)))
;; Kill all buffers in current group.
(centaur-tabs-kill-buffer-match-rule
(lambda (buffer) (not (equal buffer currentbuffer))))
))
(lambda (buffer) (not (equal buffer currentbuffer))))))
(defun centaur-tabs-kill-unmodified-buffers-in-current-group ()
"Kill all unmodified buffer in current group."
@ -179,9 +216,7 @@ Optional argument REVERSED default is move backward, if reversed is non-nil move
(currentbuffer (current-buffer)))
;; Kill all buffers in current group.
(centaur-tabs-kill-buffer-match-rule
(lambda (buffer) (not (buffer-modified-p buffer))))
))
(lambda (buffer) (not (buffer-modified-p buffer))))))
(defun centaur-tabs-kill-match-buffers-in-current-group ()
"Kill all buffers match extension in current group."
@ -195,12 +230,10 @@ Optional argument REVERSED default is move backward, if reversed is non-nil move
(centaur-tabs-kill-buffer-match-rule
(lambda (buffer)
(let ((filename (buffer-file-name buffer)))
(and filename (string-equal (file-name-extension filename) match-extension))
)))
(and filename (string-equal (file-name-extension filename) match-extension)))))
;; Switch to next group if last file killed.
(when (equal (length extension-names) 1)
(centaur-tabs-forward-group))
))
(centaur-tabs-forward-group))))
(defun centaur-tabs-keep-match-buffers-in-current-group ()
"Keep all buffers match extension in current group."
@ -214,12 +247,10 @@ Optional argument REVERSED default is move backward, if reversed is non-nil move
(centaur-tabs-kill-buffer-match-rule
(lambda (buffer)
(let ((filename (buffer-file-name buffer)))
(and filename (not (string-equal (file-name-extension filename) match-extension)))
)))
(and filename (not (string-equal (file-name-extension filename) match-extension))))))
;; Switch to next group if last file killed.
(when (equal (length extension-names) 1)
(centaur-tabs-forward-group))
))
(centaur-tabs-forward-group))))
(defun centaur-tabs-select-visible-nth-tab (tab-index)
"Select visible tab with TAB-INDEX'.
@ -254,7 +285,7 @@ not the actual logical index position of the current group."
;; ace-jump style tab switching
(defvar centaur-tabs-ace-jump-active nil
"t if centaur-tabs-ace-jump is invoked.")
"Set to t if `centaur-tabs-ace-jump' is invoked.")
(defvar centaur-tabs-dim-overlay nil
"Holds the overlay for dimming buffer when invoking centaur-tabs-ace-jump.")
@ -289,7 +320,7 @@ TAB has to be in the same group as the current tab."
(defun centaur-tabs-ace-action (action)
"Preform ACTION on a visible tab. Ace-jump style.
ACTION has to be one of value in `centuar-tabs-ace-dispatch-alist'"
ACTION has to be one of value in `centaur-tabs-ace-dispatch-alist'"
(when (centaur-tabs-current-tabset t)
(when centaur-tabs-ace-jump-dim-buffer
(centaur-tabs--dim-window))
@ -320,7 +351,7 @@ ACTION has to be one of value in `centuar-tabs-ace-dispatch-alist'"
(centaur-tabs-swap-tab sel))))
(throw 'done nil))
;; actions
((setq action-cache (assoc char centuar-tabs-ace-dispatch-alist))
((setq action-cache (assoc char centaur-tabs-ace-dispatch-alist))
(setq action-cache (cadr action-cache))
(cond ((eq action-cache 'exit) ; exit
(message "Quit")
@ -338,7 +369,7 @@ ACTION has to be one of value in `centuar-tabs-ace-dispatch-alist'"
(lambda (elem) (format "%s: %s"
(key-description (vector (car elem)))
(caddr elem)))
centuar-tabs-ace-dispatch-alist
centaur-tabs-ace-dispatch-alist
"\n")))
(t (setq action action-cache) ; other actions
(cond ((eq action-cache 'jump-to-tab)
@ -358,11 +389,9 @@ ACTION has to be one of value in `centuar-tabs-ace-dispatch-alist'"
(defun centaur-tabs-ace-jump (&optional arg)
"Select a tab and perform an action. Ace-jump style.
If no ARG is provided, select that tab.
If prefixed with one `universal-argument', swap the current
tab with the selected tab.
If prefixed with two `universal-argument's, close
selected tab."
If no ARG is provided, select that tab. If prefixed with one
`universal-argument', swap the current tab with the selected tab.
If prefixed with two `universal-argument's, close selected tab."
(interactive "p")
(cond ((eq arg 1)
(centaur-tabs-ace-action 'jump-to-tab))
@ -395,13 +424,16 @@ Should be buffer local and speed up calculation of buffer groups.")
((string-equal "*" (substring (buffer-name) 0 1)) '("Misc"))
((condition-case _err
(projectile-project-root)
(error nil)) (list (projectile-project-name)))
(error nil))
(list (projectile-project-name)))
((memq major-mode '(emacs-lisp-mode python-mode emacs-lisp-mode c-mode
c++-mode javascript-mode js-mode
js2-mode makefile-mode
lua-mode vala-mode)) '("Coding"))
((memq major-mode '(nxhtml-mode html-mode
mhtml-mode css-mode)) '("HTML"))
lua-mode vala-mode))
'("Coding"))
((memq major-mode '( nxhtml-mode html-mode
mhtml-mode css-mode))
'("HTML"))
((memq major-mode '(org-mode calendar-mode diary-mode)) '("Org"))
((memq major-mode '(dired-mode)) '("Dir"))
(t '("Other"))))
@ -446,9 +478,9 @@ Should be buffer local and speed up calculation of buffer groups.")
:action #'centaur-tabs-switch-group
:caller 'centaur-tabs-counsel-switch-group)))
(defun centaur-tabs-extract-window-to-new-frame()
"Kill the current window in the current frame, and open the current buffer in a new frame."
"Kill the current window in the current frame, and open the current buffer
in a new frame."
(interactive)
(unless (centaur-tabs--one-window-p)
(let ((buffer (current-buffer)))
@ -467,7 +499,6 @@ Should be buffer local and speed up calculation of buffer groups.")
(kill-new filename)
(message "Copied buffer file name '%s' to the kill ring." filename))))
(defun centaur-tabs-open-directory-in-external-application ()
"Open the current directory in a external application."
(interactive)
@ -476,7 +507,7 @@ Should be buffer local and speed up calculation of buffer groups.")
(defun centaur-tabs-open-in-external-application ()
"Open the file of the current buffer according to its mime type."
(interactive)
(let ((path (if (buffer-file-name) (buffer-file-name) default-directory)))
(let ((path (or (buffer-file-name) default-directory)))
(centaur-tabs--open-externally path)))
(defun centaur-tabs--open-externally (file-or-path)
@ -495,7 +526,6 @@ Modified copy of `treemacs-visit-node-in-external-application`."
(start-process "" nil "xdg-open" path)))
(_ (message "Don't know how to open files on %s." (symbol-name system-type))))))
(defun centaur-tabs--copy-directory-name-to-clipboard ()
"Copy the current directory name to the clipboard."
(interactive)
@ -507,7 +537,6 @@ Modified copy of `treemacs-visit-node-in-external-application`."
"Menu definition with a list of tab groups."
(mapcar (lambda (s) `[,s ,s]) (sort (centaur-tabs-get-groups) #'string<)))
(defun centaur-tabs--tab-submenu-tabs-definition ()
"Menu definition with a list of tabs for the current group."
(let* ((tabset (centaur-tabs-get-tabset centaur-tabs-last-focused-buffer-group))
@ -516,13 +545,9 @@ Modified copy of `treemacs-visit-node-in-external-application`."
(sorted-tabnames (sort (mapcar #'buffer-name buffers) #'string<)))
(mapcar (lambda (s) `[,s ,s]) sorted-tabnames)))
(defvar centaur-tabs--groups-submenu-key "Tab groups")
(defvar centaur-tabs--tabs-submenu-key "Go to tab of group")
(defun centaur-tabs--kill-this-buffer-dont-ask()
"Kill the current buffer without confirmation."
(interactive)
@ -530,7 +555,6 @@ Modified copy of `treemacs-visit-node-in-external-application`."
(centaur-tabs-display-update)
(redisplay t))
(defun centaur-tabs--tab-menu-definition ()
"Definition of the context menu of a tab."
`(["Kill this buffer" centaur-tabs--kill-this-buffer-dont-ask]
@ -558,8 +582,7 @@ Modified copy of `treemacs-visit-node-in-external-application`."
:active default-directory]
"----"
,( append (list centaur-tabs--groups-submenu-key) (centaur-tabs--tab-submenu-groups-definition))
,( append (list centaur-tabs--tabs-submenu-key) (centaur-tabs--tab-submenu-tabs-definition))
))
,( append (list centaur-tabs--tabs-submenu-key) (centaur-tabs--tab-submenu-tabs-definition))))
(defun centaur-tabs--one-window-p ()
"Like `one-window-p`, but taking into account side windows like treemacs."
@ -574,20 +597,16 @@ Modified copy of `treemacs-visit-node-in-external-application`."
(lambda (tab) (string= tabname (buffer-name (centaur-tabs-tab-value tab))))
seq)))
(defun centaur-tabs--tab-menu (event)
"Show a context menu for the clicked tab or button. The clicked tab, identified by EVENT, is selected."
"Show a context menu for the clicked tab or button.
The clicked tab, identified by EVENT, is selected."
(interactive "e" )
(let ((click-on-tab-p (ignore-errors (centaur-tabs-get-tab-from-event event))))
(when (not click-on-tab-p)
(centaur-tabs--groups-menu))
(when click-on-tab-p
(centaur-tabs-do-select event)
(redisplay t)
(let*
((menu (easy-menu-create-menu nil (centaur-tabs--tab-menu-definition)))
(choice (x-popup-menu t menu))
@ -596,7 +615,7 @@ Modified copy of `treemacs-visit-node-in-external-application`."
(when action-is-command-p
(call-interactively action))
(when (not action-is-command-p)
(let* ((menu-key (first choice))
(let* ((menu-key (cl-first choice))
(choice-is-group-p (string= centaur-tabs--groups-submenu-key (symbol-name menu-key)))
(name (car (last choice)))
(name-as-string (symbol-name name)))
@ -604,14 +623,12 @@ Modified copy of `treemacs-visit-node-in-external-application`."
(centaur-tabs-switch-group name-as-string)
(switch-to-buffer name-as-string))))))))
(defun centaur-tabs--groups-menu ()
"Show a popup menu with the centaur tabs groups."
(interactive)
(let*
((sorted-groups (centaur-tabs--tab-submenu-groups-definition))
(menu (easy-menu-create-menu "Tab groups" (centaur-tabs--tab-submenu-groups-definition)))
(let* ((sorted-groups (centaur-tabs--tab-submenu-groups-definition))
(menu (easy-menu-create-menu "Tab groups"
(centaur-tabs--tab-submenu-groups-definition)))
(choice (x-popup-menu t menu))
(action (lookup-key menu (apply 'vector choice)))
(action-is-command-p (and (commandp action) (functionp action))))
@ -621,7 +638,5 @@ Modified copy of `treemacs-visit-node-in-external-application`."
(let ((group (car (last choice))))
(centaur-tabs-switch-group (format "%s" group))))))
(provide 'centaur-tabs-interactive)
;;; centaur-tabs-interactive.el ends here

View file

@ -0,0 +1,15 @@
(define-package "centaur-tabs" "20240726.625" "Aesthetic, modern looking customizable tabs plugin"
'((emacs "27.1")
(powerline "2.4"))
:commit "49b9f6b813dfb1fe78aa782f76b4a7333dd8f980" :authors
'(("Emmanuel Bustos" . "ema2159@gmail.com"))
:maintainers
'(("Jen-Chieh Shen" . "jcs090218@gmail.com"))
:maintainer
'("Jen-Chieh Shen" . "jcs090218@gmail.com")
:keywords
'("frames")
:url "https://github.com/ema2159/centaur-tabs")
;; Local Variables:
;; no-byte-compile: t
;; End:

View file

@ -1,18 +1,18 @@
;;; centaur-tabs.el --- Aesthetic, modern looking customizable tabs plugin -*- lexical-binding: t; -*-
;; Copyright (C) 2019 Emmanuel Bustos
;; Copyright (C) 2019-2024 Emmanuel Bustos
;; Copyright (C) 2024 Jen-Chieh Shen
;; Filename: centaur-tabs.el
;; Description: Provide an out of box configuration to use highly customizable tabs.
;; URL: https://github.com/ema2159/centaur-tabs
;; Author: Emmanuel Bustos <ema2159@gmail.com>
;; Maintainer: Emmanuel Bustos <ema2159@gmail.com>
;; Maintainer: Jen-Chieh Shen <jcs090218@gmail.com>
;; Created: 2019-21-19 22:14:34
;; Version: 5
;; Version: 3.3
;; Known Compatibility: GNU Emacs 26.2
;; Package-Requires: ((emacs "24.4") (powerline "2.4") (cl-lib "0.5"))
;;
;;
;; Package-Requires: ((emacs "27.1") (powerline "2.4"))
;; Keywords: frames
;;; This file is NOT part of GNU Emacs
@ -54,10 +54,15 @@
;;
;;; Code:
;;; Requires
(require 'centaur-tabs-elements)
(require 'centaur-tabs-functions)
(require 'centaur-tabs-interactive)
;; Compiler pacifier
(declare-function undo-tree-undo-1 "ext:undo-tree.el")
(declare-function undo-tree-redo-1 "ext:undo-tree.el")
;;;;;;;;;;;;;;;;;;;;;;; Centaur-Tabs source code ;;;;;;;;;;;;;;;;;;;;;;;
(defgroup centaur-tabs nil
@ -66,15 +71,17 @@
(defvar centaur-tabs--buffer-show-groups nil)
;;; Minor modes
;;
;;; Minor modes
(defsubst centaur-tabs-mode-on-p ()
"Return non-nil if Centaur-Tabs mode is on."
(eq (default-value centaur-tabs-display-line-format)
centaur-tabs-header-line-format))
;;; Centaur-Tabs-Local mode
;;
;;; Centaur-Tabs-Local mode
(defvar centaur-tabs--local-hlf nil)
;;;###autoload
@ -148,19 +155,20 @@ Returns non-nil if the new state is enabled.
(buffer-list))
;; Restore previous `centaur-tabs-display-line-format'.
(set-default centaur-tabs-display-line-format centaur-tabs--global-hlf)
(centaur-tabs-free-tabsets-store))
))
(centaur-tabs-free-tabsets-store)))
;; Make sure it refresh every windows!
(force-window-update))
;;; Tab bar buffer setup
;;
;;; Tab bar buffer setup
(defun centaur-tabs-buffer-init ()
"Initialize tab bar buffer data.
Run as `centaur-tabs-init-hook'."
(setq centaur-tabs--buffers nil
centaur-tabs-current-tabset-function 'centaur-tabs-buffer-tabs
centaur-tabs-tab-label-function 'centaur-tabs-buffer-tab-label
centaur-tabs-select-tab-function 'centaur-tabs-buffer-select-tab
)
centaur-tabs-select-tab-function 'centaur-tabs-buffer-select-tab)
;; If set, initialize selected overline
(when (eq centaur-tabs-set-bar 'under)
(set-face-attribute 'centaur-tabs-selected nil
@ -188,12 +196,15 @@ Run as `centaur-tabs-init-hook'."
(set-face-attribute 'centaur-tabs-unselected-modified nil
:overline nil
:underline nil))
(add-function :after after-focus-change-function #'centaur-tabs-after-focus)
(add-hook 'window-buffer-change-functions #'centaur-tabs-on-window-buffer-change)
(add-hook 'after-save-hook #'centaur-tabs-on-saving-buffer)
(add-hook 'first-change-hook #'centaur-tabs-on-modifying-buffer)
(add-hook 'kill-buffer-hook #'centaur-tabs-buffer-track-killed)
(advice-add #'undo :after #'centaur-tabs-after-modifying-buffer)
(advice-add #'undo-tree-undo-1 :after #'centaur-tabs-after-modifying-buffer)
(advice-add #'undo-tree-redo-1 :after #'centaur-tabs-after-modifying-buffer))
(advice-add #'undo :after #'centaur-tabs-on-modifying-buffer)
(advice-add #'undo-tree-undo-1 :after #'centaur-tabs-on-modifying-buffer)
(advice-add #'undo-tree-redo-1 :after #'centaur-tabs-on-modifying-buffer)
(advice-add 'load-theme :after #'centaur-tabs--after-load-theme))
(defun centaur-tabs-buffer-quit ()
"Quit tab bar buffer.
@ -201,18 +212,19 @@ Run as `centaur-tabs-quit-hook'."
(setq centaur-tabs--buffers nil
centaur-tabs-current-tabset-function nil
centaur-tabs-tab-label-function nil
centaur-tabs-select-tab-function nil
)
(remove-hook 'after-save-hook 'centaur-tabs-after-modifying-buffer)
centaur-tabs-select-tab-function nil)
(remove-function after-focus-change-function #'centaur-tabs-after-focus)
(remove-hook 'window-buffer-change-functions #'centaur-tabs-on-window-buffer-change)
(remove-hook 'after-save-hook 'centaur-tabs-on-modifying-buffer)
(remove-hook 'first-change-hook 'centaur-tabs-on-modifying-buffer)
(remove-hook 'kill-buffer-hook 'centaur-tabs-buffer-track-killed)
(advice-remove #'undo #'centaur-tabs-after-modifying-buffer)
(advice-remove #'undo-tree-undo-1 #'centaur-tabs-after-modifying-buffer)
(advice-remove #'undo-tree-redo-1 #'centaur-tabs-after-modifying-buffer))
(advice-remove #'undo #'centaur-tabs-on-modifying-buffer)
(advice-remove #'undo-tree-undo-1 #'centaur-tabs-on-modifying-buffer)
(advice-remove #'undo-tree-redo-1 #'centaur-tabs-on-modifying-buffer)
(advice-remove 'load-theme #'centaur-tabs--after-load-theme))
(add-hook 'centaur-tabs-init-hook #'centaur-tabs-buffer-init)
(add-hook 'centaur-tabs-quit-hook #'centaur-tabs-buffer-quit)
(provide 'centaur-tabs)
;;; centaur-tabs.el ends here

View file

@ -1,6 +1,6 @@
(define-package "dash" "20240103.1301" "A modern list library for Emacs"
(define-package "dash" "20240510.1327" "A modern list library for Emacs"
'((emacs "24"))
:commit "e32a70ca636bad42232b6c79f1491dc86802a721" :authors
:commit "1de9dcb83eacfb162b6d9a118a4770b1281bcd84" :authors
'(("Magnar Sveen" . "magnars@gmail.com"))
:maintainers
'(("Magnar Sveen" . "magnars@gmail.com"))

View file

@ -2108,7 +2108,7 @@ last item in second form, etc."
Insert X at the position signified by the symbol `it' in the first
form. If there are more forms, insert the first form at the position
signified by `it' in in second form, etc."
signified by `it' in the second form, etc."
(declare (debug (form body)))
`(-as-> ,x it ,@forms))
@ -3298,6 +3298,8 @@ Return the sorted list. LIST is NOT modified by side effects.
COMPARATOR is called with two elements of LIST, and should return non-nil
if the first element should sort before the second."
(declare (important-return-value t))
;; Not yet worth changing to (sort list :lessp comparator);
;; still seems as fast or slightly faster.
(sort (copy-sequence list) comparator))
(defmacro --sort (form list)

View file

@ -1,4 +1,4 @@
This is dash.info, produced by makeinfo version 6.7 from dash.texi.
This is dash.info, produced by makeinfo version 6.8 from dash.texi.
This manual is for Dash version 2.19.1.
@ -2427,7 +2427,7 @@ readability.
Insert X at the position signified by the symbol it in the first
form. If there are more forms, insert the first form at the
position signified by it in in second form, etc.
position signified by it in the second form, etc.
(--> "def" (concat "abc" it "ghi"))
⇒ "abcdefghi"
@ -4892,53 +4892,53 @@ Node: Threading macros84441
Ref: ->84666
Ref: ->>85154
Ref: -->85657
Ref: -as->86213
Ref: -some->86667
Ref: -some->>87052
Ref: -some-->87499
Ref: -doto88066
Node: Binding88619
Ref: -when-let88826
Ref: -when-let*89287
Ref: -if-let89816
Ref: -if-let*90182
Ref: -let90805
Ref: -let*96895
Ref: -lambda97832
Ref: -setq98638
Node: Side effects99439
Ref: -each99633
Ref: -each-while100160
Ref: -each-indexed100780
Ref: -each-r101372
Ref: -each-r-while101814
Ref: -dotimes102458
Node: Destructive operations103011
Ref: !cons103229
Ref: !cdr103433
Node: Function combinators103626
Ref: -partial103830
Ref: -rpartial104348
Ref: -juxt104996
Ref: -compose105448
Ref: -applify106055
Ref: -on106485
Ref: -flip107257
Ref: -rotate-args107781
Ref: -const108410
Ref: -cut108752
Ref: -not109232
Ref: -orfn109776
Ref: -andfn110569
Ref: -iteratefn111356
Ref: -fixfn112058
Ref: -prodfn113632
Node: Development114783
Node: Contribute115072
Node: Contributors116084
Node: FDL118177
Node: GPL143497
Node: Index181246
Ref: -as->86214
Ref: -some->86668
Ref: -some->>87053
Ref: -some-->87500
Ref: -doto88067
Node: Binding88620
Ref: -when-let88827
Ref: -when-let*89288
Ref: -if-let89817
Ref: -if-let*90183
Ref: -let90806
Ref: -let*96896
Ref: -lambda97833
Ref: -setq98639
Node: Side effects99440
Ref: -each99634
Ref: -each-while100161
Ref: -each-indexed100781
Ref: -each-r101373
Ref: -each-r-while101815
Ref: -dotimes102459
Node: Destructive operations103012
Ref: !cons103230
Ref: !cdr103434
Node: Function combinators103627
Ref: -partial103831
Ref: -rpartial104349
Ref: -juxt104997
Ref: -compose105449
Ref: -applify106056
Ref: -on106486
Ref: -flip107258
Ref: -rotate-args107782
Ref: -const108411
Ref: -cut108753
Ref: -not109233
Ref: -orfn109777
Ref: -andfn110570
Ref: -iteratefn111357
Ref: -fixfn112059
Ref: -prodfn113633
Node: Development114784
Node: Contribute115073
Node: Contributors116085
Node: FDL118178
Node: GPL143498
Node: Index181247

End Tag Table

View file

Before

Width:  |  Height:  |  Size: 43 KiB

After

Width:  |  Height:  |  Size: 43 KiB

View file

Before

Width:  |  Height:  |  Size: 32 KiB

After

Width:  |  Height:  |  Size: 32 KiB

View file

@ -1,9 +1,10 @@
(define-package "dashboard" "20240319.915" "A startup screen extracted from Spacemacs"
(define-package "dashboard" "20240529.2058" "A startup screen extracted from Spacemacs"
'((emacs "26.1"))
:commit "e34ce1b4730fb88a33a571b9065114b7a77645f0" :authors
:commit "3852301f9c6f3104d9cc98389612b5ef3452a7de" :authors
'(("Rakan Al-Hneiti" . "rakan.alhneiti@gmail.com"))
:maintainers
'(("Jesús Martínez" . "jesusmartinez93@gmail.com"))
'(("Jesús Martínez" . "jesusmartinez93@gmail.com")
("Jen-Chieh" . "jcs090218@gmail.com"))
:maintainer
'("Jesús Martínez" . "jesusmartinez93@gmail.com")
:keywords

View file

@ -70,15 +70,6 @@
(declare-function string-pixel-width "subr-x.el") ; TODO: remove this after 29.1
(declare-function shr-string-pixel-width "shr.el") ; TODO: remove this after 29.1
(make-obsolete-variable 'dashboard-set-navigator
'dashboard-startupify-list "1.9.0")
(make-obsolete-variable 'dashboard-set-init-info
'dashboard-startupify-list "1.9.0")
(make-obsolete-variable 'dashboard-set-footer
'dashboard-startupify-list "1.9.0")
(defvar recentf-list nil)
(defvar dashboard-buffer-name)
@ -133,6 +124,27 @@ See `create-image' and Info node `(elisp)Image Descriptors'."
:type 'boolean
:group 'dashboard)
(defcustom dashboard-set-navigator nil
"When non nil, a navigator will be displayed under the banner."
:type 'boolean
:group 'dashboard)
(make-obsolete-variable 'dashboard-set-navigator
'dashboard-startupify-list "1.9.0")
(defcustom dashboard-set-init-info t
"When non nil, init info will be displayed under the banner."
:type 'boolean
:group 'dashboard)
(make-obsolete-variable 'dashboard-set-init-info
'dashboard-startupify-list "1.9.0")
(defcustom dashboard-set-footer t
"When non nil, a footer will be displayed at the bottom."
:type 'boolean
:group 'dashboard)
(make-obsolete-variable 'dashboard-set-footer
'dashboard-startupify-list "1.9.0")
(defcustom dashboard-footer-messages
'("The one true editor, Emacs!"
"Who the hell uses VIM anyway? Go Evil!"
@ -181,7 +193,7 @@ The value can be one of: `all-the-icons', `nerd-icons'."
Will be of the form `(list-type . icon-name-string)`.
If nil it is disabled. Possible values for list-type are:
`recents' `bookmarks' `projects' `agenda' `registers'"
:type '(repeat (alist :key-type symbol :value-type string))
:type '(alist :key-type symbol :value-type string)
:group 'dashboard)
(defcustom dashboard-heading-icon-height 1.2
@ -245,7 +257,16 @@ The format is: `icon title help action face prefix suffix`.
Example:
`((\"\" \"Star\" \"Show stars\" (lambda (&rest _)
(show-stars)) warning \"[\" \"]\"))"
:type '(repeat (repeat (list string string string function symbol string string)))
:type '(repeat (repeat (list string
string
string
function
(choice face
(repeat :tag "Anonymous face" sexp))
(choice string
(const nil))
(choice string
(const nil)))))
:group 'dashboard)
(defcustom dashboard-init-info
@ -335,8 +356,10 @@ ARGS should be a plist containing `:height', `:v-adjust', or `:face' properties.
:v-adjust -0.05
:face 'dashboard-footer-icon-face)))
(propertize ">" 'face 'dashboard-footer-icon-face))
"Footer's icon."
:type 'string
"Footer's icon.
It can be a string or a string list for display random icons."
:type '(choice string
(repeat string))
:group 'dashboard)
(defcustom dashboard-heading-shorcut-format " (%s)"
@ -411,7 +434,9 @@ installed."
Will be of the form `(list-type . list-size)'.
If nil it is disabled. Possible values for list-type are:
`recents' `bookmarks' `projects' `agenda' `registers'."
:type '(repeat (alist :key-type symbol :value-type integer))
:type '(repeat (choice
symbol
(cons symbol integer)))
:group 'dashboard)
(defcustom dashboard-item-shortcuts
@ -423,8 +448,8 @@ If nil it is disabled. Possible values for list-type are:
"Association list of items and their corresponding shortcuts.
Will be of the form `(list-type . keys)' as understood by `(kbd keys)'.
If nil, shortcuts are disabled. If an entry's value is nil, that item's
shortcut is disbaled. See `dashboard-items' for possible values of list-type.'"
:type '(repeat (alist :key-type symbol :value-type string))
shortcut is disabled. See `dashboard-items' for possible values of list-type.'"
:type '(alist :key-type symbol :value-type string)
:group 'dashboard)
(defcustom dashboard-item-names nil
@ -574,7 +599,8 @@ Optionally, provide NO-NEXT-LINE to move the cursor forward a line."
`(progn
(eval-when-compile (defvar dashboard-mode-map))
(defun ,sym nil
,(concat "Jump to " name ". This code is dynamically generated in `dashboard-insert-shortcut'.")
,(concat "Jump to " name ".
This code is dynamically generated in `dashboard-insert-shortcut'.")
(interactive)
(unless (search-forward ,search-label (point-max) t)
(search-backward ,search-label (point-min) t))
@ -599,9 +625,12 @@ If MESSAGEBUF is not nil then MSG is also written in message buffer."
"Insert a page break line in dashboard buffer."
(dashboard-append dashboard-page-separator))
(defun dashboard-insert-newline (&optional n)
"Insert N times of newlines."
(dotimes (_ (or n 1))
(defun dashboard-insert-newline (&optional times)
"When called without an argument, insert a newline.
When called with TIMES return a function that insert TIMES number of newlines."
(if times
(lambda ()
(insert (make-string times (string-to-char "\n") t)))
(insert "\n")))
(defun dashboard-insert-heading (heading &optional shortcut icon)
@ -715,7 +744,9 @@ If MESSAGEBUF is not nil then MSG is also written in message buffer."
(list :text (dashboard-get-banner-path 1)))))
((and
(pred listp)
(pred (lambda (c) (not (proper-list-p c))))
(pred (lambda (c)
(and (not (proper-list-p c))
(not (null c)))))
`(,img . ,txt))
(list :image (if (dashboard--image-supported-p img)
img
@ -725,12 +756,16 @@ If MESSAGEBUF is not nil then MSG is also written in message buffer."
txt
(message "could not find banner %s, use default instead" txt)
(dashboard-get-banner-path 1))))
((pred proper-list-p)
((and
(pred proper-list-p)
(pred (lambda (l) (not (null l)))))
(let* ((max (length banner))
(choose (nth (random max) banner)))
(dashboard-choose-banner choose)))
(_
(message "unsupported banner config %s" banner))))
(user-error "Unsupported banner type: `%s'" banner)
nil)))
(defun dashboard--image-animated-p (image-path)
"Return if image is a gif or webp.
@ -850,7 +885,8 @@ Argument IMAGE-PATH path to the image."
(when (and icon title
(not (string-equal icon ""))
(not (string-equal title "")))
(propertize " " 'face 'variable-pitch))
(propertize " " 'face `(:inherit (variable-pitch
,face))))
(when title (propertize title 'face face)))
:help-echo help
:action action
@ -872,7 +908,10 @@ ACTION is theaction taken when the user activates the widget button.
WIDGET-PARAMS are passed to the \"widget-create\" function."
`(progn
(dashboard-insert-heading ,section-name
(if (and ,list ,shortcut-char dashboard-show-shortcuts) ,shortcut-char))
(when (and ,list
,shortcut-char
dashboard-show-shortcuts)
,shortcut-char))
(if ,list
(when (and (dashboard-insert-section-list
,section-name
@ -928,10 +967,19 @@ to widget creation."
"Return a random footer from `dashboard-footer-messages'."
(nth (random (length dashboard-footer-messages)) dashboard-footer-messages))
(defun dashboard-footer-icon ()
"Return footer icon or a random icon if `dashboard-footer-messages' is a list."
(if (and (not (null dashboard-footer-icon))
(listp dashboard-footer-icon))
(dashboard-replace-displayable
(nth (random (length dashboard-footer-icon))
dashboard-footer-icon))
(dashboard-replace-displayable dashboard-footer-icon)))
(defun dashboard-insert-footer ()
"Insert footer of dashboard."
(when-let ((footer (dashboard-random-footer))
(footer-icon (dashboard-replace-displayable dashboard-footer-icon)))
(footer-icon (dashboard-footer-icon)))
(dashboard-insert-center
(if (string-empty-p footer-icon) footer-icon
(concat footer-icon " "))
@ -1340,7 +1388,9 @@ Any custom function would receives the tags from `org-get-tags'"
(defun dashboard-agenda-entry-format ()
"Format agenda entry to show it on dashboard.
Also,it set text properties that latter are used to sort entries and perform different actions."
Also,it set text properties that latter are used to sort entries and perform
different actions."
(let* ((scheduled-time (org-get-scheduled-time (point)))
(deadline-time (org-get-deadline-time (point)))
(entry-timestamp (dashboard-agenda--entry-timestamp (point)))

View file

@ -143,10 +143,15 @@ Avalaible functions:
`dashboard-insert-items'
`dashboard-insert-footer'
You can also add your custom function or a lambda to the list.
It must be a function or a cons cell where specify function and
its arg.
Also you can add your custom function or a lambda to the list.
example:
(lambda () (delete-char -1))"
:type '(repeat function)
:type '(repeat (choice
function
(cons function sexp)))
:group 'dashboard)
(defcustom dashboard-navigation-cycle nil
@ -154,8 +159,10 @@ example:
:type 'boolean
:group 'dashboard)
(defconst dashboard-buffer-name "*dashboard*"
"Dashboard's buffer name.")
(defcustom dashboard-buffer-name "*dashboard*"
"Dashboard's buffer name."
:type 'string
:group 'dashboard)
(defvar dashboard-force-refresh nil
"If non-nil, force refresh dashboard buffer.")
@ -191,8 +198,8 @@ example:
(save-excursion
(if-let* ((sep (dashboard--separator))
((and (search-backward sep nil t)
(search-forward sep nil t))))
(let ((ln (thing-at-point 'line)))
(search-forward sep nil t)))
(ln (thing-at-point 'line t)))
(cond ((string-match-p "Recent Files:" ln) 'recents)
((string-match-p "Bookmarks:" ln) 'bookmarks)
((string-match-p "Projects:" ln) 'projects)
@ -200,7 +207,7 @@ example:
((string-match-p "Registers:" ln) 'registers)
((string-match-p "List Directories:" ln) 'ls-directories)
((string-match-p "List Files:" ln) 'ls-files)
(t (user-error "Unknown section from dashboard"))))
(t (user-error "Unknown section from dashboard")))
(user-error "Failed searching dashboard section"))))
;;
@ -500,8 +507,11 @@ See `dashboard-item-generators' for all items available."
(erase-buffer)
(setq dashboard--section-starts nil)
(mapc (lambda (fn)
(funcall fn))
(mapc (lambda (entry)
(if (and (listp entry)
(not (functionp entry)))
(apply (car entry) `(,(cdr entry)))
(funcall entry)))
dashboard-startupify-list)
(when dashboard-vertically-center-content

View file

@ -1,6 +1,6 @@
(define-package "devdocs" "20240301.1838" "Emacs viewer for DevDocs"
(define-package "devdocs" "20240428.711" "Emacs viewer for DevDocs"
'((emacs "27.1"))
:commit "3424436f333955b39a0803ce9781aaffaae003f5" :authors
:commit "c14d1306648d3ae09ee3a3b3f45592334943cfeb" :authors
'(("Augusto Stoffel" . "arstoffel@gmail.com"))
:maintainers
'(("Augusto Stoffel" . "arstoffel@gmail.com"))

View file

@ -1,12 +1,12 @@
;;; devdocs.el --- Emacs viewer for DevDocs -*- lexical-binding: t -*-
;; Copyright (C) 2021 Free Software Foundation, Inc.
;; Copyright (C) 2021-2024 Free Software Foundation, Inc.
;; Author: Augusto Stoffel <arstoffel@gmail.com>
;; Keywords: help
;; URL: https://github.com/astoff/devdocs.el
;; Package-Requires: ((emacs "27.1"))
;; Version: 0.5
;; Version: 0.6.1
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
@ -82,7 +82,7 @@ name and a count."
:type '(choice (const :tag "Count in parentheses, italicized"
#("%s (%s)" 3 7 (face italic)))
(const :tag "Invisible cookie"
#("%s (%s)" 2 7 (invisible t)))
#("%s#%s" 2 5 (invisible t)))
string))
(defcustom devdocs-fontify-code-blocks t
@ -94,6 +94,9 @@ Fontification is done using the `org-src' library, which see."
"Whether to select the DevDocs window for viewing."
:type 'boolean)
(defvar devdocs-extra-rendering-functions '()
"Extra functions for `shr-external-rendering-functions'.")
(defface devdocs-code-block '((t nil))
"Additional face to apply to code blocks in DevDocs buffers.")
@ -316,7 +319,10 @@ already installed, reinstall it."
"Go to the original position in a DevDocs buffer."
(interactive)
(goto-char (point-min))
(when-let ((pred (if (fboundp 'shr--set-target-ids) #'member t)) ;; shr change in Emacs 29
(when-let ((frag (let-alist (car devdocs--stack)
(or .fragment (devdocs--path-fragment .path))))
(shr-target-id (url-unhex-string frag))
(pred (if (fboundp 'shr--set-target-ids) #'member t)) ;; shr change in Emacs 29
(match (text-property-search-forward 'shr-target-id shr-target-id pred)))
(goto-char (prop-match-beginning match))))
@ -477,15 +483,18 @@ fragment part of ENTRY.path."
(unless (eq major-mode 'devdocs-mode)
(devdocs-mode))
(let-alist entry
(let ((inhibit-read-only t)
(let* ((inhibit-read-only t)
(extra-rendering-functions (cdr (assoc
(intern .doc.type)
devdocs-extra-rendering-functions)))
(shr-external-rendering-functions `((pre . devdocs--shr-tag-pre)
,@extra-rendering-functions
,@shr-external-rendering-functions))
(file (expand-file-name (format "%s/%s.html"
.doc.slug
(url-hexify-string (devdocs--path-file .path)))
devdocs-data-dir)))
(erase-buffer)
(setq-local shr-target-id (url-unhex-string (or .fragment (devdocs--path-fragment .path))))
;; TODO: cl-progv here for shr settings?
(shr-insert-document
(with-temp-buffer
@ -494,7 +503,9 @@ fragment part of ENTRY.path."
(set-buffer-modified-p nil)
(setq-local devdocs-current-docs (list .doc.slug))
(push entry devdocs--stack)
(setq-local list-buffers-directory (format-mode-line devdocs-header-line nil nil (current-buffer)))
(setq-local list-buffers-directory (format-mode-line devdocs-header-line
nil nil
(current-buffer)))
(devdocs-goto-target)
(current-buffer))))

View file

@ -1,6 +1,6 @@
(define-package "devdocs-browser" "20231231.1455" "Browse devdocs.io documents using EWW"
(define-package "devdocs-browser" "20240511.306" "Browse devdocs.io documents using EWW"
'((emacs "27.1"))
:commit "afc460e687bec4eb947ab85d207778fc3b9b3bbc" :authors
:commit "0655b89651458777354a3b89c1d486e0fda1928d" :authors
'(("blahgeek" . "i@blahgeek.com"))
:maintainers
'(("blahgeek" . "i@blahgeek.com"))

View file

@ -32,6 +32,7 @@
(require 'eww)
(require 'eldoc)
(require 'imenu)
(require 'seq)
(defgroup devdocs-browser nil
@ -39,12 +40,40 @@
:group 'tools
:group 'web)
(defcustom devdocs-browser-cache-directory
;; Following are faces for <h1> to <h5> elements.
;; We do not reuse `shr-h1' etc. face because:
;; - they are only available since emacs 28
;; - devdocs documents usually have lower level of headings (e.g. H2 and H3 is more common), so we want different rules as the general version
(defface devdocs-browser-h1
'((t :height 1.3 :weight bold))
"Face for <h1> elements for devdocs-browser.")
(defface devdocs-browser-h2
'((t :height 1.2 :weight bold))
"Face for <h2> elements for devdocs-browser.")
(defface devdocs-browser-h3
'((t :height 1.1 :weight bold))
"Face for <h3> elements for devdocs-browser.")
(defface devdocs-browser-h4
'((t :weight bold))
"Face for <h4> elements for devdocs-browser.")
(defface devdocs-browser-h5
'((t :slant italic))
"Face for <h5> elements for devdocs-browser.")
(defcustom devdocs-browser-data-directory
(expand-file-name "devdocs-browser" user-emacs-directory)
"Directory to store devdocs cache files."
"Directory to store devdocs data files."
:type 'directory
:group 'devdocs-browser)
(defalias 'devdocs-browser-cache-directory 'devdocs-browser-data-directory)
(defcustom devdocs-browser-base-url "https://devdocs.io/"
"Base URL to fetch json metadata files."
:type 'string)
@ -160,37 +189,20 @@ See https://prismjs.com/ for list of language names."
(insert (devdocs-browser--eww-fontify-pre dom))
(shr-ensure-newline)))
(defun devdocs-browser--eww-tag-maybe-set-title (dom)
"Maybe set DOM as title if it's not set yet."
(when (zerop (length (plist-get eww-data :title)))
(eww-tag-title dom)))
(defun devdocs-browser--eww-tag-header (level dom)
"Render function for header DOM with LEVEL (number)."
;; use h1/h2/h3 as title if not set yet
(when (and (<= level 3)
(zerop (length (plist-get eww-data :title))))
(eww-tag-title dom))
(defun devdocs-browser--eww-tag-h1 (dom)
"Rendering function for h1 DOM. Maybe use it as title."
(devdocs-browser--eww-tag-maybe-set-title dom)
(shr-tag-h1 dom))
(defun devdocs-browser--eww-tag-h2 (dom)
"Rendering function for h2 DOM. Maybe use it as title."
(devdocs-browser--eww-tag-maybe-set-title dom)
(shr-heading dom (if shr-use-fonts
'(variable-pitch (:height 1.2 :weight bold))
'bold)))
(defun devdocs-browser--eww-tag-h3 (dom)
"Rendering function for h2 DOM. Maybe use it as title."
(devdocs-browser--eww-tag-maybe-set-title dom)
(shr-heading dom (if shr-use-fonts
'(variable-pitch (:height 1.1 :weight bold))
'bold)))
(defun devdocs-browser--eww-tag-h4 (dom)
"Rendering function for h4 DOM."
(shr-heading dom 'bold))
(defun devdocs-browser--eww-tag-h5 (dom)
"Rendering function for h5 DOM."
(shr-heading dom 'italic))
;; similar to shr-heading
(shr-ensure-paragraph)
(let ((start (point)))
(shr-fontize-dom dom (intern (concat "devdocs-browser-h" (number-to-string level))))
;; this is new since emacs 30, to support outline function
(put-text-property start (pos-eol) 'outline-level level))
(shr-ensure-paragraph))
(defun devdocs-browser--eww-tag-generic-ensure-paragraph (dom)
"Rendering function for generic DOM while ensuring paragraph."
@ -284,7 +296,7 @@ Can be used as `imenu-create-index-function'."
(path (plist-get entry :path))
(url (url-generic-parse-url path))
(target (url-target url))
(_ (equal (url-filename url) (url-filename page-url))))
((equal (url-filename url) (url-filename page-url))))
(cons name (devdocs-browser--position-by-target target))))
entries))))
@ -325,13 +337,12 @@ Can be used as `imenu-create-index-function'."
(setq-local shr-external-rendering-functions
(append shr-external-rendering-functions
'((pre . devdocs-browser--eww-tag-pre)
(h1 . devdocs-browser--eww-tag-h1)
(h2 . devdocs-browser--eww-tag-h2)
(h3 . devdocs-browser--eww-tag-h3)
(h4 . devdocs-browser--eww-tag-h4)
(h5 . devdocs-browser--eww-tag-h5)
(summary . devdocs-browser--eww-tag-generic-ensure-paragraph)
(section . devdocs-browser--eww-tag-generic-ensure-paragraph))))
(section . devdocs-browser--eww-tag-generic-ensure-paragraph))
(mapcar (lambda (level)
(cons (intern (concat "h" (number-to-string level)))
(apply-partially #'devdocs-browser--eww-tag-header level)))
(number-sequence 1 5))))
(setq-local imenu-create-index-function
#'devdocs-browser--imenu-create-index)
(when (boundp 'eww-auto-rename-buffer)
@ -351,13 +362,12 @@ Can be used as `imenu-create-index-function'."
(defun devdocs-browser--completing-read (prompt collection &optional def)
"Helper function for `completing-read'.
PROMPT: same meaning, but this function will append ';' at the end;
COLLECTION: alist of (name . props), where props is a plist with
COLLECTION: alist or hashtable of (name . props), where props is a plist with
possibly the following keys: :value, :annotation, :group;
if :group is not nil and name starts with '<group>: ', its removed.
DEF: same meaning;"
;; convert collection to hashtables for faster completion. `complete-with-action' also supports that.
(setq collection (delq nil collection))
(let* ((collection-ht (make-hash-table :test 'equal :size (length collection)))
(let* (collection-ht
(annotation-function
(lambda (s)
(let ((annotation (plist-get (gethash s collection-ht) :annotation)))
@ -372,8 +382,13 @@ DEF: same meaning;"
(replace-match "" t t s)
s))
(t group))))))
(mapc (lambda (elem) (puthash (car elem) (cdr elem) collection-ht))
collection)
(if (hash-table-p collection)
(setq collection-ht collection)
(setq collection-ht (make-hash-table :test 'equal :size (length collection)))
(mapc (lambda (elem)
(when elem
(puthash (car elem) (cdr elem) collection-ht)))
collection))
(setq prompt (concat prompt
(when def
(format " (default %s)" (funcall group-function def t)))
@ -384,7 +399,7 @@ DEF: same meaning;"
(if (eq action 'metadata)
`(metadata . ((annotation-function . ,annotation-function)
(group-function . ,group-function)))
(complete-with-action action collection str pred)))
(complete-with-action action collection-ht str pred)))
nil t ;; require-match
nil nil def)))
(or (plist-get (gethash res collection-ht) :value)
@ -396,7 +411,7 @@ DEF: same meaning;"
(defun devdocs-browser--read-json (file-path)
"Read json file in FILE-PATH, if it's a relative path, find it in cache dir."
(let ((filename (expand-file-name file-path devdocs-browser-cache-directory)))
(let ((filename (expand-file-name file-path devdocs-browser-data-directory)))
(when (file-exists-p filename)
(with-temp-buffer
(insert-file-contents filename)
@ -405,7 +420,7 @@ DEF: same meaning;"
(defun devdocs-browser--fetch-json (url-path file-path &optional base-url)
"Fetch json from BASE-URL / URL-PATH, also save to FILE-PATH.
BASE-URL defaults to `devdocs-browser-base-url'."
(let ((cache-filename (expand-file-name file-path devdocs-browser-cache-directory)))
(let ((cache-filename (expand-file-name file-path devdocs-browser-data-directory)))
(unless (file-exists-p (file-name-directory cache-filename))
(make-directory (file-name-directory cache-filename) t))
(with-temp-file cache-filename
@ -447,13 +462,18 @@ To upgrade docs content, see `devdocs-browser-upgrade-doc'."
(equal (plist-get doc :name) slug-or-name)))
docs-list)))
(defvar devdocs-browser--docs-cache '() "Cached doc indexes plist.")
(defcustom devdocs-browser-enable-cache t
"Whether cache doc indices in memory."
:type 'boolean
:group 'devdocs-browser)
(defvar devdocs-browser--docs-cache '() "Cached doc indices plist.")
(defun devdocs-browser--install-doc-internal (doc)
"(Re-)install doc identified by plist DOC. Return t if success."
(let* ((slug (plist-get doc :slug))
(mtime (plist-get doc :mtime))
(docs-dir (expand-file-name devdocs-browser--docs-dir devdocs-browser-cache-directory))
(docs-dir (expand-file-name devdocs-browser--docs-dir devdocs-browser-data-directory))
(doc-dir (expand-file-name slug docs-dir))
success)
(unless (file-exists-p docs-dir)
@ -478,7 +498,7 @@ To upgrade docs content, see `devdocs-browser-upgrade-doc'."
(message "Failed to install devdocs doc %s" slug))
;; remove cache
(setq devdocs-browser--docs-cache
(lax-plist-put devdocs-browser--docs-cache slug nil))
(plist-put devdocs-browser--docs-cache slug nil #'equal))
success))
(defun devdocs-browser--doc-readable-name (doc)
@ -528,12 +548,12 @@ When called interactively, user can choose from the list."
(interactive (list (completing-read "Uninstall doc: "
(devdocs-browser-list-installed-slugs)
nil t)))
(let* ((docs-dir (expand-file-name devdocs-browser--docs-dir devdocs-browser-cache-directory))
(let* ((docs-dir (expand-file-name devdocs-browser--docs-dir devdocs-browser-data-directory))
(doc-dir (expand-file-name slug docs-dir)))
(when (file-exists-p doc-dir)
(delete-directory doc-dir t)))
(setq devdocs-browser--docs-cache
(lax-plist-put devdocs-browser--docs-cache slug nil)))
(plist-put devdocs-browser--docs-cache slug nil #'equal)))
(defun devdocs-browser--upgrade-readable-name (old-doc new-doc)
"Get human readable name for upgrade from OLD-DOC to NEW-DOC."
@ -602,7 +622,7 @@ You may need to call `devdocs-browser-update-docs' first."
(defun devdocs-browser-list-installed-slugs ()
"Get a list of installed docs' slug name."
(let ((dir (expand-file-name devdocs-browser--docs-dir devdocs-browser-cache-directory)))
(let ((dir (expand-file-name devdocs-browser--docs-dir devdocs-browser-data-directory)))
(when (file-exists-p dir)
(directory-files dir nil
;; ignore ".", ".." and hidden files
@ -624,9 +644,9 @@ You may need to call `devdocs-browser-update-docs' first."
(defun devdocs-browser--load-doc (slug &optional refresh-cache)
"Load doc identified by SLUG, reload cache if REFRESH-CACHE is not nil.
Result is a plist metadata, with an extra :index field at the beginning."
(or (and (not refresh-cache) (lax-plist-get devdocs-browser--docs-cache slug))
(or (and (not refresh-cache) (plist-get devdocs-browser--docs-cache slug #'equal))
(let* ((docs-dir (expand-file-name devdocs-browser--docs-dir
devdocs-browser-cache-directory))
devdocs-browser-data-directory))
(doc-dir (expand-file-name slug docs-dir))
(metadata-filename (expand-file-name devdocs-browser--metadata-filename doc-dir))
(metadata nil)
@ -638,15 +658,16 @@ Result is a plist metadata, with an extra :index field at the beginning."
(insert-file-contents metadata-filename)
(setq metadata (read (current-buffer))))
(setq res (append `(:index ,index) metadata))
(when devdocs-browser-enable-cache
(setq devdocs-browser--docs-cache
(lax-plist-put devdocs-browser--docs-cache slug res)))
(plist-put devdocs-browser--docs-cache slug res #'equal))))
res)))
(defun devdocs-browser--download-offline-data-internal (doc)
"(re-)Download and extract offline data for DOC."
(let* ((slug (plist-get doc :slug))
(mtime (plist-get doc :mtime))
(docs-dir (expand-file-name devdocs-browser--docs-dir devdocs-browser-cache-directory))
(docs-dir (expand-file-name devdocs-browser--docs-dir devdocs-browser-data-directory))
(doc-dir (expand-file-name slug docs-dir))
(data-dir (expand-file-name devdocs-browser--offline-data-dir-name doc-dir))
success)
@ -682,7 +703,7 @@ Result is a plist metadata, with an extra :index field at the beginning."
(defun devdocs-browser-offline-data-dir (slug)
"Return doc SLUG's offline data dir if present, return nil otherwise."
(let* ((docs-dir (expand-file-name devdocs-browser--docs-dir devdocs-browser-cache-directory))
(let* ((docs-dir (expand-file-name devdocs-browser--docs-dir devdocs-browser-data-directory))
(doc-dir (expand-file-name slug docs-dir))
(data-dir (expand-file-name devdocs-browser--offline-data-dir-name doc-dir)))
(when (file-exists-p data-dir)
@ -778,7 +799,8 @@ When called interactively, user can choose from the list."
(let ((current-word-regex
(when-let ((word (thing-at-point 'word t)))
(concat "\\<" (regexp-quote word) "\\>")))
slugs rows def)
(rows (make-hash-table :test 'equal))
slugs def)
(dolist (slug-or-name slug-or-name-list)
(when-let* ((doc-simple (devdocs-browser-find-installed-doc slug-or-name))
(slug (plist-get doc-simple :slug))
@ -786,9 +808,11 @@ When called interactively, user can choose from the list."
(index (plist-get doc :index))
(entries (plist-get index :entries)))
(setq slugs (push slug slugs))
(let ((new-rows
(mapcar
(lambda (entry)
(puthash (format "%s: INDEX PAGE" slug)
`(:value (,doc "index")
:group ,slug)
rows)
(seq-doseq (entry entries)
(let* ((name (plist-get entry :name))
(path (plist-get entry :path))
(type (plist-get entry :type))
@ -796,15 +820,10 @@ When called interactively, user can choose from the list."
(when (and (null def) current-word-regex)
(when (string-match-p current-word-regex name)
(setq def title)))
(cons title `(:value (,doc ,path)
(puthash title `(:value (,doc ,path)
:group ,slug
:annotation ,type))))
entries)))
(setq rows (append new-rows rows))
(push (cons (format "%s: INDEX PAGE" slug)
`(:value (,doc "index")
:group ,slug))
rows))))
:annotation ,type)
rows)))))
(let* ((selected-value
(devdocs-browser--completing-read
(format "Devdocs browser [%s]" (mapconcat #'identity slugs ","))
@ -812,6 +831,12 @@ When called interactively, user can choose from the list."
(when selected-value
(apply #'devdocs-browser--eww-open selected-value)))))
(defcustom devdocs-browser-open-fallback-to-all-docs t
"When not sure which docs to use, whether `devdocs-browser-open' should use all installed docs, or just ask the user to pick one (like `devdocs-browser-open-in')."
:type 'boolean
:group 'devdocs-browser)
;;;###autoload
(defun devdocs-browser-open ()
"Open entry in active docs.
@ -820,7 +845,12 @@ or `devdocs-browser-major-mode-docs-alist',
or the current doc type if called in a devdocs eww buffer.
When all of them are nil, all installed docs are used."
(interactive)
(devdocs-browser-open-in (devdocs-browser--default-active-slugs)))
(if devdocs-browser-open-fallback-to-all-docs
(devdocs-browser-open-in (devdocs-browser--default-active-slugs))
(let ((slugs (devdocs-browser--default-active-slugs 'no-fallback-all)))
(if slugs
(devdocs-browser-open-in slugs)
(call-interactively 'devdocs-browser-open-in)))))
(provide 'devdocs-browser)

View file

@ -1,23 +0,0 @@
;;; dired-hacks-utils-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*-
;;
;;; Code:
(add-to-list 'load-path (directory-file-name
(or (file-name-directory #$) (car load-path))))
;;;### (autoloads nil "dired-hacks-utils" "dired-hacks-utils.el"
;;;;;; (0 0 0 0))
;;; Generated autoloads from dired-hacks-utils.el
(register-definition-prefixes "dired-hacks-utils" '("dired-"))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; coding: utf-8
;; End:
;;; dired-hacks-utils-autoloads.el ends here

View file

@ -1,2 +0,0 @@
;;; Generated package description from dired-hacks-utils.el -*- no-byte-compile: t -*-
(define-package "dired-hacks-utils" "20221127.1247" "Utilities and helpers for dired-hacks collection" '((dash "2.5.0")) :commit "41d3eb42195d9f0894c20d18cc8e722b099aa1c1" :authors '(("Matúš Goljer" . "matus.goljer@gmail.com")) :maintainer '("Matúš Goljer" . "matus.goljer@gmail.com") :keywords '("files"))

View file

@ -1,275 +0,0 @@
;;; dired-hacks-utils.el --- Utilities and helpers for dired-hacks collection
;; Copyright (C) 2014-2015 Matúš Goljer
;; Author: Matúš Goljer <matus.goljer@gmail.com>
;; Maintainer: Matúš Goljer <matus.goljer@gmail.com>
;; Keywords: files
;; Package-Version: 20221127.1247
;; Package-Commit: 41d3eb42195d9f0894c20d18cc8e722b099aa1c1
;; Version: 0.0.1
;; Created: 14th February 2014
;; Package-Requires: ((dash "2.5.0"))
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program 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 General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Utilities and helpers for `dired-hacks' collection of dired
;; improvements.
;; This package also provides these interactive functions:
;; * `dired-hacks-next-file' - go to next file, skipping empty and non-file lines
;; * `dired-hacks-previous-file' - go to previous file, skipping empty
;; and non-file lines
;; * `dired-utils-format-information-line-mode' - Format the information
;; (summary) line file sizes to be human readable (e.g. 1GB instead of 1048576).
;; See https://github.com/Fuco1/dired-hacks for the entire collection
;;; Code:
(require 'dash)
(require 'dired)
(defgroup dired-hacks ()
"Collection of useful dired additions."
:group 'dired
:prefix "dired-hacks-")
(defcustom dired-hacks-file-size-formatter 'file-size-human-readable
"The function used to format file sizes.
See `dired-utils-format-file-sizes'."
:type 'symbol
:group 'dired-hacks)
(defcustom dired-hacks-datetime-regexp
"\\sw\\sw\\sw....\\(?:[0-9][0-9]:[0-9][0-9]\\|.[0-9]\\{4\\}\\)"
"A regexp matching the date/time in the dired listing.
It is used to determine where the filename starts. It should
*not* match any characters after the last character of the
timestamp. It is assumed that the timestamp is preceded and
followed by at least one space character. You should only use
shy groups (prefixed with ?:) because the first group is used by
the font-lock to determine what portion of the name should be
colored."
:type 'string
:group 'dired-hacks)
(defalias 'dired-utils--string-trim
(if (and (require 'subr-x nil t)
(fboundp 'string-trim))
#'string-trim
(lambda (string)
(let ((s string))
(when (string-match "\\`[ \t\n\r]+" s)
(setq s (replace-match "" t t s)))
(when (string-match "[ \t\n\r]+\\'" s)
(setq s (replace-match "" t t s)))
s)))
"Trim STRING of trailing whitespace.
\(fn STRING)")
(defun dired-utils-get-filename (&optional localp)
"Like `dired-get-filename' but never signal an error.
Optional arg LOCALP with value `no-dir' means don't include
directory name in result."
(dired-get-filename localp t))
(defun dired-utils-get-all-files (&optional localp)
"Return all files in this dired buffer as a list.
LOCALP has same semantics as in `dired-get-filename'."
(save-excursion
(goto-char (point-min))
(let (r)
(while (= 0 (forward-line))
(--when-let (dired-utils-get-filename localp)
(push it r)))
(nreverse r))))
(defconst dired-utils-file-attributes-keywords
'(:isdir :nlinks :uid :gid :atime :mtime :ctime :size :modes :gidchg :inode :devnum)
"List of keywords to map with `file-attributes'.")
(defconst dired-utils-info-keywords
`(:name :issym :target ,@dired-utils-file-attributes-keywords)
"List of keywords available for `dired-utils-get-info'.")
(defun dired-utils--get-keyword-info (keyword)
"Get file information about KEYWORD."
(let ((filename (dired-utils-get-filename)))
(cl-case keyword
(:name filename)
(:isdir (file-directory-p filename))
(:issym (and (file-symlink-p filename) t))
(:target (file-symlink-p filename))
(t
(nth (-elem-index keyword dired-utils-file-attributes-keywords)
(file-attributes filename))))))
(defun dired-utils-get-info (&rest keywords)
"Query for info about the file at point.
KEYWORDS is a list of attributes to query.
When querying for one attribute, its value is returned. When
querying for more than one, a list of results is returned.
The available keywords are listed in
`dired-utils-info-keywords'."
(let ((attributes (mapcar 'dired-utils--get-keyword-info keywords)))
(if (> (length attributes) 1)
attributes
(car attributes))))
(defun dired-utils-goto-line (filename)
"Go to line describing FILENAME in listing.
Should be absolute file name matched against
`dired-get-filename'."
(goto-char (point-min))
(let (stop)
(while (and (not stop)
(= (forward-line) 0))
(when (equal filename (dired-utils-get-filename))
(setq stop t)
(dired-move-to-filename)))
stop))
(defun dired-utils-match-filename-regexp (filename alist)
"Match FILENAME against each car in ALIST and return first matched cons.
Each car in ALIST is a regular expression.
The matching is done using `string-match-p'."
(let (match)
(--each-while alist (not match)
(when (string-match-p (car it) filename)
(setq match it)))
match))
(defun dired-utils-match-filename-extension (filename alist)
"Match FILENAME against each car in ALIST and return first matched cons.
Each car in ALIST is a string representing file extension
*without* the delimiting dot."
(let (done)
(--each-while alist (not done)
(when (string-match-p (concat "\\." (regexp-quote (car it)) "\\'") filename)
(setq done it)))
done))
(defun dired-utils-format-information-line ()
"Format the disk space on the Dired information line."
(save-excursion
(goto-char (point-min))
(forward-line)
(let ((inhibit-read-only t)
(limit (line-end-position)))
(while (re-search-forward "\\(?:directory\\|available\\) \\(\\<[0-9]+$\\>\\)" nil t)
(replace-match
(save-match-data
(propertize (dired-utils--string-trim
(funcall dired-hacks-file-size-formatter
(* 1024 (string-to-number (match-string 1))) t))
'invisible 'dired-hide-details-information))
t nil nil 1)))))
;;; Predicates
(defun dired-utils-is-file-p ()
"Return non-nil if the line at point is a file or a directory."
(dired-utils-get-filename 'no-dir))
(defun dired-utils-is-dir-p ()
"Return non-nil if the line at point is a directory."
(--when-let (dired-utils-get-filename)
(file-directory-p it)))
;;; Interactive
;; TODO: add wrap-around option
(defun dired-hacks-next-file (&optional arg)
"Move point to the next file.
Optional prefix ARG says how many lines to move; default is one
line."
(interactive "p")
(unless arg (setq arg 1))
(if (< arg 0)
(dired-hacks-previous-file (- arg))
(--dotimes arg
(forward-line)
(while (and (or (not (dired-utils-is-file-p))
(get-text-property (point) 'invisible))
(= (forward-line) 0))))
(if (not (= (point) (point-max)))
(dired-move-to-filename)
(forward-line -1)
(dired-move-to-filename)
nil)))
(defun dired-hacks-previous-file (&optional arg)
"Move point to the previous file.
Optional prefix ARG says how many lines to move; default is one
line."
(interactive "p")
(unless arg (setq arg 1))
(if (< arg 0)
(dired-hacks-next-file (- arg))
(--dotimes arg
(forward-line -1)
(while (and (or (not (dired-utils-is-file-p))
(get-text-property (point) 'invisible))
(= (forward-line -1) 0))))
(if (not (= (point) (point-min)))
(dired-move-to-filename)
(dired-hacks-next-file)
nil)))
(defun dired-hacks-compare-files (file-a file-b)
"Test if two files FILE-A and FILE-B are the (probably) the same."
(interactive (let ((other-dir (dired-dwim-target-directory)))
(list (read-file-name "File A: " default-directory (car (dired-get-marked-files)) t)
(read-file-name "File B: " other-dir (with-current-buffer (cdr (assoc other-dir dired-buffers))
(car (dired-get-marked-files))) t))))
(let ((md5-a (with-temp-buffer
(shell-command (format "md5sum %s" file-a) (current-buffer))
(buffer-string)))
(md5-b (with-temp-buffer
(shell-command (format "md5sum %s" file-b) (current-buffer))
(buffer-string))))
(message "%s%sFiles are %s." md5-a md5-b
(if (equal (car (split-string md5-a))
(car (split-string md5-b)))
"probably the same" "different"))))
(define-minor-mode dired-utils-format-information-line-mode
"Toggle formatting of disk space in the Dired information line."
:group 'dired-utils
:lighter ""
(if dired-utils-format-information-line-mode
(add-hook 'dired-after-readin-hook #'dired-utils-format-information-line)
(remove-hook 'dired-after-readin-hook #'dired-utils-format-information-line)))
(provide 'dired-hacks-utils)
;;; dired-hacks-utils.el ends here

View file

@ -1,27 +0,0 @@
;;; dired-hacks-utils-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*-
;;
;;; Code:
(add-to-list 'load-path (directory-file-name
(or (file-name-directory #$) (car load-path))))
;;;### (autoloads nil "dired-hacks-utils" "dired-hacks-utils.el"
;;;;;; (0 0 0 0))
;;; Generated autoloads from dired-hacks-utils.el
(register-definition-prefixes "dired-hacks-utils" '("dired-"))
;;;***
;;;### (autoloads nil nil ("dired-hacks-utils-pkg.el") (0 0 0 0))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; coding: utf-8
;; End:
;;; dired-hacks-utils-autoloads.el ends here

View file

@ -0,0 +1,28 @@
;;; dired-hacks-utils-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*-
;; Generated by the `loaddefs-generate' function.
;; This file is part of GNU Emacs.
;;; Code:
(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path)))
;;; Generated autoloads from dired-hacks-utils.el
(register-definition-prefixes "dired-hacks-utils" '("dired-"))
;;; End of scraped data
(provide 'dired-hacks-utils-autoloads)
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; no-native-compile: t
;; coding: utf-8-emacs-unix
;; End:
;;; dired-hacks-utils-autoloads.el ends here

View file

@ -1,13 +1,15 @@
(define-package "dired-hacks-utils" "20230512.1107" "Utilities and helpers for dired-hacks collection"
'((dash "2.5.0"))
:commit "523f51b4152a3bf4e60fe57f512732c698b5c96f" :authors
(define-package "dired-hacks-utils" "20240629.1906" "Utilities and helpers for dired-hacks collection"
'((dash "2.5.0")
(emacs "24.3"))
:commit "63b04d17936c98cb4ad7ce6bc3331cda8e30c55a" :authors
'(("Matúš Goljer" . "matus.goljer@gmail.com"))
:maintainers
'(("Matúš Goljer" . "matus.goljer@gmail.com"))
:maintainer
'("Matúš Goljer" . "matus.goljer@gmail.com")
:keywords
'("files"))
'("files")
:url "https://github.com/Fuco1/dired-hacks")
;; Local Variables:
;; no-byte-compile: t
;; End:

View file

@ -7,7 +7,8 @@
;; Keywords: files
;; Version: 0.0.1
;; Created: 14th February 2014
;; Package-Requires: ((dash "2.5.0"))
;; Package-Requires: ((dash "2.5.0") (emacs "24.3"))
;; URL: https://github.com/Fuco1/dired-hacks
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
@ -41,6 +42,7 @@
(require 'dash)
(require 'dired)
(require 'dired-aux) ;; for dired-dwim-target-directory
(defgroup dired-hacks ()
"Collection of useful dired additions."

View file

@ -1,22 +0,0 @@
;;; dired-rainbow-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*-
;;
;;; Code:
(add-to-list 'load-path (directory-file-name
(or (file-name-directory #$) (car load-path))))
;;;### (autoloads nil "dired-rainbow" "dired-rainbow.el" (0 0 0 0))
;;; Generated autoloads from dired-rainbow.el
(register-definition-prefixes "dired-rainbow" '("dired-rainbow-"))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; coding: utf-8
;; End:
;;; dired-rainbow-autoloads.el ends here

View file

@ -1,2 +0,0 @@
;;; Generated package description from dired-rainbow.el -*- no-byte-compile: t -*-
(define-package "dired-rainbow" "20221127.1247" "Extended file highlighting according to its type" '((dash "2.5.0") (dired-hacks-utils "0.0.1")) :commit "41d3eb42195d9f0894c20d18cc8e722b099aa1c1" :authors '(("Matus Goljer" . "matus.goljer@gmail.com")) :maintainer '("Matus Goljer" . "matus.goljer@gmail.com") :keywords '("files"))

View file

@ -0,0 +1,28 @@
;;; dired-rainbow-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*-
;; Generated by the `loaddefs-generate' function.
;; This file is part of GNU Emacs.
;;; Code:
(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path)))
;;; Generated autoloads from dired-rainbow.el
(register-definition-prefixes "dired-rainbow" '("dired-rainbow-"))
;;; End of scraped data
(provide 'dired-rainbow-autoloads)
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; no-native-compile: t
;; coding: utf-8-emacs-unix
;; End:
;;; dired-rainbow-autoloads.el ends here

View file

@ -0,0 +1,16 @@
(define-package "dired-rainbow" "20240629.1857" "Extended file highlighting according to its type"
'((dash "2.5.0")
(dired-hacks-utils "0.0.1")
(emacs "24"))
:commit "d1a85901c892ba7ec273995070a43cbbbe5d0b37" :authors
'(("Matus Goljer" . "matus.goljer@gmail.com"))
:maintainers
'(("Matus Goljer" . "matus.goljer@gmail.com"))
:maintainer
'("Matus Goljer" . "matus.goljer@gmail.com")
:keywords
'("files")
:url "https://github.com/Fuco1/dired-hacks")
;; Local Variables:
;; no-byte-compile: t
;; End:

View file

@ -5,12 +5,10 @@
;; Author: Matus Goljer <matus.goljer@gmail.com>
;; Maintainer: Matus Goljer <matus.goljer@gmail.com>
;; Keywords: files
;; Package-Commit: 41d3eb42195d9f0894c20d18cc8e722b099aa1c1
;; Package-Version: 20221127.1247
;; Package-X-Original-Version: 20170922.817
;; Version: 0.0.3
;; Created: 16th February 2014
;; Package-Requires: ((dash "2.5.0") (dired-hacks-utils "0.0.1"))
;; Package-Requires: ((dash "2.5.0") (dired-hacks-utils "0.0.1") (emacs "24"))
;; URL: https://github.com/Fuco1/dired-hacks
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by

View file

@ -1,9 +0,0 @@
(define-package "dockerfile-mode" "20240318.24" "Major mode for editing Docker's Dockerfiles"
'((emacs "24")
(s "1.2.0"))
:commit "f6196726342b44081933597a343805db6366e7ac" :keywords
'("docker" "languages" "processes" "tools")
:url "https://github.com/spotify/dockerfile-mode")
;; Local Variables:
;; no-byte-compile: t
;; End:

View file

@ -0,0 +1,8 @@
(define-package "dockerfile-mode" "20240324.1010" "Major mode for editing Docker's Dockerfiles"
'((emacs "24"))
:commit "39a012a27fcf6fb629c447d13b6974baf906714c" :keywords
'("docker" "languages" "processes" "tools")
:url "https://github.com/spotify/dockerfile-mode")
;; Local Variables:
;; no-byte-compile: t
;; End:

View file

@ -1,7 +1,7 @@
;;; dockerfile-mode.el --- Major mode for editing Docker's Dockerfiles -*- lexical-binding: t -*-
;; Copyright (c) 2013 Spotify AB
;; Package-Requires: ((emacs "24") (s "1.2.0"))
;; Package-Requires: ((emacs "24"))
;; Homepage: https://github.com/spotify/dockerfile-mode
;; URL: https://github.com/spotify/dockerfile-mode
;; Version: 1.7
@ -29,7 +29,6 @@
(require 'sh-script)
(require 'rx)
(require 's)
(declare-function cygwin-convert-file-name-to-windows "cygw32.c" (file &optional absolute-p))
@ -166,7 +165,7 @@ by `dockerfile-enable-auto-indent'."
(defun dockerfile-build-arg-string ()
"Create a --build-arg string for each element in `dockerfile-build-args'."
(mapconcat (lambda (arg) (concat "--build-arg=" (s-replace "\\=" "=" (shell-quote-argument arg))))
(mapconcat (lambda (arg) (concat "--build-arg=" (replace-regexp-in-string "\\\\=" "=" (shell-quote-argument arg))))
dockerfile-build-args " "))
(defun dockerfile-standard-filename (file)

View file

@ -0,0 +1,68 @@
;;; focus-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*-
;; Generated by the `loaddefs-generate' function.
;; This file is part of GNU Emacs.
;;; Code:
(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path)))
;;; Generated autoloads from focus.el
(autoload 'focus-mode "focus" "\
Dim the font color of text in surrounding sections.
This is a minor mode. If called interactively, toggle the `Focus
mode' mode. If the prefix argument is positive, enable the mode,
and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable
the mode if ARG is nil, omitted, or is a positive number.
Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `focus-mode'.
The mode's hook is called both when the mode is enabled and when
it is disabled.
\\{focus-mode-map}
(fn &optional ARG)" t)
(autoload 'focus-read-only-mode "focus" "\
A read-only mode optimized for `focus-mode'.
This is a minor mode. If called interactively, toggle the
`Focus-Read-Only mode' mode. If the prefix argument is positive,
enable the mode, and if it is zero or negative, disable the mode.
If called from Lisp, toggle the mode if ARG is `toggle'. Enable
the mode if ARG is nil, omitted, or is a positive number.
Disable the mode if ARG is a negative number.
To check whether the minor mode is enabled in the current buffer,
evaluate `focus-read-only-mode'.
The mode's hook is called both when the mode is enabled and when
it is disabled.
\\{focus-read-only-mode-map}
(fn &optional ARG)" t)
(register-definition-prefixes "focus" '("focus-"))
;;; End of scraped data
(provide 'focus-autoloads)
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; no-native-compile: t
;; coding: utf-8-emacs-unix
;; End:
;;; focus-autoloads.el ends here

View file

@ -0,0 +1,13 @@
(define-package "focus" "20240528.901" "Dim the font color of text in surrounding sections"
'((emacs "24.3")
(cl-lib "0.5"))
:commit "17c471544f540f2cf9a05fd6cd87e52e5de317e2" :authors
'(("Lars Tveito" . "larstvei@ifi.uio.no"))
:maintainers
'(("Lars Tveito" . "larstvei@ifi.uio.no"))
:maintainer
'("Lars Tveito" . "larstvei@ifi.uio.no")
:url "http://github.com/larstvei/Focus")
;; Local Variables:
;; no-byte-compile: t
;; End:

View file

@ -0,0 +1,329 @@
;;; focus.el --- Dim the font color of text in surrounding sections -*- lexical-binding: t; -*-
;; Copyright (C) 2015 Lars Tveito
;; Author: Lars Tveito <larstvei@ifi.uio.no>
;; URL: http://github.com/larstvei/Focus
;; Created: 11th May 2015
;; Version: 1.0.1
;; Package-Requires: ((emacs "24.3") (cl-lib "0.5"))
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program 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 General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Focus provides `focus-mode` that dims the text of surrounding sections,
;; similar to [iA Writer's](https://ia.net/writer) Focus Mode.
;;
;; Enable the mode with `M-x focus-mode'.
;;; Code:
(require 'cl-lib)
(require 'thingatpt)
(defgroup focus ()
"Dim the font color of text in surrounding sections."
:group 'font-lock
:prefix "focus-")
(defcustom focus-mode-to-thing '((prog-mode . defun)
(text-mode . paragraph)
(org-mode . org-element))
"An associated list between mode and thing.
A thing is defined in thingatpt.el; the thing determines the
narrowness of the focused section.
Note that the order of the list matters. The first mode that the
current mode is derived from is used, so more modes that have
many derivatives should be placed by the end of the list.
Things that are defined include `symbol', `list', `sexp',
`defun', `filename', `url', `email', `word', `sentence',
`whitespace', `line', and `page'.
In order for changes to take effect, reenable `focus-mode'."
:type '(alist :key-type symbol :valye-type symbol)
:group 'focus)
(defcustom focus-read-only-blink-seconds 1
"The duration of a cursor blink in `focus-read-only-mode'."
:type 'number
:group 'focus)
(defcustom focus-update-idle-delay nil
"Delay (in seconds) before updating the focus after each command.
The default value of nil results in an immediate update.
Increase this value if you experience performance issues."
:type '(choice (const :tag "Immediate update" nil)
(const :tag "Delayed update (0.1s)" 0.1)
(number :tag "Custom delay"))
:group 'focus)
(defface focus-unfocused
'((t :inherit shadow))
"The face that overlays the unfocused area."
:group 'focus)
(defface focus-focused nil
"The face that overlays the focused area."
:group 'focus)
(defvar focus-cursor-type cursor-type
"Used to restore the users `cursor-type'.")
(defvar-local focus-current-thing nil
"Overrides the choice of thing dictated by `focus-mode-to-thing' if set.")
(defvar-local focus-current-thing-cache nil
"Caches the current thing to focus.")
(defvar-local focus-buffer nil
"Local reference to the buffer focus functions operate on.")
(defvar-local focus-pre-overlay nil
"The overlay that dims the text prior to the current-point.")
(defvar-local focus-mid-overlay nil
"The overlay that surrounds the text of the current-point.")
(defvar-local focus-post-overlay nil
"The overlay that dims the text past the current-point.")
(defvar-local focus-read-only-blink-timer nil
"Timer started from `focus-read-only-cursor-blink'.
The timer calls `focus-read-only-hide-cursor' after
`focus-read-only-blink-seconds' seconds.")
(defvar-local focus-update-timer nil
"Timer started from `focus-update'")
(defun focus-get-thing ()
"Return the current thing, based on `focus-mode-to-thing'.
This also sets `focus-current-thing-cache' to the current thing."
(or focus-current-thing
focus-current-thing-cache
(setq focus-current-thing-cache
(let* ((modes (mapcar 'car focus-mode-to-thing))
(mode (or (cl-find major-mode modes)
(apply #'derived-mode-p modes))))
(if mode (cdr (assoc mode focus-mode-to-thing)) 'sentence)))))
(defun focus-bounds ()
"Return the current bounds, based on `focus-get-thing'."
(let ((thing (focus-get-thing)))
(cond ((eq thing 'org-element)
(let* ((elem (org-element-at-point))
(beg (org-element-property :begin elem))
(end (org-element-property :end elem)))
(cons beg end)))
(t (bounds-of-thing-at-point thing)))))
(defun focus-move-focus (buffer)
"Move the focused section according to `focus-bounds'.
If `focus-mode' is enabled, this command fires after each
command."
(with-current-buffer buffer
(setq focus-update-timer nil)
(let* ((bounds (focus-bounds)))
(when bounds
(focus-move-overlays (car bounds) (cdr bounds))))))
(defun focus-update ()
"Trigger an update of the focus.
When `focus-update-idle-delay' is non-nil, start update after the
specified idle delay."
(if focus-update-idle-delay
(unless focus-update-timer
(setq focus-update-timer
(run-with-idle-timer focus-update-idle-delay nil
#'focus-move-focus focus-buffer)))
(focus-move-focus focus-buffer)))
(defun focus-move-overlays (low high)
"Move the overlays to highlight the region between LOW and HIGH."
(move-overlay focus-pre-overlay (point-min) low)
(move-overlay focus-mid-overlay low high)
(move-overlay focus-post-overlay high (point-max)))
(defun focus-init ()
"This function is run when command `focus-mode' is enabled.
It sets the `focus-pre-overlay', `focus-min-overlay', and
`focus-post-overlay' to overlays; these are invisible until
`focus-update' is run. It adds `focus-update' to
`post-command-hook'."
(unless (or focus-pre-overlay focus-post-overlay)
(setq focus-pre-overlay (make-overlay (point-min) (point-min))
focus-mid-overlay (make-overlay (point-min) (point-max))
focus-post-overlay (make-overlay (point-max) (point-max))
focus-buffer (current-buffer))
(overlay-put focus-mid-overlay 'face 'focus-focused)
(mapc (lambda (o) (overlay-put o 'face 'focus-unfocused))
(list focus-pre-overlay focus-post-overlay))
(setq focus-current-thing-cache nil
focus-update-timer nil)
(add-hook 'post-command-hook 'focus-update nil t)
(add-hook 'change-major-mode-hook 'focus-terminate nil t)))
(defun focus-terminate ()
"This function is run when command `focus-mode' is disabled.
The overlays pointed to by `focus-pre-overlay',
`focus-mid-overlay' and `focus-post-overlay' are deleted, and
`focus-update' is removed from `post-command-hook'."
(when (and focus-pre-overlay focus-post-overlay)
(mapc 'delete-overlay
(list focus-pre-overlay focus-mid-overlay focus-post-overlay))
(remove-hook 'post-command-hook 'focus-update t)
(when focus-update-timer
(cancel-timer focus-update-timer))
(setq focus-current-thing-cache nil
focus-update-timer nil
focus-pre-overlay nil
focus-mid-overlay nil
focus-post-overlay nil)))
(defun focus-goto-thing (bounds)
"Move point to the middle of BOUNDS."
(when bounds
(goto-char (/ (+ (car bounds) (cdr bounds)) 2))
(recenter nil)))
(defun focus-change-thing ()
"Adjust the narrowness of the focused section for the current buffer.
The variable `focus-mode-to-thing' dictates the default thing
according to major-mode. If `focus-current-thing' is set, this
default is overwritten. This function simply helps set the
`focus-current-thing'."
(interactive)
(let* ((candidates '(defun line list org-element paragraph sentence sexp symbol word))
(thing (completing-read "Thing: " candidates)))
(setq focus-current-thing (intern thing))))
(defun focus-pin ()
"Pin the focused section to its current location or the region, if active."
(interactive)
(when (bound-and-true-p focus-mode)
(when (region-active-p)
(focus-move-overlays (region-beginning) (region-end)))
(when focus-update-timer
(cancel-timer focus-update-timer))
(setq focus-update-timer nil)
(remove-hook 'post-command-hook 'focus-update t)))
(defun focus-unpin ()
"Unpin the focused section."
(interactive)
(when (bound-and-true-p focus-mode)
(add-hook 'post-command-hook 'focus-update nil t)))
(defun focus-next-thing (&optional n)
"Move the point to the middle of the Nth next thing."
(interactive "p")
(let ((current-bounds (focus-bounds))
(thing (focus-get-thing)))
(forward-thing thing n)
(when (equal current-bounds (focus-bounds))
(forward-thing thing (cl-signum n)))
(focus-goto-thing (focus-bounds))))
(defun focus-prev-thing (&optional n)
"Move the point to the middle of the Nth previous thing."
(interactive "p")
(focus-next-thing (- n)))
(defun focus-read-only-hide-cursor ()
"Hide the cursor.
This function is triggered by the `focus-read-only-blink-timer',
when `focus-read-only-mode' is activated."
(with-current-buffer focus-buffer
(when (and (bound-and-true-p focus-read-only-mode)
(not (null focus-read-only-blink-timer)))
(setq focus-read-only-blink-timer nil)
(setq cursor-type nil))))
(defun focus-read-only-cursor-blink ()
"Make the cursor visible for `focus-read-only-blink-seconds'.
This is added to the `pre-command-hook' when
`focus-read-only-mode' is active."
(with-current-buffer focus-buffer
(when (and (bound-and-true-p focus-read-only-mode)
(not (member last-command '(focus-next-thing focus-prev-thing))))
(when focus-read-only-blink-timer (cancel-timer focus-read-only-blink-timer))
(setq cursor-type focus-cursor-type)
(setq focus-read-only-blink-timer
(run-at-time focus-read-only-blink-seconds nil
'focus-read-only-hide-cursor)))))
(defun focus-read-only-init ()
"Run when `focus-read-only-mode' is activated.
Enables `read-only-mode', hides the cursor and adds
`focus-read-only-cursor-blink' to `pre-command-hook'.
Also `focus-read-only-terminate' is added to the `kill-buffer-hook'."
(read-only-mode 1)
(setq cursor-type nil
focus-buffer (current-buffer))
(add-hook 'pre-command-hook 'focus-read-only-cursor-blink nil t)
(add-hook 'kill-buffer-hook 'focus-read-only-terminate nil t))
(defun focus-read-only-terminate ()
"Run when `focus-read-only-mode' is deactivated.
Disables `read-only-mode' and shows the cursor again.
It cleans up the `focus-read-only-blink-timer' and hooks."
(read-only-mode -1)
(setq cursor-type focus-cursor-type)
(when focus-read-only-blink-timer
(cancel-timer focus-read-only-blink-timer))
(setq focus-read-only-blink-timer nil)
(remove-hook 'pre-command-hook 'focus-read-only-cursor-blink t)
(remove-hook 'kill-buffer-hook 'focus-read-only-terminate t))
(defun focus-turn-off-focus-read-only-mode ()
"Turn off `focus-read-only-mode'."
(interactive)
(focus-read-only-mode -1))
;;;###autoload
(define-minor-mode focus-mode
"Dim the font color of text in surrounding sections."
:init-value nil
:keymap (let ((map (make-sparse-keymap)))
(define-key map (kbd "C-c C-q") 'focus-read-only-mode)
map)
(if focus-mode (focus-init) (focus-terminate)))
;;;###autoload
(define-minor-mode focus-read-only-mode
"A read-only mode optimized for `focus-mode'."
:init-value nil
:keymap (let ((map (make-sparse-keymap)))
(define-key map (kbd "n") 'focus-next-thing)
(define-key map (kbd "SPC") 'focus-next-thing)
(define-key map (kbd "p") 'focus-prev-thing)
(define-key map (kbd "S-SPC") 'focus-prev-thing)
(define-key map (kbd "i") 'focus-turn-off-focus-read-only-mode)
(define-key map (kbd "q") 'focus-turn-off-focus-read-only-mode)
map)
(when cursor-type
(setq focus-cursor-type cursor-type))
(if focus-read-only-mode (focus-read-only-init) (focus-read-only-terminate)))
(provide 'focus)
;;; focus.el ends here

View file

@ -0,0 +1,115 @@
;;; go-mode-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*-
;; Generated by the `loaddefs-generate' function.
;; This file is part of GNU Emacs.
;;; Code:
(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path)))
;;; Generated autoloads from go-mode.el
(autoload 'go-mode "go-mode" "\
Major mode for editing Go source text.
This mode provides (not just) basic editing capabilities for
working with Go code. It offers almost complete syntax
highlighting, indentation that is almost identical to gofmt and
proper parsing of the buffer content to allow features such as
navigation by function, manipulation of comments or detection of
strings.
In addition to these core features, it offers various features to
help with writing Go code. You can directly run buffer content
through gofmt, read godoc documentation from within Emacs, modify
and clean up the list of package imports or interact with the
Playground (uploading and downloading pastes).
The following extra functions are defined:
- `gofmt'
- `godoc' and `godoc-at-point'
- `go-import-add'
- `go-goto-arguments'
- `go-goto-docstring'
- `go-goto-function'
- `go-goto-function-name'
- `go-goto-imports'
- `go-goto-return-values'
- `go-goto-method-receiver'
- `go-play-buffer' and `go-play-region'
- `go-download-play'
- `godef-describe' and `godef-jump'
- `go-coverage'
If you want to automatically run `gofmt' before saving a file,
add the following hook to your Emacs configuration:
(add-hook 'before-save-hook #'gofmt-before-save)
If you want to use `godef-jump' instead of etags (or similar),
consider binding godef-jump to `M-.', which is the default key
for `find-tag':
(add-hook 'go-mode-hook (lambda ()
(local-set-key (kbd \"M-.\") #'godef-jump)))
Please note that godef is an external dependency. You can install
it with
go get github.com/rogpeppe/godef
If you're looking for even more integration with Go, namely
on-the-fly syntax checking, auto-completion and snippets, it is
recommended that you look at flycheck
(see URL `https://github.com/flycheck/flycheck') or flymake in combination
with goflymake (see URL `https://github.com/dougm/goflymake'), gocode
(see URL `https://github.com/nsf/gocode'), go-eldoc
(see URL `github.com/syohex/emacs-go-eldoc') and yasnippet-go
(see URL `https://github.com/dominikh/yasnippet-go')
(fn)" t)
(add-to-list 'auto-mode-alist (cons "\\.go\\'" 'go-mode))
(autoload 'gofmt-before-save "go-mode" "\
Add this to .emacs to run gofmt on the current buffer when saving:
(add-hook 'before-save-hook 'gofmt-before-save).
Note that this will cause go-mode to get loaded the first time
you save any file, kind of defeating the point of autoloading." t)
(autoload 'godoc "go-mode" "\
Show Go documentation for QUERY, much like \\<go-mode-map>\\[man].
(fn QUERY)" t)
(autoload 'go-download-play "go-mode" "\
Download a paste from the playground and insert it in a Go buffer.
Tries to look for a URL at point.
(fn URL)" t)
(autoload 'go-dot-mod-mode "go-mode" "\
A major mode for editing go.mod files.
(fn)" t)
(add-to-list 'auto-mode-alist '("go\\.mod\\'" . go-dot-mod-mode))
(autoload 'go-dot-work-mode "go-mode" "\
A major mode for editor go.work files.
(fn)" t)
(add-to-list 'auto-mode-alist '("go\\.work\\'" . go-dot-work-mode))
(register-definition-prefixes "go-mode" '("go-" "god" "gofmt"))
;;; End of scraped data
(provide 'go-mode-autoloads)
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; no-native-compile: t
;; coding: utf-8-emacs-unix
;; End:
;;; go-mode-autoloads.el ends here

View file

@ -0,0 +1,8 @@
(define-package "go-mode" "20240620.1948" "Major mode for the Go programming language"
'((emacs "26.1"))
:commit "636d36e37a0d2b6adb2e12d802ff4794ccbba336" :keywords
'("languages" "go")
:url "https://github.com/dominikh/go-mode.el")
;; Local Variables:
;; no-byte-compile: t
;; End:

File diff suppressed because it is too large Load diff

View file

@ -156,27 +156,37 @@ fi
cat > $CONF_FILE <<EOF
(setq initial-scratch-message (concat initial-scratch-message
";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\\n\
(setq initial-scratch-message
";; This buffer is for text that is not saved, and for Lisp evaluation.\\n\
;; You can hit \`C-j' at end of a lisp expression to eval it.\\n\\n\
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\\n\
;; This Emacs is Powered by \`HELM' using\\n\
;; emacs program \"$EMACS\".\\n\
;; This is a minimal \`helm' configuration to discover \`helm' or debug it.\\n\
;; You can retrieve this minimal configuration in \"$CONF_FILE\".\\n\
;;
;; Some original Emacs commands are replaced by their \`helm' counterparts:\\n\\n\
;; - \`find-file'(C-x C-f) =>\`helm-find-files'\\n\
;; - \`occur'(M-s o) =>\`helm-occur'\\n\
;; - \`list-buffers'(C-x C-b) =>\`helm-buffers-list'\\n\
;; - \`completion-at-point'(M-tab) =>\`helm-lisp-completion-at-point'[1]\\n\
;; - \`apropos-command'(C-h a) =>\`helm-apropos'\\n\
;; - \`dabbrev-expand'(M-/) =>\`helm-dabbrev'\\n\
;; - \`execute-extended-command'(M-x) =>\`helm-M-x'\\n\\n
;; Some other Emacs commands are \"helmized\" by \`helm-mode'.\\n\
;; [1] Coming with emacs-24.4, \`completion-at-point' is \"helmized\" by \`helm-mode'\\n\
;; \`helm-mode' is enabled which mean that most Emacs commands using completion\\n\
;; will use helm.\\n\
;; which provides Helm completion in many places like \`shell-mode'.\\n\
;; Find context help for most Helm commands with \`C-h m'.\\n\
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\\n\\n"))
;; To start editing a file or to create a new file, visit it with \`C-x C-f'\\n\
;; and enter text in its buffer, to save your changes hit \`C-x C-s'.
;; Find context help for most Helm commands with \`C-h m' while helm is running.\\n\
;; You can also retrieve the whole user documentation with \`C-x c h h'.\\n\
;; For online documentation see \`https://github.com/emacs-helm/helm/wiki'.\\n\
;; \(Put cursor on url, hit \`C-x C-f' and then RETurn).\\n\
;; To quit this Emacs, hit \'C-x C-c'.\\n\
;; Note about keybindings in Emacs: \`C-' means \'Control-' and \`M-' \'Alt-'.\\n\
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\\n\\n")
(setq load-path (quote $LOAD_PATH))
@ -233,7 +243,7 @@ cat > $CONF_FILE <<EOF
(setq package-load-list
(if (equal load-packages '("all"))
'(all)
(append '((helm-core t) (helm t) (async t) (popup t))
(append '((helm-core t) (helm t) (async t) (wfnames t))
(mapcar (lambda (p) (list (intern p) t)) load-packages)))))
(package-initialize))
@ -256,9 +266,6 @@ cat > $CONF_FILE <<EOF
(define-key global-map [remap dabbrev-expand] 'helm-dabbrev)
(define-key global-map [remap execute-extended-command] 'helm-M-x)
(define-key global-map [remap apropos-command] 'helm-apropos)
(unless (boundp 'completion-in-region-function)
(define-key lisp-interaction-mode-map [remap completion-at-point] 'helm-lisp-completion-at-point)
(define-key emacs-lisp-mode-map [remap completion-at-point] 'helm-lisp-completion-at-point))
(add-hook 'kill-emacs-hook #'(lambda () (and (file-exists-p "$CONF_FILE") (delete-file "$CONF_FILE"))))
EOF

View file

@ -33,6 +33,7 @@
(declare-function all-the-icons-icon-for-file"ext:all-the-icons.el")
(declare-function all-the-icons-octicon "ext:all-the-icons.el")
(declare-function all-the-icons-match-to-alist "ext:all-the-icons.el")
(declare-function all-the-icons-faicon "ext:all-the-icons.el")
(defvar all-the-icons-dir-icon-alist)
@ -65,7 +66,7 @@
Don't use `setq' to set this."
:type 'boolean
:set (lambda (var val)
(if (featurep 'all-the-icons)
(if (require 'all-the-icons nil t)
(set var val)
(set var nil))))
@ -88,6 +89,10 @@ will be honored."
helm-bookmark-default-filtered-sources)
for fn = (intern (format "%s-builder" s))
do (set s (funcall fn)))))
(defcustom helm-bookmark-annotation-sign "*"
"Boomarks with annotation are prefixed with this string."
:type 'string)
(defgroup helm-bookmark-faces nil
"Customize the appearance of helm-bookmark."
@ -250,7 +255,8 @@ will be honored."
BOOKMARK is a bookmark name or a bookmark record."
(or (eq (bookmark-get-handler bookmark) 'bmkext-jump-gnus)
(eq (bookmark-get-handler bookmark) 'gnus-summary-bookmark-jump)
(eq (bookmark-get-handler bookmark) 'bookmarkp-jump-gnus)))
(eq (bookmark-get-handler bookmark) 'bookmarkp-jump-gnus)
(eq (bookmark-get-handler bookmark) 'bmkp-jump-gnus)))
(defun helm-bookmark-mu4e-bookmark-p (bookmark)
"Return non nil if BOOKMARK is a mu4e bookmark.
@ -263,21 +269,24 @@ BOOKMARK is a bookmark name or a bookmark record."
BOOKMARK is a bookmark name or a bookmark record."
(or (eq (bookmark-get-handler bookmark) 'bmkext-jump-w3m)
(eq (bookmark-get-handler bookmark) 'bookmark-w3m-bookmark-jump)
(eq (bookmark-get-handler bookmark) 'bookmarkp-jump-w3m)))
(eq (bookmark-get-handler bookmark) 'bookmarkp-jump-w3m)
(eq (bookmark-get-handler bookmark) 'bmkp-jump-w3m)))
(defun helm-bookmark-woman-bookmark-p (bookmark)
"Return non-nil if BOOKMARK is a Woman bookmark.
BOOKMARK is a bookmark name or a bookmark record."
(or (eq (bookmark-get-handler bookmark) 'bmkext-jump-woman)
(eq (bookmark-get-handler bookmark) 'woman-bookmark-jump)
(eq (bookmark-get-handler bookmark) 'bookmarkp-jump-woman)))
(eq (bookmark-get-handler bookmark) 'bookmarkp-jump-woman)
(eq (bookmark-get-handler bookmark) 'bmkp-jump-woman)))
(defun helm-bookmark-man-bookmark-p (bookmark)
"Return non-nil if BOOKMARK is a Man bookmark.
BOOKMARK is a bookmark name or a bookmark record."
(or (eq (bookmark-get-handler bookmark) 'bmkext-jump-man)
(eq (bookmark-get-handler bookmark) 'Man-bookmark-jump)
(eq (bookmark-get-handler bookmark) 'bookmarkp-jump-man)))
(eq (bookmark-get-handler bookmark) 'bookmarkp-jump-man)
(eq (bookmark-get-handler bookmark) 'bmkp-jump-man)))
(defun helm-bookmark-woman-man-bookmark-p (bookmark)
"Return non-nil if BOOKMARK is a Man or Woman bookmark.
@ -302,7 +311,10 @@ BOOKMARK is a bookmark name or a bookmark record.
This excludes bookmarks of a more specific kind (Info, Gnus, and W3m)."
(let* ((filename (bookmark-get-filename bookmark))
(isnonfile (equal filename helm-bookmark--non-file-filename)))
(and filename (not isnonfile) (not (bookmark-get-handler bookmark)))))
(and filename
(not isnonfile)
(not (helm-bookmark-org-file-p bookmark))
(not (bookmark-get-handler bookmark)))))
(defun helm-bookmark-org-file-p (bookmark)
(let* ((filename (bookmark-get-filename bookmark)))
@ -388,6 +400,10 @@ If `browse-url-browser-function' is set to something else than
(defalias 'bookmarkp-jump-w3m #'helm-bookmark-jump-w3m)
(defalias 'bookmarkp-jump-woman #'woman-bookmark-jump)
(defalias 'bookmarkp-jump-man #'Man-bookmark-jump)
(defalias 'bmkp-jump-gnus #'gnus-summary-bookmark-jump)
(defalias 'bmkp-jump-w3m #'helm-bookmark-jump-w3m)
(defalias 'bmkp-jump-woman #'woman-bookmark-jump)
(defalias 'bmkp-jump-man #'Man-bookmark-jump)
;;;; Filtered bookmark sources
@ -619,15 +635,17 @@ If `browse-url-browser-function' is set to something else than
all-the-icons-dir-icon-alist))
(apply (car it) (cdr it))
(all-the-icons-octicon "file-directory")))
(isw3m (all-the-icons-faicon "firefox"))
((and isfile isinfo) (all-the-icons-octicon "info"))
(isfile (all-the-icons-icon-for-file isfile))
((or iswoman isman)
(all-the-icons-fileicon "man-page"))
((or isgnus ismu4e)
(all-the-icons-octicon "mail-read"))))
(all-the-icons-octicon "mail-read"))
(isfile (all-the-icons-icon-for-file (helm-basename isfile)))))
;; Add a * if bookmark have annotation
if (and isannotation (not (string-equal isannotation "")))
do (setq trunc (concat "*" (if helm-bookmark-show-location trunc i)))
do (setq trunc (concat helm-bookmark-annotation-sign
(if helm-bookmark-show-location trunc i)))
for sep = (and helm-bookmark-show-location
(make-string (- (+ bookmark-bmenu-file-column 2)
(string-width trunc))
@ -749,32 +767,43 @@ renamed."
(setq bookmark-alist-modification-count (1+ bookmark-alist-modification-count))
(when (bookmark-time-to-save-p) (bookmark-save)))
(defun helm-bookmark-rename (old &optional new batch)
(defun helm-bookmark-rename (old &optional new _batch)
"Change bookmark's name from OLD to NEW.
Interactively:
If called from the keyboard, then prompt for OLD.
If called from the menubar, select OLD from a menu.
If NEW is nil, then prompt for its string value.
If BATCH is non-nil, then do not rebuild the menu list.
Unused arg _BATCH is kept for backward compatibility.
While the user enters the new name, repeated `C-w' inserts
consecutive words from the buffer into the new bookmark name."
(interactive (list (bookmark-completing-read "Old bookmark name")))
(bookmark-maybe-historicize-string old)
(bookmark-maybe-load-default-file)
(save-excursion (skip-chars-forward " ") (setq bookmark-yank-point (point)))
(save-excursion
(skip-chars-forward " ") (setq bookmark-yank-point (point)))
(setq bookmark-current-buffer (current-buffer))
(let ((newname (or new (read-from-minibuffer
"New name: " nil
(catch 'skip
(let ((newname
(or new (read-from-minibuffer
;; `format-prompt' is not available in old Emacs.
(format "New name [C-RET to skip] (default %s): " old) nil
(let ((now-map (copy-keymap minibuffer-local-map)))
(define-key now-map "\C-w" #'bookmark-yank-word)
(define-key now-map (kbd "C-<return>")
#'(lambda () (interactive) (throw 'skip 'skip)))
now-map)
nil 'bookmark-history))))
nil 'bookmark-history old))))
(bookmark-set-name old newname)
(setq bookmark-current-bookmark newname)
(unless batch (bookmark-bmenu-surreptitiously-rebuild-list))
(helm-bookmark-maybe-save-bookmark) newname))
(helm-bookmark-maybe-save-bookmark) newname)))
(defun helm-bookmark-rename-marked (_candidate)
"Rename marked bookmarks."
(let* ((bmks (helm-marked-candidates))
(count 0)
(len (length bmks)))
(cl-loop for bmk in bmks
unless (eq (helm-bookmark-rename bmk) 'skip)
do (cl-incf count))
(message "(%s/%s) bookmark(s) renamed" count len)))
(helm-make-command-from-action helm-bookmark-run-edit
"Run `helm-bookmark-edit-bookmark' from keyboard."
@ -808,7 +837,65 @@ E.g. prepended with *."
(dolist (i (helm-marked-candidates))
(bookmark-delete (helm-bookmark-get-bookmark-from-name i)
'batch)))
;;; bookmark annotations
;;
(defun helm-bookmark-show-annotation (bookmark-name-or-record)
"Display the annotation for BOOKMARK-NAME-OR-RECORD in a buffer."
(let ((annotation (bookmark-get-annotation bookmark-name-or-record)))
(when (and annotation (not (string-equal annotation "")))
(let ((buf (get-buffer-create "*Bookmark Annotation*")))
(with-current-buffer buf
(let ((inhibit-read-only t))
(erase-buffer)
(insert annotation)
(goto-char (point-min))
(set-buffer-modified-p nil)
(helm-bookmark-annotation-mode)
(insert (substitute-command-keys
"# Edit this buffer with \\[helm-bookmark-edit-annotation]")
(substitute-command-keys
"\n# Quit this buffer with \\[helm-bookmark-quit-annotation]\n"))
(set (make-local-variable 'bookmark-annotation-name)
bookmark-name-or-record)
(put 'bookmark-annotation-name 'permanent-local t)))
(pop-to-buffer buf)))))
(defun helm-bookmark-edit-annotation ()
"Edit bookmark annotation from the show annotation buffer."
(interactive)
(setq buffer-read-only nil)
(bookmark-edit-annotation-mode)
(save-excursion
(goto-char (point-min))
(delete-region
(point) (save-excursion (forward-line 2) (point)))
(insert (funcall bookmark-edit-annotation-text-func
bookmark-annotation-name))))
(put 'helm-bookmark-edit-annotation 'no-helm-mx t)
(defun helm-bookmark-quit-annotation ()
"Quit bookmark annotation buffer."
(interactive)
(quit-window t))
(put 'helm-bookmark-quit-annotation 'no-helm-mx t)
(defvar helm-bookmark-annotation-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map text-mode-map)
(define-key map (kbd "q") #'helm-bookmark-quit-annotation)
(define-key map (kbd "e") #'helm-bookmark-edit-annotation)
map)
"Map used in show annotation bookmark buffer.")
(define-derived-mode helm-bookmark-annotation-mode
text-mode "helm-annotation-mode"
"Mode to display bookmark annotations.
Special commands:
\\{helm-bookmark-annotation-mode-map}"
:interactive nil
(setq-local buffer-read-only t))
;;;###autoload
(defun helm-bookmarks ()
@ -818,7 +905,7 @@ E.g. prepended with *."
helm-source-bookmark-set)
:buffer "*helm bookmarks*"
:default (buffer-name helm-current-buffer)))
;;;###autoload
(defun helm-filtered-bookmarks ()
"Preconfigured `helm' for bookmarks (filtered by category).

View file

@ -36,6 +36,7 @@
(defvar dired-buffers)
(defvar org-directory)
(defvar helm-ff-default-directory)
(defvar major-mode-remap-alist)
(defgroup helm-buffers nil
@ -100,7 +101,10 @@ When adding a source here it is up to you to ensure the library
of this source is accessible and properly loaded."
:type '(repeat (choice symbol)))
(defcustom helm-buffers-end-truncated-string "..."
(defcustom helm-buffers-end-truncated-string
;; `truncate-string-ellipsis', the function is not available in 27.1
;; See issue#2673.
(if (char-displayable-p ?…) "" "...")
"The string to display at end of truncated buffer names."
:type 'string)
@ -148,7 +152,7 @@ you want to keep the recentest order when narrowing candidates."
Don't use `setq' to set this."
:type 'boolean
:set (lambda (var val)
(if (featurep 'all-the-icons)
(if (require 'all-the-icons nil t)
(set var val)
(set var nil))))
@ -335,6 +339,9 @@ Note that this variable is buffer-local.")
when (string-match r candidate)
return m)))
(buffer (get-buffer-create candidate)))
(helm-aif (and (boundp 'major-mode-remap-alist)
(cdr (assq mjm major-mode-remap-alist)))
(setq mjm it))
(if mjm
(with-current-buffer buffer (funcall mjm))
(set-buffer-major-mode buffer))
@ -379,7 +386,7 @@ Note that this variable is buffer-local.")
(defun helm-buffers-get-visible-buffers ()
"Returns buffers visibles on current frame."
"Returns buffers visible on visible frames."
(let (result)
(walk-windows
(lambda (x)
@ -388,6 +395,7 @@ Note that this variable is buffer-local.")
result))
(defun helm-buffer-list-1 (&optional visibles)
"Return list of all buffers except VISIBLES buffers."
(cl-loop for b in (buffer-list)
for bn = (buffer-name b)
unless (member bn visibles)
@ -431,7 +439,7 @@ The list is reordered with `helm-buffer-list-reorder-fn'."
(cond ((eq type 'dired)
(all-the-icons-octicon "file-directory"))
(buf-fname
(all-the-icons-icon-for-file buf-fname))
(all-the-icons-icon-for-file buf-name))
(t (all-the-icons-octicon "star" :v-adjust 0.0))))))
(buf-name (propertize buf-name 'face face1
'help-echo help-echo
@ -452,7 +460,7 @@ The list is reordered with `helm-buffer-list-reorder-fn'."
(format "(%s %s in `%s')"
(process-name proc)
(process-status proc) dir)
(format "(in `%s')" dir))
(format "`%s'" dir))
'face face2)))))
(defun helm-buffer--format-mode-name (buf)
@ -1002,12 +1010,14 @@ vertically."
(defun helm-buffers-persistent-kill (_buffer)
(let ((marked (helm-marked-candidates))
(sel (helm-get-selection)))
(sel (helm-get-selection))
(msg "Buffer `%s' modified, please save it before kill"))
(unwind-protect
(cl-loop for b in marked
do (progn
do (if (and (buffer-file-name b) (buffer-modified-p b))
(message msg (buffer-name b))
;; We need to preselect each marked because
;; helm-buffers-persistent-kill is deleting
;; helm-buffers-persistent-kill-1 is deleting
;; current selection.
(helm-preselect
(format "^%s"
@ -1025,7 +1035,7 @@ vertically."
(if (or (helm-follow-mode-p)
(eql current (get-buffer helm-current-buffer))
(not (eql current (get-buffer candidate))))
(switch-to-buffer candidate)
(display-buffer candidate)
(if (and helm-persistent-action-display-window
(window-dedicated-p
(next-window helm-persistent-action-display-window 1)))
@ -1110,19 +1120,18 @@ Can be used by any source that list buffers."
(cl-assert (not helm-buffers-in-project-p)
nil "You are already browsing this project"))
;;;###autoload
(defun helm-buffers-quit-and-find-file-fn (source)
(let* ((sel (helm-get-selection nil nil source))
(buf (helm-aand (bufferp sel)
(get-buffer sel)
(buffer-name it))))
(when buf
(let* ((sel (get-buffer (helm-get-selection nil nil source)))
(bname (and (bufferp sel) (buffer-name sel))))
(when bname
(or (buffer-file-name sel)
(car (rassoc buf dired-buffers))
(and (with-current-buffer buf
(car (rassoc bname dired-buffers))
(and (with-current-buffer bname
(eq major-mode 'org-agenda-mode))
org-directory
(expand-file-name org-directory))
(with-current-buffer buf
(with-current-buffer bname
(expand-file-name default-directory))))))
;;; Candidate Transformers

View file

@ -36,7 +36,7 @@
'global
(with-current-buffer (get-buffer "*Faces*")
(buffer-substring
(next-single-char-property-change (point-min) 'face)
(next-single-char-property-change (point-min) 'category)
(point-max))))
(kill-buffer "*Faces*")))

View file

@ -55,6 +55,10 @@ This value can be toggled with
\\<helm-M-x-map>\\[helm-M-x-toggle-short-doc] while in helm-M-x session."
:type 'boolean)
(defcustom helm-M-x-history-transformer-sort t
"When nil, do not sort helm-M-x's commands history."
:type 'boolean)
;;; Faces
;;
@ -134,42 +138,56 @@ Note that SORT should not be used when fuzzy matching because
fuzzy matching is running its own sort function with a different
algorithm."
(with-helm-current-buffer
(cl-loop with max-len = (when helm-M-x-show-short-doc
(helm-in-buffer-get-longest-candidate))
with local-map = (helm-M-x-current-mode-map-alist)
(cl-loop with local-map = (helm-M-x-current-mode-map-alist)
for cand in candidates
for local-key = (car (rassq cand local-map))
for key = (substitute-command-keys (format "\\[%s]" cand))
for sym = (intern (if (consp cand) (car cand) cand))
for doc = (when max-len
for doc = (when helm-M-x-show-short-doc
(helm-get-first-line-documentation (intern-soft cand)))
for disp = (if (or (eq sym major-mode)
(and (memq sym minor-mode-list)
(boundp sym)
(buffer-local-value sym helm-current-buffer)))
(buffer-local-value
sym helm-current-buffer)))
(propertize cand 'face 'helm-command-active-mode)
cand)
unless (and (null ignore-props) (or (get sym 'helm-only) (get sym 'no-helm-mx)))
unless (and (null ignore-props)
(or (get sym 'helm-only) (get sym 'no-helm-mx)
(eq sym 'helm-M-x)))
collect
(cons (cond ((and (string-match "^M-x" key) local-key)
(propertize (format "%s%s%s %s"
(propertize
(format "%s%s%s %s"
disp
(if doc (make-string (+ 1 (- max-len (length cand))) ? ) "")
(if doc (propertize doc 'face 'helm-M-x-short-doc) "")
(if doc (helm-make-separator cand) "")
(if doc
(propertize
doc 'face 'helm-M-x-short-doc)
"")
(propertize
" " 'display
(propertize local-key 'face 'helm-M-x-key)))
'match-part disp))
((string-match "^M-x" key)
(propertize (format "%s%s%s"
((and (string-match "^M-x" key)
(not (string= key "M-x")))
(propertize
(format "%s%s%s"
disp
(if doc (make-string (+ 1 (- max-len (length cand))) ? ) "")
(if doc (propertize doc 'face 'helm-M-x-short-doc) ""))
(if doc (helm-make-separator cand) "")
(if doc
(propertize
doc 'face 'helm-M-x-short-doc)
""))
'match-part disp))
(t (propertize (format "%s%s%s %s"
(t (propertize
(format "%s%s%s %s"
disp
(if doc (make-string (+ 1 (- max-len (length cand))) ? ) "")
(if doc (propertize doc 'face 'helm-M-x-short-doc) "")
(if doc (helm-make-separator cand) "")
(if doc
(propertize
doc 'face 'helm-M-x-short-doc)
"")
(propertize
" " 'display
(propertize key 'face 'helm-M-x-key)))
@ -244,7 +262,7 @@ algorithm."
(defclass helm-M-x-class (helm-source-in-buffer helm-type-command)
((requires-pattern :initform 0)
(must-match :initform t)
(filtered-candidate-transformer :initform 'helm-M-x-transformer-no-sort)
(filtered-candidate-transformer :initform #'helm-M-x-transformer)
(persistent-help :initform "Describe this command")
(help-message :initform 'helm-M-x-help-message)
(nomark :initform t)
@ -265,23 +283,19 @@ algorithm."
(defun helm-M-x-read-extended-command (collection &optional predicate history)
"Read or execute action on command name in COLLECTION or HISTORY.
When `helm-M-x-use-completion-styles' is used, Emacs
`completion-styles' mechanism is used, otherwise standard helm
completion and helm fuzzy matching are used together.
Helm completion is not provided when executing or defining kbd macros.
Helm completion is not provided when executing or defining kbd
macros.
Arg COLLECTION should be an `obarray' but can be any object
suitable for `try-completion'. Arg PREDICATE is a function that
default to `commandp' see also `try-completion'. Arg HISTORY
default to `extended-command-history'."
Arg COLLECTION should be an `obarray'.
Arg PREDICATE is a function that default to `commandp'.
Arg HISTORY default to `extended-command-history'."
(setq helm--mode-line-display-prefarg t)
(let* ((pred (or predicate #'commandp))
(helm-fuzzy-sort-fn (lambda (candidates _source)
(if helm-M-x-history-transformer-sort
;; Sort on real candidate otherwise
;; "symbol (<binding>)" is used when sorting.
(helm-fuzzy-matching-default-sort-fn-1 candidates t)))
(helm-fuzzy-matching-default-sort-fn-1 candidates t)
candidates)))
(sources `(,(helm-make-source "Emacs Commands history" 'helm-M-x-class
:data (lambda ()
(helm-comp-read-get-candidates
@ -293,6 +307,10 @@ default to `extended-command-history'."
;; Ensure using empty string to
;; not defeat helm matching fns [1]
pred nil nil ""))
:filtered-candidate-transformer
(if helm-M-x-history-transformer-sort
#'helm-M-x-transformer
#'helm-M-x-transformer-no-sort)
:fuzzy-match helm-M-x-fuzzy-match)
,(helm-make-source "Emacs Commands" 'helm-M-x-class
:data (lambda ()
@ -300,16 +318,11 @@ default to `extended-command-history'."
;; [1] Same comment as above.
collection pred nil nil ""))
:fuzzy-match helm-M-x-fuzzy-match)))
(prompt (concat (cond
((eq helm-M-x-prefix-argument '-) "- ")
((and (consp helm-M-x-prefix-argument)
(eq (car helm-M-x-prefix-argument) 4))
"C-u ")
((and (consp helm-M-x-prefix-argument)
(integerp (car helm-M-x-prefix-argument)))
(format "%d " (car helm-M-x-prefix-argument)))
((integerp helm-M-x-prefix-argument)
(format "%d " helm-M-x-prefix-argument)))
(prompt (concat (helm-acase helm-M-x-prefix-argument
(- "-")
((guard (and (consp it) (car it)))
(if (eq guard 4) "C-u " (format "%d " guard)))
((guard (integerp it)) (format "%d " it)))
"M-x ")))
(setq helm-M-x--timer (run-at-time 1 0.1 #'helm-M-x--notify-prefix-arg))
;; Fix Bug#2250, add `helm-move-selection-after-hook' which

View file

@ -54,7 +54,7 @@ Helm buffer."
(defcustom helm-dabbrev-related-buffer-fn #'helm-dabbrev--same-major-mode-p
"A function that decide if a buffer to search in its related to `current-buffer'.
This is actually determined by comparing `major-mode' of the
This is currently determined by comparing `major-mode' of the
buffer to search and the `current-buffer'.
The function take one arg, the buffer which is current, look at

View file

@ -31,7 +31,8 @@
["Recent Files" helm-recentf t]
["Locate" helm-locate t]
["Search Files with find" helm-find t]
["Bookmarks" helm-filtered-bookmarks t])
["Bookmarks" helm-filtered-bookmarks t]
["Locate library" helm-locate-library t])
("Buffers"
["Find buffers" helm-buffers-list t])
("Projects"
@ -47,8 +48,9 @@
["Emacs Manual index" helm-info-emacs t]
["Gnus Manual index" helm-info-gnus t]
["Helm documentation" helm-documentation t])
("Elpa"
["Elisp packages" helm-packages t])
("Packages"
["Elisp packages" helm-packages t]
["Finder" helm-finder t])
("Tools"
["Occur" helm-occur t]
["Grep current directory with AG" helm-do-grep-ag t]

View file

@ -33,6 +33,9 @@
(declare-function helm-comp-read "helm-mode")
(declare-function helm-M-x-transformer-no-sort-no-props "helm-command")
(defvar helm-M-x-show-short-doc)
(defvar completions-detailed)
(defvar helm-completions-detailed)
;;; Customizable values
@ -157,9 +160,9 @@ display."
;; Called each time cursor move in helm-buffer.
(defun helm-show-completion ()
(with-helm-current-buffer
(helm-aif (helm-get-selection)
(overlay-put helm-show-completion-overlay
'display (substring-no-properties
(helm-get-selection)))))
'display (substring-no-properties it)))))
(defun helm-show-completion-init-overlay (beg end)
(setq helm-show-completion-overlay (make-overlay beg end))
@ -206,6 +209,9 @@ If `helm-turn-on-show-completion' is nil do nothing."
'helm-display-function
(or helm-show-completion-display-function
'helm-default-display-buffer))
(with-helm-after-update-hook
;; Show immediately first candidate as soon as helm popup.
(helm-show-completion))
(helm-show-completion-init-overlay ,beg ,end)
,@body)
,@body)
@ -292,13 +298,10 @@ Return a cons (beg . end)."
(when (and pos (< (point) pos))
(push-mark pos t t))))
(defvar helm-lisp-completion--cache nil)
(defvar helm-lgst-len nil)
;;;###autoload
(defun helm-lisp-completion-at-point ()
"Preconfigured Helm for Lisp symbol completion at point."
(interactive)
(setq helm-lgst-len 0)
(let* ((target (helm-thing-before-point))
(beg (car (helm-bounds-of-thing-before-point)))
(end (point))
@ -311,17 +314,12 @@ Return a cons (beg . end)."
(helm-quit-if-no-candidate t)
(helm-execute-action-at-once-if-one t)
(enable-recursive-minibuffers t))
(setq helm-lisp-completion--cache (cl-loop for sym in candidates
for len = (length sym)
when (> len helm-lgst-len)
do (setq helm-lgst-len len)
collect sym))
(if candidates
(with-helm-show-completion beg end
;; Overlay is initialized now in helm-current-buffer.
(helm
:sources (helm-build-in-buffer-source "Lisp completion"
:data helm-lisp-completion--cache
:data candidates
:persistent-action `(helm-lisp-completion-persistent-action .
,(and (eq helm-elisp-help-function
'helm-elisp-show-doc-modeline)
@ -360,17 +358,17 @@ other window according to the value of
(helm-elisp-show-help "Toggle show help for the symbol")))
(defun helm-elisp--show-help-1 (candidate &optional name)
(let ((sym (intern-soft candidate)))
(pcase sym
((and (pred fboundp) (pred boundp))
(if (member name `(,helm-describe-function-function ,helm-describe-variable-function))
(funcall (intern (format "helm-%s" name)) sym)
(helm-acase (intern-soft candidate)
((guard (and (fboundp it) (boundp it)))
(if (member name `(,helm-describe-function-function
,helm-describe-variable-function))
(funcall (intern (format "helm-%s" name)) it)
;; When there is no way to know what to describe
;; prefer describe-function.
(helm-describe-function sym)))
((pred fboundp) (helm-describe-function sym))
((pred boundp) (helm-describe-variable sym))
((pred facep) (helm-describe-face sym)))))
(helm-describe-function it)))
((guard (fboundp it)) (helm-describe-function it))
((guard (boundp it)) (helm-describe-variable it))
((guard (facep it)) (helm-describe-face it))))
(defun helm-elisp-show-help (candidate &optional name)
"Show full help for the function CANDIDATE.
@ -395,15 +393,14 @@ the same time to variable and a function."
"Helm candidates transformer for Lisp completion."
(cl-loop for c in candidates
for sym = (intern c)
for annot = (pcase sym
((pred commandp) " (Com)")
((pred class-p) " (Class)")
((pred cl-generic-p) " (Gen)")
((pred fboundp) " (Fun)")
((pred boundp) " (Var)")
((pred facep) " (Face)"))
for spaces = (make-string (- helm-lgst-len (length c)) ? )
collect (cons (concat c spaces annot) c) into lst
for annot = (helm-acase sym
((guard (commandp it)) " (Com)")
((guard (class-p it)) " (Class)")
((guard (cl-generic-p it)) " (Gen)")
((guard (fboundp it)) " (Fun)")
((guard (boundp it)) " (Var)")
((guard (facep it)) " (Face)"))
collect (cons (concat c (helm-make-separator c) annot) c) into lst
finally return (sort lst #'helm-generic-sort-fn)))
;;;###autoload
@ -415,31 +412,37 @@ If SYM is not documented, return \"Not documented\".
Argument NAME allows specifiying what function to use to display
documentation when SYM name is the same for function and variable."
(let ((doc (condition-case _err
(pcase sym
((pred class-p) (cl--class-docstring (cl--find-class sym)))
((and (pred fboundp) (pred boundp))
(pcase name
("describe-function"
(documentation sym t))
("describe-variable"
(documentation-property sym 'variable-documentation t))
(_ (documentation sym t))))
((pred custom-theme-p)
(documentation-property sym 'theme-documentation t))
((pred helm-group-p) (documentation-property
sym 'group-documentation t))
((pred fboundp) (documentation sym t))
((pred boundp) (documentation-property
sym 'variable-documentation t))
((pred facep) (face-documentation sym)))
(helm-acase sym
((guard (class-p it))
(cl--class-docstring (cl--find-class it)))
((guard (and (fboundp it) (boundp it)))
(if (string= name "describe-variable")
(documentation-property it 'variable-documentation t)
(documentation it t)))
((guard (custom-theme-p it))
(documentation-property it 'theme-documentation t))
((guard (and (helm-group-p it) (not (fboundp it))))
(documentation-property it 'group-documentation t))
((guard (fboundp it))
(documentation it t))
((guard (boundp it))
(documentation-property it 'variable-documentation t))
((guard (facep it)) (face-documentation it)))
(void-function "Void function -- Not documented"))))
(if (and doc (not (string= doc ""))
;; `documentation' return "\n\n(args...)"
;; for CL-style functions.
(not (string-match-p "\\`\n\n" doc)))
;; Some commands specify key bindings in their first line.
;; Some commands specify key bindings or keymap in their first line,
;; e.g.: "\<hexl-mode-map>A mode for editing binary [...]. As a result
;; (substitute-command-keys doc) returns a string like "\nUses
;; keymap...\nFirst line docstring. See
;; <https://debbugs.gnu.org/70163>.
(truncate-string-to-width
(substitute-command-keys (car (split-string doc "\n")))
(helm-acase (split-string (substitute-command-keys doc) "\n")
((guard (and (string= (car it) "") (cdr it)))
(cadr guard))
(t (car it)))
end-column nil nil t)
(if (or (symbol-function sym) (boundp sym) (facep sym) (helm-group-p sym))
"Not documented"
@ -457,7 +460,7 @@ documentation when SYM name is the same for function and variable."
"Preconfigured Helm to complete file name at point."
(interactive)
(require 'helm-mode)
(let* ((tap (or (thing-at-point 'filename) ""))
(let* ((tap (or (thing-at-point 'filename t) ""))
beg
(init (and tap
(or force
@ -466,8 +469,7 @@ documentation when SYM name is the same for function and variable."
(search-backward tap (pos-bol) t)
(setq beg (point))
(looking-back "[^'`( ]" (1- (point)))))
(expand-file-name
(substring-no-properties tap))))
(expand-file-name tap)))
(end (point))
(helm-quit-if-no-candidate t)
(helm-execute-action-at-once-if-one t)
@ -479,6 +481,7 @@ documentation when SYM name is the same for function and variable."
(delete-region beg end) (insert (if (string-match "^~" tap)
(abbreviate-file-name completion)
completion)))))
(make-obsolete 'helm-complete-file-name-at-point 'helm-find-files "3.9.6")
;;;###autoload
(defun helm-lisp-indent ()
@ -490,20 +493,6 @@ documentation when SYM name is the same for function and variable."
tab-always-indent)))
(indent-for-tab-command current-prefix-arg)))
;;;###autoload
(defun helm-lisp-completion-or-file-name-at-point ()
"Preconfigured Helm to complete Lisp symbol or filename at point.
Filename completion happens if string start after or between a
double quote."
(interactive)
(let* ((tap (thing-at-point 'filename)))
(if (and tap (save-excursion
(end-of-line)
(search-backward tap (pos-bol) t)
(looking-back "[^'`( ]" (1- (point)))))
(helm-complete-file-name-at-point)
(helm-lisp-completion-at-point))))
;;; Apropos
;;
@ -543,18 +532,17 @@ is only used to test DEFAULT."
(defun helm-apropos-short-doc-transformer (candidates _source)
(if helm-apropos-show-short-doc
(cl-loop with max-len = (helm-in-buffer-get-longest-candidate)
for cand in candidates
(cl-loop for cand in candidates
for doc = (helm-get-first-line-documentation (intern-soft cand))
collect (cons (format "%s%s%s"
cand
(if doc
(make-string (+ 1 (if (zerop max-len)
max-len
(- max-len (string-width cand))))
? )
(helm-make-separator cand)
"")
(if doc (propertize doc 'face 'helm-M-x-short-doc) ""))
(if doc
(propertize
doc 'face 'helm-M-x-short-doc)
""))
cand))
candidates))
@ -758,23 +746,23 @@ is only used to test DEFAULT."
("Info lookup" . helm-info-lookup-symbol))))
(defun helm-info-lookup-fallback-source (candidate)
(let ((sym (helm-symbolify candidate))
src-name fn)
(cond ((class-p sym)
(setq fn #'helm-describe-function
src-name "Describe class"))
((cl-generic-p sym)
(setq fn #'helm-describe-function
src-name "Describe generic function"))
((fboundp sym)
(setq fn #'helm-describe-function
src-name "Describe function"))
((facep sym)
(setq fn #'helm-describe-face
src-name "Describe face"))
(cl-multiple-value-bind (fn src-name)
(helm-acase (helm-symbolify candidate)
((guard (class-p it))
(list #'helm-describe-function
"Describe class"))
((guard (cl-generic-p it))
(list #'helm-describe-function
"Describe generic function"))
((guard (fboundp it))
(list #'helm-describe-function
"Describe function"))
((guard (facep it))
(list #'helm-describe-face
"Describe face"))
(t
(setq fn #'helm-describe-variable
src-name "Describe variable")))
(list #'helm-describe-variable
"Describe variable")))
(helm-build-sync-source src-name
:candidates (list candidate)
:persistent-action (lambda (candidate)
@ -810,7 +798,10 @@ is only used to test DEFAULT."
(defun helm-apropos-get-default ()
(with-syntax-table emacs-lisp-mode-syntax-table
(symbol-name (intern-soft (thing-at-point 'symbol)))))
(symbol-name (intern-soft
(helm-aand (thing-at-point 'symbol t)
(replace-regexp-in-string "\\`[~=]" "" it)
(replace-regexp-in-string "[~=]\\'" "" it))))))
;;;###autoload
(defun helm-apropos (default)
@ -853,7 +844,7 @@ a string, i.e. the `symbol-name' of any existing symbol."
:persistent-help "Toggle describe function / C-u C-j: Toggle advice"))
(defun helm-advice-candidates ()
(cl-loop for (fname) in ad-advised-functions
(cl-loop for fname in ad-advised-functions
for function = (intern fname)
append
(cl-loop for class in ad-advice-classes append
@ -902,41 +893,76 @@ a string, i.e. the `symbol-name' of any existing symbol."
;;; Locate elisp library
;;
;;
(defvar helm--locate-library-cache nil)
(defvar helm--locate-library-doc-cache (make-hash-table :test 'equal))
(defun helm-locate-library-scan-list ()
(cl-loop for dir in load-path
with load-suffixes = '(".el")
when (file-directory-p dir)
append (directory-files
dir t (concat (regexp-opt (get-load-suffixes))
"\\'"))))
nconc (directory-files
dir nil (concat (regexp-opt (find-library-suffixes)) "\\'"))))
;;;###autoload
(defun helm-locate-library ()
"Preconfigured helm to locate elisp libraries."
(interactive)
(helm :sources (helm-build-in-buffer-source "Elisp libraries (Scan)"
(defun helm-locate-library (&optional arg)
"Preconfigured helm to locate elisp libraries.
When `completions-detailed' or `helm-completions-detailed' is non
nil, a description of libraries is provided. The libraries are
partially cached in the variables
`helm--locate-library-doc-cache' and
`helm--locate-library-cache'. TIP: You can make these vars
persistent for faster start with the psession package, using M-x
psession-make-persistent-variable. NOTE: The caches affect as
well `find-libray' and `locate-library' when `helm-mode' is
enabled and `completions-detailed' is non nil. There is no need
to refresh the caches, they will be updated automatically if some
new libraries are found, however when a library update its
headers and the description change you can reset the caches with
a prefix arg."
(interactive "P")
(let (done)
(when arg
(setq helm--locate-library-cache nil)
(clrhash helm--locate-library-doc-cache))
(helm :sources
(helm-build-in-buffer-source "Elisp libraries (Scan)"
:data #'helm-locate-library-scan-list
:fuzzy-match helm-locate-library-fuzzy-match
:keymap helm-generic-files-map
:search (unless helm-locate-library-fuzzy-match
(lambda (regexp)
(re-search-forward
(if helm-ff-transformer-show-only-basename
(replace-regexp-in-string
"\\`\\^" "" regexp)
regexp)
nil t)))
:match-part (lambda (candidate)
(with-helm-buffer
(if helm-ff-transformer-show-only-basename
(helm-basename candidate) candidate)))
:filter-one-by-one (lambda (c)
(with-helm-buffer
(if helm-ff-transformer-show-only-basename
(cons (helm-basename c) c) c)))
:candidate-transformer
(lambda (candidates)
(cl-loop with reporter = (unless done
(make-progress-reporter
"Scanning libraries..." 0 (length candidates)))
with lgst = (helm-in-buffer-get-longest-candidate)
for c in candidates
for count from 0
for bn = (helm-basename c 2)
for sep = (helm-make-separator bn lgst)
for path = (or (assoc-default bn helm--locate-library-cache)
;; A lock file in LOAD-PATH (bug#2626).
(unless (string-match "\\`\\.#" bn)
(let ((p (find-library-name bn)))
(push (cons bn p) helm--locate-library-cache)
p)))
for doc = (and path
(or completions-detailed helm-completions-detailed)
(or (gethash bn helm--locate-library-doc-cache)
(puthash bn (helm-locate-lib-get-summary path)
helm--locate-library-doc-cache)))
for disp = (and path
(if (and doc
(or completions-detailed helm-completions-detailed))
(helm-aand (propertize doc 'face 'font-lock-warning-face)
(propertize " " 'display (concat sep it))
(concat bn it))
bn))
when (and disp path)
collect (cons disp path)
when reporter do (progress-reporter-update reporter count)
finally do (setq done t)))
:action (helm-actions-from-type-file))
:ff-transformer-show-only-basename nil
:buffer "*helm locate library*"))
:buffer "*helm locate library*")))
;;; Modify variables from Helm
;;

View file

@ -86,14 +86,18 @@
uid 'face 'font-lock-warning-face))
key)))
(defun helm-epa--select-keys (prompt keys)
(cl-defun helm-epa--select-keys (prompt keys)
"A helm replacement for `epa--select-keys'."
(let ((result (helm :sources (helm-make-source "Epa select keys" 'helm-epa
:candidates (lambda ()
(helm-epa-get-key-list keys)))
(helm-epa-get-key-list keys))
:action (lambda (_candidate)
(helm-marked-candidates)))
:prompt (and prompt (helm-epa--format-prompt prompt))
:buffer "*helm epa*")))
(unless (equal result "")
(if (or (equal result "") (null result))
(cl-return-from helm-epa--select-keys
(error "No keys selected, aborting"))
result)))
(defun helm-epa--format-prompt (prompt)
@ -104,13 +108,23 @@
(replace-regexp-in-string "\\.[\t ]*\\'" "" (cadr split)))
(format "%s: " (replace-regexp-in-string "\\.[\t ]*\\'" "" (car split))))))
(defun helm-epa--read-signature-type-help ()
(with-temp-buffer
(save-excursion
(insert
"n: Create a normal signature)\n"
"c: Create a cleartext signature)\n"
"d: Create a detached signature)"))
(while (re-search-forward "^\\(.\\):" nil t)
(helm-add-face-text-properties (match-beginning 1) (match-end 1)
'font-lock-variable-name-face))
(buffer-string)))
(defun helm-epa--read-signature-type ()
"A helm replacement for `epa--read-signature-type'."
(let ((answer (helm-read-answer "Signature type:
(n - Create a normal signature)
(c - Create a cleartext signature)
(d - Create a detached signature)"
'("n" "c" "d"))))
(let ((answer (helm-read-answer "Signature type? [n,c,d,h]"
'("n" "c" "d")
#'helm-epa--read-signature-type-help)))
(helm-acase answer
("n" 'normal)
("c" 'clear)
@ -145,7 +159,7 @@
(progn
(advice-add 'epa--select-keys :override #'helm-epa--select-keys)
(advice-add 'epa--read-signature-type :override #'helm-epa--read-signature-type))
(advice-remove 'epa-select-keys #'helm-epa--select-keys)
(advice-remove 'epa--select-keys #'helm-epa--select-keys)
(advice-remove 'epa--read-signature-type #'helm-epa--read-signature-type)))
(defun helm-epa-action-transformer (actions _candidate)

View file

@ -290,7 +290,7 @@ at point."
(delete-char -1) (setq del-dot t)
(setq helm-ec-target (substring helm-ec-target 0 (1- (length helm-ec-target)))))
(cond ((eq first ?\()
(helm-lisp-completion-or-file-name-at-point))
(helm-lisp-completion-at-point))
;; In eshell `pcomplete-parse-arguments' is called
;; with `pcomplete-parse-arguments-function'
;; locally bound to `eshell-complete-parse-arguments'

View file

@ -23,7 +23,8 @@
(require 'edebug)
(declare-function helm-lisp-completion-at-point "helm-elisp.el")
(declare-function helm-elisp-show-doc-modeline "helm-elisp.el")
(defvar helm-elisp-help-function)
(defgroup helm-eval nil
"Eval related Applications and libraries for Helm."
@ -83,8 +84,13 @@ Should take one arg: the string to display."
(define-key map (kbd "<left>") #'backward-char)
map))
(defclass helm-evaluation-result-class (helm-source-dummy)
((echo-input-in-header-line
:initarg :echo-input-in-header-line
:initform 'never)))
(defun helm-build-evaluation-result-source ()
(helm-build-dummy-source "Evaluation Result"
(helm-make-source "Evaluation Result" 'helm-evaluation-result-class
:multiline t
:mode-line "C-RET: nl-and-indent, M-tab: reindent, C-tab:complete, C-p/n: next/prec-line."
:filtered-candidate-transformer

View file

@ -67,16 +67,15 @@ If this variable is not set by the user, it will be calculated
automatically.")
(defun helm-external-commands-list-1 (&optional sort)
"Returns a list of all external commands the user can execute.
"Return a list of all external commands the user can execute.
If `helm-external-commands-list' is non-nil it will return its
contents. Else it calculates all external commands and sets
`helm-external-commands-list'."
(helm-aif helm-external-commands-list
it
(or helm-external-commands-list
(setq helm-external-commands-list
(cl-loop
for dir in (split-string (getenv "PATH") path-separator)
when (and (file-exists-p dir) (file-accessible-directory-p dir))
(cl-loop for dir in (split-string (getenv "PATH") path-separator)
when (and (file-exists-p dir)
(file-accessible-directory-p dir))
for lsdir = (cl-loop for i in (directory-files dir t)
for bn = (file-name-nondirectory i)
when (and (not (member bn completions))

View file

@ -132,10 +132,11 @@
(cl-assert (executable-find helm-fd-executable) nil "Could not find fd executable")
(cl-assert (not (file-remote-p directory)) nil "Fd not supported on remote directories")
(let ((default-directory directory))
(helm :sources (helm-make-source
(format "fd (%s)"
(abbreviate-file-name default-directory))
'helm-fd-class)
(helm :sources (helm-make-source "Fd" 'helm-fd-class
:header-name
(lambda (name)
(format "%s (%s)"
name (abbreviate-file-name default-directory))))
:buffer "*helm fd*")))

View file

@ -50,6 +50,7 @@ Using `setq' to modify this variable will have no effect."
(define-key map (kbd "a") 'helm-apropos)
(define-key map (kbd "e") 'helm-etags-select)
(define-key map (kbd "l") 'helm-locate)
(define-key map (kbd "L") 'helm-locate-library)
(define-key map (kbd "s") 'helm-surfraw)
(define-key map (kbd "r") 'helm-regexp)
(define-key map (kbd "m") 'helm-man-woman)
@ -84,6 +85,7 @@ Using `setq' to modify this variable will have no effect."
(define-key map (kbd "b") 'helm-resume)
(define-key map (kbd "M-g i") 'helm-gid)
(define-key map (kbd "@") 'helm-packages)
(define-key map (kbd "h p") 'helm-finder)
map)
"Default keymap for \\[helm-command-prefix] commands.
The normal global definition of the character \\[helm-command-prefix] indirects to this keymap.")

View file

@ -533,16 +533,16 @@ Have no effect when grep backend use \"--color=\"."
(and rec-com rec-com-ack-p)))))))
(defun helm-grep--pipe-command-for-grep-command (smartcase pipe-switches &optional grep-cmd)
(pcase (or grep-cmd (helm-grep-command))
(helm-acase (or grep-cmd (helm-grep-command))
;; Use grep for GNU regexp based tools.
((or "grep" "zgrep" "git-grep")
(("grep" "zgrep" "git-grep")
(format "grep --color=always%s %s"
(if smartcase " -i" "")
pipe-switches))
;; Use ack-grep for PCRE based tools.
;; Sometimes ack-grep cmd is ack only.
((and (pred (string-match-p "ack")) ack)
(format "%s --smart-case --color %s" ack pipe-switches))))
;; Sometimes ack-grep cmd is ack only so compare by matching ack.
((guard (string-match-p "ack" it))
(format "%s --smart-case --color %s" it pipe-switches))))
(defun helm-grep--prepare-cmd-line (only-files &optional include zgrep)
(let* ((default-directory (or helm-ff-default-directory
@ -1196,7 +1196,7 @@ of grep."
:initform nil
:documentation
" The grep backend that will be used.
It is actually used only as an internal flag
It is currently used only as an internal flag
and doesn't set the backend by itself.
You probably don't want to modify this.")
(candidate-number-limit :initform 9999)
@ -1243,7 +1243,7 @@ Argument DEFAULT-INPUT is use as `default' arg of `helm' and
INPUT is used as `input' arg of `helm'. See `helm' docstring.
Arg BACKEND when non-nil specifies which backend to use.
It is used actually to specify \\='zgrep' or \\='git'.
It is used currently to specify \\='zgrep' or \\='git'.
When BACKEND \\='zgrep' is used don't prompt for a choice in
recurse, and ignore EXTS, search being made recursively on files
matching `helm-zgrep-file-extension-regexp' only."
@ -1635,8 +1635,12 @@ returns if available with current AG version."
(helm-default-directory)
default-directory))
(cmd-line (helm-grep-ag-prepare-cmd-line
helm-pattern (or (file-remote-p directory 'localname)
directory)
;; NOTE Encode directory name and pattern,
;; or it may not work with Chinese and maybe other non-utf8
;; characters on MSWindows systems issue#2677 and issue#2678.
(encode-coding-string helm-pattern locale-coding-system)
(or (file-remote-p directory 'localname)
(encode-coding-string directory locale-coding-system))
type))
(start-time (float-time))
(proc-name (helm-grep--ag-command)))
@ -1693,18 +1697,27 @@ returns if available with current AG version."
proc-name
(replace-regexp-in-string "\n" "" event))))))))))
(defvar helm-grep-ag-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-grep-map)
(define-key map (kbd "C-s") 'helm-grep-run-ag-grep-parent-directory)
map))
(defclass helm-grep-ag-class (helm-source-async)
((nohighlight :initform t)
(pcre :initarg :pcre :initform t
:documentation
" Backend is using pcre regexp engine when non--nil.")
(keymap :initform 'helm-grep-map)
(keymap :initform 'helm-grep-ag-map)
(history :initform 'helm-grep-ag-history)
(help-message :initform 'helm-grep-help-message)
(filtered-candidate-transformer :initform #'helm-grep-fc-transformer)
(persistent-action :initform 'helm-grep-persistent-action)
(persistent-help :initform "Jump to line (`C-u' Record in mark ring)")
(candidate-number-limit :initform 99999)
(directory :initarg :directory :initform nil
:documentation
" Directory currently searched.")
(requires-pattern :initform 2)
(nomark :initform t)
(action :initform 'helm-grep-actions)
@ -1728,16 +1741,30 @@ If INPUT is provided, use it as the search string."
:header-name (lambda (name)
(format "%s [%s]"
name (abbreviate-file-name directory)))
:directory directory
:action (append helm-grep-actions
`((,(format "%s grep parent directory"
(upcase (helm-grep--ag-command)))
. helm-grep-ag-grep-parent-directory)))
:candidates-process
(lambda () (helm-grep-ag-init directory type))))
(helm-set-local-variable 'helm-input-idle-delay helm-grep-input-idle-delay)
(helm :sources 'helm-source-grep-ag
:keymap helm-grep-map
:history 'helm-grep-ag-history
:input input
:truncate-lines helm-grep-truncate-lines
:buffer (format "*helm %s*" (helm-grep--ag-command))))
(defun helm-grep-ag-grep-parent-directory (_candidate)
"Restart helm-grep-ag in the parent of the currently searched directory."
(let* ((src (with-helm-buffer (car helm-sources)))
(directory (helm-basedir (helm-get-attr 'directory src) t))
(input helm-pattern))
(helm-grep-ag-1 directory nil input)))
(helm-make-command-from-action helm-grep-run-ag-grep-parent-directory
"Ag grep parent directory." 'helm-grep-ag-grep-parent-directory)
(defun helm-grep-ag (directory with-types)
"Start grep AG in DIRECTORY.
When WITH-TYPES is non-nil provide completion on AG types."

View file

@ -588,10 +588,10 @@ On completion (\\[helm-ff-run-complete-fn-at-point]):
Use of wildcard is supported to run an action over a set of files.
Example: You can copy all the files with \".el\" extension by using \"*.el\" and
Example: You can copy all the files with \".el\" extension by using \"*.el\" and
then run copy action.
Similarly, \"**.el\" (note the two stars) will recursively select all \".el\"
Similarly, \"**.el\" (note the two stars) will recursively select all \".el\"
files under the current directory.
Note that when recursively copying files, you may have files with same name
@ -606,7 +606,7 @@ to backup files in current directory.
This command is available only when `dired-async-mode' is active.
When using an action that involves an external backend (e.g. grep), using \"**\"
is not recommended (even thought it works fine) because it will be slower to
is not recommended (even though it works fine) because it will be slower to
select all the files. You are better off leaving the backend to do it, it will
be faster. However, if you know you have not many files it is reasonable to use
this, also using not recursive wildcard (e.g. \"*.el\") is perfectly fine for
@ -614,14 +614,14 @@ this.
The \"**\" feature is active by default in the option `helm-file-globstar'. It
is different from the Bash \"shopt globstar\" feature in that to list files with
a named extension recursively you would write \"**.el\" whereas in Bash it would
be \"**/*.el\". Directory selection with \"**/\" like Bash \"shopt globstar\"
a named extension recursively you would write \"**.el\" whereas in Bash it would
be \"**/*.el\". Directory selection with \"**/\" like Bash \"shopt globstar\"
option is not supported yet.
Helm supports different styles of wildcards:
- `sh' style, the ones supported by `file-expand-wildcards'.
e.g. \"*.el\", \"*.[ch]\" which match respectively all \".el\"
e.g. \"*.el\", \"*.[ch]\" which match respectively all \".el\"
files or all \".c\" and \".h\" files.
- `bash' style (partially) In addition to what allowed in `sh'
@ -807,7 +807,7 @@ instead its scp method if you want to avoid out of memory
problems and crash Emacs or the whole system. Moreover when using
scp method, you will hit a bug when copying more than 3 files at
the time, see [[https://github.com/emacs-helm/helm/issues/1945][bug#1945]].
The best way actually is using Rsync to copy files from or to
The best way currently is using Rsync to copy files from or to
remote, see [[Use Rsync to copy files][Use Rsync to copy files]].
Also if you often work on remote you may consider using SSHFS
instead of relying on tramp.
@ -873,7 +873,7 @@ rsync command line with a prefix arg (see above).
Since Android doesn't provide anymore mass storage for USB, it is
not simple to access files on Android, the best way to do this
actually seems to use Adb, here some hints to set this up, read
currently seems to use Adb, here some hints to set this up, read
in addition the Tramp documentation.
1) Install Adb, most distribution provide it.
@ -915,6 +915,40 @@ On remote files grep is not well supported by TRAMP unless you suspend updates b
entering the pattern and re-enable it once your pattern is ready.
To toggle suspend-update, use `\\<helm-map>\\[helm-toggle-suspend-update]'.
*** Compressing or uncompressing files from helm-find-files
**** Compressing/uncompressing using Helm commands
Helm provide commands like dired (reusing dired code)
to (un)compress files from `helm-find-files', however these
commands are asynchronous.
You can use `\\<helm-find-files-map>\\[helm-ff-run-compress-marked-files]' to compress marked files.
To compress file(s) to an archive use `\\<helm-find-files-map>\\[helm-ff-run-compress-to]'.
To quickly compress/uncompress small files without quitting Helm use `\\<helm-find-files-map>\\[helm-ff-persistent-compress]'.
NOTE: This persistent action is NOT asynchronous, IOW it will block Helm
for a while until compression/uncompression finish.
**** Compressing/uncompressing using external commands in Eshell
You can use Eshell aliases to uncompress files,
see [[Execute Eshell commands on files][Execute Eshell commands on files]] for more infos.
Here some aliases using commands from the excellent =atools= package:
alias pack2zip apack -e -F .zip $* &
alias pack2gz apack -e -F .tar.gz $* &
alias pack2bz apack -e -F .tar.bz $* &
alias pack2xz apack -e -F .tar.xz $* &
alias unpack aunpack $1 &
Note the \"&\" at end of commands that make eshell aliases asynchronous.
NOTE: Using the ampersand at end of command to make it asynchronous is broken
in all emacs versions before emacs-28 (see emacs bug#50209).
Of course you can use any other commands of your choice as aliases.
*** Execute Eshell commands on files
Setting up aliases in Eshell allows you to set up powerful customized commands.
@ -1006,9 +1040,9 @@ Starting at helm version 2.9.7 it is somewhat possible to
colorize fnames by listing files without loosing performances with
external commands (ls and awk) if your system is compatible.
For this you can use `helm-list-dir-external' as value
for `helm-list-directory-function'.
for `helm-list-remote-directory-fn'.
See `helm-list-directory-function' documentation for more infos.
See `helm-list-remote-directory-fn' documentation for more infos.
**** Completing host
@ -1267,7 +1301,10 @@ If `all-the-icons' package is installed, turning on
|\\[helm-ff-sort-by-size]|Sort by size.
|\\[helm-ff-toggle-dirs-only]|Show only directories.
|\\[helm-ff-toggle-files-only]|Show only files.
|\\[helm-ff-sort-by-ext]|Sort by extensions.")
|\\[helm-ff-sort-by-ext]|Sort by extensions.
|\\[helm-ff-run-compress-to]|Compress file(s) to archive.
|\\[helm-ff-run-compress-marked-files]|Compress file(s).
|\\[helm-ff-persistent-compress]|Compress file(s) without quitting.")
;;; Help for file-name-history
;;
@ -2251,6 +2288,15 @@ See [[Moving in `helm-buffer'][Moving in `helm-buffer']].
(defvar helm-top-help-message
"* Helm Top
** Tips
*** Auto update
You can enable auto updating in `helm-top' by turning on
`helm-top-poll-mode' either interactively or in your init file
with (helm-top-poll-mode 1).
Calling `helm-top' with a prefix arg also toggle auto updating.
** Commands
\\<helm-top-map>
|Keys|Description

View file

@ -100,7 +100,7 @@ Don't use `setq' to set this."
:group 'helm-imenu
:type 'boolean
:set (lambda (var val)
(if (featurep 'all-the-icons)
(if (require 'all-the-icons nil t)
(set var val)
(set var nil))))
@ -111,17 +111,17 @@ Don't use `setq' to set this."
:group 'helm-imenu
:type 'boolean
:set (lambda (var val)
(if (featurep 'all-the-icons)
(if (require 'all-the-icons nil t)
(set var val)
(set var nil))))
(defcustom helm-imenu-icon-type-alist
'(("Array" . (all-the-icons-material "crop" :face font-lock-builtin-face))
("Array" . (all-the-icons-material "crop" :face font-lock-builtin-face))
("Boolean" . (all-the-icons-material "crop" :face font-lock-builtin-face))
("Arrays" . (all-the-icons-material "crop" :face font-lock-builtin-face))
("Boolean" . (all-the-icons-material "crop" :face font-lock-builtin-face))
("Booleans" . (all-the-icons-material "crop" :face font-lock-builtin-face))
("Class" . (all-the-icons-octicon "package" :face font-lock-type-face))
("Class" . (all-the-icons-octicon "package" :face font-lock-type-face))
("Classes" . (all-the-icons-octicon "package" :face font-lock-type-face))
("Color" . (all-the-icons-material "color_lens" :face font-lock-builtin-face))
("Colors" . (all-the-icons-material "color_lens" :face font-lock-builtin-face))
("Constant" . (all-the-icons-material "crop" :face font-lock-builtin-face))
@ -157,7 +157,7 @@ Don't use `setq' to set this."
("Module" . (all-the-icons-faicon "angle-double-right" :face font-lock-builtin-face))
("Modules" . (all-the-icons-faicon "angle-double-right" :face font-lock-builtin-face))
("Numeric" . (all-the-icons-material "crop" :face font-lock-builtin-face))
("Numeric" . (all-the-icons-material "crop" :face font-lock-builtin-face))
("Numerics" . (all-the-icons-material "crop" :face font-lock-builtin-face))
("Object" . (all-the-icons-faicon "angle-double-right" :face font-lock-builtin-face))
("Objects" . (all-the-icons-faicon "angle-double-right" :face font-lock-builtin-face))
("Operator" . (all-the-icons-faicon "calculator" :face font-lock-builtin-face))
@ -167,7 +167,7 @@ Don't use `setq' to set this."
("Reference" . (all-the-icons-octicon "book" :face font-lock-variable-name-face))
("References" . (all-the-icons-octicon "book" :face font-lock-variable-name-face))
("Snippet" . (all-the-icons-material "border_style" :face font-lock-variable-name-face))
("Snippet" . (all-the-icons-material "border_style" :face font-lock-variable-name-face))
("Snippets" . (all-the-icons-material "border_style" :face font-lock-variable-name-face))
("String" . (all-the-icons-material "text_fields" :face font-lock-variable-name-face))
("Strings" . (all-the-icons-material "text_fields" :face font-lock-variable-name-face))
("Struct" . (all-the-icons-faicon "cog" :face font-lock-type-face))
@ -320,7 +320,8 @@ The sexp should be an `all-the-icons' function with its args."
(if (equal (cdr cur) mb)
(prog1 nil
(helm-set-pattern "")
(helm-force-update (concat "\\_<" (car cur) "\\_>")))
(helm-force-update
(concat "\\_<" (regexp-quote (car cur)) "\\_>")))
t)))
(defun helm-imenu-quit-and-find-file-fn (source)
@ -406,12 +407,11 @@ The sexp should be an `all-the-icons' function with its args."
(and (cdr elm)
;; Semantic uses overlays whereas imenu uses
;; markers (Bug#1706).
(setcdr elm (pcase (cdr elm) ; Same as [1].
((and ov (pred overlayp))
(copy-overlay ov))
((and mk (or (pred markerp)
(pred integerp)))
(copy-marker mk))))
(setcdr elm (helm-acase (cdr elm) ; Same as [1].
((guard (overlayp it))
(copy-overlay it))
((guard (or (markerp it) (integerp it)))
(copy-marker it))))
(list elm))))))
(defun helm-imenu--get-prop (item)
@ -443,10 +443,9 @@ The icon is found in `helm-imenu-icon-type-alist', if not
(cl-loop for (k . v) in candidates
;; (k . v) == (symbol-name . marker)
for bufname = (buffer-name
(pcase v
((pred overlayp) (overlay-buffer v))
((or (pred markerp) (pred integerp))
(marker-buffer v))))
(helm-acase v
((guard (overlayp it)) (overlay-buffer it))
((guard (markerp it)) (marker-buffer it))))
for types = (or (helm-imenu--get-prop k)
(list (if (with-current-buffer bufname
(derived-mode-p 'prog-mode))

View file

@ -141,6 +141,21 @@ If line have a node use the node, otherwise use directly first name found."
:initform nil
:custom 'string)
(init :initform #'helm-info-init)
(filtered-candidate-transformer
:initform
(lambda (candidates _source)
(cl-loop for line in candidates
when (string-match helm-info--node-regexp line)
do (progn
(helm-add-face-text-properties
(match-beginning 1) (match-end 1)
'font-lock-keyword-face
nil line)
(helm-add-face-text-properties
(match-beginning 2) (match-end 2)
'font-lock-warning-face
nil line))
collect line)))
(display-to-real :initform #'helm-info-display-to-real)
(get-line :initform #'buffer-substring)
(action :initform '(("Goto node" . helm-info-goto)))))
@ -301,6 +316,14 @@ Info files are made available."
;; Symbol at point is used as default as long as one of the sources
;; in `helm-info-default-sources' is member of
;; `helm-sources-using-default-as-input'.
(let* ((current (and Info-current-file
(intern-soft
(concat "helm-source-info-"
(helm-basename Info-current-file)))))
(helm-info-default-sources
(if (and current (not (memq current helm-info-default-sources)))
(cons current helm-info-default-sources)
helm-info-default-sources)))
(cl-loop for src in helm-info-default-sources
for name = (if (symbolp src)
(assoc 'name (symbol-value src))
@ -308,7 +331,7 @@ Info files are made available."
unless name
do (warn "Couldn't build source `%S' without its info file" src))
(helm :sources helm-info-default-sources
:buffer "*helm info*"))
:buffer "*helm info*")))
(provide 'helm-info)

View file

@ -56,7 +56,7 @@ unless `helm-locate-command' is non-nil.
Here are the default values it will use according to your system:
Gnu/linux: \"locate %s -e -A --regex %s\"
Gnu/linux: \"locate %s -e -A -N --regex %s\"
berkeley-unix: \"locate %s %s\"
windows-nt: \"es %s %s\"
Others: \"locate %s %s\"
@ -69,6 +69,10 @@ for this.
The last option must be the one preceding pattern i.e \"-r\" or
\"--regex\".
The option \"-N\" may not be available on old locate versions, it is needed on
latest systems as locate send quoted filenames, it is BTW enabled by default, if
this option is not recognized on your system, remove it.
You will be able to pass other options such as \"-b\" or \"l\"
during Helm invocation after entering pattern only when multi
matching, not when fuzzy matching.
@ -211,7 +215,8 @@ See `helm-locate-with-db' and `helm-locate'."
(unless helm-locate-command
(setq helm-locate-command
(cl-case system-type
(gnu/linux "locate %s -e -A --regex %s")
;; Use -N option by default (bug#2625)
(gnu/linux "locate %s -e -A -N --regex %s")
(berkeley-unix "locate %s %s")
(windows-nt "es %s %s")
(t "locate %s %s")))))

View file

@ -27,6 +27,8 @@
(declare-function jabber-chat-with "ext:jabber.el")
(declare-function jabber-read-account "ext:jabber.el")
(declare-function helm-comp-read "helm-mode")
(declare-function outline-back-to-heading "outline.el")
(declare-function outline-end-of-heading "outline.el")
(defgroup helm-misc nil
@ -387,6 +389,33 @@ Default action change TZ environment variable locally to emacs."
(delete-minibuffer-contents)
(insert elm)))
;;;###autoload
(defun helm-outline ()
"Basic helm navigation tool for outline buffers."
(interactive)
(helm :sources (helm-build-sync-source "helm outline"
:candidates
(lambda ()
(with-helm-current-buffer
(save-excursion
(goto-char (point-min))
(cl-loop while (re-search-forward outline-regexp nil t)
for beg = (match-beginning 0)
for end = (progn
(outline-end-of-heading) (point))
collect
(cons (buffer-substring beg end) beg)))))
:action (lambda (pos)
(helm-goto-char pos)
(helm-highlight-current-line)))
:preselect (save-excursion
(when (condition-case _err
(outline-back-to-heading)
(error nil))
(regexp-quote
(buffer-substring
(point) (progn (outline-end-of-heading) (point))))))
:buffer "*helm outline*"))
(provide 'helm-misc)

View file

@ -30,6 +30,10 @@
(defvar helm-mode)
(defvar password-cache)
(defvar package--builtins)
(defvar helm--locate-library-doc-cache)
(defvar helm--locate-library-cache)
(defvar completion-lazy-hilit) ; Emacs-30 only.
(defvar eww-bookmarks)
;; No warnings in Emacs built --without-x
(declare-function x-file-dialog "xfns.c")
@ -46,6 +50,7 @@
(declare-function package-get-descriptor "package")
(declare-function print-coding-system-briefly "mul-diag.el")
(declare-function color-rgb-to-hex "color.el")
(declare-function find-library-name "find-func.el")
(defgroup helm-mode nil
"Enable helm completion."
@ -62,6 +67,9 @@
(dired-do-symlink . helm-read-file-name-handler-1)
(dired-do-relsymlink . helm-read-file-name-handler-1)
(dired-do-hardlink . helm-read-file-name-handler-1)
;; Next two are using completing-read where not needed.
(read-multiple-choice--long-answers . nil)
(dired-do-touch . nil)
(basic-save-buffer . helm-read-file-name-handler-1)
(write-file . (default helm-read-file-name-handler-1))
(write-region . (default helm-read-file-name-handler-1))
@ -252,6 +260,11 @@ This is mainly needed to prevent \"*Completions*\" buffers to popup.")
Not guaranteed to work with Emacs < 27."
:type 'boolean
:group 'helm-mode)
(defvar helm-mode-find-file-target-alist
'(("switch-to-buffer" . helm-buffers-quit-and-find-file-fn))
"An alist composed of (SOURCE_NAME . FUNCTION) elements.
Where FUNCTION is a function suitable for `helm-quit-and-find-file'.")
(defface helm-mode-prefix
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
@ -263,6 +276,16 @@ Not guaranteed to work with Emacs < 27."
'((t :inherit font-lock-property-name-face))
"Face used to highlight invalid functions."
:group 'helm-mode)
(defface helm-completions-detailed
'((t :inherit font-lock-warning-face))
"Face used to highlight completion-detailed informations."
:group 'helm-mode)
(defface helm-completions-annotations
'((t :inherit font-lock-property-name-face))
"Face used to highlight annotations in completion."
:group 'helm-mode)
(defvar helm-comp-read-map
(let ((map (make-sparse-keymap)))
@ -272,6 +295,12 @@ Not guaranteed to work with Emacs < 27."
map)
"Keymap for `helm-comp-read'.")
(defvar helm-comp-in-region-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-comp-read-map)
map)
"Keymap for completion-at-point and friends.")
(defun helm-mode-delete-char-backward-1 ()
(interactive)
(condition-case err
@ -349,8 +378,8 @@ NOT `setq'."
:set (lambda (var val)
(set var val)
(if (memq val '(helm helm-fuzzy))
(define-key helm-comp-read-map (kbd "DEL") 'helm-mode-delete-char-backward-maybe)
(define-key helm-comp-read-map (kbd "DEL") 'delete-backward-char))))
(define-key helm-comp-in-region-map (kbd "DEL") 'helm-mode-delete-char-backward-maybe)
(define-key helm-comp-in-region-map (kbd "DEL") 'delete-backward-char))))
(defconst helm-completion--all-styles
(let ((flex (if (assq 'flex completion-styles-alist)
@ -366,21 +395,23 @@ NOT `setq'."
(defcustom helm-completion-styles-alist '((gud-mode . helm)
;; See https://github.com/djcb/mu/issues/2181.
(mu4e-compose-mode . emacs))
(mu4e-compose-mode . emacs)
(wfnames-mode . (emacs helm flex)))
"Allow configuring `helm-completion-style' per mode or command.
NOTE: Use a mode for a completion that will be used in a buffer
i.e. completion-in-region, whereas you have to specify instead a
command to affect the completing-read trigerred by this
command. Commands specified in `helm-completing-read-handlers-alist' take
precedence on commands you put here.
NOTE: Commands involving `completing-read' specified in
`helm-completing-read-handlers-alist' take precedence on commands
you put here. Specifying a mode instead of a command affect only
completion-in-region and not the completing-read's called in this mode, use
`helm-completing-read-handlers-alist' for this.
Each entry is a cons cell like (mode . style) where style must be
a suitable value for `helm-completion-style'. When specifying
emacs as style for a mode or a command, `completion-styles' can
be specified by using a cons cell specifying completion-styles to
use with helm emacs style, e.g. (foo-mode . (emacs helm flex))
will set `completion-styles' to \\='(helm flex) for foo-mode."
Each entry is a cons cell like (mode_or_command . style) where
style must be a suitable value for `helm-completion-style'. When
specifying emacs as style for a mode or a command,
`completion-styles' can be specified by using a cons cell
specifying completion-styles to use with helm emacs style,
e.g. (foo-mode . (emacs helm flex)) will set `completion-styles'
to \\='(helm flex) for foo-mode."
:group 'helm-mode
:type
`(alist :key-type (symbol :tag "Major Mode")
@ -535,9 +566,8 @@ If COLLECTION is an `obarray', a TEST should be needed. See `obarray'."
(member (downcase pattern) candidates)
(member (upcase pattern) candidates)))
(defun helm-cr-default-transformer (candidates source)
(defun helm-cr-default-transformer (candidates _source)
"Default filter candidate function for `helm-comp-read'."
(let ((must-match (helm-get-attr 'must-match source)))
;; Annotation and affixation are already handled in completion-in-region and
;; in helm-completing-read-default-2 when emacs style is in use.
;; For helm-completing-read-default-1 we handle them in an extra FCT; This
@ -551,26 +581,7 @@ If COLLECTION is an `obarray', a TEST should be needed. See `obarray'."
(string-match "\n" elm))
(cons (replace-regexp-in-string "\n" "->" elm) c))
(t c)))
collect cand into lst
finally return
;; Unquote helm-pattern when it is added as candidate
;; (Bug#2015).
(let ((pat (replace-regexp-in-string "\\s\\" "" helm-pattern)))
(if (or (string= pat "")
(eq must-match t)
(helm-cr--pattern-in-candidates-p lst pat))
lst
(append (list (cons (helm-aand (propertize "[?]" 'face 'helm-ff-prefix)
(propertize " " 'display it 'unknown t)
(concat it pat))
pat))
lst))))))
(defun helm-comp-read--move-to-first-real-candidate ()
(helm-aif (helm-get-selection nil 'withprop)
;; Avoid error with candidates with an image as display (Bug#2296).
(when (helm-candidate-prefixed-p it)
(helm-next-line))))
collect cand))
(defun helm-cr-default (default cands)
(delq nil
@ -617,7 +628,7 @@ If COLLECTION is an `obarray', a TEST should be needed. See `obarray'."
(name "Helm Completions")
header-name
candidates-in-buffer
get-line
(get-line #'buffer-substring)
diacritics
match-part
match-dynamic
@ -634,6 +645,7 @@ If COLLECTION is an `obarray', a TEST should be needed. See `obarray'."
multiline
allow-nest
coerce
raw-candidate
(group 'helm))
"Read a string in the minibuffer, with helm completion.
@ -756,6 +768,9 @@ Keys description:
- COERCE: See coerce in `helm-source'.
- RAW-CANDIDATE: Do not unquote the unknown candidate coming from helm-pattern
when non nil.
- GROUP: See group in `helm-source'.
Any prefix args passed during `helm-comp-read' invocation will be recorded
@ -786,8 +801,14 @@ that use `helm-comp-read'. See `helm-M-x' for example."
nil "Error: History should be specified as a symbol")
(when (get-buffer helm-action-buffer)
(kill-buffer helm-action-buffer))
(unless (memq must-match '(confirm confirm-after-completion t nil))
;; Fix completing-read's using something else than `t' e.g. 1 or
;; The value of MUST-MATCH is given to
;; `helm--set-minibuffer-completion-confirm' which compute it and propagate it
;; to `minibuffer-completion-confirm' which is then used by
;; `helm-confirm-and-exit-minibuffer'.
(unless (or (memq must-match '(confirm confirm-after-completion t nil))
(functionp must-match))
;; Fix completing-read's using something else than (confirm
;; confirm-after-completion t nil) or a function e.g. 1 or
;; whatever (bug #2527).
(setq must-match t))
(let ((action-fn `(("Sole action (Identity)"
@ -846,6 +867,20 @@ that use `helm-comp-read'. See `helm-M-x' for example."
:mode-line mode-line
:help-message help-message
:action action-fn))
(dummy-src (helm-build-dummy-source "Unknown candidate"
:must-match must-match
:keymap keymap
:filtered-candidate-transformer
(lambda (_candidates _source)
(let ((pat (if raw-candidate
helm-pattern
(replace-regexp-in-string "\\s\\" "" helm-pattern))))
(unless (string= pat "")
(list (cons (helm-aand (propertize "[?]" 'face 'helm-ff-prefix)
(propertize " " 'display it 'unknown t)
(concat it pat))
pat)))))
:action action-fn))
(src (helm-build-sync-source name
:candidates get-candidates
:match-part match-part
@ -903,8 +938,11 @@ that use `helm-comp-read'. See `helm-M-x' for example."
(setq src-list (cl-loop for src in src-list
collect (cons '(nomark) src))))
(when reverse-history (setq src-list (nreverse src-list)))
(add-hook 'helm-after-update-hook 'helm-comp-read--move-to-first-real-candidate)
(unwind-protect
(unless (eq must-match t)
(setq src-list (append src-list (list dummy-src))))
(when raw-candidate
(cl-loop for src in src-list
do (helm-set-attr 'raw-candidate t src)))
(setq result (helm
:sources src-list
:input initial-input
@ -918,7 +956,6 @@ that use `helm-comp-read'. See `helm-M-x' for example."
:case-fold-search case-fold
:history (and (symbolp input-history) input-history)
:buffer buffer))
(remove-hook 'helm-after-update-hook 'helm-comp-read--move-to-first-real-candidate))
;; If `history' is a symbol save it, except when it is t.
(when (and result history (symbolp history) (not (eq history t)))
(set history
@ -992,6 +1029,9 @@ that use `helm-comp-read'. See `helm-M-x' for example."
(symbol-help . (metadata
(affixation-function . helm-symbol-completion-table-affixation)
(category . symbol-help)))
(eww-help . (metadata ;; Emacs-30 only
(affixation-function . helm-completion-eww-affixation)
(category . eww-help)))
(package . (metadata
(affixation-function . helm-completion-package-affixation)
(category . package)))
@ -1003,7 +1043,13 @@ that use `helm-comp-read'. See `helm-M-x' for example."
(category . coding-system)))
(color . (metadata
(affixation-function . helm-completion-color-affixation)
(category . color))))
(category . color)))
(library . (metadata
(affixation-function . helm-completion-library-affixation)
(category . library)))
(charset . (metadata
(affixation-function . helm-completion-charset-affixation)
(category . charset))))
"Extra metadata for completing-read.
Alist composed of (CATEGORY . METADATA).
@ -1017,9 +1063,7 @@ like this:
FLAGS is a list of variables to renitialize to nil when exiting or quitting.
It is used to add `affixation-function' or `annotation-function' if original
metadata doesn't have some and `completions-detailed' is non nil.
When using emacs as `helm-completion-style', this has no effect, keeping same
behavior as emacs vanilla.")
metadata doesn't have some and `completions-detailed' is non nil.")
(defvar helm-completing-read-command-categories
'(("customize-variable" . symbol-help)
@ -1038,7 +1082,12 @@ behavior as emacs vanilla.")
("trace-function-foreground" . symbol-help)
("trace-function-background" . symbol-help)
("describe-minor-mode" . symbol-help)
("where-is" . symbol-help)
("execute-extended-command" . symbol-help)
("info-lookup-symbol" . symbol-help)
("Info-goto-emacs-command-node" . symbol-help)
("find-library" . library)
("locate-library" . library)
("kill-buffer" . buffer)
("package-install" . package)
("package-vc-install" . package)
@ -1047,7 +1096,20 @@ behavior as emacs vanilla.")
("load-theme" . theme)
("describe-theme" . theme)
("describe-coding-system" . coding-system)
("read-color" . color))
("set-file-name-coding-system" . coding-system)
("set-keyboard-coding-system" . coding-system)
("set-terminal-coding-system" . coding-system)
("set-process-coding-system" . coding-system)
("set-buffer-process-coding-system" . coding-system)
("set-buffer-file-coding-system" . coding-system)
("set-selection-coding-system" . coding-system)
("set-next-selection-coding-system" . coding-system)
("set-clipboard-coding-system" . coding-system)
("universal-coding-system-argument" . coding-system)
("read-color" . color)
("list-charset-chars" . charset)
;; Emacs-30 only
("eww" . eww-help))
"An alist to specify metadata category by command.
Some commands provide a completion-table with no category
@ -1058,9 +1120,10 @@ should be specified as a string and the category as a symbol.")
(defvar helm-completing-read--buffer-lgst-mode nil)
(defun helm-completing-read-buffer-affixation (completions)
(let ((len-mode (or helm-completing-read--buffer-lgst-mode
(setq helm-completing-read--buffer-lgst-mode
(cl-loop for bn in completions
maximize (with-current-buffer bn
(length (symbol-name major-mode)))))))
(length (symbol-name major-mode))))))))
(lambda (comp)
(let* ((buf (get-buffer comp))
(fname (buffer-file-name buf))
@ -1070,17 +1133,17 @@ should be specified as a string and the category as a symbol.")
"fm " 'face 'font-lock-comment-face))
(fname
(propertize
" f " 'face 'font-lock-property-name-face))
" f " 'face 'helm-completions-annotations))
(t (propertize "nf " 'face 'font-lock-doc-face))))
(mode (with-current-buffer comp
(propertize
(symbol-name major-mode) 'face 'font-lock-warning-face)))
(symbol-name major-mode) 'face 'helm-completions-detailed)))
(size (helm-buffer-size buf))
(max-len helm-buffer-max-length)
(bname (truncate-string-to-width
comp helm-buffer-max-length nil nil
helm-buffers-end-truncated-string))
(suffix (format "%s%s%s%s%s(in %s)"
(suffix (format "%s%s%s%s%s `%s'"
(make-string (1+ (- max-len (length bname))) ? )
(propertize size
'face 'helm-buffer-size)
@ -1113,7 +1176,7 @@ the speed avoiding one useless loop on complete list of candidates.
Returns a function and not a list of completions.
It affects actually describe-variable/function/command/symbol functions.
It affects currently describe-variable/function/command/symbol functions.
It uses `helm-get-first-line-documentation' which allow providing documentation
for `describe-variable' symbols and align properly documentation when helm style
is used."
@ -1128,12 +1191,13 @@ is used."
(max-len (and (memq helm-completion-style '(helm helm-fuzzy))
(helm-in-buffer-get-longest-candidate)))
(sep (if (or (null max-len) (zerop max-len))
" --" ; Default separator.
(make-string (- max-len (length comp)) ? )))
" -- " ; Default separator.
(helm-make-separator comp max-len)))
(doc (ignore-errors
(helm-get-first-line-documentation sym)))
(symbol-class (help--symbol-class sym))
(group (helm-group-p sym)))
(symbol-class (with-helm-current-buffer (help--symbol-class sym)))
(group (helm-group-p sym))
(key (helm-completion-get-key sym)))
(list
;; Symbol (comp).
(if (or (symbol-function sym) (boundp sym)
@ -1142,22 +1206,41 @@ is used."
;; Not already defined function. To test add an advice on a non
;; existing function.
(propertize comp 'face 'helm-completion-invalid))
;; Prefix.
(helm-aand (propertize
(cond ((and symbol-class group)
;; Prefixes.
;; " c " command
;; " - " obsolete, 'byte-obsolete-info
;; " v " var, not a defcustom
;; " ' " local-variable-if-set-p
;; " * " not default value if buffer local
;; " - " 'byte-obsolete-variable
(helm-aand (cond ((and symbol-class group)
(concat "g" symbol-class))
((and (not (string= symbol-class ""))
symbol-class))
(group "g")
(t "i"))
'face 'completions-annotations)
(propertize " " 'display (format "%-4s" it)))
(t "i")) ; Not already defined function.
(propertize it 'face 'helm-completions-detailed)
;; help--symbol-class currently can return at most 8
;; characters long symbol class but it is very rare, it is
;; generally max 4 (bug#2656).
(propertize
;; (format "%-4s" it) may make spaces inheriting text props
;; with emacs -nw in emacs<29.
" " 'display (format "%-4s" it)))
;; Suffix.
(if doc
(helm-aand (propertize doc 'face 'completions-annotations)
(propertize " " 'display (concat sep it)))
(helm-aand (propertize doc 'face 'helm-completions-detailed)
(propertize " " 'display (concat sep it key)))
"")))))
(defun helm-completion-get-key (sym)
"Return key description on symbol SYM."
(with-helm-current-buffer
(let* ((key (and (commandp sym) (where-is-internal sym nil 'first-only)))
(binding (and key (key-description key))))
(when binding
(propertize (format " (%s)" binding) 'face 'shadow)))))
(defun helm-completion-package-affixation (_completions)
(lambda (comp)
(let* ((sym (intern-soft comp))
@ -1167,32 +1250,28 @@ is used."
(desc (if built-in
(aref (assoc-default sym package--builtins) 2)
(and id (package-desc-summary id))))
(sep (make-string (1+ (- (helm-in-buffer-get-longest-candidate)
(length comp)))
? )))
(sep (helm-make-separator comp)))
(list comp
(propertize
(if status
(format "%s " (substring status 0 1))
"b ")
'face 'font-lock-property-name-face)
'face 'helm-completions-annotations)
(or (helm-aand desc
(propertize it 'face 'font-lock-warning-face)
(propertize it 'face 'helm-completions-detailed)
(propertize " " 'display (concat sep it)))
"")))))
(defun helm-completion-theme-affixation (_completions)
(lambda (comp)
(let* ((sym (intern-soft comp))
(sep (make-string (1+ (- (helm-in-buffer-get-longest-candidate)
(length comp)))
? ))
(sep (helm-make-separator comp))
(doc (if (custom-theme-p sym)
(helm-get-first-line-documentation sym)
(helm--get-theme-doc-1 sym))))
(list comp
""
(helm-aand (propertize doc 'face 'font-lock-warning-face)
(helm-aand (propertize doc 'face 'helm-completions-detailed)
(propertize " " 'display (concat sep it)))))))
(defun helm--get-theme-doc-1 (sym)
@ -1227,23 +1306,27 @@ is used."
(buffer-substring beg end))))
(defun helm-completion-coding-system-affixation (_comps)
(require 'mule-diag)
(lambda (comp)
(let ((doc (with-output-to-string
(with-current-buffer standard-output
(print-coding-system-briefly (intern comp) 'tightly))))
(sep (make-string (1+ (- (helm-in-buffer-get-longest-candidate)
(length comp)))
? )))
(sep (helm-make-separator comp)))
(list comp "" (helm-aand (replace-regexp-in-string "^ *" "" doc)
(replace-regexp-in-string "[\n]" "" it)
(propertize it 'face 'font-lock-warning-face)
(propertize it 'face 'helm-completions-detailed)
(propertize " " 'display (concat sep it)))))))
(defun helm-completion-charset-affixation (_comps)
(lambda (comp)
(let ((doc (charset-description (intern comp)))
(sep (helm-make-separator comp)))
(list comp "" (helm-aand (propertize doc 'face 'helm-completions-detailed)
(propertize " " 'display (concat sep it)))))))
(defun helm-completion-color-affixation (_comps)
(lambda (comp)
(let ((sep (make-string (1+ (- (helm-in-buffer-get-longest-candidate)
(length comp)))
? ))
(let ((sep (helm-make-separator comp))
(rgb (condition-case nil
(helm-acase comp
("foreground at point" (with-helm-current-buffer
@ -1258,8 +1341,45 @@ is used."
(helm-aand (propertize rgb 'face `(:background ,rgb
:distant-foreground "black"))
(propertize " " 'display (concat sep it)))))))
(defun helm-completion-library-affixation (_comps)
(require 'helm-elisp)
(lambda (comp)
;; Because find-library-include-other-files default to t, we have all the
;; unrelated files and directories coming in ... Even if this modify the
;; behavior of find-library-include-other-files remove them for the benefit
;; of everybody.
(unless (or (string-match "\\(\\.elc\\|/\\)\\'" comp)
(string-match "\\`\\.#" comp)) ; (bug#2526)
(let* ((sep (helm-make-separator comp))
(path (or (assoc-default comp helm--locate-library-cache)
(let ((p (find-library-name comp)))
(push (cons comp p) helm--locate-library-cache)
p)))
(doc (or (gethash comp helm--locate-library-doc-cache)
(puthash comp (helm-locate-lib-get-summary path)
helm--locate-library-doc-cache))))
(list comp
""
(helm-aand (propertize doc 'face 'font-lock-warning-face)
(propertize " " 'display (concat sep it))))))))
(defun helm-completion-eww-affixation (_completions)
(lambda (comp)
(let* ((title (or (cl-loop for bmk in eww-bookmarks
for title = (plist-get bmk :title)
for url = (plist-get bmk :url)
thereis (and (string= comp url) title))
"Unknown title"))
(sep (helm-make-separator title 72)))
(list (propertize comp 'display
(truncate-string-to-width comp 72 nil nil t))
(helm-aand (propertize (truncate-string-to-width title 72)
'face 'helm-completions-detailed)
(propertize " " 'display (concat it sep)))
""))))
;;; Generic completing read
;;; Completing read handlers
;;
;;
(defun helm-completing-read-default-1
@ -1284,11 +1404,9 @@ handling properties, see `helm-comp-read'.
This handler should be used when candidate list doesn't need to be rebuilt
dynamically otherwise use `helm-completing-read-default-2'."
(let* ((history (or (car-safe hist) hist))
(initial-input (helm-aif (pcase init
((pred (stringp)) init)
;; INIT is a cons cell.
(`(,l . ,_ll) l))
it))
(initial-input (helm-acase init
((guard (stringp it)) it)
((guard (consp it)) (car it))))
(minibuffer-completion-table collection)
(metadata (or (completion-metadata (or initial-input "") collection test)
'(metadata)))
@ -1344,7 +1462,7 @@ dynamically otherwise use `helm-completing-read-default-2'."
:quit-when-no-cand (eq require-match t)
:nomark (null helm-comp-read-use-marked)
:candidates-in-buffer cands-in-buffer
:get-line get-line
:get-line (or get-line #'buffer-substring)
:exec-when-only-one exec-when-only-one
:fuzzy (eq helm-completion-style 'helm-fuzzy)
:buffer buffer
@ -1367,11 +1485,11 @@ dynamically otherwise use `helm-completing-read-default-2'."
Call `helm-comp-read' with same args as `completing-read'.
For the meaning of optional args see `helm-completing-read-default-1'.
This handler uses dynamic matching which allows honouring `completion-styles'."
(let* ((history (or (car-safe hist) hist))
(input (pcase init
((pred (stringp)) init)
;; INIT is a cons cell.
(`(,l . ,_ll) l)))
(let* ((completion-lazy-hilit t)
(history (or (car-safe hist) hist))
(input (helm-acase init
((guard (stringp it)) it)
((guard (consp it)) (car it))))
(completion-flex-nospace t)
(minibuffer-completion-table collection)
;; (completion-styles
@ -1424,16 +1542,9 @@ This handler uses dynamic matching which allows honouring `completion-styles'."
(append (and default
(memq helm-completion-style '(helm helm-fuzzy))
(list default))
(helm-completion--initial-filter
(let ((lst (if (and sort-fn (> (length str) 0))
(if (and sort-fn (> (length str) 0))
(funcall sort-fn all)
all)))
(if (and default afix)
(prog1 (append (list default)
(delete default lst))
(setq default nil))
lst))
afun afix category)))))
all)))))
(data (if (memq helm-completion-style '(helm helm-fuzzy))
(funcall compfn (or input "") nil nil)
compfn))
@ -1442,7 +1553,20 @@ This handler uses dynamic matching which allows honouring `completion-styles'."
(if (or helm-completion--sorting-done
(string= helm-pattern ""))
candidates
(sort candidates 'helm-generic-sort-fn)))))
(sort candidates 'helm-generic-sort-fn))))
flags)
(helm-aif (and (null category)
(assoc-default name helm-completing-read-command-categories))
(setq metadata `(metadata (category . ,it))
category it))
(helm-aif (and (or (and (boundp 'completions-detailed) completions-detailed)
helm-completions-detailed)
(assoc-default category helm-completing-read-extra-metadata))
(progn
(setq metadata it)
(setq afun (completion-metadata-get metadata 'annotation-function)
afix (completion-metadata-get metadata 'affixation-function)
flags (completion-metadata-get metadata 'flags))))
(unwind-protect
(helm-comp-read
;; Completion-at-point and friends have no prompt.
@ -1454,21 +1578,29 @@ This handler uses dynamic matching which allows honouring `completion-styles'."
:history history
:nomark (null helm-comp-read-use-marked)
:reverse-history helm-mode-reverse-history
;; In helm h-c-styles default is passed directly in
;; candidates.
:default (and (eq helm-completion-style 'emacs) (null afix) default)
;; If DEF is not provided, fallback to empty string
;; to avoid `thing-at-point' to be appended on top of list.
;; FIXME: default is added first in the collection fn, and then it is
;; added here and appended to candidates with the get candidates fn of
;; helm-comp-read, later when sorting default may move somewhere
;; whereas it has to stay on top.
:default (or default "")
:fc-transformer
;; Ensure sort fn is at the end.
(append '(helm-cr-default-transformer)
(and helm-completion-in-region-default-sort-fn
(list helm-completion-in-region-default-sort-fn)))
(append (and (or afix afun (memq category '(file library)))
(list (lambda (candidates source)
(helm-completion--initial-filter
(funcall helm-completion-in-region-default-sort-fn
candidates source)
afun afix category))))
'(helm-cr-default-transformer))
:match-dynamic (eq helm-completion-style 'emacs)
:diacritics helm-mode-ignore-diacritics
:fuzzy (eq helm-completion-style 'helm-fuzzy)
:exec-when-only-one exec-when-only-one
:quit-when-no-cand (eq require-match t)
:must-match require-match)
(setq helm-completion--sorting-done nil))))
(setq helm-completion--sorting-done nil)
(dolist (f flags) (set f nil)))))
(defun helm-mode-all-the-icons-handler (prompt collection test require-match
init hist default inherit-input-method
@ -1667,7 +1799,9 @@ See documentation of `completing-read' and `all-completions' for details."
;; otherwise helm have not the time to close its initial session.
(minibuffer-setup-hook
(cl-loop for h in minibuffer-setup-hook
unless (or (consp h) ; a lambda.
;; lambdas are no more represented as list in
;; Emacs-29+ Bug#2666.
unless (or (and (not (symbolp h)) (functionp h)) ; a lambda.
(byte-code-function-p h)
(helm-subr-native-elisp-p h)
(memq h helm-mode-minibuffer-setup-hook-black-list))
@ -1813,8 +1947,7 @@ Keys description:
(kill-buffer helm-action-buffer))
(mapc (lambda (hook)
(add-hook 'helm-after-update-hook hook))
'(helm-ff-move-to-first-real-candidate
helm-ff-update-when-only-one-matched
'(helm-ff-update-when-only-one-matched
helm-ff-auto-expand-to-home-or-root))
(let* ((action-fn `(("Sole action (Identity)"
. (lambda (candidate)
@ -1842,6 +1975,18 @@ Keys description:
(replace-regexp-in-string "helm-maybe-exit-minibuffer"
"helm-confirm-and-exit-minibuffer"
helm-read-file-name-mode-line-string))
(dummy-src
(unless (eq must-match t)
;; Non existing file or dir source.
(helm-build-dummy-source "New file or directory"
:keymap 'helm-read-file-map
:must-match must-match
:filtered-candidate-transformer
(lambda (_candidates _source)
(unless (file-exists-p helm-pattern)
(list (helm-ff-filter-candidate-one-by-one
helm-pattern nil t))))
:action action-fn)))
(src-list
(list
;; History source.
@ -1859,7 +2004,7 @@ Keys description:
:must-match must-match
:nomark nomark
:action action-fn)
;; Other source.
;; List files source.
(helm-build-sync-source name
:header-name (lambda (name)
(concat name (substitute-command-keys
@ -1883,12 +2028,11 @@ Keys description:
(cl-loop with hn = (helm-ff--tramp-hostnames)
;; helm-find-files-get-candidates is
;; returning a list of cons cells.
for (d . r) in (helm-find-files-get-candidates
must-match)
for (d . r) in (helm-find-files-get-candidates)
when (or (member r hn) ; A tramp host
(funcall test r)) ; Test ok
collect (cons d r)))
(helm-find-files-get-candidates must-match)))
(helm-find-files-get-candidates)))
:update (lambda ()
(remhash helm-ff-default-directory
helm-ff--list-directory-cache))
@ -1906,13 +2050,15 @@ Keys description:
:action action-fn)))
;; Helm result.
(result (helm
:sources (if helm-mode-reverse-history
:sources (append (if helm-mode-reverse-history
(reverse src-list) src-list)
(list dummy-src))
:input (if (string-match helm-ff-url-regexp initial-input)
initial-input
(expand-file-name initial-input))
:prompt prompt
:candidate-number-limit candidate-number-limit
:dim-prompt-on-update t
:resume 'noresume
:case-fold-search case-fold
:default default
@ -2182,6 +2328,7 @@ When AFUN, AFIX are nil and CATEGORY is not file return COMPS unmodified."
(if (functionp affixations)
(cl-loop for comp in comps
for cand = (funcall affixations comp)
when cand
collect (cons (propertize (concat (nth 1 cand) ;prefix
(nth 0 cand) ;comp
(nth 2 cand)) ;suffix
@ -2198,16 +2345,10 @@ When AFUN, AFIX are nil and CATEGORY is not file return COMPS unmodified."
;; completing against a quoted symbol.
(mapcar (lambda (s)
(let ((ann (funcall afun s)))
(if ann
(cons
(concat
s
(propertize
" " 'display
(propertize
(or (helm-aand
ann
'face 'completions-annotations)))
s)
(propertize ann 'face 'helm-completions-annotations)
(cons (concat s (propertize " " 'display it)) s))
s)))
comps))
(t comps)))
@ -2216,7 +2357,7 @@ When AFUN, AFIX are nil and CATEGORY is not file return COMPS unmodified."
(defun helm-completion-try-completion (string table pred point)
"The try completion function for `completing-styles-alist'.
Actually does nothing."
Currently does nothing."
;; AFAIU the try-completions style functions
;; are here to check if what is at point is suitable for TABLE but
;; there is no way to pass a multiple pattern from what is at point
@ -2228,10 +2369,8 @@ Actually does nothing."
(defun helm-completion-all-completions (string table pred point)
"The all completions function for `completing-styles-alist'."
;; FIXME: No need to bind all these value.
;; (cl-multiple-value-bind (all _pattern prefix _suffix _carbounds)
(pcase-let ((`(,all ,_pattern ,prefix ,_suffix ,_carbounds)
(helm-completion--multi-all-completions string table pred point)))
(cl-multiple-value-bind (all _pattern prefix _suffix _carbounds)
(helm-completion--multi-all-completions string table pred point)
(when all (nconc all (length prefix)))))
(defun helm-completion--multi-all-completions-1 (string collection &optional predicate)
@ -2299,7 +2438,7 @@ Actually does nothing."
(suffix (substring afterpoint (cdr bounds)))
(all (helm-completion--multi-all-completions-1
;; Using `regexp-quote' on STRING fixes bug#2355 but
;; breaks regexp matching in multi match, actually with
;; breaks regexp matching in multi match, currently with
;; Helm-3.7.1 and emacs-27+ it seems using plain STRING
;; works for both so use it.
;;(regexp-quote string)
@ -2329,8 +2468,8 @@ Actually does nothing."
;; It is needed here to make minibuffer-complete work in emacs-26,
;; e.g. with regular M-x.
(unless (string-match-p " " string)
(pcase-let ((`(,all ,pattern ,prefix ,suffix ,_carbounds)
(helm-completion--flex-all-completions string table pred point)))
(cl-multiple-value-bind (all pattern prefix suffix _carbounds)
(helm-completion--flex-all-completions string table pred point)
(when minibuffer-completing-file-name
(setq all (completion-pcm--filename-try-filter all)))
(completion-pcm--merge-try pattern all prefix suffix))))
@ -2339,10 +2478,10 @@ Actually does nothing."
"The all completions function for `completing-styles-alist'."
;; FIXME: No need to bind all these value.
(unless (string-match-p " " string)
(pcase-let ((`(,all ,pattern ,prefix ,_suffix ,_carbounds)
(cl-multiple-value-bind (all pattern prefix _suffix _carbounds)
(helm-completion--flex-all-completions
string table pred point
#'helm-completion--flex-transform-pattern)))
#'helm-completion--flex-transform-pattern)
(let ((regexp (completion-pcm--pattern->regex pattern 'group)))
(when all (nconc (helm-flex-add-score-as-prop all regexp)
(length prefix)))))))
@ -2398,8 +2537,19 @@ Can be used for `completion-in-region-function' by advicing it with an
;; relaying on crap old completion-styles emacs22 which
;; add suffix after prefix. e.g. def|else.
(initial-input (buffer-substring-no-properties start (point)))
(current-command (or (helm-this-command)
this-command
;; Some backends are async and
;; use a callback, in those
;; cases, we can't retrieve from
;; frames the last interactive
;; command, so fallback to
;; `last-command' which may be
;; the one that called the callback.
last-command))
string)
(helm-aif (cdr (assq major-mode helm-completion-styles-alist))
(helm-aif (cdr (or (assq major-mode helm-completion-styles-alist)
(assq current-command helm-completion-styles-alist)))
(customize-set-variable 'helm-completion-style
(if (cdr-safe it) (car it) it)))
;; This hook force usage of the display part of candidate with
@ -2414,26 +2564,16 @@ Can be used for `completion-in-region-function' by advicing it with an
(input (buffer-substring-no-properties start end))
(prefix (and (eq helm-completion-style 'emacs) initial-input))
(point (point))
(current-command (or (helm-this-command)
this-command
;; Some backends are async and
;; use a callback, in those
;; cases, we can't retrieve from
;; frames the last interactive
;; command, so fallback to
;; `last-command' which may be
;; the one that called the callback.
last-command))
(crm (eq current-command 'crm-complete))
(str-command (helm-symbol-name current-command))
(buf-name (format "*helm-mode-%s*" str-command))
(require-match (or (and (boundp 'require-match) require-match)
minibuffer-completion-confirm
(require-match (cond ((boundp 'require-match) require-match)
(minibuffer-completion-confirm)
;; If prompt have not been propagated here, that's
;; probably mean we have no prompt and we are in
;; completion-at-point or friend, so use a non--nil
;; value for require-match.
(not (boundp 'prompt))))
((not (boundp 'prompt)))))
(metadata (completion-metadata input collection predicate))
;; `completion-extra-properties' is let-bounded in `completion-at-point'.
;; `afun' is a closure to call against each string in `data'.
@ -2446,10 +2586,6 @@ Can be used for `completion-in-region-function' by advicing it with an
;; completion-in-region, try anyway never know.
(afix (or (plist-get completion-extra-properties :affixation-function)
(completion-metadata-get metadata 'affixation-function)))
(init-space-suffix (unless (or (memq helm-completion-style '(helm-fuzzy emacs))
(string-suffix-p " " input)
(string= input ""))
" "))
(category (or (eq (completion-metadata-get metadata 'category) 'file)
(eq (plist-get completion-extra-properties :category) 'file)))
(file-comp-p (or (eq category 'file)
@ -2458,7 +2594,8 @@ Can be used for `completion-in-region-function' by advicing it with an
;; so data looks like this: '(a b c d . 0) and (last data) == (d . 0).
base-size
(compfn (lambda (str _predicate _action)
(let* ((completion-ignore-case (helm-set-case-fold-search))
(let* ((completion-lazy-hilit t)
(completion-ignore-case (helm-set-case-fold-search))
(comps
(completion-all-completions
str ; This is helm-pattern
@ -2503,11 +2640,9 @@ Can be used for `completion-in-region-function' by advicing it with an
(unless base-size (setq base-size bs))
(setq helm-completion--sorting-done (and sort-fn t))
(setq all (copy-sequence comps))
(helm-completion--initial-filter
(if (and sort-fn (> (length str) 0))
(funcall sort-fn all)
all)
afun afix category))))
all))))
(data (if (memq helm-completion-style '(helm helm-fuzzy))
(funcall compfn input nil nil)
compfn))
@ -2523,27 +2658,29 @@ Can be used for `completion-in-region-function' by advicing it with an
:initial-input
(cond ((and file-comp-p
(not (string-match "/\\'" initial-input)))
(concat (helm-mode--completion-in-region-initial-input
(helm-mode--completion-in-region-initial-input
(if (memq helm-completion-style '(helm helm-fuzzy))
(helm-basename initial-input)
initial-input))
init-space-suffix))
initial-input)))
((string-match "/\\'" initial-input)
(and (eq helm-completion-style 'emacs) initial-input))
((or (null require-match)
(stringp require-match))
(helm-mode--completion-in-region-initial-input initial-input))
(t (concat (helm-mode--completion-in-region-initial-input initial-input)
init-space-suffix)))
(t (helm-mode--completion-in-region-initial-input initial-input)))
:buffer buf-name
:fc-transformer
;; Ensure sort fn is at the end.
(append '(helm-cr-default-transformer)
(and helm-completion-in-region-default-sort-fn
(list helm-completion-in-region-default-sort-fn)))
(append (and (or afix afun (memq category '(file library)))
(list (lambda (candidates source)
(helm-completion--initial-filter
(funcall helm-completion-in-region-default-sort-fn
candidates source)
afun afix category))))
'(helm-cr-default-transformer))
:match-dynamic (eq helm-completion-style 'emacs)
:fuzzy (eq helm-completion-style 'helm-fuzzy)
:exec-when-only-one t
:keymap helm-comp-in-region-map
:quit-when-no-cand
(lambda ()
;; Delay message to overwrite "Quit".
@ -2561,18 +2698,20 @@ Can be used for `completion-in-region-function' by advicing it with an
(helm-completion-in-region--insert-result
result start point end base-size))
;; Allow running extra property `:exit-function' (Bug#2265,
;; Bug#2356). Function is called with 'exact if for a unique
;; match which is exact, the return value of `try-completion'
;; is t or a string ending with "/" i.e. possibly a directory
;; (Bug#2274),
;; otherwise it is called with 'finished.
;; Bug#2356). Function is called with 'exact if the return value of
;; `try-completion' is a string ending with / (possibly a directory
;; Bug#2274), otherwise it is always called with 'finished. However it
;; is still not clear what to use, the documentation on this beeing
;; really bad (see bug#2646).
(when (and (stringp string) exit-fun)
(let ((tcomp (try-completion initial-input collection)))
(funcall exit-fun string
(if (or (eq tcomp t) ; Unique.
(and (stringp tcomp)
(string-match "/\\'" tcomp))) ; A directory.
'exact 'finished))))
(helm-acase (try-completion initial-input collection predicate)
((guard (and (stringp it)
(or (string-match "/\\'" it)
;; Fix bug#2669.
(string-match "/\\'" string))))
'exact)
(t 'finished))))
(remove-hook 'helm-before-action-hook 'helm-completion-in-region--selection)
(customize-set-variable 'helm-completion-style old--helm-completion-style)
(setq helm-completion--sorting-done nil)

Some files were not shown because too many files have changed in this diff Show more