elpa updates
This commit is contained in:
parent
cb49eaf0af
commit
c8dc9e9f02
|
|
@ -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"))
|
'((emacs "24.3"))
|
||||||
:commit "ee414384938ccf2ce93c77d717b85dc5538a257d" :authors
|
:commit "39ef44f810c34e8900978788467cc675870bcd19" :authors
|
||||||
'(("Dominic Charlesworth" . "dgc336@gmail.com"))
|
'(("Dominic Charlesworth" . "dgc336@gmail.com"))
|
||||||
:maintainers
|
:maintainers
|
||||||
'(("Dominic Charlesworth" . "dgc336@gmail.com"))
|
'(("Dominic Charlesworth" . "dgc336@gmail.com"))
|
||||||
|
|
@ -168,6 +168,12 @@
|
||||||
("dll" all-the-icons-faicon "cogs" :face all-the-icons-silver)
|
("dll" all-the-icons-faicon "cogs" :face all-the-icons-silver)
|
||||||
("ds_store" all-the-icons-faicon "cogs" :face all-the-icons-silver)
|
("ds_store" all-the-icons-faicon "cogs" :face all-the-icons-silver)
|
||||||
;; Source Codes
|
;; 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)
|
("scpt" all-the-icons-fileicon "apple" :face all-the-icons-pink)
|
||||||
("aup" all-the-icons-fileicon "audacity" :face all-the-icons-yellow)
|
("aup" all-the-icons-fileicon "audacity" :face all-the-icons-yellow)
|
||||||
("elm" all-the-icons-fileicon "elm" :face all-the-icons-blue)
|
("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)
|
("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)
|
("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)
|
("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)
|
("matlab" all-the-icons-fileicon "matlab" :face all-the-icons-orange)
|
||||||
("nix" all-the-icons-fileicon "nix" :face all-the-icons-blue)
|
("nix" all-the-icons-fileicon "nix" :face all-the-icons-blue)
|
||||||
("pl" all-the-icons-alltheicon "perl" :face all-the-icons-lorange)
|
("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)
|
(perl-mode all-the-icons-alltheicon "perl" :face all-the-icons-lorange)
|
||||||
(cperl-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-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)
|
(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-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)
|
(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)
|
(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)
|
(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)
|
(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-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-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)
|
(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-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)
|
(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)
|
(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)
|
(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)
|
(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)))
|
(ess-r-mode all-the-icons-fileicon "R" :face all-the-icons-lblue)))
|
||||||
File diff suppressed because it is too large
Load diff
|
|
@ -138,6 +138,11 @@ Same as `byte-compile-file' but asynchronous.
|
||||||
(fn FILE)" t)
|
(fn FILE)" t)
|
||||||
(register-definition-prefixes "async-bytecomp" '("async-"))
|
(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
|
;;; Generated autoloads from dired-async.el
|
||||||
|
|
||||||
|
|
@ -60,19 +60,11 @@ all packages are always compiled asynchronously."
|
||||||
(defvar async-bytecomp-load-variable-regexp "\\`load-path\\'"
|
(defvar async-bytecomp-load-variable-regexp "\\`load-path\\'"
|
||||||
"The variable used by `async-inject-variables' when (re)compiling async.")
|
"The variable used by `async-inject-variables' when (re)compiling async.")
|
||||||
|
|
||||||
;;;###autoload
|
(defun async-bytecomp--file-to-comp-buffer (file-or-dir &optional quiet type)
|
||||||
(defun async-byte-recompile-directory (directory &optional quiet)
|
(let ((bn (file-name-nondirectory file-or-dir))
|
||||||
"Compile all *.el files in DIRECTORY asynchronously.
|
(action-name (pcase type
|
||||||
All *.elc files are systematically deleted before proceeding."
|
('file "File")
|
||||||
(cl-loop with dir = (directory-files directory t "\\.elc\\'")
|
('directory "Directory"))))
|
||||||
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)
|
|
||||||
(if (file-exists-p async-byte-compile-log-file)
|
(if (file-exists-p async-byte-compile-log-file)
|
||||||
(let ((buf (get-buffer-create byte-compile-log-buffer))
|
(let ((buf (get-buffer-create byte-compile-log-buffer))
|
||||||
(n 0))
|
(n 0))
|
||||||
|
|
@ -89,10 +81,26 @@ All *.elc files are systematically deleted before proceeding."
|
||||||
(while (re-search-forward "^.*:Error:" nil t)
|
(while (re-search-forward "^.*:Error:" nil t)
|
||||||
(cl-incf n)))
|
(cl-incf n)))
|
||||||
(if (> n 0)
|
(if (> n 0)
|
||||||
(message "Failed to compile %d files in directory `%s'" n directory)
|
(message "Failed to compile %d files in directory `%s'" n bn)
|
||||||
(message "Directory `%s' compiled asynchronously with warnings" directory)))))
|
(message "%s `%s' compiled asynchronously with warnings"
|
||||||
|
action-name bn)))))
|
||||||
(unless quiet
|
(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
|
(async-start
|
||||||
`(lambda ()
|
`(lambda ()
|
||||||
(require 'bytecomp)
|
(require 'bytecomp)
|
||||||
|
|
@ -140,13 +148,10 @@ All *.elc files are systematically deleted before proceeding."
|
||||||
(memq cur-package (async-bytecomp--get-package-deps
|
(memq cur-package (async-bytecomp--get-package-deps
|
||||||
async-bytecomp-allowed-packages)))
|
async-bytecomp-allowed-packages)))
|
||||||
(progn
|
(progn
|
||||||
;; FIXME: Why do we use (eq cur-package 'async) once
|
|
||||||
;; and (string= cur-package "async") afterwards?
|
|
||||||
(when (eq cur-package 'async)
|
(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
|
;; Add to `load-path' the latest version of async and
|
||||||
;; reload it when reinstalling async.
|
;; reload it when reinstalling async.
|
||||||
(when (string= cur-package "async")
|
|
||||||
(cl-pushnew pkg-dir load-path)
|
(cl-pushnew pkg-dir load-path)
|
||||||
(load "async-bytecomp"))
|
(load "async-bytecomp"))
|
||||||
;; `async-byte-recompile-directory' will add directory
|
;; `async-byte-recompile-directory' will add directory
|
||||||
|
|
@ -173,28 +178,13 @@ Same as `byte-compile-file' but asynchronous."
|
||||||
(interactive "fFile: ")
|
(interactive "fFile: ")
|
||||||
(let ((call-back
|
(let ((call-back
|
||||||
(lambda (&optional _ignore)
|
(lambda (&optional _ignore)
|
||||||
(let ((bn (file-name-nondirectory file)))
|
(async-bytecomp--file-to-comp-buffer file nil '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-start
|
(async-start
|
||||||
`(lambda ()
|
`(lambda ()
|
||||||
(require 'bytecomp)
|
(require 'bytecomp)
|
||||||
,(async-inject-variables async-bytecomp-load-variable-regexp)
|
,(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)
|
(add-to-list 'load-path default-directory)
|
||||||
(byte-compile-file ,file)
|
(byte-compile-file ,file)
|
||||||
(when (get-buffer byte-compile-log-buffer)
|
(when (get-buffer byte-compile-log-buffer)
|
||||||
132
code/elpa/async-20240719.640/async-package.el
Normal file
132
code/elpa/async-20240719.640/async-package.el
Normal 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
|
||||||
|
|
@ -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"))
|
'((emacs "24.4"))
|
||||||
:commit "a368df08d34ae0c0a36fc3e90b1ecda252915257" :authors
|
:commit "93957f5b0f2ed22aeef02972de860fb9c45b4422" :authors
|
||||||
'(("John Wiegley" . "jwiegley@gmail.com"))
|
'(("John Wiegley" . "jwiegley@gmail.com"))
|
||||||
:maintainers
|
:maintainers
|
||||||
'(("Thierry Volpiatto" . "thievol@posteo.net"))
|
'(("Thierry Volpiatto" . "thievol@posteo.net"))
|
||||||
|
|
@ -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."
|
for password is required unless a password is stored in a \".authinfo\" file."
|
||||||
:type 'boolean)
|
: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-debug nil)
|
||||||
(defvar async-send-over-pipe t)
|
(defvar async-send-over-pipe t)
|
||||||
(defvar async-in-child-emacs nil)
|
(defvar async-in-child-emacs nil)
|
||||||
|
|
@ -110,14 +117,17 @@ is returned unmodified."
|
||||||
collect elm))
|
collect elm))
|
||||||
(t object)))
|
(t object)))
|
||||||
|
|
||||||
|
(defvar async-inject-variables-exclude-regexps '("-syntax-table\\'")
|
||||||
|
"A list of regexps that `async-inject-variables' should ignore.")
|
||||||
|
|
||||||
(defun async-inject-variables
|
(defun async-inject-variables
|
||||||
(include-regexp &optional predicate exclude-regexp noprops)
|
(include-regexp &optional predicate exclude-regexp noprops)
|
||||||
"Return a `setq' form that replicates part of the calling environment.
|
"Return a `setq' form that replicates part of the calling environment.
|
||||||
|
|
||||||
It sets the value for every variable matching INCLUDE-REGEXP and
|
It sets the value for every variable matching INCLUDE-REGEXP and
|
||||||
also PREDICATE. It will not perform injection for any variable
|
also PREDICATE. It will not perform injection for any variable
|
||||||
matching EXCLUDE-REGEXP (if present) or representing a `syntax-table'
|
matching EXCLUDE-REGEXP (if present) and variables matching one of
|
||||||
i.e. ending by \"-syntax-table\".
|
`async-inject-variables-exclude-regexps'.
|
||||||
When NOPROPS is non nil it tries to strip out text properties of each
|
When NOPROPS is non nil it tries to strip out text properties of each
|
||||||
variable's value with `async-variables-noprops-function'.
|
variable's value with `async-variables-noprops-function'.
|
||||||
|
|
||||||
|
|
@ -136,14 +146,16 @@ It is intended to be used as follows:
|
||||||
,@(let (bindings)
|
,@(let (bindings)
|
||||||
(mapatoms
|
(mapatoms
|
||||||
(lambda (sym)
|
(lambda (sym)
|
||||||
(let* ((sname (and (boundp sym) (symbol-name sym)))
|
(let ((sname (and (boundp sym) (symbol-name sym)))
|
||||||
(value (and sname (symbol-value sym))))
|
value)
|
||||||
(when (and sname
|
(when (and sname
|
||||||
(or (null include-regexp)
|
(or (null include-regexp)
|
||||||
(string-match include-regexp sname))
|
(string-match include-regexp sname))
|
||||||
(or (null exclude-regexp)
|
(or (null exclude-regexp)
|
||||||
(not (string-match exclude-regexp sname)))
|
(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)
|
(unless (or (stringp value)
|
||||||
(memq value '(nil t))
|
(memq value '(nil t))
|
||||||
(numberp value)
|
(numberp value)
|
||||||
|
|
@ -426,7 +438,8 @@ working directory."
|
||||||
:name name
|
:name name
|
||||||
:buffer buf
|
:buffer buf
|
||||||
:stderr buf-err
|
:stderr buf-err
|
||||||
:command (cons program program-args)))))
|
:command (cons program program-args)
|
||||||
|
:noquery async-process-noquery-on-exit))))
|
||||||
(set-process-sentinel
|
(set-process-sentinel
|
||||||
(get-buffer-process buf-err)
|
(get-buffer-process buf-err)
|
||||||
(lambda (proc _change)
|
(lambda (proc _change)
|
||||||
|
|
@ -387,6 +387,7 @@ ESC or `q' to not overwrite any of the remaining files,
|
||||||
(dired-copy-preserve-time
|
(dired-copy-preserve-time
|
||||||
,dired-copy-preserve-time)
|
,dired-copy-preserve-time)
|
||||||
(dired-create-destination-dirs ',create-dir)
|
(dired-create-destination-dirs ',create-dir)
|
||||||
|
(dired-vc-rename-file ,dired-vc-rename-file)
|
||||||
auth-source-save-behavior)
|
auth-source-save-behavior)
|
||||||
(setq overwrite-backup-query nil)
|
(setq overwrite-backup-query nil)
|
||||||
;; Inline `backup-file' as long as it is not
|
;; Inline `backup-file' as long as it is not
|
||||||
|
|
@ -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
|
|
||||||
|
|
@ -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:
|
|
||||||
|
|
@ -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:
|
;;; Code:
|
||||||
|
|
||||||
(add-to-list 'load-path (directory-file-name
|
(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path)))
|
||||||
(or (file-name-directory #$) (car load-path))))
|
|
||||||
|
|
||||||
|
|
||||||
;;;### (autoloads nil "centaur-tabs" "centaur-tabs.el" (0 0 0 0))
|
|
||||||
;;; Generated autoloads from centaur-tabs.el
|
;;; Generated autoloads from centaur-tabs.el
|
||||||
|
|
||||||
(autoload 'centaur-tabs-local-mode "centaur-tabs" "\
|
(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
|
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.
|
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 "\
|
(defvar centaur-tabs-mode nil "\
|
||||||
Non-nil if Centaur-Tabs mode is enabled.
|
Non-nil if Centaur-Tabs mode is enabled.
|
||||||
See the `centaur-tabs-mode' command
|
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;
|
Setting this variable directly does not take effect;
|
||||||
either customize it (see the info node `Easy Customization')
|
either customize it (see the info node `Easy Customization')
|
||||||
or call the function `centaur-tabs-mode'.")
|
or call the function `centaur-tabs-mode'.")
|
||||||
|
|
||||||
(custom-autoload 'centaur-tabs-mode "centaur-tabs" nil)
|
(custom-autoload 'centaur-tabs-mode "centaur-tabs" nil)
|
||||||
|
|
||||||
(autoload 'centaur-tabs-mode "centaur-tabs" "\
|
(autoload 'centaur-tabs-mode "centaur-tabs" "\
|
||||||
Toggle display of a tab bar in the header line.
|
Toggle display of a tab bar in the header line.
|
||||||
With prefix argument ARG, turn on if positive, otherwise off.
|
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}
|
\\{centaur-tabs-mode-map}
|
||||||
|
|
||||||
\(fn &optional ARG)" t nil)
|
(fn &optional ARG)" t)
|
||||||
|
|
||||||
(register-definition-prefixes "centaur-tabs" '("centaur-tabs-"))
|
(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
|
;;; 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
|
;;; Generated autoloads from centaur-tabs-functions.el
|
||||||
|
|
||||||
(autoload 'centaur-tabs-backward "centaur-tabs-functions" "\
|
(autoload 'centaur-tabs-backward "centaur-tabs-functions" "\
|
||||||
Select the previous available tab.
|
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" "\
|
(autoload 'centaur-tabs-forward "centaur-tabs-functions" "\
|
||||||
Select the next available tab.
|
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" "\
|
(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" "\
|
(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" "\
|
(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" "\
|
(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-"))
|
(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
|
;;; Generated autoloads from centaur-tabs-interactive.el
|
||||||
|
|
||||||
(autoload 'centaur-tabs-counsel-switch-group "centaur-tabs-interactive" "\
|
(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-"))
|
(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:
|
;; Local Variables:
|
||||||
;; version-control: never
|
;; version-control: never
|
||||||
;; no-byte-compile: t
|
;; no-byte-compile: t
|
||||||
;; no-update-autoloads: t
|
;; no-update-autoloads: t
|
||||||
;; coding: utf-8
|
;; no-native-compile: t
|
||||||
|
;; coding: utf-8-emacs-unix
|
||||||
;; End:
|
;; End:
|
||||||
|
|
||||||
;;; centaur-tabs-autoloads.el ends here
|
;;; centaur-tabs-autoloads.el ends here
|
||||||
891
code/elpa/centaur-tabs-20240726.625/centaur-tabs-elements.el
Normal file
891
code/elpa/centaur-tabs-20240726.625/centaur-tabs-elements.el
Normal 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
|
||||||
|
|
@ -1,10 +1,10 @@
|
||||||
;;; centaur-tabs-functions.el --- centaur-tabs logic components -*- lexical-binding: t; -*-
|
;;; 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 file is not part of GNU Emacs.
|
||||||
|
|
||||||
;;
|
|
||||||
;; This program is free software; you can redistribute it and/or
|
;; This program is free software; you can redistribute it and/or
|
||||||
;; modify it under the terms of the GNU General Public License as
|
;; modify it under the terms of the GNU General Public License as
|
||||||
;; published by the Free Software Foundation; either version 2, or
|
;; 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
|
;; along with this program; see the file COPYING. If not, write to
|
||||||
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
|
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
|
||||||
;; Floor, Boston, MA 02110-1301, USA.
|
;; Floor, Boston, MA 02110-1301, USA.
|
||||||
;;
|
|
||||||
;;; Commentary:
|
;;; Commentary:
|
||||||
|
;;
|
||||||
;; This file contains functions that control the logic of centaur-tabs
|
;; This file contains functions that control the logic of centaur-tabs
|
||||||
|
;;
|
||||||
|
|
||||||
;;; Code:
|
;;; Code:
|
||||||
;;; Require
|
|
||||||
(require 'cl-lib)
|
(require 'cl-lib)
|
||||||
(require 'seq)
|
(require 'seq)
|
||||||
(require 'centaur-tabs-elements)
|
(require 'centaur-tabs-elements)
|
||||||
|
|
||||||
;; Compiler pacifier
|
;; Compiler pacifier
|
||||||
(declare-function ivy-read "ext:ivy.el" t t)
|
(declare-function vterm "ext:vterm.el")
|
||||||
(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 centaur-tabs-move-current-tab-to-right "nerd-icons.el")
|
||||||
(declare-function all-the-icons-auto-mode-match? "ext:all-the-icons.el" t t)
|
(declare-function centaur-tabs-move-current-tab-to-left "nerd-icons.el")
|
||||||
(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)
|
(defvar centaur-tabs--buffer-show-groups)
|
||||||
(declare-function nerd-icons-match? "ext:nerd-icons.el" t t)
|
(defvar centaur-tabs-ace-jump-active)
|
||||||
(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 centaur-tabs-mode "centaur-tabs.el")
|
||||||
(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)
|
|
||||||
|
|
||||||
;;; Customs
|
|
||||||
;;
|
;;
|
||||||
|
;;; Customs
|
||||||
|
|
||||||
(defcustom centaur-tabs-cycle-scope nil
|
(defcustom centaur-tabs-cycle-scope nil
|
||||||
"*Specify the scope of cyclic navigation through tabs.
|
"*Specify the scope of cyclic navigation through tabs.
|
||||||
The following scopes are possible:
|
The following scopes are possible:
|
||||||
|
|
@ -71,7 +70,8 @@ visible."
|
||||||
:type 'boolean)
|
:type 'boolean)
|
||||||
|
|
||||||
(defcustom centaur-tabs-common-group-name "Common"
|
(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
|
:group 'centaur-tabs
|
||||||
:type 'string)
|
:type 'string)
|
||||||
|
|
||||||
|
|
@ -95,6 +95,9 @@ visible."
|
||||||
"*Helm"
|
"*Helm"
|
||||||
" *which"
|
" *which"
|
||||||
"*Compile-Log*"
|
"*Compile-Log*"
|
||||||
|
"*Choices"
|
||||||
|
"*Process"
|
||||||
|
"*Calc"
|
||||||
"*lsp"
|
"*lsp"
|
||||||
"*LSP"
|
"*LSP"
|
||||||
"*company"
|
"*company"
|
||||||
|
|
@ -103,15 +106,17 @@ visible."
|
||||||
"*ediff"
|
"*ediff"
|
||||||
"*tramp"
|
"*tramp"
|
||||||
" *Mini"
|
" *Mini"
|
||||||
"*help"
|
|
||||||
"*straight"
|
"*straight"
|
||||||
" *temp"
|
" *temp")
|
||||||
"*Help")
|
|
||||||
"List of prefixes that indicates which buffers should not be included as tabs.
|
"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."
|
Buffers that have names that start with any of these strings will be ignored."
|
||||||
:type '(repeat string)
|
:type '(repeat string)
|
||||||
:group 'centaur-tabs)
|
: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
|
(defvar centaur-tabs-hide-tab-function 'centaur-tabs-hide-tab
|
||||||
"Function to hide tabs.
|
"Function to hide tabs.
|
||||||
This function filters tabs. The tab will hide if this function returns t.")
|
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 ()
|
(defun centaur-tabs-headline-match ()
|
||||||
"Make headline use centaur-tabs-default-face."
|
"Make headline use centaur-tabs-default-face."
|
||||||
(set-face-attribute centaur-tabs-display-line nil :background (face-background 'centaur-tabs-unselected nil 'default)
|
(set-face-attribute
|
||||||
:box nil
|
centaur-tabs-display-line nil
|
||||||
:overline nil
|
:background (face-background 'centaur-tabs-unselected nil 'default)
|
||||||
:underline nil))
|
:box nil :overline nil :underline nil))
|
||||||
|
|
||||||
;; Change the font and height for all tab faces
|
;; Change the font and height for all tab faces
|
||||||
(defun centaur-tabs-change-fonts (family height)
|
(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 '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-down) 'centaur-tabs-forward )
|
||||||
(define-key map (vector centaur-tabs-display-line 'wheel-up ) 'centaur-tabs-backward)
|
(define-key map (vector centaur-tabs-display-line 'wheel-up ) 'centaur-tabs-backward)
|
||||||
|
|
||||||
;;; Use right click to show the rest of groups
|
;;; Use right click to show the rest of groups
|
||||||
(define-key map (vector centaur-tabs-display-line 'mouse-3) 'centaur-tabs--tab-menu )
|
(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)
|
map)
|
||||||
"Keymap to use in Centaur-Tabs mode.")
|
"Keymap to use in Centaur-Tabs mode.")
|
||||||
|
|
||||||
|
|
@ -294,87 +294,9 @@ When not specified, ELLIPSIS defaults to ‘...’."
|
||||||
map)
|
map)
|
||||||
"Keymap used for setting mouse events for new tab button.")
|
"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
|
;;; Tab and tab sets
|
||||||
;;
|
|
||||||
(defsubst centaur-tabs-make-tab (object tabset)
|
(defsubst centaur-tabs-make-tab (object tabset)
|
||||||
"Return a new tab with value OBJECT.
|
"Return a new tab with value OBJECT.
|
||||||
TABSET is the tab set the tab belongs to."
|
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.
|
"Hook run after tab bar data has been initialized.
|
||||||
You should use this hook to initialize dependent data.")
|
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 ()
|
(defsubst centaur-tabs-init-tabsets-store ()
|
||||||
"Initialize the tab set store."
|
"Initialize the tab set store."
|
||||||
(setq centaur-tabs-tabsets (make-vector 31 0)
|
(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)
|
(defun centaur-tabs-make-tabset (name &rest objects)
|
||||||
"Make a new tab set whose name is the string NAME.
|
"Make a new tab set whose name is the string NAME.
|
||||||
It is initialized with tabs build from the list of OBJECTS."
|
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))
|
(let* ((tabset (intern name centaur-tabs-tabsets))
|
||||||
(tabs (cl-mapcar #'(lambda (object)
|
(tabs (mapcar #'(lambda (object)
|
||||||
(centaur-tabs-make-tab object tabset))
|
(centaur-tabs-make-tab object tabset))
|
||||||
objects)))
|
objects)))
|
||||||
(set tabset tabs)
|
(set tabset tabs)
|
||||||
(centaur-tabs-put-cache tabset 'select (car tabs))
|
(centaur-tabs-put-cache tabset 'select (car tabs))
|
||||||
(put tabset 'start 0)
|
(put tabset 'start 0)
|
||||||
tabset))
|
tabset)))
|
||||||
|
|
||||||
(defsubst centaur-tabs-get-tabset (name)
|
(defsubst centaur-tabs-get-tabset (name)
|
||||||
"Return the tab set whose name is the string 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)
|
(defsubst centaur-tabs-tab-values (tabset)
|
||||||
"Return the list of tab values in 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)
|
(defun centaur-tabs-get-cache (cache key)
|
||||||
"Return the per-frame cached value of KEY in CACHE."
|
"Return the cached value of KEY in CACHE."
|
||||||
(let
|
(when-let* ((cache (format "%s" cache))
|
||||||
((cached-hash (frame-parameter nil cache)))
|
(cached-hash (gethash cache centaur-tabs-display-hash))
|
||||||
(if (hash-table-p cached-hash)
|
((hash-table-p cached-hash)))
|
||||||
(gethash key cached-hash nil))))
|
(gethash key cached-hash nil)))
|
||||||
|
|
||||||
(defun centaur-tabs-put-cache (cache key value)
|
(defun centaur-tabs-put-cache (cache key value)
|
||||||
"Set the per-frame cached value of KEY in CACHE to VALUE."
|
"Set the cached value of KEY in CACHE to VALUE."
|
||||||
(let*
|
(let* ((cache (format "%s" cache))
|
||||||
((cached-hash (frame-parameter nil cache))
|
(cached-hash (gethash cache centaur-tabs-display-hash))
|
||||||
(hash (if (hash-table-p cached-hash) cached-hash (make-hash-table))))
|
(hash (if (hash-table-p cached-hash) cached-hash (make-hash-table))))
|
||||||
(puthash key value hash)
|
(puthash key value hash)
|
||||||
(set-frame-parameter nil cache hash))
|
(puthash cache hash centaur-tabs-display-hash))
|
||||||
value)
|
value)
|
||||||
|
|
||||||
(defsubst centaur-tabs-get-tab (object tabset)
|
(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)
|
(defsubst centaur-tabs-template (tabset)
|
||||||
"Return the cached visual representation of TABSET.
|
"Return the cached visual representation of TABSET.
|
||||||
That is, a `centaur-tabs-display-line-format' template, or nil if the cache is
|
That is, a `centaur-tabs-display-line-format' template, or nil if
|
||||||
empty."
|
the cache is empty."
|
||||||
(centaur-tabs-get-cache tabset 'template))
|
(centaur-tabs-get-cache tabset 'template))
|
||||||
|
|
||||||
(defsubst centaur-tabs-set-template (tabset template)
|
(defsubst centaur-tabs-set-template (tabset template)
|
||||||
"Set the cached visual representation of TABSET to TEMPLATE.
|
"Set the cached visual representation of TABSET to TEMPLATE.
|
||||||
TEMPLATE must be a valid `centaur-tabs-display-line-format' template, or nil to
|
TEMPLATE must be a valid `centaur-tabs-display-line-format' template,
|
||||||
cleanup the cache."
|
or nil to cleanup the cache."
|
||||||
(centaur-tabs-put-cache tabset 'template template))
|
(centaur-tabs-put-cache tabset 'template template))
|
||||||
|
|
||||||
(defsubst centaur-tabs-selected-tab (tabset)
|
(defsubst centaur-tabs-selected-tab (tabset)
|
||||||
|
|
@ -551,7 +477,7 @@ Otherwise insert it."
|
||||||
tabs
|
tabs
|
||||||
(let* ((tab (centaur-tabs-make-tab object tabset))
|
(let* ((tab (centaur-tabs-make-tab object tabset))
|
||||||
(selected (centaur-tabs-selected-tab 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)
|
(centaur-tabs-set-template tabset nil)
|
||||||
(set tabset (centaur-tabs-insert-at tabs selected-index tab))))))
|
(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-set-template centaur-tabs-tabsets-tabset nil)
|
||||||
centaur-tabs-tabsets-tabset)
|
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
|
;; Functions for modification hooks and advices
|
||||||
(defun centaur-tabs-on-saving-buffer ()
|
(defun centaur-tabs-on-saving-buffer ()
|
||||||
"Function to be run after the buffer is saved."
|
"Function to be run after the buffer is saved."
|
||||||
(centaur-tabs-set-template centaur-tabs-current-tabset nil)
|
(centaur-tabs-set-template centaur-tabs-current-tabset nil)
|
||||||
(centaur-tabs-display-update))
|
(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."
|
"Function to be run after the buffer is first changed."
|
||||||
(set-buffer-modified-p (buffer-modified-p))
|
(set-buffer-modified-p (buffer-modified-p))
|
||||||
(centaur-tabs-set-template centaur-tabs-current-tabset nil)
|
(centaur-tabs-set-template centaur-tabs-current-tabset nil)
|
||||||
(centaur-tabs-display-update))
|
(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)
|
(defsubst centaur-tabs-line-tab (tab)
|
||||||
"Return the display representation of tab TAB.
|
"Return the display representation of tab TAB.
|
||||||
That is, a propertized string used as an `centaur-tabs-display-line-format'
|
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)
|
(when (or (not centaur-tabs-style-left)
|
||||||
(not centaur-tabs-style-right))
|
(not centaur-tabs-style-right))
|
||||||
(centaur-tabs-select-separator-style centaur-tabs-style))
|
(centaur-tabs-select-separator-style centaur-tabs-style))
|
||||||
(concat
|
(concat (centaur-tabs-separator-render centaur-tabs-style-left face)
|
||||||
(centaur-tabs-separator-render centaur-tabs-style-left face)
|
|
||||||
bar
|
bar
|
||||||
|
|
||||||
;; left margin
|
;; left margin
|
||||||
(if centaur-tabs-left-edge-margin
|
(when centaur-tabs-left-edge-margin
|
||||||
(propertize
|
(propertize centaur-tabs-left-edge-margin
|
||||||
centaur-tabs-left-edge-margin
|
|
||||||
'face face
|
'face face
|
||||||
'centaur-tabs-tab tab
|
'centaur-tabs-tab tab
|
||||||
'pointer centaur-tabs-mouse-pointer
|
'pointer centaur-tabs-mouse-pointer
|
||||||
'local-map centaur-tabs-default-map))
|
'local-map centaur-tabs-default-map))
|
||||||
|
|
||||||
;; left close button
|
;; left close button
|
||||||
(if centaur-tabs-set-left-close-button
|
(when centaur-tabs-set-left-close-button
|
||||||
(propertize
|
(propertize centaur-tabs-close-button
|
||||||
centaur-tabs-close-button
|
|
||||||
'face (if selected-p
|
'face (if selected-p
|
||||||
'centaur-tabs-close-selected
|
'centaur-tabs-close-selected
|
||||||
'centaur-tabs-close-unselected)
|
'centaur-tabs-close-unselected)
|
||||||
|
|
@ -704,9 +733,7 @@ Call `centaur-tabs-tab-label-function' to obtain a label for TAB."
|
||||||
|
|
||||||
;; icon
|
;; icon
|
||||||
(if (= (length icon) 0) ""
|
(if (= (length icon) 0) ""
|
||||||
(concat
|
(concat (propertize centaur-tabs-icons-prefix
|
||||||
(propertize
|
|
||||||
" "
|
|
||||||
'face face
|
'face face
|
||||||
'centaur-tabs-tab tab
|
'centaur-tabs-tab tab
|
||||||
'pointer centaur-tabs-mouse-pointer
|
'pointer centaur-tabs-mouse-pointer
|
||||||
|
|
@ -714,8 +741,7 @@ Call `centaur-tabs-tab-label-function' to obtain a label for TAB."
|
||||||
icon))
|
icon))
|
||||||
|
|
||||||
;; tab name
|
;; tab name
|
||||||
(propertize
|
(propertize (concat
|
||||||
(concat
|
|
||||||
(if centaur-tabs-tab-label-function
|
(if centaur-tabs-tab-label-function
|
||||||
(funcall centaur-tabs-tab-label-function tab)
|
(funcall centaur-tabs-tab-label-function tab)
|
||||||
(buffer-name buf))
|
(buffer-name buf))
|
||||||
|
|
@ -729,22 +755,24 @@ Call `centaur-tabs-tab-label-function' to obtain a label for TAB."
|
||||||
|
|
||||||
;; tab identifier
|
;; tab identifier
|
||||||
(when centaur-tabs-show-jump-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
|
(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
|
'centaur-tabs-tab tab
|
||||||
'face (if selected-p
|
'face (if selected-p
|
||||||
'centaur-tabs-jump-identifier-selected
|
'centaur-tabs-jump-identifier-selected
|
||||||
'centaur-tabs-jump-identifier-unselected)
|
'centaur-tabs-jump-identifier-unselected)
|
||||||
'pointer centaur-tabs-mouse-pointer
|
'pointer centaur-tabs-mouse-pointer
|
||||||
'help-echo buf-file-name
|
'help-echo buf-file-name
|
||||||
'local-map centaur-tabs-default-map)))
|
'local-map centaur-tabs-default-map))))
|
||||||
|
|
||||||
;; close button and/or modified marker
|
;; close button and/or modified marker
|
||||||
(unless centaur-tabs-ace-jump-active
|
(unless centaur-tabs-ace-jump-active
|
||||||
(if centaur-tabs-set-close-button
|
(if centaur-tabs-set-close-button
|
||||||
(propertize
|
(propertize (if use-mod-mark-p
|
||||||
(if use-mod-mark-p
|
|
||||||
centaur-tabs-modified-marker
|
centaur-tabs-modified-marker
|
||||||
centaur-tabs-close-button)
|
centaur-tabs-close-button)
|
||||||
'face (if use-mod-mark-p
|
'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
|
'mouse-face 'centaur-tabs-close-mouse-face
|
||||||
'local-map centaur-tabs-close-map)
|
'local-map centaur-tabs-close-map)
|
||||||
(if (and centaur-tabs-set-modified-marker modified-p)
|
(if (and centaur-tabs-set-modified-marker modified-p)
|
||||||
(propertize
|
(propertize centaur-tabs-modified-marker
|
||||||
centaur-tabs-modified-marker
|
|
||||||
'face mod-mark-face
|
'face mod-mark-face
|
||||||
'pointer centaur-tabs-mouse-pointer
|
'pointer centaur-tabs-mouse-pointer
|
||||||
'centaur-tabs-tab tab
|
'centaur-tabs-tab tab
|
||||||
|
|
@ -768,9 +795,8 @@ Call `centaur-tabs-tab-label-function' to obtain a label for TAB."
|
||||||
"" )))
|
"" )))
|
||||||
|
|
||||||
;; right margin
|
;; right margin
|
||||||
(if centaur-tabs-right-edge-margin
|
(when centaur-tabs-right-edge-margin
|
||||||
(propertize
|
(propertize centaur-tabs-right-edge-margin
|
||||||
centaur-tabs-right-edge-margin
|
|
||||||
'face face
|
'face face
|
||||||
'centaur-tabs-tab tab
|
'centaur-tabs-tab tab
|
||||||
'pointer centaur-tabs-mouse-pointer
|
'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'
|
That is, a propertized string used as an `centaur-tabs-display-line-format'
|
||||||
template element."
|
template element."
|
||||||
(let* ((face 'centaur-tabs-unselected))
|
(let* ((face 'centaur-tabs-unselected))
|
||||||
(concat
|
(concat (propertize button
|
||||||
(propertize
|
|
||||||
button
|
|
||||||
'face face
|
'face face
|
||||||
'mouse-face 'highlight))))
|
'mouse-face 'highlight))))
|
||||||
|
|
||||||
|
|
@ -796,7 +820,7 @@ template element."
|
||||||
(padcolor centaur-tabs-background-color)
|
(padcolor centaur-tabs-background-color)
|
||||||
(all-tabs (centaur-tabs-tabs tabset))
|
(all-tabs (centaur-tabs-tabs tabset))
|
||||||
(total-tabs (length all-tabs))
|
(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)
|
atsel elts)
|
||||||
;; Track the selected tab to ensure it is always visible.
|
;; Track the selected tab to ensure it is always visible.
|
||||||
(when centaur-tabs--track-selected
|
(when centaur-tabs--track-selected
|
||||||
|
|
@ -827,7 +851,7 @@ template element."
|
||||||
(apply #'insert elts)
|
(apply #'insert elts)
|
||||||
(goto-char (point-min))
|
(goto-char (point-min))
|
||||||
(> (vertical-motion 1) 0)))
|
(> (vertical-motion 1) 0)))
|
||||||
(centaur-tabs-scroll tabset 1)
|
(centaur-tabs-scroll tabset -1)
|
||||||
(setq elts (cdr elts))))))
|
(setq elts (cdr elts))))))
|
||||||
(setq elts (nreverse elts))
|
(setq elts (nreverse elts))
|
||||||
(setq centaur-tabs--track-selected nil))
|
(setq centaur-tabs--track-selected nil))
|
||||||
|
|
@ -845,13 +869,14 @@ template element."
|
||||||
(propertize "% "
|
(propertize "% "
|
||||||
'face (list :background padcolor)
|
'face (list :background padcolor)
|
||||||
'pointer 'arrow)
|
'pointer 'arrow)
|
||||||
(centaur-tabs-line-format--new-button)))
|
(centaur-tabs-line-format--new-button)))))
|
||||||
))
|
|
||||||
|
|
||||||
(defun centaur-tabs-count (index count)
|
(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
|
(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")
|
'help-echo "Tabs count")
|
||||||
""))
|
""))
|
||||||
|
|
||||||
|
|
@ -883,8 +908,9 @@ template element."
|
||||||
"Return the header line templates that represent the tab bar.
|
"Return the header line templates that represent the tab bar.
|
||||||
Inhibit display of the tab bar in current window where
|
Inhibit display of the tab bar in current window where
|
||||||
`centaur-tabs-hide-tab-function' return t."
|
`centaur-tabs-hide-tab-function' return t."
|
||||||
(cond
|
(cond ((or (centaur-tabs-hide-tab-cached (current-buffer))
|
||||||
((centaur-tabs-hide-tab-cached (current-buffer))
|
(and centaur-tabs-hide-predicate
|
||||||
|
(funcall centaur-tabs-hide-predicate)))
|
||||||
;; Don't show the tab bar.
|
;; Don't show the tab bar.
|
||||||
(set centaur-tabs-display-line-format nil))
|
(set centaur-tabs-display-line-format nil))
|
||||||
((centaur-tabs-current-tabset t)
|
((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))
|
(defconst centaur-tabs-header-line-format '(:eval (centaur-tabs-line))
|
||||||
"The tab bar header line format.")
|
"The tab bar header line format.")
|
||||||
|
|
||||||
;;; Cyclic navigation through tabs
|
|
||||||
;;
|
;;
|
||||||
|
;;; Cyclic navigation through tabs
|
||||||
|
|
||||||
(defun centaur-tabs-cycle (&optional backward)
|
(defun centaur-tabs-cycle (&optional backward)
|
||||||
"Cycle to the next available tab.
|
"Cycle to the next available tab.
|
||||||
The scope of the cyclic navigation through tabs is specified by the
|
The scope of the cyclic navigation through tabs is specified by the
|
||||||
|
|
@ -922,8 +949,7 @@ instead."
|
||||||
;; to the first/last visible tab.
|
;; to the first/last visible tab.
|
||||||
(unless tab
|
(unless tab
|
||||||
(setq tabset (centaur-tabs-tabs tabset)
|
(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.
|
;; Cycle through tab groups only.
|
||||||
((eq cycle 'groups)
|
((eq cycle 'groups)
|
||||||
(setq tab (centaur-tabs-tab-next ttabset selected backward))
|
(setq tab (centaur-tabs-tab-next ttabset selected backward))
|
||||||
|
|
@ -931,8 +957,7 @@ instead."
|
||||||
;; to the first/last available group.
|
;; to the first/last available group.
|
||||||
(unless tab
|
(unless tab
|
||||||
(setq tabset (centaur-tabs-tabs ttabset)
|
(setq tabset (centaur-tabs-tabs ttabset)
|
||||||
tab (car (if backward (last tabset) tabset))))
|
tab (car (if backward (last tabset) tabset)))))
|
||||||
)
|
|
||||||
(t
|
(t
|
||||||
;; Cycle through visible tabs then tab groups.
|
;; Cycle through visible tabs then tab groups.
|
||||||
(setq tab (centaur-tabs-tab-next tabset selected backward))
|
(setq tab (centaur-tabs-tab-next tabset selected backward))
|
||||||
|
|
@ -947,8 +972,7 @@ instead."
|
||||||
tab (car (if backward (last tabset) tabset))))
|
tab (car (if backward (last tabset) tabset))))
|
||||||
;; Select the first/last visible tab of the new group.
|
;; Select the first/last visible tab of the new group.
|
||||||
(setq tabset (centaur-tabs-tabs (centaur-tabs-tab-tabset tab))
|
(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))))
|
(centaur-tabs-buffer-select-tab tab))))
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
|
|
@ -997,32 +1021,23 @@ Depend on the setting of the option `centaur-tabs-cycle-scope'."
|
||||||
(let ((centaur-tabs-cycle-scope 'tabs))
|
(let ((centaur-tabs-cycle-scope 'tabs))
|
||||||
(centaur-tabs-cycle)))
|
(centaur-tabs-cycle)))
|
||||||
|
|
||||||
;;; Buffer tabs
|
|
||||||
;;
|
;;
|
||||||
|
;;; Buffer tabs
|
||||||
|
|
||||||
(defgroup centaur-tabs-buffer nil
|
(defgroup centaur-tabs-buffer nil
|
||||||
"Display buffers in the tab bar."
|
"Display buffers in the tab bar."
|
||||||
:group 'centaur-tabs)
|
: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 ()
|
(defun centaur-tabs-buffer-list ()
|
||||||
"Return the list of buffers to show in tabs.
|
"Return the list of buffers to show in tabs.
|
||||||
Exclude buffers whose name starts with a space, when they are not
|
Exclude buffers whose name starts with a space, when they are not
|
||||||
visiting a file. The current buffer is always included."
|
visiting a file."
|
||||||
(centaur-tabs-filter-out
|
(seq-filter (lambda (b)
|
||||||
'centaur-tabs-hide-tab-cached
|
(cond ((eq (current-buffer) b) b)
|
||||||
(delq nil
|
|
||||||
(cl-mapcar #'(lambda (b)
|
|
||||||
(cond
|
|
||||||
;; Always include the current buffer.
|
|
||||||
((eq (current-buffer) b) b)
|
|
||||||
((buffer-file-name b) b)
|
((buffer-file-name b) b)
|
||||||
((char-equal ?\ (aref (buffer-name b) 0)) nil)
|
((char-equal ?\ (aref (buffer-name b) 0)) nil)
|
||||||
((buffer-live-p b) b)))
|
((buffer-live-p b) b)))
|
||||||
(buffer-list)))))
|
(buffer-list)))
|
||||||
|
|
||||||
(defun centaur-tabs-buffer-mode-derived-p (mode parents)
|
(defun centaur-tabs-buffer-mode-derived-p (mode parents)
|
||||||
"Return non-nil if MODE derives from a mode in 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))))
|
(setq mode (get mode 'derived-mode-parent))))
|
||||||
derived))
|
derived))
|
||||||
|
|
||||||
;;; Group buffers in tab sets.
|
|
||||||
;;
|
;;
|
||||||
|
;;; Group buffers in tab sets.
|
||||||
|
|
||||||
(defvar centaur-tabs--buffers nil)
|
(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 ()
|
(defun centaur-tabs-buffer-update-groups ()
|
||||||
"Update tabsets from groups of existing buffers.
|
"Update tabsets from groups of existing buffers.
|
||||||
Return the the first group where the current buffer is."
|
Return the the first group where the current buffer is."
|
||||||
(let ((bl (sort
|
(let ((bl (sort
|
||||||
(cl-mapcar
|
(mapcar
|
||||||
#'(lambda (b)
|
#'(lambda (b)
|
||||||
(with-current-buffer b
|
(with-current-buffer b
|
||||||
(list (current-buffer)
|
(list (current-buffer)
|
||||||
|
|
@ -1075,19 +1095,25 @@ Return the the first group where the current buffer is."
|
||||||
(dolist (tab (centaur-tabs-tabs tabset))
|
(dolist (tab (centaur-tabs-tabs tabset))
|
||||||
(let ((e (assq (centaur-tabs-tab-value tab) bl)))
|
(let ((e (assq (centaur-tabs-tab-value tab) bl)))
|
||||||
(or (and e (memq tabset
|
(or (and e (memq tabset
|
||||||
(cl-mapcar 'centaur-tabs-get-tabset
|
(mapcar 'centaur-tabs-get-tabset
|
||||||
(nth 2 e))))
|
(nth 2 e))))
|
||||||
(centaur-tabs-delete-tab tab))))
|
(centaur-tabs-delete-tab tab))))
|
||||||
;; Return empty tab sets
|
;; Return empty tab sets
|
||||||
(unless (centaur-tabs-tabs tabset)
|
(unless (centaur-tabs-tabs tabset)
|
||||||
tabset))))
|
tabset))))
|
||||||
;; The new cache becomes the current one.
|
;; The new cache becomes the current one.
|
||||||
(setq centaur-tabs--buffers bl)))
|
(setq centaur-tabs--buffers bl))))
|
||||||
;; Return the first group the current buffer belongs to.
|
|
||||||
(car (nth 2 (assq (current-buffer) centaur-tabs--buffers))))
|
(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)
|
(defsubst centaur-tabs-buffer-show-groups (flag)
|
||||||
"Set display of tabs for groups of buffers to 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 ()
|
(defun centaur-tabs-buffer-tabs ()
|
||||||
"Return the buffers to display on the tab bar, in a tab set."
|
"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)
|
(centaur-tabs-select-tab-value (current-buffer) tabset)
|
||||||
(when centaur-tabs--buffer-show-groups
|
(when centaur-tabs--buffer-show-groups
|
||||||
(setq tabset (centaur-tabs-get-tabsets-tabset))
|
(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)
|
(defun centaur-tabs-separator-render (item face)
|
||||||
"Render ITEM using FACE."
|
"Render ITEM using FACE."
|
||||||
(cond
|
(cond ((and (listp item) (eq 'image (car item)))
|
||||||
((and (listp item) (eq 'image (car item)))
|
(propertize " " 'display item 'face face))
|
||||||
(propertize " " 'display item
|
|
||||||
'face face))
|
|
||||||
(t item)))
|
(t item)))
|
||||||
|
|
||||||
(defvar centaur-tabs-last-focused-buffer nil
|
(defvar centaur-tabs-last-focused-buffer nil
|
||||||
|
|
@ -1140,8 +1164,7 @@ That is, a string used to represent it on the tab bar."
|
||||||
(setq centaur-tabs-last-focused-buffer buffer)
|
(setq centaur-tabs-last-focused-buffer buffer)
|
||||||
(setq centaur-tabs-last-focused-buffer-group group)
|
(setq centaur-tabs-last-focused-buffer-group group)
|
||||||
;;(centaur-tabs-buffer-show-groups nil)
|
;;(centaur-tabs-buffer-show-groups nil)
|
||||||
(centaur-tabs-display-update)
|
(centaur-tabs-display-update)))
|
||||||
))
|
|
||||||
|
|
||||||
(defun centaur-tabs-buffer-track-killed ()
|
(defun centaur-tabs-buffer-track-killed ()
|
||||||
"Hook run just before actually killing a buffer.
|
"Hook run just before actually killing a buffer.
|
||||||
|
|
@ -1185,7 +1208,8 @@ first."
|
||||||
(nreverse (centaur-tabs-insert-after (nreverse list) bef-el el)))
|
(nreverse (centaur-tabs-insert-after (nreverse list) bef-el el)))
|
||||||
|
|
||||||
(defun centaur-tabs-adjust-buffer-order ()
|
(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.
|
;; Don't trigger by centaur-tabs command, it's annoying.
|
||||||
;; This feature should be trigger by search plugins, such as ibuffer, helm or ivy.
|
;; 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))
|
(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)
|
(when (string= current-group centaur-tabs-last-focused-buffer-group)
|
||||||
(let* ((bufset (centaur-tabs-get-tabset current-group))
|
(let* ((bufset (centaur-tabs-get-tabset current-group))
|
||||||
(current-group-tabs (centaur-tabs-tabs bufset))
|
(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))
|
(current-buffer-index (cl-position current current-group-buffers))
|
||||||
(previous-buffer-index (cl-position previous 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)))))
|
(setq new-group-tabs (centaur-tabs-insert-before base-group-tabs previous-tab current-tab)))))
|
||||||
(set bufset new-group-tabs)
|
(set bufset new-group-tabs)
|
||||||
(centaur-tabs-set-template bufset nil)
|
(centaur-tabs-set-template bufset nil)
|
||||||
(centaur-tabs-display-update)
|
(centaur-tabs-display-update)))))
|
||||||
))))
|
|
||||||
|
|
||||||
;; Update the group name of the last accessed tab.
|
;; Update the group name of the last accessed tab.
|
||||||
(setq centaur-tabs-last-focused-buffer-group current-group)))))
|
(setq centaur-tabs-last-focused-buffer-group current-group)))))
|
||||||
|
|
@ -1253,10 +1276,10 @@ first."
|
||||||
;; Just continue if two buffers are in the same group.
|
;; Just continue if two buffers are in the same group.
|
||||||
(when (string= current-group centaur-tabs-last-focused-buffer-group)
|
(when (string= current-group centaur-tabs-last-focused-buffer-group)
|
||||||
(let* ((bufset (centaur-tabs-get-tabset current-group))
|
(let* ((bufset (centaur-tabs-get-tabset current-group))
|
||||||
(current-group-tabs (centaur-tabs-tabs bufset)))
|
(current-group-tabs (centaur-tabs-tabs bufset))
|
||||||
(setq new-group-tabs (sort current-group-tabs
|
(new-group-tabs (sort current-group-tabs
|
||||||
(lambda (x y)
|
(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)
|
(set bufset new-group-tabs)
|
||||||
(centaur-tabs-set-template bufset nil)
|
(centaur-tabs-set-template bufset nil)
|
||||||
(centaur-tabs-display-update)))
|
(centaur-tabs-display-update)))
|
||||||
|
|
@ -1271,17 +1294,17 @@ first."
|
||||||
(setq centaur-tabs-adjust-buffer-order-function 'centaur-tabs-adjust-buffer-order-alphabetically)
|
(setq centaur-tabs-adjust-buffer-order-function 'centaur-tabs-adjust-buffer-order-alphabetically)
|
||||||
(add-hook 'post-command-hook centaur-tabs-adjust-buffer-order-function))
|
(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 ()
|
(defun centaur-tabs-project-name ()
|
||||||
"Get project name for tabs."
|
"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)
|
(project-name (if (proper-list-p project-current)
|
||||||
(car (last project-current))
|
(car (last project-current))
|
||||||
(cdr project-current))))
|
(cdr project-current))))
|
||||||
(if project-name
|
(format "Project: %s" (expand-file-name project-name))))
|
||||||
(format "Project: %s" (expand-file-name project-name))
|
|
||||||
centaur-tabs-common-group-name)))
|
|
||||||
|
|
||||||
;; Rules to control buffer's group rules.
|
;; Rules to control buffer's group rules.
|
||||||
(defvar centaur-tabs-groups-hash (make-hash-table :test 'equal))
|
(defvar centaur-tabs-groups-hash (make-hash-table :test 'equal))
|
||||||
|
|
@ -1291,14 +1314,8 @@ first."
|
||||||
"Get group name of buffer BUF."
|
"Get group name of buffer BUF."
|
||||||
(let ((group-name (gethash buf centaur-tabs-groups-hash)))
|
(let ((group-name (gethash buf centaur-tabs-groups-hash)))
|
||||||
;; Return group name cache if it exists for improve performance.
|
;; Return group name cache if it exists for improve performance.
|
||||||
(if group-name
|
(or group-name
|
||||||
group-name
|
centaur-tabs-common-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)))))
|
|
||||||
|
|
||||||
(defun centaur-tabs-buffer-groups ()
|
(defun centaur-tabs-buffer-groups ()
|
||||||
"`centaur-tabs-buffer-groups' control buffers' group rules.
|
"`centaur-tabs-buffer-groups' control buffers' group rules.
|
||||||
|
|
@ -1309,6 +1326,8 @@ All buffer name start with * will group to \"Emacs\".
|
||||||
Other buffer group by `centaur-tabs-get-group-name' with project name."
|
Other buffer group by `centaur-tabs-get-group-name' with project name."
|
||||||
(list
|
(list
|
||||||
(cond
|
(cond
|
||||||
|
((when-let ((project-name (centaur-tabs-project-name)))
|
||||||
|
project-name))
|
||||||
((or (string-equal "*" (substring (buffer-name) 0 1))
|
((or (string-equal "*" (substring (buffer-name) 0 1))
|
||||||
(memq major-mode '( magit-process-mode
|
(memq major-mode '( magit-process-mode
|
||||||
magit-status-mode
|
magit-status-mode
|
||||||
|
|
@ -1316,17 +1335,13 @@ Other buffer group by `centaur-tabs-get-group-name' with project name."
|
||||||
magit-log-mode
|
magit-log-mode
|
||||||
magit-file-mode
|
magit-file-mode
|
||||||
magit-blob-mode
|
magit-blob-mode
|
||||||
magit-blame-mode
|
magit-blame-mode)))
|
||||||
)))
|
|
||||||
"Emacs")
|
"Emacs")
|
||||||
((derived-mode-p 'eshell-mode)
|
((derived-mode-p 'shell-mode) "Shell")
|
||||||
"EShell")
|
((derived-mode-p 'eshell-mode) "EShell")
|
||||||
((derived-mode-p 'emacs-lisp-mode)
|
((derived-mode-p 'emacs-lisp-mode) "Elisp")
|
||||||
"Elisp")
|
((derived-mode-p 'dired-mode) "Dired")
|
||||||
((derived-mode-p 'dired-mode)
|
((memq major-mode '( org-mode org-agenda-mode diary-mode)) "OrgMode")
|
||||||
"Dired")
|
|
||||||
((memq major-mode '(org-mode org-agenda-mode diary-mode))
|
|
||||||
"OrgMode")
|
|
||||||
(t
|
(t
|
||||||
(centaur-tabs-get-group-name (current-buffer))))))
|
(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.
|
;; Is not magit buffer.
|
||||||
(and (string-prefix-p "magit" name)
|
(and (string-prefix-p "magit" name)
|
||||||
(not (file-name-extension name)))
|
(not (file-name-extension name))))))
|
||||||
)))
|
|
||||||
|
|
||||||
(defun centaur-tabs-hide-tab-cached (buf)
|
(defun centaur-tabs-hide-tab-cached (buf)
|
||||||
"Cached vesion of `centaur-tabs-hide-tab' to improve performance.
|
"Cached vesion of `centaur-tabs-hide-tab' to improve performance.
|
||||||
|
|
@ -1384,7 +1398,7 @@ Operates over buffer BUF"
|
||||||
(defun centaur-tabs-get-groups ()
|
(defun centaur-tabs-get-groups ()
|
||||||
"Refresh tabs groups."
|
"Refresh tabs groups."
|
||||||
(set centaur-tabs-tabsets-tabset (centaur-tabs-map-tabsets 'centaur-tabs-selected-tab))
|
(set centaur-tabs-tabsets-tabset (centaur-tabs-map-tabsets 'centaur-tabs-selected-tab))
|
||||||
(cl-mapcar #'(lambda (group)
|
(mapcar #'(lambda (group)
|
||||||
(format "%s" (cdr group)))
|
(format "%s" (cdr group)))
|
||||||
(centaur-tabs-tabs centaur-tabs-tabsets-tabset)))
|
(centaur-tabs-tabs centaur-tabs-tabsets-tabset)))
|
||||||
|
|
||||||
|
|
@ -1396,13 +1410,13 @@ Operates over buffer BUF"
|
||||||
(with-current-buffer buffer
|
(with-current-buffer buffer
|
||||||
(when (string-equal 'current-group-name (cdr (centaur-tabs-selected-tab (centaur-tabs-current-tabset t))))
|
(when (string-equal 'current-group-name (cdr (centaur-tabs-selected-tab (centaur-tabs-current-tabset t))))
|
||||||
(when (buffer-file-name buffer)
|
(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))
|
(buffer-list))
|
||||||
extension-names))
|
extension-names))
|
||||||
|
|
||||||
(defcustom centaur-tabs-enable-ido-completion t
|
(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
|
:group 'centaur-tabs
|
||||||
:type 'boolean)
|
:type 'boolean)
|
||||||
|
|
||||||
|
|
@ -1420,10 +1434,8 @@ Refer to the variable `centaur-tabs-enable-ido-completion'."
|
||||||
(add-hook hook (lambda ()
|
(add-hook hook (lambda ()
|
||||||
(if (boundp 'tab-line-format)
|
(if (boundp 'tab-line-format)
|
||||||
(setq-local tab-line-format nil)
|
(setq-local tab-line-format nil)
|
||||||
(setq-local header-line-format nil))
|
(setq-local header-line-format nil)))))
|
||||||
)))
|
|
||||||
centaur-tabs-hide-tabs-hooks)
|
centaur-tabs-hide-tabs-hooks)
|
||||||
|
|
||||||
(provide 'centaur-tabs-functions)
|
(provide 'centaur-tabs-functions)
|
||||||
|
|
||||||
;;; centaur-tabs-functions.el ends here
|
;;; centaur-tabs-functions.el ends here
|
||||||
|
|
@ -1,10 +1,10 @@
|
||||||
;;; centaur-tabs-interactive.el --- centaur-tabs interactive functions and plugins support lexical-binding: t; -*-
|
;;; 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 file is not part of GNU Emacs.
|
||||||
|
|
||||||
;;
|
|
||||||
;; This program is free software; you can redistribute it and/or
|
;; This program is free software; you can redistribute it and/or
|
||||||
;; modify it under the terms of the GNU General Public License as
|
;; modify it under the terms of the GNU General Public License as
|
||||||
;; published by the Free Software Foundation; either version 2, or
|
;; 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
|
;; along with this program; see the file COPYING. If not, write to
|
||||||
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
|
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
|
||||||
;; Floor, Boston, MA 02110-1301, USA.
|
;; Floor, Boston, MA 02110-1301, USA.
|
||||||
;;
|
|
||||||
;;; Commentary:
|
;;; Commentary:
|
||||||
|
;;
|
||||||
;; This file contains centaur-tabs interactive functions and plugins support
|
;; This file contains centaur-tabs interactive functions and plugins support
|
||||||
|
;;
|
||||||
|
|
||||||
;;; Code:
|
;;; Code:
|
||||||
;;; Requires
|
|
||||||
|
(require 'cl-lib)
|
||||||
(require 'centaur-tabs-elements)
|
(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 ;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;; Interactive functions ;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(defun centaur-tabs-switch-group (&optional groupname)
|
(defun centaur-tabs-switch-group (&optional groupname)
|
||||||
"Switch tab groups using ido. GROUPNAME can optionaly be provided."
|
"Switch tab groups using ido. GROUPNAME can optionaly be provided."
|
||||||
(interactive)
|
(interactive)
|
||||||
(let* ((tab-buffer-list (cl-mapcar
|
(let* ((tab-buffer-list (mapcar
|
||||||
#'(lambda (b)
|
#'(lambda (b)
|
||||||
(with-current-buffer b
|
(with-current-buffer b
|
||||||
(list (current-buffer)
|
(list (current-buffer)
|
||||||
|
|
@ -42,8 +82,7 @@
|
||||||
(groups (centaur-tabs-get-groups))
|
(groups (centaur-tabs-get-groups))
|
||||||
(group-name (or groupname (centaur-tabs-completing-read "Groups: " groups))) )
|
(group-name (or groupname (centaur-tabs-completing-read "Groups: " groups))) )
|
||||||
(catch 'done
|
(catch 'done
|
||||||
(mapc
|
(mapc #'(lambda (group)
|
||||||
#'(lambda (group)
|
|
||||||
(when (equal group-name (car (car (cdr (cdr group)))))
|
(when (equal group-name (car (car (cdr (cdr group)))))
|
||||||
(throw 'done (switch-to-buffer (car (cdr group))))))
|
(throw 'done (switch-to-buffer (car (cdr group))))))
|
||||||
tab-buffer-list) )))
|
tab-buffer-list) )))
|
||||||
|
|
@ -72,7 +111,8 @@ TYPE is default option."
|
||||||
|
|
||||||
(defun centaur-tabs-backward-tab-other-window (&optional reversed)
|
(defun centaur-tabs-backward-tab-other-window (&optional reversed)
|
||||||
"Move to left tab in other window.
|
"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)
|
(interactive)
|
||||||
(other-window 1)
|
(other-window 1)
|
||||||
(if reversed
|
(if reversed
|
||||||
|
|
@ -147,8 +187,7 @@ Optional argument REVERSED default is move backward, if reversed is non-nil move
|
||||||
(with-current-buffer buffer
|
(with-current-buffer buffer
|
||||||
(when (string-equal current-group-name (cdr (centaur-tabs-selected-tab (centaur-tabs-current-tabset t))))
|
(when (string-equal current-group-name (cdr (centaur-tabs-selected-tab (centaur-tabs-current-tabset t))))
|
||||||
(when (funcall ,match-rule buffer)
|
(when (funcall ,match-rule buffer)
|
||||||
(kill-buffer buffer))
|
(kill-buffer buffer)))))
|
||||||
)))
|
|
||||||
(buffer-list))))
|
(buffer-list))))
|
||||||
|
|
||||||
(defun centaur-tabs-kill-all-buffers-in-current-group ()
|
(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
|
(centaur-tabs-kill-buffer-match-rule
|
||||||
(lambda (_buffer) t))
|
(lambda (_buffer) t))
|
||||||
;; Switch to next group.
|
;; Switch to next group.
|
||||||
(centaur-tabs-forward-group)
|
(centaur-tabs-forward-group)))
|
||||||
))
|
|
||||||
|
|
||||||
(defun centaur-tabs-kill-other-buffers-in-current-group ()
|
(defun centaur-tabs-kill-other-buffers-in-current-group ()
|
||||||
"Kill all buffers except current buffer 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)))
|
(currentbuffer (current-buffer)))
|
||||||
;; Kill all buffers in current group.
|
;; Kill all buffers in current group.
|
||||||
(centaur-tabs-kill-buffer-match-rule
|
(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 ()
|
(defun centaur-tabs-kill-unmodified-buffers-in-current-group ()
|
||||||
"Kill all unmodified buffer 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)))
|
(currentbuffer (current-buffer)))
|
||||||
;; Kill all buffers in current group.
|
;; Kill all buffers in current group.
|
||||||
(centaur-tabs-kill-buffer-match-rule
|
(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 ()
|
(defun centaur-tabs-kill-match-buffers-in-current-group ()
|
||||||
"Kill all buffers match extension 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
|
(centaur-tabs-kill-buffer-match-rule
|
||||||
(lambda (buffer)
|
(lambda (buffer)
|
||||||
(let ((filename (buffer-file-name 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.
|
;; Switch to next group if last file killed.
|
||||||
(when (equal (length extension-names) 1)
|
(when (equal (length extension-names) 1)
|
||||||
(centaur-tabs-forward-group))
|
(centaur-tabs-forward-group))))
|
||||||
))
|
|
||||||
|
|
||||||
(defun centaur-tabs-keep-match-buffers-in-current-group ()
|
(defun centaur-tabs-keep-match-buffers-in-current-group ()
|
||||||
"Keep all buffers match extension 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
|
(centaur-tabs-kill-buffer-match-rule
|
||||||
(lambda (buffer)
|
(lambda (buffer)
|
||||||
(let ((filename (buffer-file-name 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.
|
;; Switch to next group if last file killed.
|
||||||
(when (equal (length extension-names) 1)
|
(when (equal (length extension-names) 1)
|
||||||
(centaur-tabs-forward-group))
|
(centaur-tabs-forward-group))))
|
||||||
))
|
|
||||||
|
|
||||||
(defun centaur-tabs-select-visible-nth-tab (tab-index)
|
(defun centaur-tabs-select-visible-nth-tab (tab-index)
|
||||||
"Select visible tab with 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
|
;; ace-jump style tab switching
|
||||||
|
|
||||||
(defvar centaur-tabs-ace-jump-active nil
|
(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
|
(defvar centaur-tabs-dim-overlay nil
|
||||||
"Holds the overlay for dimming buffer when invoking centaur-tabs-ace-jump.")
|
"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)
|
(defun centaur-tabs-ace-action (action)
|
||||||
"Preform ACTION on a visible tab. Ace-jump style.
|
"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-current-tabset t)
|
||||||
(when centaur-tabs-ace-jump-dim-buffer
|
(when centaur-tabs-ace-jump-dim-buffer
|
||||||
(centaur-tabs--dim-window))
|
(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))))
|
(centaur-tabs-swap-tab sel))))
|
||||||
(throw 'done nil))
|
(throw 'done nil))
|
||||||
;; actions
|
;; 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))
|
(setq action-cache (cadr action-cache))
|
||||||
(cond ((eq action-cache 'exit) ; exit
|
(cond ((eq action-cache 'exit) ; exit
|
||||||
(message "Quit")
|
(message "Quit")
|
||||||
|
|
@ -338,7 +369,7 @@ ACTION has to be one of value in `centuar-tabs-ace-dispatch-alist'"
|
||||||
(lambda (elem) (format "%s: %s"
|
(lambda (elem) (format "%s: %s"
|
||||||
(key-description (vector (car elem)))
|
(key-description (vector (car elem)))
|
||||||
(caddr elem)))
|
(caddr elem)))
|
||||||
centuar-tabs-ace-dispatch-alist
|
centaur-tabs-ace-dispatch-alist
|
||||||
"\n")))
|
"\n")))
|
||||||
(t (setq action action-cache) ; other actions
|
(t (setq action action-cache) ; other actions
|
||||||
(cond ((eq action-cache 'jump-to-tab)
|
(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)
|
(defun centaur-tabs-ace-jump (&optional arg)
|
||||||
"Select a tab and perform an action. Ace-jump style.
|
"Select a tab and perform an action. Ace-jump style.
|
||||||
If no ARG is provided, select that tab.
|
If no ARG is provided, select that tab. If prefixed with one
|
||||||
If prefixed with one `universal-argument', swap the current
|
`universal-argument', swap the current tab with the selected tab.
|
||||||
tab with the selected tab.
|
If prefixed with two `universal-argument's, close selected tab."
|
||||||
If prefixed with two `universal-argument's, close
|
|
||||||
selected tab."
|
|
||||||
(interactive "p")
|
(interactive "p")
|
||||||
(cond ((eq arg 1)
|
(cond ((eq arg 1)
|
||||||
(centaur-tabs-ace-action 'jump-to-tab))
|
(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"))
|
((string-equal "*" (substring (buffer-name) 0 1)) '("Misc"))
|
||||||
((condition-case _err
|
((condition-case _err
|
||||||
(projectile-project-root)
|
(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
|
((memq major-mode '(emacs-lisp-mode python-mode emacs-lisp-mode c-mode
|
||||||
c++-mode javascript-mode js-mode
|
c++-mode javascript-mode js-mode
|
||||||
js2-mode makefile-mode
|
js2-mode makefile-mode
|
||||||
lua-mode vala-mode)) '("Coding"))
|
lua-mode vala-mode))
|
||||||
|
'("Coding"))
|
||||||
((memq major-mode '( nxhtml-mode html-mode
|
((memq major-mode '( nxhtml-mode html-mode
|
||||||
mhtml-mode css-mode)) '("HTML"))
|
mhtml-mode css-mode))
|
||||||
|
'("HTML"))
|
||||||
((memq major-mode '(org-mode calendar-mode diary-mode)) '("Org"))
|
((memq major-mode '(org-mode calendar-mode diary-mode)) '("Org"))
|
||||||
((memq major-mode '(dired-mode)) '("Dir"))
|
((memq major-mode '(dired-mode)) '("Dir"))
|
||||||
(t '("Other"))))
|
(t '("Other"))))
|
||||||
|
|
@ -446,9 +478,9 @@ Should be buffer local and speed up calculation of buffer groups.")
|
||||||
:action #'centaur-tabs-switch-group
|
:action #'centaur-tabs-switch-group
|
||||||
:caller 'centaur-tabs-counsel-switch-group)))
|
:caller 'centaur-tabs-counsel-switch-group)))
|
||||||
|
|
||||||
|
|
||||||
(defun centaur-tabs-extract-window-to-new-frame()
|
(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)
|
(interactive)
|
||||||
(unless (centaur-tabs--one-window-p)
|
(unless (centaur-tabs--one-window-p)
|
||||||
(let ((buffer (current-buffer)))
|
(let ((buffer (current-buffer)))
|
||||||
|
|
@ -467,7 +499,6 @@ Should be buffer local and speed up calculation of buffer groups.")
|
||||||
(kill-new filename)
|
(kill-new filename)
|
||||||
(message "Copied buffer file name '%s' to the kill ring." filename))))
|
(message "Copied buffer file name '%s' to the kill ring." filename))))
|
||||||
|
|
||||||
|
|
||||||
(defun centaur-tabs-open-directory-in-external-application ()
|
(defun centaur-tabs-open-directory-in-external-application ()
|
||||||
"Open the current directory in a external application."
|
"Open the current directory in a external application."
|
||||||
(interactive)
|
(interactive)
|
||||||
|
|
@ -476,7 +507,7 @@ Should be buffer local and speed up calculation of buffer groups.")
|
||||||
(defun centaur-tabs-open-in-external-application ()
|
(defun centaur-tabs-open-in-external-application ()
|
||||||
"Open the file of the current buffer according to its mime type."
|
"Open the file of the current buffer according to its mime type."
|
||||||
(interactive)
|
(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)))
|
(centaur-tabs--open-externally path)))
|
||||||
|
|
||||||
(defun centaur-tabs--open-externally (file-or-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)))
|
(start-process "" nil "xdg-open" path)))
|
||||||
(_ (message "Don't know how to open files on %s." (symbol-name system-type))))))
|
(_ (message "Don't know how to open files on %s." (symbol-name system-type))))))
|
||||||
|
|
||||||
|
|
||||||
(defun centaur-tabs--copy-directory-name-to-clipboard ()
|
(defun centaur-tabs--copy-directory-name-to-clipboard ()
|
||||||
"Copy the current directory name to the clipboard."
|
"Copy the current directory name to the clipboard."
|
||||||
(interactive)
|
(interactive)
|
||||||
|
|
@ -507,7 +537,6 @@ Modified copy of `treemacs-visit-node-in-external-application`."
|
||||||
"Menu definition with a list of tab groups."
|
"Menu definition with a list of tab groups."
|
||||||
(mapcar (lambda (s) `[,s ,s]) (sort (centaur-tabs-get-groups) #'string<)))
|
(mapcar (lambda (s) `[,s ,s]) (sort (centaur-tabs-get-groups) #'string<)))
|
||||||
|
|
||||||
|
|
||||||
(defun centaur-tabs--tab-submenu-tabs-definition ()
|
(defun centaur-tabs--tab-submenu-tabs-definition ()
|
||||||
"Menu definition with a list of tabs for the current group."
|
"Menu definition with a list of tabs for the current group."
|
||||||
(let* ((tabset (centaur-tabs-get-tabset centaur-tabs-last-focused-buffer-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<)))
|
(sorted-tabnames (sort (mapcar #'buffer-name buffers) #'string<)))
|
||||||
(mapcar (lambda (s) `[,s ,s]) sorted-tabnames)))
|
(mapcar (lambda (s) `[,s ,s]) sorted-tabnames)))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(defvar centaur-tabs--groups-submenu-key "Tab groups")
|
(defvar centaur-tabs--groups-submenu-key "Tab groups")
|
||||||
(defvar centaur-tabs--tabs-submenu-key "Go to tab of group")
|
(defvar centaur-tabs--tabs-submenu-key "Go to tab of group")
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(defun centaur-tabs--kill-this-buffer-dont-ask()
|
(defun centaur-tabs--kill-this-buffer-dont-ask()
|
||||||
"Kill the current buffer without confirmation."
|
"Kill the current buffer without confirmation."
|
||||||
(interactive)
|
(interactive)
|
||||||
|
|
@ -530,7 +555,6 @@ Modified copy of `treemacs-visit-node-in-external-application`."
|
||||||
(centaur-tabs-display-update)
|
(centaur-tabs-display-update)
|
||||||
(redisplay t))
|
(redisplay t))
|
||||||
|
|
||||||
|
|
||||||
(defun centaur-tabs--tab-menu-definition ()
|
(defun centaur-tabs--tab-menu-definition ()
|
||||||
"Definition of the context menu of a tab."
|
"Definition of the context menu of a tab."
|
||||||
`(["Kill this buffer" centaur-tabs--kill-this-buffer-dont-ask]
|
`(["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]
|
:active default-directory]
|
||||||
"----"
|
"----"
|
||||||
,( append (list centaur-tabs--groups-submenu-key) (centaur-tabs--tab-submenu-groups-definition))
|
,( 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 ()
|
(defun centaur-tabs--one-window-p ()
|
||||||
"Like `one-window-p`, but taking into account side windows like treemacs."
|
"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))))
|
(lambda (tab) (string= tabname (buffer-name (centaur-tabs-tab-value tab))))
|
||||||
seq)))
|
seq)))
|
||||||
|
|
||||||
|
|
||||||
(defun centaur-tabs--tab-menu (event)
|
(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" )
|
(interactive "e" )
|
||||||
|
|
||||||
(let ((click-on-tab-p (ignore-errors (centaur-tabs-get-tab-from-event event))))
|
(let ((click-on-tab-p (ignore-errors (centaur-tabs-get-tab-from-event event))))
|
||||||
|
|
||||||
(when (not click-on-tab-p)
|
(when (not click-on-tab-p)
|
||||||
(centaur-tabs--groups-menu))
|
(centaur-tabs--groups-menu))
|
||||||
|
|
||||||
(when click-on-tab-p
|
(when click-on-tab-p
|
||||||
(centaur-tabs-do-select event)
|
(centaur-tabs-do-select event)
|
||||||
(redisplay t)
|
(redisplay t)
|
||||||
|
|
||||||
(let*
|
(let*
|
||||||
((menu (easy-menu-create-menu nil (centaur-tabs--tab-menu-definition)))
|
((menu (easy-menu-create-menu nil (centaur-tabs--tab-menu-definition)))
|
||||||
(choice (x-popup-menu t menu))
|
(choice (x-popup-menu t menu))
|
||||||
|
|
@ -596,7 +615,7 @@ Modified copy of `treemacs-visit-node-in-external-application`."
|
||||||
(when action-is-command-p
|
(when action-is-command-p
|
||||||
(call-interactively action))
|
(call-interactively action))
|
||||||
(when (not action-is-command-p)
|
(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)))
|
(choice-is-group-p (string= centaur-tabs--groups-submenu-key (symbol-name menu-key)))
|
||||||
(name (car (last choice)))
|
(name (car (last choice)))
|
||||||
(name-as-string (symbol-name name)))
|
(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)
|
(centaur-tabs-switch-group name-as-string)
|
||||||
(switch-to-buffer name-as-string))))))))
|
(switch-to-buffer name-as-string))))))))
|
||||||
|
|
||||||
|
|
||||||
(defun centaur-tabs--groups-menu ()
|
(defun centaur-tabs--groups-menu ()
|
||||||
"Show a popup menu with the centaur tabs groups."
|
"Show a popup menu with the centaur tabs groups."
|
||||||
(interactive)
|
(interactive)
|
||||||
|
(let* ((sorted-groups (centaur-tabs--tab-submenu-groups-definition))
|
||||||
(let*
|
(menu (easy-menu-create-menu "Tab groups"
|
||||||
((sorted-groups (centaur-tabs--tab-submenu-groups-definition))
|
(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))
|
(choice (x-popup-menu t menu))
|
||||||
(action (lookup-key menu (apply 'vector choice)))
|
(action (lookup-key menu (apply 'vector choice)))
|
||||||
(action-is-command-p (and (commandp action) (functionp action))))
|
(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))))
|
(let ((group (car (last choice))))
|
||||||
(centaur-tabs-switch-group (format "%s" group))))))
|
(centaur-tabs-switch-group (format "%s" group))))))
|
||||||
|
|
||||||
|
|
||||||
(provide 'centaur-tabs-interactive)
|
(provide 'centaur-tabs-interactive)
|
||||||
|
|
||||||
;;; centaur-tabs-interactive.el ends here
|
;;; centaur-tabs-interactive.el ends here
|
||||||
15
code/elpa/centaur-tabs-20240726.625/centaur-tabs-pkg.el
Normal file
15
code/elpa/centaur-tabs-20240726.625/centaur-tabs-pkg.el
Normal 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:
|
||||||
|
|
@ -1,18 +1,18 @@
|
||||||
;;; centaur-tabs.el --- Aesthetic, modern looking customizable tabs plugin -*- lexical-binding: t; -*-
|
;;; 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
|
;; Filename: centaur-tabs.el
|
||||||
;; Description: Provide an out of box configuration to use highly customizable tabs.
|
;; Description: Provide an out of box configuration to use highly customizable tabs.
|
||||||
;; URL: https://github.com/ema2159/centaur-tabs
|
;; URL: https://github.com/ema2159/centaur-tabs
|
||||||
;; Author: Emmanuel Bustos <ema2159@gmail.com>
|
;; 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
|
;; Created: 2019-21-19 22:14:34
|
||||||
;; Version: 5
|
;; Version: 3.3
|
||||||
;; Known Compatibility: GNU Emacs 26.2
|
;; 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
|
;;; This file is NOT part of GNU Emacs
|
||||||
|
|
||||||
|
|
@ -54,10 +54,15 @@
|
||||||
;;
|
;;
|
||||||
|
|
||||||
;;; Code:
|
;;; Code:
|
||||||
;;; Requires
|
|
||||||
(require 'centaur-tabs-elements)
|
(require 'centaur-tabs-elements)
|
||||||
(require 'centaur-tabs-functions)
|
(require 'centaur-tabs-functions)
|
||||||
(require 'centaur-tabs-interactive)
|
(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 ;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;; Centaur-Tabs source code ;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(defgroup centaur-tabs nil
|
(defgroup centaur-tabs nil
|
||||||
|
|
@ -66,15 +71,17 @@
|
||||||
|
|
||||||
(defvar centaur-tabs--buffer-show-groups nil)
|
(defvar centaur-tabs--buffer-show-groups nil)
|
||||||
|
|
||||||
;;; Minor modes
|
|
||||||
;;
|
;;
|
||||||
|
;;; Minor modes
|
||||||
|
|
||||||
(defsubst centaur-tabs-mode-on-p ()
|
(defsubst centaur-tabs-mode-on-p ()
|
||||||
"Return non-nil if Centaur-Tabs mode is on."
|
"Return non-nil if Centaur-Tabs mode is on."
|
||||||
(eq (default-value centaur-tabs-display-line-format)
|
(eq (default-value centaur-tabs-display-line-format)
|
||||||
centaur-tabs-header-line-format))
|
centaur-tabs-header-line-format))
|
||||||
|
|
||||||
;;; Centaur-Tabs-Local mode
|
|
||||||
;;
|
;;
|
||||||
|
;;; Centaur-Tabs-Local mode
|
||||||
|
|
||||||
(defvar centaur-tabs--local-hlf nil)
|
(defvar centaur-tabs--local-hlf nil)
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
|
|
@ -148,19 +155,20 @@ Returns non-nil if the new state is enabled.
|
||||||
(buffer-list))
|
(buffer-list))
|
||||||
;; Restore previous `centaur-tabs-display-line-format'.
|
;; Restore previous `centaur-tabs-display-line-format'.
|
||||||
(set-default centaur-tabs-display-line-format centaur-tabs--global-hlf)
|
(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 ()
|
(defun centaur-tabs-buffer-init ()
|
||||||
"Initialize tab bar buffer data.
|
"Initialize tab bar buffer data.
|
||||||
Run as `centaur-tabs-init-hook'."
|
Run as `centaur-tabs-init-hook'."
|
||||||
(setq centaur-tabs--buffers nil
|
(setq centaur-tabs--buffers nil
|
||||||
centaur-tabs-current-tabset-function 'centaur-tabs-buffer-tabs
|
centaur-tabs-current-tabset-function 'centaur-tabs-buffer-tabs
|
||||||
centaur-tabs-tab-label-function 'centaur-tabs-buffer-tab-label
|
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
|
;; If set, initialize selected overline
|
||||||
(when (eq centaur-tabs-set-bar 'under)
|
(when (eq centaur-tabs-set-bar 'under)
|
||||||
(set-face-attribute 'centaur-tabs-selected nil
|
(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
|
(set-face-attribute 'centaur-tabs-unselected-modified nil
|
||||||
:overline nil
|
:overline nil
|
||||||
:underline 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 'after-save-hook #'centaur-tabs-on-saving-buffer)
|
||||||
(add-hook 'first-change-hook #'centaur-tabs-on-modifying-buffer)
|
(add-hook 'first-change-hook #'centaur-tabs-on-modifying-buffer)
|
||||||
(add-hook 'kill-buffer-hook #'centaur-tabs-buffer-track-killed)
|
(add-hook 'kill-buffer-hook #'centaur-tabs-buffer-track-killed)
|
||||||
(advice-add #'undo :after #'centaur-tabs-after-modifying-buffer)
|
(advice-add #'undo :after #'centaur-tabs-on-modifying-buffer)
|
||||||
(advice-add #'undo-tree-undo-1 :after #'centaur-tabs-after-modifying-buffer)
|
(advice-add #'undo-tree-undo-1 :after #'centaur-tabs-on-modifying-buffer)
|
||||||
(advice-add #'undo-tree-redo-1 :after #'centaur-tabs-after-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 ()
|
(defun centaur-tabs-buffer-quit ()
|
||||||
"Quit tab bar buffer.
|
"Quit tab bar buffer.
|
||||||
|
|
@ -201,18 +212,19 @@ Run as `centaur-tabs-quit-hook'."
|
||||||
(setq centaur-tabs--buffers nil
|
(setq centaur-tabs--buffers nil
|
||||||
centaur-tabs-current-tabset-function nil
|
centaur-tabs-current-tabset-function nil
|
||||||
centaur-tabs-tab-label-function nil
|
centaur-tabs-tab-label-function nil
|
||||||
centaur-tabs-select-tab-function nil
|
centaur-tabs-select-tab-function nil)
|
||||||
)
|
(remove-function after-focus-change-function #'centaur-tabs-after-focus)
|
||||||
(remove-hook 'after-save-hook 'centaur-tabs-after-modifying-buffer)
|
(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 'first-change-hook 'centaur-tabs-on-modifying-buffer)
|
||||||
(remove-hook 'kill-buffer-hook 'centaur-tabs-buffer-track-killed)
|
(remove-hook 'kill-buffer-hook 'centaur-tabs-buffer-track-killed)
|
||||||
(advice-remove #'undo #'centaur-tabs-after-modifying-buffer)
|
(advice-remove #'undo #'centaur-tabs-on-modifying-buffer)
|
||||||
(advice-remove #'undo-tree-undo-1 #'centaur-tabs-after-modifying-buffer)
|
(advice-remove #'undo-tree-undo-1 #'centaur-tabs-on-modifying-buffer)
|
||||||
(advice-remove #'undo-tree-redo-1 #'centaur-tabs-after-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-init-hook #'centaur-tabs-buffer-init)
|
||||||
(add-hook 'centaur-tabs-quit-hook #'centaur-tabs-buffer-quit)
|
(add-hook 'centaur-tabs-quit-hook #'centaur-tabs-buffer-quit)
|
||||||
|
|
||||||
(provide 'centaur-tabs)
|
(provide 'centaur-tabs)
|
||||||
|
|
||||||
;;; centaur-tabs.el ends here
|
;;; centaur-tabs.el ends here
|
||||||
|
|
@ -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"))
|
'((emacs "24"))
|
||||||
:commit "e32a70ca636bad42232b6c79f1491dc86802a721" :authors
|
:commit "1de9dcb83eacfb162b6d9a118a4770b1281bcd84" :authors
|
||||||
'(("Magnar Sveen" . "magnars@gmail.com"))
|
'(("Magnar Sveen" . "magnars@gmail.com"))
|
||||||
:maintainers
|
:maintainers
|
||||||
'(("Magnar Sveen" . "magnars@gmail.com"))
|
'(("Magnar Sveen" . "magnars@gmail.com"))
|
||||||
|
|
@ -2108,7 +2108,7 @@ last item in second form, etc."
|
||||||
|
|
||||||
Insert X at the position signified by the symbol `it' in the first
|
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
|
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)))
|
(declare (debug (form body)))
|
||||||
`(-as-> ,x it ,@forms))
|
`(-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
|
COMPARATOR is called with two elements of LIST, and should return non-nil
|
||||||
if the first element should sort before the second."
|
if the first element should sort before the second."
|
||||||
(declare (important-return-value t))
|
(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))
|
(sort (copy-sequence list) comparator))
|
||||||
|
|
||||||
(defmacro --sort (form list)
|
(defmacro --sort (form list)
|
||||||
|
|
@ -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.
|
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
|
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
|
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"))
|
(--> "def" (concat "abc" it "ghi"))
|
||||||
⇒ "abcdefghi"
|
⇒ "abcdefghi"
|
||||||
|
|
@ -4892,53 +4892,53 @@ Node: Threading macros84441
|
||||||
Ref: ->84666
|
Ref: ->84666
|
||||||
Ref: ->>85154
|
Ref: ->>85154
|
||||||
Ref: -->85657
|
Ref: -->85657
|
||||||
Ref: -as->86213
|
Ref: -as->86214
|
||||||
Ref: -some->86667
|
Ref: -some->86668
|
||||||
Ref: -some->>87052
|
Ref: -some->>87053
|
||||||
Ref: -some-->87499
|
Ref: -some-->87500
|
||||||
Ref: -doto88066
|
Ref: -doto88067
|
||||||
Node: Binding88619
|
Node: Binding88620
|
||||||
Ref: -when-let88826
|
Ref: -when-let88827
|
||||||
Ref: -when-let*89287
|
Ref: -when-let*89288
|
||||||
Ref: -if-let89816
|
Ref: -if-let89817
|
||||||
Ref: -if-let*90182
|
Ref: -if-let*90183
|
||||||
Ref: -let90805
|
Ref: -let90806
|
||||||
Ref: -let*96895
|
Ref: -let*96896
|
||||||
Ref: -lambda97832
|
Ref: -lambda97833
|
||||||
Ref: -setq98638
|
Ref: -setq98639
|
||||||
Node: Side effects99439
|
Node: Side effects99440
|
||||||
Ref: -each99633
|
Ref: -each99634
|
||||||
Ref: -each-while100160
|
Ref: -each-while100161
|
||||||
Ref: -each-indexed100780
|
Ref: -each-indexed100781
|
||||||
Ref: -each-r101372
|
Ref: -each-r101373
|
||||||
Ref: -each-r-while101814
|
Ref: -each-r-while101815
|
||||||
Ref: -dotimes102458
|
Ref: -dotimes102459
|
||||||
Node: Destructive operations103011
|
Node: Destructive operations103012
|
||||||
Ref: !cons103229
|
Ref: !cons103230
|
||||||
Ref: !cdr103433
|
Ref: !cdr103434
|
||||||
Node: Function combinators103626
|
Node: Function combinators103627
|
||||||
Ref: -partial103830
|
Ref: -partial103831
|
||||||
Ref: -rpartial104348
|
Ref: -rpartial104349
|
||||||
Ref: -juxt104996
|
Ref: -juxt104997
|
||||||
Ref: -compose105448
|
Ref: -compose105449
|
||||||
Ref: -applify106055
|
Ref: -applify106056
|
||||||
Ref: -on106485
|
Ref: -on106486
|
||||||
Ref: -flip107257
|
Ref: -flip107258
|
||||||
Ref: -rotate-args107781
|
Ref: -rotate-args107782
|
||||||
Ref: -const108410
|
Ref: -const108411
|
||||||
Ref: -cut108752
|
Ref: -cut108753
|
||||||
Ref: -not109232
|
Ref: -not109233
|
||||||
Ref: -orfn109776
|
Ref: -orfn109777
|
||||||
Ref: -andfn110569
|
Ref: -andfn110570
|
||||||
Ref: -iteratefn111356
|
Ref: -iteratefn111357
|
||||||
Ref: -fixfn112058
|
Ref: -fixfn112059
|
||||||
Ref: -prodfn113632
|
Ref: -prodfn113633
|
||||||
Node: Development114783
|
Node: Development114784
|
||||||
Node: Contribute115072
|
Node: Contribute115073
|
||||||
Node: Contributors116084
|
Node: Contributors116085
|
||||||
Node: FDL118177
|
Node: FDL118178
|
||||||
Node: GPL143497
|
Node: GPL143498
|
||||||
Node: Index181246
|
Node: Index181247
|
||||||
|
|
||||||
End Tag Table
|
End Tag Table
|
||||||
|
|
||||||
|
Before Width: | Height: | Size: 43 KiB After Width: | Height: | Size: 43 KiB |
|
Before Width: | Height: | Size: 32 KiB After Width: | Height: | Size: 32 KiB |
|
|
@ -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"))
|
'((emacs "26.1"))
|
||||||
:commit "e34ce1b4730fb88a33a571b9065114b7a77645f0" :authors
|
:commit "3852301f9c6f3104d9cc98389612b5ef3452a7de" :authors
|
||||||
'(("Rakan Al-Hneiti" . "rakan.alhneiti@gmail.com"))
|
'(("Rakan Al-Hneiti" . "rakan.alhneiti@gmail.com"))
|
||||||
:maintainers
|
:maintainers
|
||||||
'(("Jesús Martínez" . "jesusmartinez93@gmail.com"))
|
'(("Jesús Martínez" . "jesusmartinez93@gmail.com")
|
||||||
|
("Jen-Chieh" . "jcs090218@gmail.com"))
|
||||||
:maintainer
|
:maintainer
|
||||||
'("Jesús Martínez" . "jesusmartinez93@gmail.com")
|
'("Jesús Martínez" . "jesusmartinez93@gmail.com")
|
||||||
:keywords
|
:keywords
|
||||||
|
|
@ -70,15 +70,6 @@
|
||||||
(declare-function string-pixel-width "subr-x.el") ; TODO: remove this after 29.1
|
(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
|
(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 recentf-list nil)
|
||||||
|
|
||||||
(defvar dashboard-buffer-name)
|
(defvar dashboard-buffer-name)
|
||||||
|
|
@ -133,6 +124,27 @@ See `create-image' and Info node `(elisp)Image Descriptors'."
|
||||||
:type 'boolean
|
:type 'boolean
|
||||||
:group 'dashboard)
|
: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
|
(defcustom dashboard-footer-messages
|
||||||
'("The one true editor, Emacs!"
|
'("The one true editor, Emacs!"
|
||||||
"Who the hell uses VIM anyway? Go Evil!"
|
"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)`.
|
Will be of the form `(list-type . icon-name-string)`.
|
||||||
If nil it is disabled. Possible values for list-type are:
|
If nil it is disabled. Possible values for list-type are:
|
||||||
`recents' `bookmarks' `projects' `agenda' `registers'"
|
`recents' `bookmarks' `projects' `agenda' `registers'"
|
||||||
:type '(repeat (alist :key-type symbol :value-type string))
|
:type '(alist :key-type symbol :value-type string)
|
||||||
:group 'dashboard)
|
:group 'dashboard)
|
||||||
|
|
||||||
(defcustom dashboard-heading-icon-height 1.2
|
(defcustom dashboard-heading-icon-height 1.2
|
||||||
|
|
@ -245,7 +257,16 @@ The format is: `icon title help action face prefix suffix`.
|
||||||
Example:
|
Example:
|
||||||
`((\"☆\" \"Star\" \"Show stars\" (lambda (&rest _)
|
`((\"☆\" \"Star\" \"Show stars\" (lambda (&rest _)
|
||||||
(show-stars)) warning \"[\" \"]\"))"
|
(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)
|
:group 'dashboard)
|
||||||
|
|
||||||
(defcustom dashboard-init-info
|
(defcustom dashboard-init-info
|
||||||
|
|
@ -335,8 +356,10 @@ ARGS should be a plist containing `:height', `:v-adjust', or `:face' properties.
|
||||||
:v-adjust -0.05
|
:v-adjust -0.05
|
||||||
:face 'dashboard-footer-icon-face)))
|
:face 'dashboard-footer-icon-face)))
|
||||||
(propertize ">" 'face 'dashboard-footer-icon-face))
|
(propertize ">" 'face 'dashboard-footer-icon-face))
|
||||||
"Footer's icon."
|
"Footer's icon.
|
||||||
:type 'string
|
It can be a string or a string list for display random icons."
|
||||||
|
:type '(choice string
|
||||||
|
(repeat string))
|
||||||
:group 'dashboard)
|
:group 'dashboard)
|
||||||
|
|
||||||
(defcustom dashboard-heading-shorcut-format " (%s)"
|
(defcustom dashboard-heading-shorcut-format " (%s)"
|
||||||
|
|
@ -411,7 +434,9 @@ installed."
|
||||||
Will be of the form `(list-type . list-size)'.
|
Will be of the form `(list-type . list-size)'.
|
||||||
If nil it is disabled. Possible values for list-type are:
|
If nil it is disabled. Possible values for list-type are:
|
||||||
`recents' `bookmarks' `projects' `agenda' `registers'."
|
`recents' `bookmarks' `projects' `agenda' `registers'."
|
||||||
:type '(repeat (alist :key-type symbol :value-type integer))
|
:type '(repeat (choice
|
||||||
|
symbol
|
||||||
|
(cons symbol integer)))
|
||||||
:group 'dashboard)
|
:group 'dashboard)
|
||||||
|
|
||||||
(defcustom dashboard-item-shortcuts
|
(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.
|
"Association list of items and their corresponding shortcuts.
|
||||||
Will be of the form `(list-type . keys)' as understood by `(kbd keys)'.
|
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
|
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.'"
|
shortcut is disabled. See `dashboard-items' for possible values of list-type.'"
|
||||||
:type '(repeat (alist :key-type symbol :value-type string))
|
:type '(alist :key-type symbol :value-type string)
|
||||||
:group 'dashboard)
|
:group 'dashboard)
|
||||||
|
|
||||||
(defcustom dashboard-item-names nil
|
(defcustom dashboard-item-names nil
|
||||||
|
|
@ -574,7 +599,8 @@ Optionally, provide NO-NEXT-LINE to move the cursor forward a line."
|
||||||
`(progn
|
`(progn
|
||||||
(eval-when-compile (defvar dashboard-mode-map))
|
(eval-when-compile (defvar dashboard-mode-map))
|
||||||
(defun ,sym nil
|
(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)
|
(interactive)
|
||||||
(unless (search-forward ,search-label (point-max) t)
|
(unless (search-forward ,search-label (point-max) t)
|
||||||
(search-backward ,search-label (point-min) 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."
|
"Insert a page break line in dashboard buffer."
|
||||||
(dashboard-append dashboard-page-separator))
|
(dashboard-append dashboard-page-separator))
|
||||||
|
|
||||||
(defun dashboard-insert-newline (&optional n)
|
(defun dashboard-insert-newline (&optional times)
|
||||||
"Insert N times of newlines."
|
"When called without an argument, insert a newline.
|
||||||
(dotimes (_ (or n 1))
|
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")))
|
(insert "\n")))
|
||||||
|
|
||||||
(defun dashboard-insert-heading (heading &optional shortcut icon)
|
(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)))))
|
(list :text (dashboard-get-banner-path 1)))))
|
||||||
((and
|
((and
|
||||||
(pred listp)
|
(pred listp)
|
||||||
(pred (lambda (c) (not (proper-list-p c))))
|
(pred (lambda (c)
|
||||||
|
(and (not (proper-list-p c))
|
||||||
|
(not (null c)))))
|
||||||
`(,img . ,txt))
|
`(,img . ,txt))
|
||||||
(list :image (if (dashboard--image-supported-p img)
|
(list :image (if (dashboard--image-supported-p img)
|
||||||
img
|
img
|
||||||
|
|
@ -725,12 +756,16 @@ If MESSAGEBUF is not nil then MSG is also written in message buffer."
|
||||||
txt
|
txt
|
||||||
(message "could not find banner %s, use default instead" txt)
|
(message "could not find banner %s, use default instead" txt)
|
||||||
(dashboard-get-banner-path 1))))
|
(dashboard-get-banner-path 1))))
|
||||||
((pred proper-list-p)
|
((and
|
||||||
|
(pred proper-list-p)
|
||||||
|
(pred (lambda (l) (not (null l)))))
|
||||||
|
|
||||||
(let* ((max (length banner))
|
(let* ((max (length banner))
|
||||||
(choose (nth (random max) banner)))
|
(choose (nth (random max) banner)))
|
||||||
(dashboard-choose-banner choose)))
|
(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)
|
(defun dashboard--image-animated-p (image-path)
|
||||||
"Return if image is a gif or webp.
|
"Return if image is a gif or webp.
|
||||||
|
|
@ -850,7 +885,8 @@ Argument IMAGE-PATH path to the image."
|
||||||
(when (and icon title
|
(when (and icon title
|
||||||
(not (string-equal icon ""))
|
(not (string-equal icon ""))
|
||||||
(not (string-equal title "")))
|
(not (string-equal title "")))
|
||||||
(propertize " " 'face 'variable-pitch))
|
(propertize " " 'face `(:inherit (variable-pitch
|
||||||
|
,face))))
|
||||||
(when title (propertize title 'face face)))
|
(when title (propertize title 'face face)))
|
||||||
:help-echo help
|
:help-echo help
|
||||||
:action action
|
: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."
|
WIDGET-PARAMS are passed to the \"widget-create\" function."
|
||||||
`(progn
|
`(progn
|
||||||
(dashboard-insert-heading ,section-name
|
(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
|
(if ,list
|
||||||
(when (and (dashboard-insert-section-list
|
(when (and (dashboard-insert-section-list
|
||||||
,section-name
|
,section-name
|
||||||
|
|
@ -928,10 +967,19 @@ to widget creation."
|
||||||
"Return a random footer from `dashboard-footer-messages'."
|
"Return a random footer from `dashboard-footer-messages'."
|
||||||
(nth (random (length dashboard-footer-messages)) 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 ()
|
(defun dashboard-insert-footer ()
|
||||||
"Insert footer of dashboard."
|
"Insert footer of dashboard."
|
||||||
(when-let ((footer (dashboard-random-footer))
|
(when-let ((footer (dashboard-random-footer))
|
||||||
(footer-icon (dashboard-replace-displayable dashboard-footer-icon)))
|
(footer-icon (dashboard-footer-icon)))
|
||||||
(dashboard-insert-center
|
(dashboard-insert-center
|
||||||
(if (string-empty-p footer-icon) footer-icon
|
(if (string-empty-p footer-icon) footer-icon
|
||||||
(concat 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 ()
|
(defun dashboard-agenda-entry-format ()
|
||||||
"Format agenda entry to show it on dashboard.
|
"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)))
|
(let* ((scheduled-time (org-get-scheduled-time (point)))
|
||||||
(deadline-time (org-get-deadline-time (point)))
|
(deadline-time (org-get-deadline-time (point)))
|
||||||
(entry-timestamp (dashboard-agenda--entry-timestamp (point)))
|
(entry-timestamp (dashboard-agenda--entry-timestamp (point)))
|
||||||
|
|
@ -143,10 +143,15 @@ Avalaible functions:
|
||||||
`dashboard-insert-items'
|
`dashboard-insert-items'
|
||||||
`dashboard-insert-footer'
|
`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:
|
example:
|
||||||
(lambda () (delete-char -1))"
|
(lambda () (delete-char -1))"
|
||||||
:type '(repeat function)
|
:type '(repeat (choice
|
||||||
|
function
|
||||||
|
(cons function sexp)))
|
||||||
:group 'dashboard)
|
:group 'dashboard)
|
||||||
|
|
||||||
(defcustom dashboard-navigation-cycle nil
|
(defcustom dashboard-navigation-cycle nil
|
||||||
|
|
@ -154,8 +159,10 @@ example:
|
||||||
:type 'boolean
|
:type 'boolean
|
||||||
:group 'dashboard)
|
:group 'dashboard)
|
||||||
|
|
||||||
(defconst dashboard-buffer-name "*dashboard*"
|
(defcustom dashboard-buffer-name "*dashboard*"
|
||||||
"Dashboard's buffer name.")
|
"Dashboard's buffer name."
|
||||||
|
:type 'string
|
||||||
|
:group 'dashboard)
|
||||||
|
|
||||||
(defvar dashboard-force-refresh nil
|
(defvar dashboard-force-refresh nil
|
||||||
"If non-nil, force refresh dashboard buffer.")
|
"If non-nil, force refresh dashboard buffer.")
|
||||||
|
|
@ -191,8 +198,8 @@ example:
|
||||||
(save-excursion
|
(save-excursion
|
||||||
(if-let* ((sep (dashboard--separator))
|
(if-let* ((sep (dashboard--separator))
|
||||||
((and (search-backward sep nil t)
|
((and (search-backward sep nil t)
|
||||||
(search-forward sep nil t))))
|
(search-forward sep nil t)))
|
||||||
(let ((ln (thing-at-point 'line)))
|
(ln (thing-at-point 'line t)))
|
||||||
(cond ((string-match-p "Recent Files:" ln) 'recents)
|
(cond ((string-match-p "Recent Files:" ln) 'recents)
|
||||||
((string-match-p "Bookmarks:" ln) 'bookmarks)
|
((string-match-p "Bookmarks:" ln) 'bookmarks)
|
||||||
((string-match-p "Projects:" ln) 'projects)
|
((string-match-p "Projects:" ln) 'projects)
|
||||||
|
|
@ -200,7 +207,7 @@ example:
|
||||||
((string-match-p "Registers:" ln) 'registers)
|
((string-match-p "Registers:" ln) 'registers)
|
||||||
((string-match-p "List Directories:" ln) 'ls-directories)
|
((string-match-p "List Directories:" ln) 'ls-directories)
|
||||||
((string-match-p "List Files:" ln) 'ls-files)
|
((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"))))
|
(user-error "Failed searching dashboard section"))))
|
||||||
|
|
||||||
;;
|
;;
|
||||||
|
|
@ -500,8 +507,11 @@ See `dashboard-item-generators' for all items available."
|
||||||
(erase-buffer)
|
(erase-buffer)
|
||||||
(setq dashboard--section-starts nil)
|
(setq dashboard--section-starts nil)
|
||||||
|
|
||||||
(mapc (lambda (fn)
|
(mapc (lambda (entry)
|
||||||
(funcall fn))
|
(if (and (listp entry)
|
||||||
|
(not (functionp entry)))
|
||||||
|
(apply (car entry) `(,(cdr entry)))
|
||||||
|
(funcall entry)))
|
||||||
dashboard-startupify-list)
|
dashboard-startupify-list)
|
||||||
|
|
||||||
(when dashboard-vertically-center-content
|
(when dashboard-vertically-center-content
|
||||||
|
|
@ -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"))
|
'((emacs "27.1"))
|
||||||
:commit "3424436f333955b39a0803ce9781aaffaae003f5" :authors
|
:commit "c14d1306648d3ae09ee3a3b3f45592334943cfeb" :authors
|
||||||
'(("Augusto Stoffel" . "arstoffel@gmail.com"))
|
'(("Augusto Stoffel" . "arstoffel@gmail.com"))
|
||||||
:maintainers
|
:maintainers
|
||||||
'(("Augusto Stoffel" . "arstoffel@gmail.com"))
|
'(("Augusto Stoffel" . "arstoffel@gmail.com"))
|
||||||
|
|
@ -1,12 +1,12 @@
|
||||||
;;; devdocs.el --- Emacs viewer for DevDocs -*- lexical-binding: t -*-
|
;;; 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>
|
;; Author: Augusto Stoffel <arstoffel@gmail.com>
|
||||||
;; Keywords: help
|
;; Keywords: help
|
||||||
;; URL: https://github.com/astoff/devdocs.el
|
;; URL: https://github.com/astoff/devdocs.el
|
||||||
;; Package-Requires: ((emacs "27.1"))
|
;; Package-Requires: ((emacs "27.1"))
|
||||||
;; Version: 0.5
|
;; Version: 0.6.1
|
||||||
|
|
||||||
;; This program is free software; you can redistribute it and/or modify
|
;; 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
|
;; 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"
|
:type '(choice (const :tag "Count in parentheses, italicized"
|
||||||
#("%s (%s)" 3 7 (face italic)))
|
#("%s (%s)" 3 7 (face italic)))
|
||||||
(const :tag "Invisible cookie"
|
(const :tag "Invisible cookie"
|
||||||
#("%s (%s)" 2 7 (invisible t)))
|
#("%s#%s" 2 5 (invisible t)))
|
||||||
string))
|
string))
|
||||||
|
|
||||||
(defcustom devdocs-fontify-code-blocks t
|
(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."
|
"Whether to select the DevDocs window for viewing."
|
||||||
:type 'boolean)
|
:type 'boolean)
|
||||||
|
|
||||||
|
(defvar devdocs-extra-rendering-functions '()
|
||||||
|
"Extra functions for `shr-external-rendering-functions'.")
|
||||||
|
|
||||||
(defface devdocs-code-block '((t nil))
|
(defface devdocs-code-block '((t nil))
|
||||||
"Additional face to apply to code blocks in DevDocs buffers.")
|
"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."
|
"Go to the original position in a DevDocs buffer."
|
||||||
(interactive)
|
(interactive)
|
||||||
(goto-char (point-min))
|
(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)))
|
(match (text-property-search-forward 'shr-target-id shr-target-id pred)))
|
||||||
(goto-char (prop-match-beginning match))))
|
(goto-char (prop-match-beginning match))))
|
||||||
|
|
||||||
|
|
@ -477,15 +483,18 @@ fragment part of ENTRY.path."
|
||||||
(unless (eq major-mode 'devdocs-mode)
|
(unless (eq major-mode 'devdocs-mode)
|
||||||
(devdocs-mode))
|
(devdocs-mode))
|
||||||
(let-alist entry
|
(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)
|
(shr-external-rendering-functions `((pre . devdocs--shr-tag-pre)
|
||||||
|
,@extra-rendering-functions
|
||||||
,@shr-external-rendering-functions))
|
,@shr-external-rendering-functions))
|
||||||
(file (expand-file-name (format "%s/%s.html"
|
(file (expand-file-name (format "%s/%s.html"
|
||||||
.doc.slug
|
.doc.slug
|
||||||
(url-hexify-string (devdocs--path-file .path)))
|
(url-hexify-string (devdocs--path-file .path)))
|
||||||
devdocs-data-dir)))
|
devdocs-data-dir)))
|
||||||
(erase-buffer)
|
(erase-buffer)
|
||||||
(setq-local shr-target-id (url-unhex-string (or .fragment (devdocs--path-fragment .path))))
|
|
||||||
;; TODO: cl-progv here for shr settings?
|
;; TODO: cl-progv here for shr settings?
|
||||||
(shr-insert-document
|
(shr-insert-document
|
||||||
(with-temp-buffer
|
(with-temp-buffer
|
||||||
|
|
@ -494,7 +503,9 @@ fragment part of ENTRY.path."
|
||||||
(set-buffer-modified-p nil)
|
(set-buffer-modified-p nil)
|
||||||
(setq-local devdocs-current-docs (list .doc.slug))
|
(setq-local devdocs-current-docs (list .doc.slug))
|
||||||
(push entry devdocs--stack)
|
(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)
|
(devdocs-goto-target)
|
||||||
(current-buffer))))
|
(current-buffer))))
|
||||||
|
|
||||||
|
|
@ -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"))
|
'((emacs "27.1"))
|
||||||
:commit "afc460e687bec4eb947ab85d207778fc3b9b3bbc" :authors
|
:commit "0655b89651458777354a3b89c1d486e0fda1928d" :authors
|
||||||
'(("blahgeek" . "i@blahgeek.com"))
|
'(("blahgeek" . "i@blahgeek.com"))
|
||||||
:maintainers
|
:maintainers
|
||||||
'(("blahgeek" . "i@blahgeek.com"))
|
'(("blahgeek" . "i@blahgeek.com"))
|
||||||
|
|
@ -32,6 +32,7 @@
|
||||||
(require 'eww)
|
(require 'eww)
|
||||||
(require 'eldoc)
|
(require 'eldoc)
|
||||||
(require 'imenu)
|
(require 'imenu)
|
||||||
|
(require 'seq)
|
||||||
|
|
||||||
|
|
||||||
(defgroup devdocs-browser nil
|
(defgroup devdocs-browser nil
|
||||||
|
|
@ -39,12 +40,40 @@
|
||||||
:group 'tools
|
:group 'tools
|
||||||
:group 'web)
|
: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)
|
(expand-file-name "devdocs-browser" user-emacs-directory)
|
||||||
"Directory to store devdocs cache files."
|
"Directory to store devdocs data files."
|
||||||
:type 'directory
|
:type 'directory
|
||||||
:group 'devdocs-browser)
|
:group 'devdocs-browser)
|
||||||
|
|
||||||
|
(defalias 'devdocs-browser-cache-directory 'devdocs-browser-data-directory)
|
||||||
|
|
||||||
(defcustom devdocs-browser-base-url "https://devdocs.io/"
|
(defcustom devdocs-browser-base-url "https://devdocs.io/"
|
||||||
"Base URL to fetch json metadata files."
|
"Base URL to fetch json metadata files."
|
||||||
:type 'string)
|
:type 'string)
|
||||||
|
|
@ -160,37 +189,20 @@ See https://prismjs.com/ for list of language names."
|
||||||
(insert (devdocs-browser--eww-fontify-pre dom))
|
(insert (devdocs-browser--eww-fontify-pre dom))
|
||||||
(shr-ensure-newline)))
|
(shr-ensure-newline)))
|
||||||
|
|
||||||
(defun devdocs-browser--eww-tag-maybe-set-title (dom)
|
(defun devdocs-browser--eww-tag-header (level dom)
|
||||||
"Maybe set DOM as title if it's not set yet."
|
"Render function for header DOM with LEVEL (number)."
|
||||||
(when (zerop (length (plist-get eww-data :title)))
|
;; use h1/h2/h3 as title if not set yet
|
||||||
(eww-tag-title dom)))
|
(when (and (<= level 3)
|
||||||
|
(zerop (length (plist-get eww-data :title))))
|
||||||
|
(eww-tag-title dom))
|
||||||
|
|
||||||
(defun devdocs-browser--eww-tag-h1 (dom)
|
;; similar to shr-heading
|
||||||
"Rendering function for h1 DOM. Maybe use it as title."
|
(shr-ensure-paragraph)
|
||||||
(devdocs-browser--eww-tag-maybe-set-title dom)
|
(let ((start (point)))
|
||||||
(shr-tag-h1 dom))
|
(shr-fontize-dom dom (intern (concat "devdocs-browser-h" (number-to-string level))))
|
||||||
|
;; this is new since emacs 30, to support outline function
|
||||||
(defun devdocs-browser--eww-tag-h2 (dom)
|
(put-text-property start (pos-eol) 'outline-level level))
|
||||||
"Rendering function for h2 DOM. Maybe use it as title."
|
(shr-ensure-paragraph))
|
||||||
(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))
|
|
||||||
|
|
||||||
(defun devdocs-browser--eww-tag-generic-ensure-paragraph (dom)
|
(defun devdocs-browser--eww-tag-generic-ensure-paragraph (dom)
|
||||||
"Rendering function for generic DOM while ensuring paragraph."
|
"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))
|
(path (plist-get entry :path))
|
||||||
(url (url-generic-parse-url path))
|
(url (url-generic-parse-url path))
|
||||||
(target (url-target url))
|
(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))))
|
(cons name (devdocs-browser--position-by-target target))))
|
||||||
entries))))
|
entries))))
|
||||||
|
|
||||||
|
|
@ -325,13 +337,12 @@ Can be used as `imenu-create-index-function'."
|
||||||
(setq-local shr-external-rendering-functions
|
(setq-local shr-external-rendering-functions
|
||||||
(append shr-external-rendering-functions
|
(append shr-external-rendering-functions
|
||||||
'((pre . devdocs-browser--eww-tag-pre)
|
'((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)
|
(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
|
(setq-local imenu-create-index-function
|
||||||
#'devdocs-browser--imenu-create-index)
|
#'devdocs-browser--imenu-create-index)
|
||||||
(when (boundp 'eww-auto-rename-buffer)
|
(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)
|
(defun devdocs-browser--completing-read (prompt collection &optional def)
|
||||||
"Helper function for `completing-read'.
|
"Helper function for `completing-read'.
|
||||||
PROMPT: same meaning, but this function will append ';' at the end;
|
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;
|
possibly the following keys: :value, :annotation, :group;
|
||||||
if :group is not nil and name starts with '<group>: ', its removed.
|
if :group is not nil and name starts with '<group>: ', its removed.
|
||||||
DEF: same meaning;"
|
DEF: same meaning;"
|
||||||
;; convert collection to hashtables for faster completion. `complete-with-action' also supports that.
|
;; convert collection to hashtables for faster completion. `complete-with-action' also supports that.
|
||||||
(setq collection (delq nil collection))
|
(let* (collection-ht
|
||||||
(let* ((collection-ht (make-hash-table :test 'equal :size (length collection)))
|
|
||||||
(annotation-function
|
(annotation-function
|
||||||
(lambda (s)
|
(lambda (s)
|
||||||
(let ((annotation (plist-get (gethash s collection-ht) :annotation)))
|
(let ((annotation (plist-get (gethash s collection-ht) :annotation)))
|
||||||
|
|
@ -372,8 +382,13 @@ DEF: same meaning;"
|
||||||
(replace-match "" t t s)
|
(replace-match "" t t s)
|
||||||
s))
|
s))
|
||||||
(t group))))))
|
(t group))))))
|
||||||
(mapc (lambda (elem) (puthash (car elem) (cdr elem) collection-ht))
|
(if (hash-table-p collection)
|
||||||
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
|
(setq prompt (concat prompt
|
||||||
(when def
|
(when def
|
||||||
(format " (default %s)" (funcall group-function def t)))
|
(format " (default %s)" (funcall group-function def t)))
|
||||||
|
|
@ -384,7 +399,7 @@ DEF: same meaning;"
|
||||||
(if (eq action 'metadata)
|
(if (eq action 'metadata)
|
||||||
`(metadata . ((annotation-function . ,annotation-function)
|
`(metadata . ((annotation-function . ,annotation-function)
|
||||||
(group-function . ,group-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 t ;; require-match
|
||||||
nil nil def)))
|
nil nil def)))
|
||||||
(or (plist-get (gethash res collection-ht) :value)
|
(or (plist-get (gethash res collection-ht) :value)
|
||||||
|
|
@ -396,7 +411,7 @@ DEF: same meaning;"
|
||||||
|
|
||||||
(defun devdocs-browser--read-json (file-path)
|
(defun devdocs-browser--read-json (file-path)
|
||||||
"Read json file in FILE-PATH, if it's a relative path, find it in cache dir."
|
"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)
|
(when (file-exists-p filename)
|
||||||
(with-temp-buffer
|
(with-temp-buffer
|
||||||
(insert-file-contents filename)
|
(insert-file-contents filename)
|
||||||
|
|
@ -405,7 +420,7 @@ DEF: same meaning;"
|
||||||
(defun devdocs-browser--fetch-json (url-path file-path &optional base-url)
|
(defun devdocs-browser--fetch-json (url-path file-path &optional base-url)
|
||||||
"Fetch json from BASE-URL / URL-PATH, also save to FILE-PATH.
|
"Fetch json from BASE-URL / URL-PATH, also save to FILE-PATH.
|
||||||
BASE-URL defaults to `devdocs-browser-base-url'."
|
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))
|
(unless (file-exists-p (file-name-directory cache-filename))
|
||||||
(make-directory (file-name-directory cache-filename) t))
|
(make-directory (file-name-directory cache-filename) t))
|
||||||
(with-temp-file cache-filename
|
(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)))
|
(equal (plist-get doc :name) slug-or-name)))
|
||||||
docs-list)))
|
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)
|
(defun devdocs-browser--install-doc-internal (doc)
|
||||||
"(Re-)install doc identified by plist DOC. Return t if success."
|
"(Re-)install doc identified by plist DOC. Return t if success."
|
||||||
(let* ((slug (plist-get doc :slug))
|
(let* ((slug (plist-get doc :slug))
|
||||||
(mtime (plist-get doc :mtime))
|
(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))
|
(doc-dir (expand-file-name slug docs-dir))
|
||||||
success)
|
success)
|
||||||
(unless (file-exists-p docs-dir)
|
(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))
|
(message "Failed to install devdocs doc %s" slug))
|
||||||
;; remove cache
|
;; remove cache
|
||||||
(setq devdocs-browser--docs-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))
|
success))
|
||||||
|
|
||||||
(defun devdocs-browser--doc-readable-name (doc)
|
(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: "
|
(interactive (list (completing-read "Uninstall doc: "
|
||||||
(devdocs-browser-list-installed-slugs)
|
(devdocs-browser-list-installed-slugs)
|
||||||
nil t)))
|
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)))
|
(doc-dir (expand-file-name slug docs-dir)))
|
||||||
(when (file-exists-p doc-dir)
|
(when (file-exists-p doc-dir)
|
||||||
(delete-directory doc-dir t)))
|
(delete-directory doc-dir t)))
|
||||||
(setq devdocs-browser--docs-cache
|
(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)
|
(defun devdocs-browser--upgrade-readable-name (old-doc new-doc)
|
||||||
"Get human readable name for upgrade from OLD-DOC to 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 ()
|
(defun devdocs-browser-list-installed-slugs ()
|
||||||
"Get a list of installed docs' slug name."
|
"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)
|
(when (file-exists-p dir)
|
||||||
(directory-files dir nil
|
(directory-files dir nil
|
||||||
;; ignore ".", ".." and hidden files
|
;; 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)
|
(defun devdocs-browser--load-doc (slug &optional refresh-cache)
|
||||||
"Load doc identified by SLUG, reload cache if REFRESH-CACHE is not nil.
|
"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."
|
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
|
(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))
|
(doc-dir (expand-file-name slug docs-dir))
|
||||||
(metadata-filename (expand-file-name devdocs-browser--metadata-filename doc-dir))
|
(metadata-filename (expand-file-name devdocs-browser--metadata-filename doc-dir))
|
||||||
(metadata nil)
|
(metadata nil)
|
||||||
|
|
@ -638,15 +658,16 @@ Result is a plist metadata, with an extra :index field at the beginning."
|
||||||
(insert-file-contents metadata-filename)
|
(insert-file-contents metadata-filename)
|
||||||
(setq metadata (read (current-buffer))))
|
(setq metadata (read (current-buffer))))
|
||||||
(setq res (append `(:index ,index) metadata))
|
(setq res (append `(:index ,index) metadata))
|
||||||
|
(when devdocs-browser-enable-cache
|
||||||
(setq devdocs-browser--docs-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)))
|
res)))
|
||||||
|
|
||||||
(defun devdocs-browser--download-offline-data-internal (doc)
|
(defun devdocs-browser--download-offline-data-internal (doc)
|
||||||
"(re-)Download and extract offline data for DOC."
|
"(re-)Download and extract offline data for DOC."
|
||||||
(let* ((slug (plist-get doc :slug))
|
(let* ((slug (plist-get doc :slug))
|
||||||
(mtime (plist-get doc :mtime))
|
(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))
|
(doc-dir (expand-file-name slug docs-dir))
|
||||||
(data-dir (expand-file-name devdocs-browser--offline-data-dir-name doc-dir))
|
(data-dir (expand-file-name devdocs-browser--offline-data-dir-name doc-dir))
|
||||||
success)
|
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)
|
(defun devdocs-browser-offline-data-dir (slug)
|
||||||
"Return doc SLUG's offline data dir if present, return nil otherwise."
|
"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))
|
(doc-dir (expand-file-name slug docs-dir))
|
||||||
(data-dir (expand-file-name devdocs-browser--offline-data-dir-name doc-dir)))
|
(data-dir (expand-file-name devdocs-browser--offline-data-dir-name doc-dir)))
|
||||||
(when (file-exists-p data-dir)
|
(when (file-exists-p data-dir)
|
||||||
|
|
@ -778,7 +799,8 @@ When called interactively, user can choose from the list."
|
||||||
(let ((current-word-regex
|
(let ((current-word-regex
|
||||||
(when-let ((word (thing-at-point 'word t)))
|
(when-let ((word (thing-at-point 'word t)))
|
||||||
(concat "\\<" (regexp-quote word) "\\>")))
|
(concat "\\<" (regexp-quote word) "\\>")))
|
||||||
slugs rows def)
|
(rows (make-hash-table :test 'equal))
|
||||||
|
slugs def)
|
||||||
(dolist (slug-or-name slug-or-name-list)
|
(dolist (slug-or-name slug-or-name-list)
|
||||||
(when-let* ((doc-simple (devdocs-browser-find-installed-doc slug-or-name))
|
(when-let* ((doc-simple (devdocs-browser-find-installed-doc slug-or-name))
|
||||||
(slug (plist-get doc-simple :slug))
|
(slug (plist-get doc-simple :slug))
|
||||||
|
|
@ -786,9 +808,11 @@ When called interactively, user can choose from the list."
|
||||||
(index (plist-get doc :index))
|
(index (plist-get doc :index))
|
||||||
(entries (plist-get index :entries)))
|
(entries (plist-get index :entries)))
|
||||||
(setq slugs (push slug slugs))
|
(setq slugs (push slug slugs))
|
||||||
(let ((new-rows
|
(puthash (format "%s: INDEX PAGE" slug)
|
||||||
(mapcar
|
`(:value (,doc "index")
|
||||||
(lambda (entry)
|
:group ,slug)
|
||||||
|
rows)
|
||||||
|
(seq-doseq (entry entries)
|
||||||
(let* ((name (plist-get entry :name))
|
(let* ((name (plist-get entry :name))
|
||||||
(path (plist-get entry :path))
|
(path (plist-get entry :path))
|
||||||
(type (plist-get entry :type))
|
(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 (and (null def) current-word-regex)
|
||||||
(when (string-match-p current-word-regex name)
|
(when (string-match-p current-word-regex name)
|
||||||
(setq def title)))
|
(setq def title)))
|
||||||
(cons title `(:value (,doc ,path)
|
(puthash title `(:value (,doc ,path)
|
||||||
:group ,slug
|
:group ,slug
|
||||||
:annotation ,type))))
|
:annotation ,type)
|
||||||
entries)))
|
rows)))))
|
||||||
(setq rows (append new-rows rows))
|
|
||||||
(push (cons (format "%s: INDEX PAGE" slug)
|
|
||||||
`(:value (,doc "index")
|
|
||||||
:group ,slug))
|
|
||||||
rows))))
|
|
||||||
(let* ((selected-value
|
(let* ((selected-value
|
||||||
(devdocs-browser--completing-read
|
(devdocs-browser--completing-read
|
||||||
(format "Devdocs browser [%s]" (mapconcat #'identity slugs ","))
|
(format "Devdocs browser [%s]" (mapconcat #'identity slugs ","))
|
||||||
|
|
@ -812,6 +831,12 @@ When called interactively, user can choose from the list."
|
||||||
(when selected-value
|
(when selected-value
|
||||||
(apply #'devdocs-browser--eww-open 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
|
;;;###autoload
|
||||||
(defun devdocs-browser-open ()
|
(defun devdocs-browser-open ()
|
||||||
"Open entry in active docs.
|
"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.
|
or the current doc type if called in a devdocs eww buffer.
|
||||||
When all of them are nil, all installed docs are used."
|
When all of them are nil, all installed docs are used."
|
||||||
(interactive)
|
(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)
|
(provide 'devdocs-browser)
|
||||||
|
|
@ -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
|
|
||||||
|
|
@ -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"))
|
|
||||||
|
|
@ -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
|
|
||||||
|
|
@ -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
|
|
||||||
|
|
@ -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
|
||||||
|
|
@ -1,13 +1,15 @@
|
||||||
(define-package "dired-hacks-utils" "20230512.1107" "Utilities and helpers for dired-hacks collection"
|
(define-package "dired-hacks-utils" "20240629.1906" "Utilities and helpers for dired-hacks collection"
|
||||||
'((dash "2.5.0"))
|
'((dash "2.5.0")
|
||||||
:commit "523f51b4152a3bf4e60fe57f512732c698b5c96f" :authors
|
(emacs "24.3"))
|
||||||
|
:commit "63b04d17936c98cb4ad7ce6bc3331cda8e30c55a" :authors
|
||||||
'(("Matúš Goljer" . "matus.goljer@gmail.com"))
|
'(("Matúš Goljer" . "matus.goljer@gmail.com"))
|
||||||
:maintainers
|
:maintainers
|
||||||
'(("Matúš Goljer" . "matus.goljer@gmail.com"))
|
'(("Matúš Goljer" . "matus.goljer@gmail.com"))
|
||||||
:maintainer
|
:maintainer
|
||||||
'("Matúš Goljer" . "matus.goljer@gmail.com")
|
'("Matúš Goljer" . "matus.goljer@gmail.com")
|
||||||
:keywords
|
:keywords
|
||||||
'("files"))
|
'("files")
|
||||||
|
:url "https://github.com/Fuco1/dired-hacks")
|
||||||
;; Local Variables:
|
;; Local Variables:
|
||||||
;; no-byte-compile: t
|
;; no-byte-compile: t
|
||||||
;; End:
|
;; End:
|
||||||
|
|
@ -7,7 +7,8 @@
|
||||||
;; Keywords: files
|
;; Keywords: files
|
||||||
;; Version: 0.0.1
|
;; Version: 0.0.1
|
||||||
;; Created: 14th February 2014
|
;; 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
|
;; 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
|
;; it under the terms of the GNU General Public License as published by
|
||||||
|
|
@ -41,6 +42,7 @@
|
||||||
|
|
||||||
(require 'dash)
|
(require 'dash)
|
||||||
(require 'dired)
|
(require 'dired)
|
||||||
|
(require 'dired-aux) ;; for dired-dwim-target-directory
|
||||||
|
|
||||||
(defgroup dired-hacks ()
|
(defgroup dired-hacks ()
|
||||||
"Collection of useful dired additions."
|
"Collection of useful dired additions."
|
||||||
|
|
@ -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
|
|
||||||
|
|
@ -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"))
|
|
||||||
|
|
@ -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
|
||||||
16
code/elpa/dired-rainbow-20240629.1857/dired-rainbow-pkg.el
Normal file
16
code/elpa/dired-rainbow-20240629.1857/dired-rainbow-pkg.el
Normal 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:
|
||||||
|
|
@ -5,12 +5,10 @@
|
||||||
;; Author: Matus Goljer <matus.goljer@gmail.com>
|
;; Author: Matus Goljer <matus.goljer@gmail.com>
|
||||||
;; Maintainer: Matus Goljer <matus.goljer@gmail.com>
|
;; Maintainer: Matus Goljer <matus.goljer@gmail.com>
|
||||||
;; Keywords: files
|
;; Keywords: files
|
||||||
;; Package-Commit: 41d3eb42195d9f0894c20d18cc8e722b099aa1c1
|
|
||||||
;; Package-Version: 20221127.1247
|
|
||||||
;; Package-X-Original-Version: 20170922.817
|
|
||||||
;; Version: 0.0.3
|
;; Version: 0.0.3
|
||||||
;; Created: 16th February 2014
|
;; 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
|
;; 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
|
;; it under the terms of the GNU General Public License as published by
|
||||||
|
|
@ -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:
|
|
||||||
|
|
@ -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:
|
||||||
|
|
@ -1,7 +1,7 @@
|
||||||
;;; dockerfile-mode.el --- Major mode for editing Docker's Dockerfiles -*- lexical-binding: t -*-
|
;;; dockerfile-mode.el --- Major mode for editing Docker's Dockerfiles -*- lexical-binding: t -*-
|
||||||
|
|
||||||
;; Copyright (c) 2013 Spotify AB
|
;; Copyright (c) 2013 Spotify AB
|
||||||
;; Package-Requires: ((emacs "24") (s "1.2.0"))
|
;; Package-Requires: ((emacs "24"))
|
||||||
;; Homepage: https://github.com/spotify/dockerfile-mode
|
;; Homepage: https://github.com/spotify/dockerfile-mode
|
||||||
;; URL: https://github.com/spotify/dockerfile-mode
|
;; URL: https://github.com/spotify/dockerfile-mode
|
||||||
;; Version: 1.7
|
;; Version: 1.7
|
||||||
|
|
@ -29,7 +29,6 @@
|
||||||
|
|
||||||
(require 'sh-script)
|
(require 'sh-script)
|
||||||
(require 'rx)
|
(require 'rx)
|
||||||
(require 's)
|
|
||||||
|
|
||||||
|
|
||||||
(declare-function cygwin-convert-file-name-to-windows "cygw32.c" (file &optional absolute-p))
|
(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 ()
|
(defun dockerfile-build-arg-string ()
|
||||||
"Create a --build-arg string for each element in `dockerfile-build-args'."
|
"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 " "))
|
dockerfile-build-args " "))
|
||||||
|
|
||||||
(defun dockerfile-standard-filename (file)
|
(defun dockerfile-standard-filename (file)
|
||||||
68
code/elpa/focus-20240528.901/focus-autoloads.el
Normal file
68
code/elpa/focus-20240528.901/focus-autoloads.el
Normal 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
|
||||||
13
code/elpa/focus-20240528.901/focus-pkg.el
Normal file
13
code/elpa/focus-20240528.901/focus-pkg.el
Normal 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:
|
||||||
329
code/elpa/focus-20240528.901/focus.el
Normal file
329
code/elpa/focus-20240528.901/focus.el
Normal 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
|
||||||
115
code/elpa/go-mode-20240620.1948/go-mode-autoloads.el
Normal file
115
code/elpa/go-mode-20240620.1948/go-mode-autoloads.el
Normal 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
|
||||||
8
code/elpa/go-mode-20240620.1948/go-mode-pkg.el
Normal file
8
code/elpa/go-mode-20240620.1948/go-mode-pkg.el
Normal 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:
|
||||||
3095
code/elpa/go-mode-20240620.1948/go-mode.el
Normal file
3095
code/elpa/go-mode-20240620.1948/go-mode.el
Normal file
File diff suppressed because it is too large
Load diff
|
|
@ -156,27 +156,37 @@ fi
|
||||||
|
|
||||||
|
|
||||||
cat > $CONF_FILE <<EOF
|
cat > $CONF_FILE <<EOF
|
||||||
(setq initial-scratch-message (concat initial-scratch-message
|
(setq initial-scratch-message
|
||||||
";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\\n\
|
";; 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\
|
;; This Emacs is Powered by \`HELM' using\\n\
|
||||||
;; emacs program \"$EMACS\".\\n\
|
;; emacs program \"$EMACS\".\\n\
|
||||||
;; This is a minimal \`helm' configuration to discover \`helm' or debug it.\\n\
|
;; This is a minimal \`helm' configuration to discover \`helm' or debug it.\\n\
|
||||||
;; You can retrieve this minimal configuration in \"$CONF_FILE\".\\n\
|
;; You can retrieve this minimal configuration in \"$CONF_FILE\".\\n\
|
||||||
;;
|
|
||||||
;; Some original Emacs commands are replaced by their \`helm' counterparts:\\n\\n\
|
;; Some original Emacs commands are replaced by their \`helm' counterparts:\\n\\n\
|
||||||
;; - \`find-file'(C-x C-f) =>\`helm-find-files'\\n\
|
;; - \`find-file'(C-x C-f) =>\`helm-find-files'\\n\
|
||||||
;; - \`occur'(M-s o) =>\`helm-occur'\\n\
|
;; - \`occur'(M-s o) =>\`helm-occur'\\n\
|
||||||
;; - \`list-buffers'(C-x C-b) =>\`helm-buffers-list'\\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\
|
;; - \`apropos-command'(C-h a) =>\`helm-apropos'\\n\
|
||||||
;; - \`dabbrev-expand'(M-/) =>\`helm-dabbrev'\\n\
|
;; - \`dabbrev-expand'(M-/) =>\`helm-dabbrev'\\n\
|
||||||
;; - \`execute-extended-command'(M-x) =>\`helm-M-x'\\n\\n
|
;; - \`execute-extended-command'(M-x) =>\`helm-M-x'\\n\\n
|
||||||
;; Some other Emacs commands are \"helmized\" by \`helm-mode'.\\n\
|
;; \`helm-mode' is enabled which mean that most Emacs commands using completion\\n\
|
||||||
;; [1] Coming with emacs-24.4, \`completion-at-point' is \"helmized\" by \`helm-mode'\\n\
|
;; will use helm.\\n\
|
||||||
|
|
||||||
;; which provides Helm completion in many places like \`shell-mode'.\\n\
|
;; To start editing a file or to create a new file, visit it with \`C-x C-f'\\n\
|
||||||
;; Find context help for most Helm commands with \`C-h m'.\\n\
|
;; and enter text in its buffer, to save your changes hit \`C-x C-s'.
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\\n\\n"))
|
|
||||||
|
;; 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))
|
(setq load-path (quote $LOAD_PATH))
|
||||||
|
|
||||||
|
|
@ -233,7 +243,7 @@ cat > $CONF_FILE <<EOF
|
||||||
(setq package-load-list
|
(setq package-load-list
|
||||||
(if (equal load-packages '("all"))
|
(if (equal load-packages '("all"))
|
||||||
'(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)))))
|
(mapcar (lambda (p) (list (intern p) t)) load-packages)))))
|
||||||
|
|
||||||
(package-initialize))
|
(package-initialize))
|
||||||
|
|
@ -256,9 +266,6 @@ cat > $CONF_FILE <<EOF
|
||||||
(define-key global-map [remap dabbrev-expand] 'helm-dabbrev)
|
(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 execute-extended-command] 'helm-M-x)
|
||||||
(define-key global-map [remap apropos-command] 'helm-apropos)
|
(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"))))
|
(add-hook 'kill-emacs-hook #'(lambda () (and (file-exists-p "$CONF_FILE") (delete-file "$CONF_FILE"))))
|
||||||
EOF
|
EOF
|
||||||
|
|
||||||
File diff suppressed because it is too large
Load diff
|
|
@ -33,6 +33,7 @@
|
||||||
(declare-function all-the-icons-icon-for-file"ext:all-the-icons.el")
|
(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-octicon "ext:all-the-icons.el")
|
||||||
(declare-function all-the-icons-match-to-alist "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)
|
(defvar all-the-icons-dir-icon-alist)
|
||||||
|
|
||||||
|
|
@ -65,7 +66,7 @@
|
||||||
Don't use `setq' to set this."
|
Don't use `setq' to set this."
|
||||||
:type 'boolean
|
:type 'boolean
|
||||||
:set (lambda (var val)
|
:set (lambda (var val)
|
||||||
(if (featurep 'all-the-icons)
|
(if (require 'all-the-icons nil t)
|
||||||
(set var val)
|
(set var val)
|
||||||
(set var nil))))
|
(set var nil))))
|
||||||
|
|
||||||
|
|
@ -88,6 +89,10 @@ will be honored."
|
||||||
helm-bookmark-default-filtered-sources)
|
helm-bookmark-default-filtered-sources)
|
||||||
for fn = (intern (format "%s-builder" s))
|
for fn = (intern (format "%s-builder" s))
|
||||||
do (set s (funcall fn)))))
|
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
|
(defgroup helm-bookmark-faces nil
|
||||||
"Customize the appearance of helm-bookmark."
|
"Customize the appearance of helm-bookmark."
|
||||||
|
|
@ -250,7 +255,8 @@ will be honored."
|
||||||
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-gnus)
|
(or (eq (bookmark-get-handler bookmark) 'bmkext-jump-gnus)
|
||||||
(eq (bookmark-get-handler bookmark) 'gnus-summary-bookmark-jump)
|
(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)
|
(defun helm-bookmark-mu4e-bookmark-p (bookmark)
|
||||||
"Return non nil if BOOKMARK is a mu4e 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."
|
BOOKMARK is a bookmark name or a bookmark record."
|
||||||
(or (eq (bookmark-get-handler bookmark) 'bmkext-jump-w3m)
|
(or (eq (bookmark-get-handler bookmark) 'bmkext-jump-w3m)
|
||||||
(eq (bookmark-get-handler bookmark) 'bookmark-w3m-bookmark-jump)
|
(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)
|
(defun helm-bookmark-woman-bookmark-p (bookmark)
|
||||||
"Return non-nil if BOOKMARK is a Woman bookmark.
|
"Return non-nil if BOOKMARK is a Woman bookmark.
|
||||||
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-woman)
|
(or (eq (bookmark-get-handler bookmark) 'bmkext-jump-woman)
|
||||||
(eq (bookmark-get-handler bookmark) 'woman-bookmark-jump)
|
(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)
|
(defun helm-bookmark-man-bookmark-p (bookmark)
|
||||||
"Return non-nil if BOOKMARK is a Man bookmark.
|
"Return non-nil if BOOKMARK is a Man bookmark.
|
||||||
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-man)
|
(or (eq (bookmark-get-handler bookmark) 'bmkext-jump-man)
|
||||||
(eq (bookmark-get-handler bookmark) 'Man-bookmark-jump)
|
(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)
|
(defun helm-bookmark-woman-man-bookmark-p (bookmark)
|
||||||
"Return non-nil if BOOKMARK is a Man or Woman 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)."
|
This excludes bookmarks of a more specific kind (Info, Gnus, and W3m)."
|
||||||
(let* ((filename (bookmark-get-filename bookmark))
|
(let* ((filename (bookmark-get-filename bookmark))
|
||||||
(isnonfile (equal filename helm-bookmark--non-file-filename)))
|
(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)
|
(defun helm-bookmark-org-file-p (bookmark)
|
||||||
(let* ((filename (bookmark-get-filename 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-w3m #'helm-bookmark-jump-w3m)
|
||||||
(defalias 'bookmarkp-jump-woman #'woman-bookmark-jump)
|
(defalias 'bookmarkp-jump-woman #'woman-bookmark-jump)
|
||||||
(defalias 'bookmarkp-jump-man #'Man-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
|
;;;; Filtered bookmark sources
|
||||||
|
|
@ -619,15 +635,17 @@ If `browse-url-browser-function' is set to something else than
|
||||||
all-the-icons-dir-icon-alist))
|
all-the-icons-dir-icon-alist))
|
||||||
(apply (car it) (cdr it))
|
(apply (car it) (cdr it))
|
||||||
(all-the-icons-octicon "file-directory")))
|
(all-the-icons-octicon "file-directory")))
|
||||||
|
(isw3m (all-the-icons-faicon "firefox"))
|
||||||
((and isfile isinfo) (all-the-icons-octicon "info"))
|
((and isfile isinfo) (all-the-icons-octicon "info"))
|
||||||
(isfile (all-the-icons-icon-for-file isfile))
|
|
||||||
((or iswoman isman)
|
((or iswoman isman)
|
||||||
(all-the-icons-fileicon "man-page"))
|
(all-the-icons-fileicon "man-page"))
|
||||||
((or isgnus ismu4e)
|
((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
|
;; Add a * if bookmark have annotation
|
||||||
if (and isannotation (not (string-equal isannotation "")))
|
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
|
for sep = (and helm-bookmark-show-location
|
||||||
(make-string (- (+ bookmark-bmenu-file-column 2)
|
(make-string (- (+ bookmark-bmenu-file-column 2)
|
||||||
(string-width trunc))
|
(string-width trunc))
|
||||||
|
|
@ -749,32 +767,43 @@ renamed."
|
||||||
(setq bookmark-alist-modification-count (1+ bookmark-alist-modification-count))
|
(setq bookmark-alist-modification-count (1+ bookmark-alist-modification-count))
|
||||||
(when (bookmark-time-to-save-p) (bookmark-save)))
|
(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.
|
"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 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
|
While the user enters the new name, repeated `C-w' inserts
|
||||||
consecutive words from the buffer into the new bookmark name."
|
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-historicize-string old)
|
||||||
(bookmark-maybe-load-default-file)
|
(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))
|
(setq bookmark-current-buffer (current-buffer))
|
||||||
(let ((newname (or new (read-from-minibuffer
|
(catch 'skip
|
||||||
"New name: " nil
|
(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)))
|
(let ((now-map (copy-keymap minibuffer-local-map)))
|
||||||
(define-key now-map "\C-w" #'bookmark-yank-word)
|
(define-key now-map "\C-w" #'bookmark-yank-word)
|
||||||
|
(define-key now-map (kbd "C-<return>")
|
||||||
|
#'(lambda () (interactive) (throw 'skip 'skip)))
|
||||||
now-map)
|
now-map)
|
||||||
nil 'bookmark-history))))
|
nil 'bookmark-history old))))
|
||||||
(bookmark-set-name old newname)
|
(bookmark-set-name old newname)
|
||||||
(setq bookmark-current-bookmark 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
|
(helm-make-command-from-action helm-bookmark-run-edit
|
||||||
"Run `helm-bookmark-edit-bookmark' from keyboard."
|
"Run `helm-bookmark-edit-bookmark' from keyboard."
|
||||||
|
|
@ -808,7 +837,65 @@ E.g. prepended with *."
|
||||||
(dolist (i (helm-marked-candidates))
|
(dolist (i (helm-marked-candidates))
|
||||||
(bookmark-delete (helm-bookmark-get-bookmark-from-name i)
|
(bookmark-delete (helm-bookmark-get-bookmark-from-name i)
|
||||||
'batch)))
|
'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
|
;;;###autoload
|
||||||
(defun helm-bookmarks ()
|
(defun helm-bookmarks ()
|
||||||
|
|
@ -818,7 +905,7 @@ E.g. prepended with *."
|
||||||
helm-source-bookmark-set)
|
helm-source-bookmark-set)
|
||||||
:buffer "*helm bookmarks*"
|
:buffer "*helm bookmarks*"
|
||||||
:default (buffer-name helm-current-buffer)))
|
:default (buffer-name helm-current-buffer)))
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
(defun helm-filtered-bookmarks ()
|
(defun helm-filtered-bookmarks ()
|
||||||
"Preconfigured `helm' for bookmarks (filtered by category).
|
"Preconfigured `helm' for bookmarks (filtered by category).
|
||||||
|
|
@ -36,6 +36,7 @@
|
||||||
(defvar dired-buffers)
|
(defvar dired-buffers)
|
||||||
(defvar org-directory)
|
(defvar org-directory)
|
||||||
(defvar helm-ff-default-directory)
|
(defvar helm-ff-default-directory)
|
||||||
|
(defvar major-mode-remap-alist)
|
||||||
|
|
||||||
|
|
||||||
(defgroup helm-buffers nil
|
(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."
|
of this source is accessible and properly loaded."
|
||||||
:type '(repeat (choice symbol)))
|
: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."
|
"The string to display at end of truncated buffer names."
|
||||||
:type 'string)
|
:type 'string)
|
||||||
|
|
||||||
|
|
@ -148,7 +152,7 @@ you want to keep the recentest order when narrowing candidates."
|
||||||
Don't use `setq' to set this."
|
Don't use `setq' to set this."
|
||||||
:type 'boolean
|
:type 'boolean
|
||||||
:set (lambda (var val)
|
:set (lambda (var val)
|
||||||
(if (featurep 'all-the-icons)
|
(if (require 'all-the-icons nil t)
|
||||||
(set var val)
|
(set var val)
|
||||||
(set var nil))))
|
(set var nil))))
|
||||||
|
|
||||||
|
|
@ -335,6 +339,9 @@ Note that this variable is buffer-local.")
|
||||||
when (string-match r candidate)
|
when (string-match r candidate)
|
||||||
return m)))
|
return m)))
|
||||||
(buffer (get-buffer-create candidate)))
|
(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
|
(if mjm
|
||||||
(with-current-buffer buffer (funcall mjm))
|
(with-current-buffer buffer (funcall mjm))
|
||||||
(set-buffer-major-mode buffer))
|
(set-buffer-major-mode buffer))
|
||||||
|
|
@ -379,7 +386,7 @@ Note that this variable is buffer-local.")
|
||||||
|
|
||||||
|
|
||||||
(defun helm-buffers-get-visible-buffers ()
|
(defun helm-buffers-get-visible-buffers ()
|
||||||
"Returns buffers visibles on current frame."
|
"Returns buffers visible on visible frames."
|
||||||
(let (result)
|
(let (result)
|
||||||
(walk-windows
|
(walk-windows
|
||||||
(lambda (x)
|
(lambda (x)
|
||||||
|
|
@ -388,6 +395,7 @@ Note that this variable is buffer-local.")
|
||||||
result))
|
result))
|
||||||
|
|
||||||
(defun helm-buffer-list-1 (&optional visibles)
|
(defun helm-buffer-list-1 (&optional visibles)
|
||||||
|
"Return list of all buffers except VISIBLES buffers."
|
||||||
(cl-loop for b in (buffer-list)
|
(cl-loop for b in (buffer-list)
|
||||||
for bn = (buffer-name b)
|
for bn = (buffer-name b)
|
||||||
unless (member bn visibles)
|
unless (member bn visibles)
|
||||||
|
|
@ -431,7 +439,7 @@ The list is reordered with `helm-buffer-list-reorder-fn'."
|
||||||
(cond ((eq type 'dired)
|
(cond ((eq type 'dired)
|
||||||
(all-the-icons-octicon "file-directory"))
|
(all-the-icons-octicon "file-directory"))
|
||||||
(buf-fname
|
(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))))))
|
(t (all-the-icons-octicon "star" :v-adjust 0.0))))))
|
||||||
(buf-name (propertize buf-name 'face face1
|
(buf-name (propertize buf-name 'face face1
|
||||||
'help-echo help-echo
|
'help-echo help-echo
|
||||||
|
|
@ -452,7 +460,7 @@ The list is reordered with `helm-buffer-list-reorder-fn'."
|
||||||
(format "(%s %s in `%s')"
|
(format "(%s %s in `%s')"
|
||||||
(process-name proc)
|
(process-name proc)
|
||||||
(process-status proc) dir)
|
(process-status proc) dir)
|
||||||
(format "(in `%s')" dir))
|
(format "`%s'" dir))
|
||||||
'face face2)))))
|
'face face2)))))
|
||||||
|
|
||||||
(defun helm-buffer--format-mode-name (buf)
|
(defun helm-buffer--format-mode-name (buf)
|
||||||
|
|
@ -1002,12 +1010,14 @@ vertically."
|
||||||
|
|
||||||
(defun helm-buffers-persistent-kill (_buffer)
|
(defun helm-buffers-persistent-kill (_buffer)
|
||||||
(let ((marked (helm-marked-candidates))
|
(let ((marked (helm-marked-candidates))
|
||||||
(sel (helm-get-selection)))
|
(sel (helm-get-selection))
|
||||||
|
(msg "Buffer `%s' modified, please save it before kill"))
|
||||||
(unwind-protect
|
(unwind-protect
|
||||||
(cl-loop for b in marked
|
(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
|
;; We need to preselect each marked because
|
||||||
;; helm-buffers-persistent-kill is deleting
|
;; helm-buffers-persistent-kill-1 is deleting
|
||||||
;; current selection.
|
;; current selection.
|
||||||
(helm-preselect
|
(helm-preselect
|
||||||
(format "^%s"
|
(format "^%s"
|
||||||
|
|
@ -1025,7 +1035,7 @@ vertically."
|
||||||
(if (or (helm-follow-mode-p)
|
(if (or (helm-follow-mode-p)
|
||||||
(eql current (get-buffer helm-current-buffer))
|
(eql current (get-buffer helm-current-buffer))
|
||||||
(not (eql current (get-buffer candidate))))
|
(not (eql current (get-buffer candidate))))
|
||||||
(switch-to-buffer candidate)
|
(display-buffer candidate)
|
||||||
(if (and helm-persistent-action-display-window
|
(if (and helm-persistent-action-display-window
|
||||||
(window-dedicated-p
|
(window-dedicated-p
|
||||||
(next-window helm-persistent-action-display-window 1)))
|
(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)
|
(cl-assert (not helm-buffers-in-project-p)
|
||||||
nil "You are already browsing this project"))
|
nil "You are already browsing this project"))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
(defun helm-buffers-quit-and-find-file-fn (source)
|
(defun helm-buffers-quit-and-find-file-fn (source)
|
||||||
(let* ((sel (helm-get-selection nil nil source))
|
(let* ((sel (get-buffer (helm-get-selection nil nil source)))
|
||||||
(buf (helm-aand (bufferp sel)
|
(bname (and (bufferp sel) (buffer-name sel))))
|
||||||
(get-buffer sel)
|
(when bname
|
||||||
(buffer-name it))))
|
|
||||||
(when buf
|
|
||||||
(or (buffer-file-name sel)
|
(or (buffer-file-name sel)
|
||||||
(car (rassoc buf dired-buffers))
|
(car (rassoc bname dired-buffers))
|
||||||
(and (with-current-buffer buf
|
(and (with-current-buffer bname
|
||||||
(eq major-mode 'org-agenda-mode))
|
(eq major-mode 'org-agenda-mode))
|
||||||
org-directory
|
org-directory
|
||||||
(expand-file-name org-directory))
|
(expand-file-name org-directory))
|
||||||
(with-current-buffer buf
|
(with-current-buffer bname
|
||||||
(expand-file-name default-directory))))))
|
(expand-file-name default-directory))))))
|
||||||
|
|
||||||
;;; Candidate Transformers
|
;;; Candidate Transformers
|
||||||
|
|
@ -36,7 +36,7 @@
|
||||||
'global
|
'global
|
||||||
(with-current-buffer (get-buffer "*Faces*")
|
(with-current-buffer (get-buffer "*Faces*")
|
||||||
(buffer-substring
|
(buffer-substring
|
||||||
(next-single-char-property-change (point-min) 'face)
|
(next-single-char-property-change (point-min) 'category)
|
||||||
(point-max))))
|
(point-max))))
|
||||||
(kill-buffer "*Faces*")))
|
(kill-buffer "*Faces*")))
|
||||||
|
|
||||||
|
|
@ -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."
|
\\<helm-M-x-map>\\[helm-M-x-toggle-short-doc] while in helm-M-x session."
|
||||||
:type 'boolean)
|
:type 'boolean)
|
||||||
|
|
||||||
|
(defcustom helm-M-x-history-transformer-sort t
|
||||||
|
"When nil, do not sort helm-M-x's commands history."
|
||||||
|
:type 'boolean)
|
||||||
|
|
||||||
|
|
||||||
;;; Faces
|
;;; 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
|
fuzzy matching is running its own sort function with a different
|
||||||
algorithm."
|
algorithm."
|
||||||
(with-helm-current-buffer
|
(with-helm-current-buffer
|
||||||
(cl-loop with max-len = (when helm-M-x-show-short-doc
|
(cl-loop with local-map = (helm-M-x-current-mode-map-alist)
|
||||||
(helm-in-buffer-get-longest-candidate))
|
|
||||||
with local-map = (helm-M-x-current-mode-map-alist)
|
|
||||||
for cand in candidates
|
for cand in candidates
|
||||||
for local-key = (car (rassq cand local-map))
|
for local-key = (car (rassq cand local-map))
|
||||||
for key = (substitute-command-keys (format "\\[%s]" cand))
|
for key = (substitute-command-keys (format "\\[%s]" cand))
|
||||||
for sym = (intern (if (consp cand) (car cand) 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)))
|
(helm-get-first-line-documentation (intern-soft cand)))
|
||||||
for disp = (if (or (eq sym major-mode)
|
for disp = (if (or (eq sym major-mode)
|
||||||
(and (memq sym minor-mode-list)
|
(and (memq sym minor-mode-list)
|
||||||
(boundp sym)
|
(boundp sym)
|
||||||
(buffer-local-value sym helm-current-buffer)))
|
(buffer-local-value
|
||||||
|
sym helm-current-buffer)))
|
||||||
(propertize cand 'face 'helm-command-active-mode)
|
(propertize cand 'face 'helm-command-active-mode)
|
||||||
cand)
|
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
|
collect
|
||||||
(cons (cond ((and (string-match "^M-x" key) local-key)
|
(cons (cond ((and (string-match "^M-x" key) local-key)
|
||||||
(propertize (format "%s%s%s %s"
|
(propertize
|
||||||
|
(format "%s%s%s %s"
|
||||||
disp
|
disp
|
||||||
(if doc (make-string (+ 1 (- max-len (length cand))) ? ) "")
|
(if doc (helm-make-separator cand) "")
|
||||||
(if doc (propertize doc 'face 'helm-M-x-short-doc) "")
|
(if doc
|
||||||
|
(propertize
|
||||||
|
doc 'face 'helm-M-x-short-doc)
|
||||||
|
"")
|
||||||
(propertize
|
(propertize
|
||||||
" " 'display
|
" " 'display
|
||||||
(propertize local-key 'face 'helm-M-x-key)))
|
(propertize local-key 'face 'helm-M-x-key)))
|
||||||
'match-part disp))
|
'match-part disp))
|
||||||
((string-match "^M-x" key)
|
((and (string-match "^M-x" key)
|
||||||
(propertize (format "%s%s%s"
|
(not (string= key "M-x")))
|
||||||
|
(propertize
|
||||||
|
(format "%s%s%s"
|
||||||
disp
|
disp
|
||||||
(if doc (make-string (+ 1 (- max-len (length cand))) ? ) "")
|
(if doc (helm-make-separator cand) "")
|
||||||
(if doc (propertize doc 'face 'helm-M-x-short-doc) ""))
|
(if doc
|
||||||
|
(propertize
|
||||||
|
doc 'face 'helm-M-x-short-doc)
|
||||||
|
""))
|
||||||
'match-part disp))
|
'match-part disp))
|
||||||
(t (propertize (format "%s%s%s %s"
|
(t (propertize
|
||||||
|
(format "%s%s%s %s"
|
||||||
disp
|
disp
|
||||||
(if doc (make-string (+ 1 (- max-len (length cand))) ? ) "")
|
(if doc (helm-make-separator cand) "")
|
||||||
(if doc (propertize doc 'face 'helm-M-x-short-doc) "")
|
(if doc
|
||||||
|
(propertize
|
||||||
|
doc 'face 'helm-M-x-short-doc)
|
||||||
|
"")
|
||||||
(propertize
|
(propertize
|
||||||
" " 'display
|
" " 'display
|
||||||
(propertize key 'face 'helm-M-x-key)))
|
(propertize key 'face 'helm-M-x-key)))
|
||||||
|
|
@ -244,7 +262,7 @@ algorithm."
|
||||||
(defclass helm-M-x-class (helm-source-in-buffer helm-type-command)
|
(defclass helm-M-x-class (helm-source-in-buffer helm-type-command)
|
||||||
((requires-pattern :initform 0)
|
((requires-pattern :initform 0)
|
||||||
(must-match :initform t)
|
(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")
|
(persistent-help :initform "Describe this command")
|
||||||
(help-message :initform 'helm-M-x-help-message)
|
(help-message :initform 'helm-M-x-help-message)
|
||||||
(nomark :initform t)
|
(nomark :initform t)
|
||||||
|
|
@ -265,23 +283,19 @@ algorithm."
|
||||||
(defun helm-M-x-read-extended-command (collection &optional predicate history)
|
(defun helm-M-x-read-extended-command (collection &optional predicate history)
|
||||||
"Read or execute action on command name in COLLECTION or HISTORY.
|
"Read or execute action on command name in COLLECTION or HISTORY.
|
||||||
|
|
||||||
When `helm-M-x-use-completion-styles' is used, Emacs
|
Helm completion is not provided when executing or defining kbd macros.
|
||||||
`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
|
Arg COLLECTION should be an `obarray'.
|
||||||
macros.
|
Arg PREDICATE is a function that default to `commandp'.
|
||||||
|
Arg HISTORY default to `extended-command-history'."
|
||||||
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'."
|
|
||||||
(setq helm--mode-line-display-prefarg t)
|
(setq helm--mode-line-display-prefarg t)
|
||||||
(let* ((pred (or predicate #'commandp))
|
(let* ((pred (or predicate #'commandp))
|
||||||
(helm-fuzzy-sort-fn (lambda (candidates _source)
|
(helm-fuzzy-sort-fn (lambda (candidates _source)
|
||||||
|
(if helm-M-x-history-transformer-sort
|
||||||
;; Sort on real candidate otherwise
|
;; Sort on real candidate otherwise
|
||||||
;; "symbol (<binding>)" is used when sorting.
|
;; "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
|
(sources `(,(helm-make-source "Emacs Commands history" 'helm-M-x-class
|
||||||
:data (lambda ()
|
:data (lambda ()
|
||||||
(helm-comp-read-get-candidates
|
(helm-comp-read-get-candidates
|
||||||
|
|
@ -293,6 +307,10 @@ default to `extended-command-history'."
|
||||||
;; Ensure using empty string to
|
;; Ensure using empty string to
|
||||||
;; not defeat helm matching fns [1]
|
;; not defeat helm matching fns [1]
|
||||||
pred nil nil ""))
|
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)
|
:fuzzy-match helm-M-x-fuzzy-match)
|
||||||
,(helm-make-source "Emacs Commands" 'helm-M-x-class
|
,(helm-make-source "Emacs Commands" 'helm-M-x-class
|
||||||
:data (lambda ()
|
:data (lambda ()
|
||||||
|
|
@ -300,16 +318,11 @@ default to `extended-command-history'."
|
||||||
;; [1] Same comment as above.
|
;; [1] Same comment as above.
|
||||||
collection pred nil nil ""))
|
collection pred nil nil ""))
|
||||||
:fuzzy-match helm-M-x-fuzzy-match)))
|
:fuzzy-match helm-M-x-fuzzy-match)))
|
||||||
(prompt (concat (cond
|
(prompt (concat (helm-acase helm-M-x-prefix-argument
|
||||||
((eq helm-M-x-prefix-argument '-) "- ")
|
(- "-")
|
||||||
((and (consp helm-M-x-prefix-argument)
|
((guard (and (consp it) (car it)))
|
||||||
(eq (car helm-M-x-prefix-argument) 4))
|
(if (eq guard 4) "C-u " (format "%d " guard)))
|
||||||
"C-u ")
|
((guard (integerp it)) (format "%d " it)))
|
||||||
((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)))
|
|
||||||
"M-x ")))
|
"M-x ")))
|
||||||
(setq helm-M-x--timer (run-at-time 1 0.1 #'helm-M-x--notify-prefix-arg))
|
(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
|
;; Fix Bug#2250, add `helm-move-selection-after-hook' which
|
||||||
|
|
@ -54,7 +54,7 @@ Helm buffer."
|
||||||
(defcustom helm-dabbrev-related-buffer-fn #'helm-dabbrev--same-major-mode-p
|
(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'.
|
"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'.
|
buffer to search and the `current-buffer'.
|
||||||
|
|
||||||
The function take one arg, the buffer which is current, look at
|
The function take one arg, the buffer which is current, look at
|
||||||
|
|
@ -31,7 +31,8 @@
|
||||||
["Recent Files" helm-recentf t]
|
["Recent Files" helm-recentf t]
|
||||||
["Locate" helm-locate t]
|
["Locate" helm-locate t]
|
||||||
["Search Files with find" helm-find 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"
|
("Buffers"
|
||||||
["Find buffers" helm-buffers-list t])
|
["Find buffers" helm-buffers-list t])
|
||||||
("Projects"
|
("Projects"
|
||||||
|
|
@ -47,8 +48,9 @@
|
||||||
["Emacs Manual index" helm-info-emacs t]
|
["Emacs Manual index" helm-info-emacs t]
|
||||||
["Gnus Manual index" helm-info-gnus t]
|
["Gnus Manual index" helm-info-gnus t]
|
||||||
["Helm documentation" helm-documentation t])
|
["Helm documentation" helm-documentation t])
|
||||||
("Elpa"
|
("Packages"
|
||||||
["Elisp packages" helm-packages t])
|
["Elisp packages" helm-packages t]
|
||||||
|
["Finder" helm-finder t])
|
||||||
("Tools"
|
("Tools"
|
||||||
["Occur" helm-occur t]
|
["Occur" helm-occur t]
|
||||||
["Grep current directory with AG" helm-do-grep-ag t]
|
["Grep current directory with AG" helm-do-grep-ag t]
|
||||||
|
|
@ -33,6 +33,9 @@
|
||||||
(declare-function helm-comp-read "helm-mode")
|
(declare-function helm-comp-read "helm-mode")
|
||||||
(declare-function helm-M-x-transformer-no-sort-no-props "helm-command")
|
(declare-function helm-M-x-transformer-no-sort-no-props "helm-command")
|
||||||
(defvar helm-M-x-show-short-doc)
|
(defvar helm-M-x-show-short-doc)
|
||||||
|
(defvar completions-detailed)
|
||||||
|
(defvar helm-completions-detailed)
|
||||||
|
|
||||||
|
|
||||||
;;; Customizable values
|
;;; Customizable values
|
||||||
|
|
||||||
|
|
@ -157,9 +160,9 @@ display."
|
||||||
;; Called each time cursor move in helm-buffer.
|
;; Called each time cursor move in helm-buffer.
|
||||||
(defun helm-show-completion ()
|
(defun helm-show-completion ()
|
||||||
(with-helm-current-buffer
|
(with-helm-current-buffer
|
||||||
|
(helm-aif (helm-get-selection)
|
||||||
(overlay-put helm-show-completion-overlay
|
(overlay-put helm-show-completion-overlay
|
||||||
'display (substring-no-properties
|
'display (substring-no-properties it)))))
|
||||||
(helm-get-selection)))))
|
|
||||||
|
|
||||||
(defun helm-show-completion-init-overlay (beg end)
|
(defun helm-show-completion-init-overlay (beg end)
|
||||||
(setq helm-show-completion-overlay (make-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
|
'helm-display-function
|
||||||
(or helm-show-completion-display-function
|
(or helm-show-completion-display-function
|
||||||
'helm-default-display-buffer))
|
'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)
|
(helm-show-completion-init-overlay ,beg ,end)
|
||||||
,@body)
|
,@body)
|
||||||
,@body)
|
,@body)
|
||||||
|
|
@ -292,13 +298,10 @@ Return a cons (beg . end)."
|
||||||
(when (and pos (< (point) pos))
|
(when (and pos (< (point) pos))
|
||||||
(push-mark pos t t))))
|
(push-mark pos t t))))
|
||||||
|
|
||||||
(defvar helm-lisp-completion--cache nil)
|
|
||||||
(defvar helm-lgst-len nil)
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
(defun helm-lisp-completion-at-point ()
|
(defun helm-lisp-completion-at-point ()
|
||||||
"Preconfigured Helm for Lisp symbol completion at point."
|
"Preconfigured Helm for Lisp symbol completion at point."
|
||||||
(interactive)
|
(interactive)
|
||||||
(setq helm-lgst-len 0)
|
|
||||||
(let* ((target (helm-thing-before-point))
|
(let* ((target (helm-thing-before-point))
|
||||||
(beg (car (helm-bounds-of-thing-before-point)))
|
(beg (car (helm-bounds-of-thing-before-point)))
|
||||||
(end (point))
|
(end (point))
|
||||||
|
|
@ -311,17 +314,12 @@ Return a cons (beg . end)."
|
||||||
(helm-quit-if-no-candidate t)
|
(helm-quit-if-no-candidate t)
|
||||||
(helm-execute-action-at-once-if-one t)
|
(helm-execute-action-at-once-if-one t)
|
||||||
(enable-recursive-minibuffers 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
|
(if candidates
|
||||||
(with-helm-show-completion beg end
|
(with-helm-show-completion beg end
|
||||||
;; Overlay is initialized now in helm-current-buffer.
|
;; Overlay is initialized now in helm-current-buffer.
|
||||||
(helm
|
(helm
|
||||||
:sources (helm-build-in-buffer-source "Lisp completion"
|
:sources (helm-build-in-buffer-source "Lisp completion"
|
||||||
:data helm-lisp-completion--cache
|
:data candidates
|
||||||
:persistent-action `(helm-lisp-completion-persistent-action .
|
:persistent-action `(helm-lisp-completion-persistent-action .
|
||||||
,(and (eq helm-elisp-help-function
|
,(and (eq helm-elisp-help-function
|
||||||
'helm-elisp-show-doc-modeline)
|
'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")))
|
(helm-elisp-show-help "Toggle show help for the symbol")))
|
||||||
|
|
||||||
(defun helm-elisp--show-help-1 (candidate &optional name)
|
(defun helm-elisp--show-help-1 (candidate &optional name)
|
||||||
(let ((sym (intern-soft candidate)))
|
(helm-acase (intern-soft candidate)
|
||||||
(pcase sym
|
((guard (and (fboundp it) (boundp it)))
|
||||||
((and (pred fboundp) (pred boundp))
|
(if (member name `(,helm-describe-function-function
|
||||||
(if (member name `(,helm-describe-function-function ,helm-describe-variable-function))
|
,helm-describe-variable-function))
|
||||||
(funcall (intern (format "helm-%s" name)) sym)
|
(funcall (intern (format "helm-%s" name)) it)
|
||||||
;; When there is no way to know what to describe
|
;; When there is no way to know what to describe
|
||||||
;; prefer describe-function.
|
;; prefer describe-function.
|
||||||
(helm-describe-function sym)))
|
(helm-describe-function it)))
|
||||||
((pred fboundp) (helm-describe-function sym))
|
((guard (fboundp it)) (helm-describe-function it))
|
||||||
((pred boundp) (helm-describe-variable sym))
|
((guard (boundp it)) (helm-describe-variable it))
|
||||||
((pred facep) (helm-describe-face sym)))))
|
((guard (facep it)) (helm-describe-face it))))
|
||||||
|
|
||||||
(defun helm-elisp-show-help (candidate &optional name)
|
(defun helm-elisp-show-help (candidate &optional name)
|
||||||
"Show full help for the function CANDIDATE.
|
"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."
|
"Helm candidates transformer for Lisp completion."
|
||||||
(cl-loop for c in candidates
|
(cl-loop for c in candidates
|
||||||
for sym = (intern c)
|
for sym = (intern c)
|
||||||
for annot = (pcase sym
|
for annot = (helm-acase sym
|
||||||
((pred commandp) " (Com)")
|
((guard (commandp it)) " (Com)")
|
||||||
((pred class-p) " (Class)")
|
((guard (class-p it)) " (Class)")
|
||||||
((pred cl-generic-p) " (Gen)")
|
((guard (cl-generic-p it)) " (Gen)")
|
||||||
((pred fboundp) " (Fun)")
|
((guard (fboundp it)) " (Fun)")
|
||||||
((pred boundp) " (Var)")
|
((guard (boundp it)) " (Var)")
|
||||||
((pred facep) " (Face)"))
|
((guard (facep it)) " (Face)"))
|
||||||
for spaces = (make-string (- helm-lgst-len (length c)) ? )
|
collect (cons (concat c (helm-make-separator c) annot) c) into lst
|
||||||
collect (cons (concat c spaces annot) c) into lst
|
|
||||||
finally return (sort lst #'helm-generic-sort-fn)))
|
finally return (sort lst #'helm-generic-sort-fn)))
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
|
|
@ -415,31 +412,37 @@ If SYM is not documented, return \"Not documented\".
|
||||||
Argument NAME allows specifiying what function to use to display
|
Argument NAME allows specifiying what function to use to display
|
||||||
documentation when SYM name is the same for function and variable."
|
documentation when SYM name is the same for function and variable."
|
||||||
(let ((doc (condition-case _err
|
(let ((doc (condition-case _err
|
||||||
(pcase sym
|
(helm-acase sym
|
||||||
((pred class-p) (cl--class-docstring (cl--find-class sym)))
|
((guard (class-p it))
|
||||||
((and (pred fboundp) (pred boundp))
|
(cl--class-docstring (cl--find-class it)))
|
||||||
(pcase name
|
((guard (and (fboundp it) (boundp it)))
|
||||||
("describe-function"
|
(if (string= name "describe-variable")
|
||||||
(documentation sym t))
|
(documentation-property it 'variable-documentation t)
|
||||||
("describe-variable"
|
(documentation it t)))
|
||||||
(documentation-property sym 'variable-documentation t))
|
((guard (custom-theme-p it))
|
||||||
(_ (documentation sym t))))
|
(documentation-property it 'theme-documentation t))
|
||||||
((pred custom-theme-p)
|
((guard (and (helm-group-p it) (not (fboundp it))))
|
||||||
(documentation-property sym 'theme-documentation t))
|
(documentation-property it 'group-documentation t))
|
||||||
((pred helm-group-p) (documentation-property
|
((guard (fboundp it))
|
||||||
sym 'group-documentation t))
|
(documentation it t))
|
||||||
((pred fboundp) (documentation sym t))
|
((guard (boundp it))
|
||||||
((pred boundp) (documentation-property
|
(documentation-property it 'variable-documentation t))
|
||||||
sym 'variable-documentation t))
|
((guard (facep it)) (face-documentation it)))
|
||||||
((pred facep) (face-documentation sym)))
|
|
||||||
(void-function "Void function -- Not documented"))))
|
(void-function "Void function -- Not documented"))))
|
||||||
(if (and doc (not (string= doc ""))
|
(if (and doc (not (string= doc ""))
|
||||||
;; `documentation' return "\n\n(args...)"
|
;; `documentation' return "\n\n(args...)"
|
||||||
;; for CL-style functions.
|
;; for CL-style functions.
|
||||||
(not (string-match-p "\\`\n\n" doc)))
|
(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
|
(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)
|
end-column nil nil t)
|
||||||
(if (or (symbol-function sym) (boundp sym) (facep sym) (helm-group-p sym))
|
(if (or (symbol-function sym) (boundp sym) (facep sym) (helm-group-p sym))
|
||||||
"Not documented"
|
"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."
|
"Preconfigured Helm to complete file name at point."
|
||||||
(interactive)
|
(interactive)
|
||||||
(require 'helm-mode)
|
(require 'helm-mode)
|
||||||
(let* ((tap (or (thing-at-point 'filename) ""))
|
(let* ((tap (or (thing-at-point 'filename t) ""))
|
||||||
beg
|
beg
|
||||||
(init (and tap
|
(init (and tap
|
||||||
(or force
|
(or force
|
||||||
|
|
@ -466,8 +469,7 @@ documentation when SYM name is the same for function and variable."
|
||||||
(search-backward tap (pos-bol) t)
|
(search-backward tap (pos-bol) t)
|
||||||
(setq beg (point))
|
(setq beg (point))
|
||||||
(looking-back "[^'`( ]" (1- (point)))))
|
(looking-back "[^'`( ]" (1- (point)))))
|
||||||
(expand-file-name
|
(expand-file-name tap)))
|
||||||
(substring-no-properties tap))))
|
|
||||||
(end (point))
|
(end (point))
|
||||||
(helm-quit-if-no-candidate t)
|
(helm-quit-if-no-candidate t)
|
||||||
(helm-execute-action-at-once-if-one 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)
|
(delete-region beg end) (insert (if (string-match "^~" tap)
|
||||||
(abbreviate-file-name completion)
|
(abbreviate-file-name completion)
|
||||||
completion)))))
|
completion)))))
|
||||||
|
(make-obsolete 'helm-complete-file-name-at-point 'helm-find-files "3.9.6")
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
(defun helm-lisp-indent ()
|
(defun helm-lisp-indent ()
|
||||||
|
|
@ -490,20 +493,6 @@ documentation when SYM name is the same for function and variable."
|
||||||
tab-always-indent)))
|
tab-always-indent)))
|
||||||
(indent-for-tab-command current-prefix-arg)))
|
(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
|
;;; Apropos
|
||||||
;;
|
;;
|
||||||
|
|
@ -543,18 +532,17 @@ is only used to test DEFAULT."
|
||||||
|
|
||||||
(defun helm-apropos-short-doc-transformer (candidates _source)
|
(defun helm-apropos-short-doc-transformer (candidates _source)
|
||||||
(if helm-apropos-show-short-doc
|
(if helm-apropos-show-short-doc
|
||||||
(cl-loop with max-len = (helm-in-buffer-get-longest-candidate)
|
(cl-loop for cand in candidates
|
||||||
for cand in candidates
|
|
||||||
for doc = (helm-get-first-line-documentation (intern-soft cand))
|
for doc = (helm-get-first-line-documentation (intern-soft cand))
|
||||||
collect (cons (format "%s%s%s"
|
collect (cons (format "%s%s%s"
|
||||||
cand
|
cand
|
||||||
(if doc
|
(if doc
|
||||||
(make-string (+ 1 (if (zerop max-len)
|
(helm-make-separator cand)
|
||||||
max-len
|
|
||||||
(- max-len (string-width cand))))
|
|
||||||
? )
|
|
||||||
"")
|
"")
|
||||||
(if doc (propertize doc 'face 'helm-M-x-short-doc) ""))
|
(if doc
|
||||||
|
(propertize
|
||||||
|
doc 'face 'helm-M-x-short-doc)
|
||||||
|
""))
|
||||||
cand))
|
cand))
|
||||||
candidates))
|
candidates))
|
||||||
|
|
||||||
|
|
@ -758,23 +746,23 @@ is only used to test DEFAULT."
|
||||||
("Info lookup" . helm-info-lookup-symbol))))
|
("Info lookup" . helm-info-lookup-symbol))))
|
||||||
|
|
||||||
(defun helm-info-lookup-fallback-source (candidate)
|
(defun helm-info-lookup-fallback-source (candidate)
|
||||||
(let ((sym (helm-symbolify candidate))
|
(cl-multiple-value-bind (fn src-name)
|
||||||
src-name fn)
|
(helm-acase (helm-symbolify candidate)
|
||||||
(cond ((class-p sym)
|
((guard (class-p it))
|
||||||
(setq fn #'helm-describe-function
|
(list #'helm-describe-function
|
||||||
src-name "Describe class"))
|
"Describe class"))
|
||||||
((cl-generic-p sym)
|
((guard (cl-generic-p it))
|
||||||
(setq fn #'helm-describe-function
|
(list #'helm-describe-function
|
||||||
src-name "Describe generic function"))
|
"Describe generic function"))
|
||||||
((fboundp sym)
|
((guard (fboundp it))
|
||||||
(setq fn #'helm-describe-function
|
(list #'helm-describe-function
|
||||||
src-name "Describe function"))
|
"Describe function"))
|
||||||
((facep sym)
|
((guard (facep it))
|
||||||
(setq fn #'helm-describe-face
|
(list #'helm-describe-face
|
||||||
src-name "Describe face"))
|
"Describe face"))
|
||||||
(t
|
(t
|
||||||
(setq fn #'helm-describe-variable
|
(list #'helm-describe-variable
|
||||||
src-name "Describe variable")))
|
"Describe variable")))
|
||||||
(helm-build-sync-source src-name
|
(helm-build-sync-source src-name
|
||||||
:candidates (list candidate)
|
:candidates (list candidate)
|
||||||
:persistent-action (lambda (candidate)
|
:persistent-action (lambda (candidate)
|
||||||
|
|
@ -810,7 +798,10 @@ is only used to test DEFAULT."
|
||||||
|
|
||||||
(defun helm-apropos-get-default ()
|
(defun helm-apropos-get-default ()
|
||||||
(with-syntax-table emacs-lisp-mode-syntax-table
|
(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
|
;;;###autoload
|
||||||
(defun helm-apropos (default)
|
(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"))
|
:persistent-help "Toggle describe function / C-u C-j: Toggle advice"))
|
||||||
|
|
||||||
(defun helm-advice-candidates ()
|
(defun helm-advice-candidates ()
|
||||||
(cl-loop for (fname) in ad-advised-functions
|
(cl-loop for fname in ad-advised-functions
|
||||||
for function = (intern fname)
|
for function = (intern fname)
|
||||||
append
|
append
|
||||||
(cl-loop for class in ad-advice-classes 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
|
;;; 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 ()
|
(defun helm-locate-library-scan-list ()
|
||||||
(cl-loop for dir in load-path
|
(cl-loop for dir in load-path
|
||||||
with load-suffixes = '(".el")
|
|
||||||
when (file-directory-p dir)
|
when (file-directory-p dir)
|
||||||
append (directory-files
|
nconc (directory-files
|
||||||
dir t (concat (regexp-opt (get-load-suffixes))
|
dir nil (concat (regexp-opt (find-library-suffixes)) "\\'"))))
|
||||||
"\\'"))))
|
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
(defun helm-locate-library ()
|
(defun helm-locate-library (&optional arg)
|
||||||
"Preconfigured helm to locate elisp libraries."
|
"Preconfigured helm to locate elisp libraries.
|
||||||
(interactive)
|
|
||||||
(helm :sources (helm-build-in-buffer-source "Elisp libraries (Scan)"
|
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
|
:data #'helm-locate-library-scan-list
|
||||||
:fuzzy-match helm-locate-library-fuzzy-match
|
:fuzzy-match helm-locate-library-fuzzy-match
|
||||||
:keymap helm-generic-files-map
|
:keymap helm-generic-files-map
|
||||||
:search (unless helm-locate-library-fuzzy-match
|
:candidate-transformer
|
||||||
(lambda (regexp)
|
(lambda (candidates)
|
||||||
(re-search-forward
|
(cl-loop with reporter = (unless done
|
||||||
(if helm-ff-transformer-show-only-basename
|
(make-progress-reporter
|
||||||
(replace-regexp-in-string
|
"Scanning libraries..." 0 (length candidates)))
|
||||||
"\\`\\^" "" regexp)
|
with lgst = (helm-in-buffer-get-longest-candidate)
|
||||||
regexp)
|
for c in candidates
|
||||||
nil t)))
|
for count from 0
|
||||||
:match-part (lambda (candidate)
|
for bn = (helm-basename c 2)
|
||||||
(with-helm-buffer
|
for sep = (helm-make-separator bn lgst)
|
||||||
(if helm-ff-transformer-show-only-basename
|
for path = (or (assoc-default bn helm--locate-library-cache)
|
||||||
(helm-basename candidate) candidate)))
|
;; A lock file in LOAD-PATH (bug#2626).
|
||||||
:filter-one-by-one (lambda (c)
|
(unless (string-match "\\`\\.#" bn)
|
||||||
(with-helm-buffer
|
(let ((p (find-library-name bn)))
|
||||||
(if helm-ff-transformer-show-only-basename
|
(push (cons bn p) helm--locate-library-cache)
|
||||||
(cons (helm-basename c) c) c)))
|
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))
|
:action (helm-actions-from-type-file))
|
||||||
:ff-transformer-show-only-basename nil
|
:buffer "*helm locate library*")))
|
||||||
:buffer "*helm locate library*"))
|
|
||||||
|
|
||||||
;;; Modify variables from Helm
|
;;; Modify variables from Helm
|
||||||
;;
|
;;
|
||||||
|
|
@ -86,14 +86,18 @@
|
||||||
uid 'face 'font-lock-warning-face))
|
uid 'face 'font-lock-warning-face))
|
||||||
key)))
|
key)))
|
||||||
|
|
||||||
(defun helm-epa--select-keys (prompt keys)
|
(cl-defun helm-epa--select-keys (prompt keys)
|
||||||
"A helm replacement for `epa--select-keys'."
|
"A helm replacement for `epa--select-keys'."
|
||||||
(let ((result (helm :sources (helm-make-source "Epa select keys" 'helm-epa
|
(let ((result (helm :sources (helm-make-source "Epa select keys" 'helm-epa
|
||||||
:candidates (lambda ()
|
: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))
|
:prompt (and prompt (helm-epa--format-prompt prompt))
|
||||||
:buffer "*helm epa*")))
|
: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)))
|
result)))
|
||||||
|
|
||||||
(defun helm-epa--format-prompt (prompt)
|
(defun helm-epa--format-prompt (prompt)
|
||||||
|
|
@ -104,13 +108,23 @@
|
||||||
(replace-regexp-in-string "\\.[\t ]*\\'" "" (cadr split)))
|
(replace-regexp-in-string "\\.[\t ]*\\'" "" (cadr split)))
|
||||||
(format "%s: " (replace-regexp-in-string "\\.[\t ]*\\'" "" (car 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 ()
|
(defun helm-epa--read-signature-type ()
|
||||||
"A helm replacement for `epa--read-signature-type'."
|
"A helm replacement for `epa--read-signature-type'."
|
||||||
(let ((answer (helm-read-answer "Signature type:
|
(let ((answer (helm-read-answer "Signature type? [n,c,d,h]"
|
||||||
(n - Create a normal signature)
|
'("n" "c" "d")
|
||||||
(c - Create a cleartext signature)
|
#'helm-epa--read-signature-type-help)))
|
||||||
(d - Create a detached signature)"
|
|
||||||
'("n" "c" "d"))))
|
|
||||||
(helm-acase answer
|
(helm-acase answer
|
||||||
("n" 'normal)
|
("n" 'normal)
|
||||||
("c" 'clear)
|
("c" 'clear)
|
||||||
|
|
@ -145,7 +159,7 @@
|
||||||
(progn
|
(progn
|
||||||
(advice-add 'epa--select-keys :override #'helm-epa--select-keys)
|
(advice-add 'epa--select-keys :override #'helm-epa--select-keys)
|
||||||
(advice-add 'epa--read-signature-type :override #'helm-epa--read-signature-type))
|
(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)))
|
(advice-remove 'epa--read-signature-type #'helm-epa--read-signature-type)))
|
||||||
|
|
||||||
(defun helm-epa-action-transformer (actions _candidate)
|
(defun helm-epa-action-transformer (actions _candidate)
|
||||||
|
|
@ -290,7 +290,7 @@ at point."
|
||||||
(delete-char -1) (setq del-dot t)
|
(delete-char -1) (setq del-dot t)
|
||||||
(setq helm-ec-target (substring helm-ec-target 0 (1- (length helm-ec-target)))))
|
(setq helm-ec-target (substring helm-ec-target 0 (1- (length helm-ec-target)))))
|
||||||
(cond ((eq first ?\()
|
(cond ((eq first ?\()
|
||||||
(helm-lisp-completion-or-file-name-at-point))
|
(helm-lisp-completion-at-point))
|
||||||
;; In eshell `pcomplete-parse-arguments' is called
|
;; In eshell `pcomplete-parse-arguments' is called
|
||||||
;; with `pcomplete-parse-arguments-function'
|
;; with `pcomplete-parse-arguments-function'
|
||||||
;; locally bound to `eshell-complete-parse-arguments'
|
;; locally bound to `eshell-complete-parse-arguments'
|
||||||
|
|
@ -23,7 +23,8 @@
|
||||||
(require 'edebug)
|
(require 'edebug)
|
||||||
|
|
||||||
(declare-function helm-lisp-completion-at-point "helm-elisp.el")
|
(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
|
(defgroup helm-eval nil
|
||||||
"Eval related Applications and libraries for Helm."
|
"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)
|
(define-key map (kbd "<left>") #'backward-char)
|
||||||
map))
|
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 ()
|
(defun helm-build-evaluation-result-source ()
|
||||||
(helm-build-dummy-source "Evaluation Result"
|
(helm-make-source "Evaluation Result" 'helm-evaluation-result-class
|
||||||
:multiline t
|
:multiline t
|
||||||
:mode-line "C-RET: nl-and-indent, M-tab: reindent, C-tab:complete, C-p/n: next/prec-line."
|
:mode-line "C-RET: nl-and-indent, M-tab: reindent, C-tab:complete, C-p/n: next/prec-line."
|
||||||
:filtered-candidate-transformer
|
:filtered-candidate-transformer
|
||||||
|
|
@ -67,16 +67,15 @@ If this variable is not set by the user, it will be calculated
|
||||||
automatically.")
|
automatically.")
|
||||||
|
|
||||||
(defun helm-external-commands-list-1 (&optional sort)
|
(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
|
If `helm-external-commands-list' is non-nil it will return its
|
||||||
contents. Else it calculates all external commands and sets
|
contents. Else it calculates all external commands and sets
|
||||||
`helm-external-commands-list'."
|
`helm-external-commands-list'."
|
||||||
(helm-aif helm-external-commands-list
|
(or helm-external-commands-list
|
||||||
it
|
|
||||||
(setq helm-external-commands-list
|
(setq helm-external-commands-list
|
||||||
(cl-loop
|
(cl-loop for dir in (split-string (getenv "PATH") path-separator)
|
||||||
for dir in (split-string (getenv "PATH") path-separator)
|
when (and (file-exists-p dir)
|
||||||
when (and (file-exists-p dir) (file-accessible-directory-p dir))
|
(file-accessible-directory-p dir))
|
||||||
for lsdir = (cl-loop for i in (directory-files dir t)
|
for lsdir = (cl-loop for i in (directory-files dir t)
|
||||||
for bn = (file-name-nondirectory i)
|
for bn = (file-name-nondirectory i)
|
||||||
when (and (not (member bn completions))
|
when (and (not (member bn completions))
|
||||||
|
|
@ -132,10 +132,11 @@
|
||||||
(cl-assert (executable-find helm-fd-executable) nil "Could not find fd executable")
|
(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")
|
(cl-assert (not (file-remote-p directory)) nil "Fd not supported on remote directories")
|
||||||
(let ((default-directory directory))
|
(let ((default-directory directory))
|
||||||
(helm :sources (helm-make-source
|
(helm :sources (helm-make-source "Fd" 'helm-fd-class
|
||||||
(format "fd (%s)"
|
:header-name
|
||||||
(abbreviate-file-name default-directory))
|
(lambda (name)
|
||||||
'helm-fd-class)
|
(format "%s (%s)"
|
||||||
|
name (abbreviate-file-name default-directory))))
|
||||||
:buffer "*helm fd*")))
|
:buffer "*helm fd*")))
|
||||||
|
|
||||||
|
|
||||||
File diff suppressed because it is too large
Load diff
|
|
@ -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 "a") 'helm-apropos)
|
||||||
(define-key map (kbd "e") 'helm-etags-select)
|
(define-key map (kbd "e") 'helm-etags-select)
|
||||||
(define-key map (kbd "l") 'helm-locate)
|
(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 "s") 'helm-surfraw)
|
||||||
(define-key map (kbd "r") 'helm-regexp)
|
(define-key map (kbd "r") 'helm-regexp)
|
||||||
(define-key map (kbd "m") 'helm-man-woman)
|
(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 "b") 'helm-resume)
|
||||||
(define-key map (kbd "M-g i") 'helm-gid)
|
(define-key map (kbd "M-g i") 'helm-gid)
|
||||||
(define-key map (kbd "@") 'helm-packages)
|
(define-key map (kbd "@") 'helm-packages)
|
||||||
|
(define-key map (kbd "h p") 'helm-finder)
|
||||||
map)
|
map)
|
||||||
"Default keymap for \\[helm-command-prefix] commands.
|
"Default keymap for \\[helm-command-prefix] commands.
|
||||||
The normal global definition of the character \\[helm-command-prefix] indirects to this keymap.")
|
The normal global definition of the character \\[helm-command-prefix] indirects to this keymap.")
|
||||||
|
|
@ -533,16 +533,16 @@ Have no effect when grep backend use \"--color=\"."
|
||||||
(and rec-com rec-com-ack-p)))))))
|
(and rec-com rec-com-ack-p)))))))
|
||||||
|
|
||||||
(defun helm-grep--pipe-command-for-grep-command (smartcase pipe-switches &optional grep-cmd)
|
(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.
|
;; Use grep for GNU regexp based tools.
|
||||||
((or "grep" "zgrep" "git-grep")
|
(("grep" "zgrep" "git-grep")
|
||||||
(format "grep --color=always%s %s"
|
(format "grep --color=always%s %s"
|
||||||
(if smartcase " -i" "")
|
(if smartcase " -i" "")
|
||||||
pipe-switches))
|
pipe-switches))
|
||||||
;; Use ack-grep for PCRE based tools.
|
;; Use ack-grep for PCRE based tools.
|
||||||
;; Sometimes ack-grep cmd is ack only.
|
;; Sometimes ack-grep cmd is ack only so compare by matching ack.
|
||||||
((and (pred (string-match-p "ack")) ack)
|
((guard (string-match-p "ack" it))
|
||||||
(format "%s --smart-case --color %s" ack pipe-switches))))
|
(format "%s --smart-case --color %s" it pipe-switches))))
|
||||||
|
|
||||||
(defun helm-grep--prepare-cmd-line (only-files &optional include zgrep)
|
(defun helm-grep--prepare-cmd-line (only-files &optional include zgrep)
|
||||||
(let* ((default-directory (or helm-ff-default-directory
|
(let* ((default-directory (or helm-ff-default-directory
|
||||||
|
|
@ -1196,7 +1196,7 @@ of grep."
|
||||||
:initform nil
|
:initform nil
|
||||||
:documentation
|
:documentation
|
||||||
" The grep backend that will be used.
|
" 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.
|
and doesn't set the backend by itself.
|
||||||
You probably don't want to modify this.")
|
You probably don't want to modify this.")
|
||||||
(candidate-number-limit :initform 9999)
|
(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.
|
INPUT is used as `input' arg of `helm'. See `helm' docstring.
|
||||||
|
|
||||||
Arg BACKEND when non-nil specifies which backend to use.
|
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
|
When BACKEND \\='zgrep' is used don't prompt for a choice in
|
||||||
recurse, and ignore EXTS, search being made recursively on files
|
recurse, and ignore EXTS, search being made recursively on files
|
||||||
matching `helm-zgrep-file-extension-regexp' only."
|
matching `helm-zgrep-file-extension-regexp' only."
|
||||||
|
|
@ -1635,8 +1635,12 @@ returns if available with current AG version."
|
||||||
(helm-default-directory)
|
(helm-default-directory)
|
||||||
default-directory))
|
default-directory))
|
||||||
(cmd-line (helm-grep-ag-prepare-cmd-line
|
(cmd-line (helm-grep-ag-prepare-cmd-line
|
||||||
helm-pattern (or (file-remote-p directory 'localname)
|
;; NOTE Encode directory name and pattern,
|
||||||
directory)
|
;; 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))
|
type))
|
||||||
(start-time (float-time))
|
(start-time (float-time))
|
||||||
(proc-name (helm-grep--ag-command)))
|
(proc-name (helm-grep--ag-command)))
|
||||||
|
|
@ -1693,18 +1697,27 @@ returns if available with current AG version."
|
||||||
proc-name
|
proc-name
|
||||||
(replace-regexp-in-string "\n" "" event))))))))))
|
(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)
|
(defclass helm-grep-ag-class (helm-source-async)
|
||||||
((nohighlight :initform t)
|
((nohighlight :initform t)
|
||||||
(pcre :initarg :pcre :initform t
|
(pcre :initarg :pcre :initform t
|
||||||
:documentation
|
:documentation
|
||||||
" Backend is using pcre regexp engine when non--nil.")
|
" 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)
|
(history :initform 'helm-grep-ag-history)
|
||||||
(help-message :initform 'helm-grep-help-message)
|
(help-message :initform 'helm-grep-help-message)
|
||||||
(filtered-candidate-transformer :initform #'helm-grep-fc-transformer)
|
(filtered-candidate-transformer :initform #'helm-grep-fc-transformer)
|
||||||
(persistent-action :initform 'helm-grep-persistent-action)
|
(persistent-action :initform 'helm-grep-persistent-action)
|
||||||
(persistent-help :initform "Jump to line (`C-u' Record in mark ring)")
|
(persistent-help :initform "Jump to line (`C-u' Record in mark ring)")
|
||||||
(candidate-number-limit :initform 99999)
|
(candidate-number-limit :initform 99999)
|
||||||
|
(directory :initarg :directory :initform nil
|
||||||
|
:documentation
|
||||||
|
" Directory currently searched.")
|
||||||
(requires-pattern :initform 2)
|
(requires-pattern :initform 2)
|
||||||
(nomark :initform t)
|
(nomark :initform t)
|
||||||
(action :initform 'helm-grep-actions)
|
(action :initform 'helm-grep-actions)
|
||||||
|
|
@ -1728,16 +1741,30 @@ If INPUT is provided, use it as the search string."
|
||||||
:header-name (lambda (name)
|
:header-name (lambda (name)
|
||||||
(format "%s [%s]"
|
(format "%s [%s]"
|
||||||
name (abbreviate-file-name directory)))
|
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
|
:candidates-process
|
||||||
(lambda () (helm-grep-ag-init directory type))))
|
(lambda () (helm-grep-ag-init directory type))))
|
||||||
(helm-set-local-variable 'helm-input-idle-delay helm-grep-input-idle-delay)
|
(helm-set-local-variable 'helm-input-idle-delay helm-grep-input-idle-delay)
|
||||||
(helm :sources 'helm-source-grep-ag
|
(helm :sources 'helm-source-grep-ag
|
||||||
:keymap helm-grep-map
|
|
||||||
:history 'helm-grep-ag-history
|
:history 'helm-grep-ag-history
|
||||||
:input input
|
:input input
|
||||||
:truncate-lines helm-grep-truncate-lines
|
:truncate-lines helm-grep-truncate-lines
|
||||||
:buffer (format "*helm %s*" (helm-grep--ag-command))))
|
: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)
|
(defun helm-grep-ag (directory with-types)
|
||||||
"Start grep AG in DIRECTORY.
|
"Start grep AG in DIRECTORY.
|
||||||
When WITH-TYPES is non-nil provide completion on AG types."
|
When WITH-TYPES is non-nil provide completion on AG types."
|
||||||
|
|
@ -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.
|
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.
|
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.
|
files under the current directory.
|
||||||
|
|
||||||
Note that when recursively copying files, you may have files with same name
|
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.
|
This command is available only when `dired-async-mode' is active.
|
||||||
|
|
||||||
When using an action that involves an external backend (e.g. grep), using \"**\"
|
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
|
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
|
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
|
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
|
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
|
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
|
a named extension recursively you would write \"**.el\" whereas in Bash it would
|
||||||
be \"**/*.el\". Directory selection with \"**/\" like Bash \"shopt globstar\"
|
be \"**/*.el\". Directory selection with \"**/\" like Bash \"shopt globstar\"
|
||||||
option is not supported yet.
|
option is not supported yet.
|
||||||
|
|
||||||
Helm supports different styles of wildcards:
|
Helm supports different styles of wildcards:
|
||||||
|
|
||||||
- `sh' style, the ones supported by `file-expand-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.
|
files or all \".c\" and \".h\" files.
|
||||||
|
|
||||||
- `bash' style (partially) In addition to what allowed in `sh'
|
- `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
|
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
|
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 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]].
|
remote, see [[Use Rsync to copy files][Use Rsync to copy files]].
|
||||||
Also if you often work on remote you may consider using SSHFS
|
Also if you often work on remote you may consider using SSHFS
|
||||||
instead of relying on tramp.
|
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
|
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
|
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.
|
in addition the Tramp documentation.
|
||||||
|
|
||||||
1) Install Adb, most distribution provide it.
|
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.
|
entering the pattern and re-enable it once your pattern is ready.
|
||||||
To toggle suspend-update, use `\\<helm-map>\\[helm-toggle-suspend-update]'.
|
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
|
*** Execute Eshell commands on files
|
||||||
|
|
||||||
Setting up aliases in Eshell allows you to set up powerful customized commands.
|
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
|
colorize fnames by listing files without loosing performances with
|
||||||
external commands (ls and awk) if your system is compatible.
|
external commands (ls and awk) if your system is compatible.
|
||||||
For this you can use `helm-list-dir-external' as value
|
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
|
**** 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-sort-by-size]|Sort by size.
|
||||||
|\\[helm-ff-toggle-dirs-only]|Show only directories.
|
|\\[helm-ff-toggle-dirs-only]|Show only directories.
|
||||||
|\\[helm-ff-toggle-files-only]|Show only files.
|
|\\[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
|
;;; Help for file-name-history
|
||||||
;;
|
;;
|
||||||
|
|
@ -2251,6 +2288,15 @@ See [[Moving in `helm-buffer'][Moving in `helm-buffer']].
|
||||||
(defvar helm-top-help-message
|
(defvar helm-top-help-message
|
||||||
"* Helm Top
|
"* 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
|
** Commands
|
||||||
\\<helm-top-map>
|
\\<helm-top-map>
|
||||||
|Keys|Description
|
|Keys|Description
|
||||||
|
|
@ -100,7 +100,7 @@ Don't use `setq' to set this."
|
||||||
:group 'helm-imenu
|
:group 'helm-imenu
|
||||||
:type 'boolean
|
:type 'boolean
|
||||||
:set (lambda (var val)
|
:set (lambda (var val)
|
||||||
(if (featurep 'all-the-icons)
|
(if (require 'all-the-icons nil t)
|
||||||
(set var val)
|
(set var val)
|
||||||
(set var nil))))
|
(set var nil))))
|
||||||
|
|
||||||
|
|
@ -111,17 +111,17 @@ Don't use `setq' to set this."
|
||||||
:group 'helm-imenu
|
:group 'helm-imenu
|
||||||
:type 'boolean
|
:type 'boolean
|
||||||
:set (lambda (var val)
|
:set (lambda (var val)
|
||||||
(if (featurep 'all-the-icons)
|
(if (require 'all-the-icons nil t)
|
||||||
(set var val)
|
(set var val)
|
||||||
(set var nil))))
|
(set var nil))))
|
||||||
|
|
||||||
(defcustom helm-imenu-icon-type-alist
|
(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))
|
||||||
("Array" . (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))
|
|
||||||
("Boolean" . (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))
|
||||||
("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))
|
("Color" . (all-the-icons-material "color_lens" :face font-lock-builtin-face))
|
||||||
("Colors" . (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))
|
("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))
|
("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))
|
("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))
|
||||||
("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))
|
("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))
|
("Objects" . (all-the-icons-faicon "angle-double-right" :face font-lock-builtin-face))
|
||||||
("Operator" . (all-the-icons-faicon "calculator" :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))
|
("Reference" . (all-the-icons-octicon "book" :face font-lock-variable-name-face))
|
||||||
("References" . (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))
|
||||||
("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))
|
("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))
|
("Strings" . (all-the-icons-material "text_fields" :face font-lock-variable-name-face))
|
||||||
("Struct" . (all-the-icons-faicon "cog" :face font-lock-type-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)
|
(if (equal (cdr cur) mb)
|
||||||
(prog1 nil
|
(prog1 nil
|
||||||
(helm-set-pattern "")
|
(helm-set-pattern "")
|
||||||
(helm-force-update (concat "\\_<" (car cur) "\\_>")))
|
(helm-force-update
|
||||||
|
(concat "\\_<" (regexp-quote (car cur)) "\\_>")))
|
||||||
t)))
|
t)))
|
||||||
|
|
||||||
(defun helm-imenu-quit-and-find-file-fn (source)
|
(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)
|
(and (cdr elm)
|
||||||
;; Semantic uses overlays whereas imenu uses
|
;; Semantic uses overlays whereas imenu uses
|
||||||
;; markers (Bug#1706).
|
;; markers (Bug#1706).
|
||||||
(setcdr elm (pcase (cdr elm) ; Same as [1].
|
(setcdr elm (helm-acase (cdr elm) ; Same as [1].
|
||||||
((and ov (pred overlayp))
|
((guard (overlayp it))
|
||||||
(copy-overlay ov))
|
(copy-overlay it))
|
||||||
((and mk (or (pred markerp)
|
((guard (or (markerp it) (integerp it)))
|
||||||
(pred integerp)))
|
(copy-marker it))))
|
||||||
(copy-marker mk))))
|
|
||||||
(list elm))))))
|
(list elm))))))
|
||||||
|
|
||||||
(defun helm-imenu--get-prop (item)
|
(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
|
(cl-loop for (k . v) in candidates
|
||||||
;; (k . v) == (symbol-name . marker)
|
;; (k . v) == (symbol-name . marker)
|
||||||
for bufname = (buffer-name
|
for bufname = (buffer-name
|
||||||
(pcase v
|
(helm-acase v
|
||||||
((pred overlayp) (overlay-buffer v))
|
((guard (overlayp it)) (overlay-buffer it))
|
||||||
((or (pred markerp) (pred integerp))
|
((guard (markerp it)) (marker-buffer it))))
|
||||||
(marker-buffer v))))
|
|
||||||
for types = (or (helm-imenu--get-prop k)
|
for types = (or (helm-imenu--get-prop k)
|
||||||
(list (if (with-current-buffer bufname
|
(list (if (with-current-buffer bufname
|
||||||
(derived-mode-p 'prog-mode))
|
(derived-mode-p 'prog-mode))
|
||||||
|
|
@ -141,6 +141,21 @@ If line have a node use the node, otherwise use directly first name found."
|
||||||
:initform nil
|
:initform nil
|
||||||
:custom 'string)
|
:custom 'string)
|
||||||
(init :initform #'helm-info-init)
|
(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)
|
(display-to-real :initform #'helm-info-display-to-real)
|
||||||
(get-line :initform #'buffer-substring)
|
(get-line :initform #'buffer-substring)
|
||||||
(action :initform '(("Goto node" . helm-info-goto)))))
|
(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
|
;; Symbol at point is used as default as long as one of the sources
|
||||||
;; in `helm-info-default-sources' is member of
|
;; in `helm-info-default-sources' is member of
|
||||||
;; `helm-sources-using-default-as-input'.
|
;; `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
|
(cl-loop for src in helm-info-default-sources
|
||||||
for name = (if (symbolp src)
|
for name = (if (symbolp src)
|
||||||
(assoc 'name (symbol-value src))
|
(assoc 'name (symbol-value src))
|
||||||
|
|
@ -308,7 +331,7 @@ Info files are made available."
|
||||||
unless name
|
unless name
|
||||||
do (warn "Couldn't build source `%S' without its info file" src))
|
do (warn "Couldn't build source `%S' without its info file" src))
|
||||||
(helm :sources helm-info-default-sources
|
(helm :sources helm-info-default-sources
|
||||||
:buffer "*helm info*"))
|
:buffer "*helm info*")))
|
||||||
|
|
||||||
(provide 'helm-info)
|
(provide 'helm-info)
|
||||||
|
|
||||||
|
|
@ -56,7 +56,7 @@ unless `helm-locate-command' is non-nil.
|
||||||
|
|
||||||
Here are the default values it will use according to your system:
|
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\"
|
berkeley-unix: \"locate %s %s\"
|
||||||
windows-nt: \"es %s %s\"
|
windows-nt: \"es %s %s\"
|
||||||
Others: \"locate %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
|
The last option must be the one preceding pattern i.e \"-r\" or
|
||||||
\"--regex\".
|
\"--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\"
|
You will be able to pass other options such as \"-b\" or \"l\"
|
||||||
during Helm invocation after entering pattern only when multi
|
during Helm invocation after entering pattern only when multi
|
||||||
matching, not when fuzzy matching.
|
matching, not when fuzzy matching.
|
||||||
|
|
@ -211,7 +215,8 @@ See `helm-locate-with-db' and `helm-locate'."
|
||||||
(unless helm-locate-command
|
(unless helm-locate-command
|
||||||
(setq helm-locate-command
|
(setq helm-locate-command
|
||||||
(cl-case system-type
|
(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")
|
(berkeley-unix "locate %s %s")
|
||||||
(windows-nt "es %s %s")
|
(windows-nt "es %s %s")
|
||||||
(t "locate %s %s")))))
|
(t "locate %s %s")))))
|
||||||
|
|
@ -27,6 +27,8 @@
|
||||||
(declare-function jabber-chat-with "ext:jabber.el")
|
(declare-function jabber-chat-with "ext:jabber.el")
|
||||||
(declare-function jabber-read-account "ext:jabber.el")
|
(declare-function jabber-read-account "ext:jabber.el")
|
||||||
(declare-function helm-comp-read "helm-mode")
|
(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
|
(defgroup helm-misc nil
|
||||||
|
|
@ -387,6 +389,33 @@ Default action change TZ environment variable locally to emacs."
|
||||||
(delete-minibuffer-contents)
|
(delete-minibuffer-contents)
|
||||||
(insert elm)))
|
(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)
|
(provide 'helm-misc)
|
||||||
|
|
||||||
|
|
@ -30,6 +30,10 @@
|
||||||
(defvar helm-mode)
|
(defvar helm-mode)
|
||||||
(defvar password-cache)
|
(defvar password-cache)
|
||||||
(defvar package--builtins)
|
(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
|
;; No warnings in Emacs built --without-x
|
||||||
(declare-function x-file-dialog "xfns.c")
|
(declare-function x-file-dialog "xfns.c")
|
||||||
|
|
@ -46,6 +50,7 @@
|
||||||
(declare-function package-get-descriptor "package")
|
(declare-function package-get-descriptor "package")
|
||||||
(declare-function print-coding-system-briefly "mul-diag.el")
|
(declare-function print-coding-system-briefly "mul-diag.el")
|
||||||
(declare-function color-rgb-to-hex "color.el")
|
(declare-function color-rgb-to-hex "color.el")
|
||||||
|
(declare-function find-library-name "find-func.el")
|
||||||
|
|
||||||
(defgroup helm-mode nil
|
(defgroup helm-mode nil
|
||||||
"Enable helm completion."
|
"Enable helm completion."
|
||||||
|
|
@ -62,6 +67,9 @@
|
||||||
(dired-do-symlink . helm-read-file-name-handler-1)
|
(dired-do-symlink . helm-read-file-name-handler-1)
|
||||||
(dired-do-relsymlink . helm-read-file-name-handler-1)
|
(dired-do-relsymlink . helm-read-file-name-handler-1)
|
||||||
(dired-do-hardlink . 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)
|
(basic-save-buffer . helm-read-file-name-handler-1)
|
||||||
(write-file . (default helm-read-file-name-handler-1))
|
(write-file . (default helm-read-file-name-handler-1))
|
||||||
(write-region . (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."
|
Not guaranteed to work with Emacs < 27."
|
||||||
:type 'boolean
|
:type 'boolean
|
||||||
:group 'helm-mode)
|
: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
|
(defface helm-mode-prefix
|
||||||
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
|
`((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))
|
'((t :inherit font-lock-property-name-face))
|
||||||
"Face used to highlight invalid functions."
|
"Face used to highlight invalid functions."
|
||||||
:group 'helm-mode)
|
: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
|
(defvar helm-comp-read-map
|
||||||
(let ((map (make-sparse-keymap)))
|
(let ((map (make-sparse-keymap)))
|
||||||
|
|
@ -272,6 +295,12 @@ Not guaranteed to work with Emacs < 27."
|
||||||
map)
|
map)
|
||||||
"Keymap for `helm-comp-read'.")
|
"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 ()
|
(defun helm-mode-delete-char-backward-1 ()
|
||||||
(interactive)
|
(interactive)
|
||||||
(condition-case err
|
(condition-case err
|
||||||
|
|
@ -349,8 +378,8 @@ NOT `setq'."
|
||||||
:set (lambda (var val)
|
:set (lambda (var val)
|
||||||
(set var val)
|
(set var val)
|
||||||
(if (memq val '(helm helm-fuzzy))
|
(if (memq val '(helm helm-fuzzy))
|
||||||
(define-key helm-comp-read-map (kbd "DEL") 'helm-mode-delete-char-backward-maybe)
|
(define-key helm-comp-in-region-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") 'delete-backward-char))))
|
||||||
|
|
||||||
(defconst helm-completion--all-styles
|
(defconst helm-completion--all-styles
|
||||||
(let ((flex (if (assq 'flex completion-styles-alist)
|
(let ((flex (if (assq 'flex completion-styles-alist)
|
||||||
|
|
@ -366,21 +395,23 @@ NOT `setq'."
|
||||||
|
|
||||||
(defcustom helm-completion-styles-alist '((gud-mode . helm)
|
(defcustom helm-completion-styles-alist '((gud-mode . helm)
|
||||||
;; See https://github.com/djcb/mu/issues/2181.
|
;; 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.
|
"Allow configuring `helm-completion-style' per mode or command.
|
||||||
|
|
||||||
NOTE: Use a mode for a completion that will be used in a buffer
|
NOTE: Commands involving `completing-read' specified in
|
||||||
i.e. completion-in-region, whereas you have to specify instead a
|
`helm-completing-read-handlers-alist' take precedence on commands
|
||||||
command to affect the completing-read trigerred by this
|
you put here. Specifying a mode instead of a command affect only
|
||||||
command. Commands specified in `helm-completing-read-handlers-alist' take
|
completion-in-region and not the completing-read's called in this mode, use
|
||||||
precedence on commands you put here.
|
`helm-completing-read-handlers-alist' for this.
|
||||||
|
|
||||||
Each entry is a cons cell like (mode . style) where style must be
|
Each entry is a cons cell like (mode_or_command . style) where
|
||||||
a suitable value for `helm-completion-style'. When specifying
|
style must be a suitable value for `helm-completion-style'. When
|
||||||
emacs as style for a mode or a command, `completion-styles' can
|
specifying emacs as style for a mode or a command,
|
||||||
be specified by using a cons cell specifying completion-styles to
|
`completion-styles' can be specified by using a cons cell
|
||||||
use with helm emacs style, e.g. (foo-mode . (emacs helm flex))
|
specifying completion-styles to use with helm emacs style,
|
||||||
will set `completion-styles' to \\='(helm flex) for foo-mode."
|
e.g. (foo-mode . (emacs helm flex)) will set `completion-styles'
|
||||||
|
to \\='(helm flex) for foo-mode."
|
||||||
:group 'helm-mode
|
:group 'helm-mode
|
||||||
:type
|
:type
|
||||||
`(alist :key-type (symbol :tag "Major Mode")
|
`(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 (downcase pattern) candidates)
|
||||||
(member (upcase 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'."
|
"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
|
;; Annotation and affixation are already handled in completion-in-region and
|
||||||
;; in helm-completing-read-default-2 when emacs style is in use.
|
;; 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
|
;; 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))
|
(string-match "\n" elm))
|
||||||
(cons (replace-regexp-in-string "\n" "->" elm) c))
|
(cons (replace-regexp-in-string "\n" "->" elm) c))
|
||||||
(t c)))
|
(t c)))
|
||||||
collect cand into lst
|
collect cand))
|
||||||
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))))
|
|
||||||
|
|
||||||
(defun helm-cr-default (default cands)
|
(defun helm-cr-default (default cands)
|
||||||
(delq nil
|
(delq nil
|
||||||
|
|
@ -617,7 +628,7 @@ If COLLECTION is an `obarray', a TEST should be needed. See `obarray'."
|
||||||
(name "Helm Completions")
|
(name "Helm Completions")
|
||||||
header-name
|
header-name
|
||||||
candidates-in-buffer
|
candidates-in-buffer
|
||||||
get-line
|
(get-line #'buffer-substring)
|
||||||
diacritics
|
diacritics
|
||||||
match-part
|
match-part
|
||||||
match-dynamic
|
match-dynamic
|
||||||
|
|
@ -634,6 +645,7 @@ If COLLECTION is an `obarray', a TEST should be needed. See `obarray'."
|
||||||
multiline
|
multiline
|
||||||
allow-nest
|
allow-nest
|
||||||
coerce
|
coerce
|
||||||
|
raw-candidate
|
||||||
(group 'helm))
|
(group 'helm))
|
||||||
"Read a string in the minibuffer, with helm completion.
|
"Read a string in the minibuffer, with helm completion.
|
||||||
|
|
||||||
|
|
@ -756,6 +768,9 @@ Keys description:
|
||||||
|
|
||||||
- COERCE: See coerce in `helm-source'.
|
- 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'.
|
- GROUP: See group in `helm-source'.
|
||||||
|
|
||||||
Any prefix args passed during `helm-comp-read' invocation will be recorded
|
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")
|
nil "Error: History should be specified as a symbol")
|
||||||
(when (get-buffer helm-action-buffer)
|
(when (get-buffer helm-action-buffer)
|
||||||
(kill-buffer helm-action-buffer))
|
(kill-buffer helm-action-buffer))
|
||||||
(unless (memq must-match '(confirm confirm-after-completion t nil))
|
;; The value of MUST-MATCH is given to
|
||||||
;; Fix completing-read's using something else than `t' e.g. 1 or
|
;; `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).
|
;; whatever (bug #2527).
|
||||||
(setq must-match t))
|
(setq must-match t))
|
||||||
(let ((action-fn `(("Sole action (Identity)"
|
(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
|
:mode-line mode-line
|
||||||
:help-message help-message
|
:help-message help-message
|
||||||
:action action-fn))
|
: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
|
(src (helm-build-sync-source name
|
||||||
:candidates get-candidates
|
:candidates get-candidates
|
||||||
:match-part match-part
|
: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
|
(setq src-list (cl-loop for src in src-list
|
||||||
collect (cons '(nomark) src))))
|
collect (cons '(nomark) src))))
|
||||||
(when reverse-history (setq src-list (nreverse src-list)))
|
(when reverse-history (setq src-list (nreverse src-list)))
|
||||||
(add-hook 'helm-after-update-hook 'helm-comp-read--move-to-first-real-candidate)
|
(unless (eq must-match t)
|
||||||
(unwind-protect
|
(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
|
(setq result (helm
|
||||||
:sources src-list
|
:sources src-list
|
||||||
:input initial-input
|
:input initial-input
|
||||||
|
|
@ -918,7 +956,6 @@ that use `helm-comp-read'. See `helm-M-x' for example."
|
||||||
:case-fold-search case-fold
|
:case-fold-search case-fold
|
||||||
:history (and (symbolp input-history) input-history)
|
:history (and (symbolp input-history) input-history)
|
||||||
:buffer buffer))
|
: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.
|
;; If `history' is a symbol save it, except when it is t.
|
||||||
(when (and result history (symbolp history) (not (eq history t)))
|
(when (and result history (symbolp history) (not (eq history t)))
|
||||||
(set history
|
(set history
|
||||||
|
|
@ -992,6 +1029,9 @@ that use `helm-comp-read'. See `helm-M-x' for example."
|
||||||
(symbol-help . (metadata
|
(symbol-help . (metadata
|
||||||
(affixation-function . helm-symbol-completion-table-affixation)
|
(affixation-function . helm-symbol-completion-table-affixation)
|
||||||
(category . symbol-help)))
|
(category . symbol-help)))
|
||||||
|
(eww-help . (metadata ;; Emacs-30 only
|
||||||
|
(affixation-function . helm-completion-eww-affixation)
|
||||||
|
(category . eww-help)))
|
||||||
(package . (metadata
|
(package . (metadata
|
||||||
(affixation-function . helm-completion-package-affixation)
|
(affixation-function . helm-completion-package-affixation)
|
||||||
(category . package)))
|
(category . package)))
|
||||||
|
|
@ -1003,7 +1043,13 @@ that use `helm-comp-read'. See `helm-M-x' for example."
|
||||||
(category . coding-system)))
|
(category . coding-system)))
|
||||||
(color . (metadata
|
(color . (metadata
|
||||||
(affixation-function . helm-completion-color-affixation)
|
(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.
|
"Extra metadata for completing-read.
|
||||||
|
|
||||||
Alist composed of (CATEGORY . METADATA).
|
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.
|
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
|
It is used to add `affixation-function' or `annotation-function' if original
|
||||||
metadata doesn't have some and `completions-detailed' is non nil.
|
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.")
|
|
||||||
|
|
||||||
(defvar helm-completing-read-command-categories
|
(defvar helm-completing-read-command-categories
|
||||||
'(("customize-variable" . symbol-help)
|
'(("customize-variable" . symbol-help)
|
||||||
|
|
@ -1038,7 +1082,12 @@ behavior as emacs vanilla.")
|
||||||
("trace-function-foreground" . symbol-help)
|
("trace-function-foreground" . symbol-help)
|
||||||
("trace-function-background" . symbol-help)
|
("trace-function-background" . symbol-help)
|
||||||
("describe-minor-mode" . 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)
|
("find-library" . library)
|
||||||
|
("locate-library" . library)
|
||||||
("kill-buffer" . buffer)
|
("kill-buffer" . buffer)
|
||||||
("package-install" . package)
|
("package-install" . package)
|
||||||
("package-vc-install" . package)
|
("package-vc-install" . package)
|
||||||
|
|
@ -1047,7 +1096,20 @@ behavior as emacs vanilla.")
|
||||||
("load-theme" . theme)
|
("load-theme" . theme)
|
||||||
("describe-theme" . theme)
|
("describe-theme" . theme)
|
||||||
("describe-coding-system" . coding-system)
|
("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.
|
"An alist to specify metadata category by command.
|
||||||
|
|
||||||
Some commands provide a completion-table with no category
|
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)
|
(defvar helm-completing-read--buffer-lgst-mode nil)
|
||||||
(defun helm-completing-read-buffer-affixation (completions)
|
(defun helm-completing-read-buffer-affixation (completions)
|
||||||
(let ((len-mode (or helm-completing-read--buffer-lgst-mode
|
(let ((len-mode (or helm-completing-read--buffer-lgst-mode
|
||||||
|
(setq helm-completing-read--buffer-lgst-mode
|
||||||
(cl-loop for bn in completions
|
(cl-loop for bn in completions
|
||||||
maximize (with-current-buffer bn
|
maximize (with-current-buffer bn
|
||||||
(length (symbol-name major-mode)))))))
|
(length (symbol-name major-mode))))))))
|
||||||
(lambda (comp)
|
(lambda (comp)
|
||||||
(let* ((buf (get-buffer comp))
|
(let* ((buf (get-buffer comp))
|
||||||
(fname (buffer-file-name buf))
|
(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))
|
"fm " 'face 'font-lock-comment-face))
|
||||||
(fname
|
(fname
|
||||||
(propertize
|
(propertize
|
||||||
" f " 'face 'font-lock-property-name-face))
|
" f " 'face 'helm-completions-annotations))
|
||||||
(t (propertize "nf " 'face 'font-lock-doc-face))))
|
(t (propertize "nf " 'face 'font-lock-doc-face))))
|
||||||
(mode (with-current-buffer comp
|
(mode (with-current-buffer comp
|
||||||
(propertize
|
(propertize
|
||||||
(symbol-name major-mode) 'face 'font-lock-warning-face)))
|
(symbol-name major-mode) 'face 'helm-completions-detailed)))
|
||||||
(size (helm-buffer-size buf))
|
(size (helm-buffer-size buf))
|
||||||
(max-len helm-buffer-max-length)
|
(max-len helm-buffer-max-length)
|
||||||
(bname (truncate-string-to-width
|
(bname (truncate-string-to-width
|
||||||
comp helm-buffer-max-length nil nil
|
comp helm-buffer-max-length nil nil
|
||||||
helm-buffers-end-truncated-string))
|
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))) ? )
|
(make-string (1+ (- max-len (length bname))) ? )
|
||||||
(propertize size
|
(propertize size
|
||||||
'face 'helm-buffer-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.
|
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
|
It uses `helm-get-first-line-documentation' which allow providing documentation
|
||||||
for `describe-variable' symbols and align properly documentation when helm style
|
for `describe-variable' symbols and align properly documentation when helm style
|
||||||
is used."
|
is used."
|
||||||
|
|
@ -1129,11 +1192,12 @@ is used."
|
||||||
(helm-in-buffer-get-longest-candidate)))
|
(helm-in-buffer-get-longest-candidate)))
|
||||||
(sep (if (or (null max-len) (zerop max-len))
|
(sep (if (or (null max-len) (zerop max-len))
|
||||||
" -- " ; Default separator.
|
" -- " ; Default separator.
|
||||||
(make-string (- max-len (length comp)) ? )))
|
(helm-make-separator comp max-len)))
|
||||||
(doc (ignore-errors
|
(doc (ignore-errors
|
||||||
(helm-get-first-line-documentation sym)))
|
(helm-get-first-line-documentation sym)))
|
||||||
(symbol-class (help--symbol-class sym))
|
(symbol-class (with-helm-current-buffer (help--symbol-class sym)))
|
||||||
(group (helm-group-p sym)))
|
(group (helm-group-p sym))
|
||||||
|
(key (helm-completion-get-key sym)))
|
||||||
(list
|
(list
|
||||||
;; Symbol (comp).
|
;; Symbol (comp).
|
||||||
(if (or (symbol-function sym) (boundp sym)
|
(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
|
;; Not already defined function. To test add an advice on a non
|
||||||
;; existing function.
|
;; existing function.
|
||||||
(propertize comp 'face 'helm-completion-invalid))
|
(propertize comp 'face 'helm-completion-invalid))
|
||||||
;; Prefix.
|
;; Prefixes.
|
||||||
(helm-aand (propertize
|
;; " c " command
|
||||||
(cond ((and symbol-class group)
|
;; " - " 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))
|
(concat "g" symbol-class))
|
||||||
((and (not (string= symbol-class ""))
|
((and (not (string= symbol-class ""))
|
||||||
symbol-class))
|
symbol-class))
|
||||||
(group "g")
|
(group "g")
|
||||||
(t "i"))
|
(t "i")) ; Not already defined function.
|
||||||
'face 'completions-annotations)
|
(propertize it 'face 'helm-completions-detailed)
|
||||||
(propertize " " 'display (format "%-4s" it)))
|
;; 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.
|
;; Suffix.
|
||||||
(if doc
|
(if doc
|
||||||
(helm-aand (propertize doc 'face 'completions-annotations)
|
(helm-aand (propertize doc 'face 'helm-completions-detailed)
|
||||||
(propertize " " 'display (concat sep it)))
|
(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)
|
(defun helm-completion-package-affixation (_completions)
|
||||||
(lambda (comp)
|
(lambda (comp)
|
||||||
(let* ((sym (intern-soft comp))
|
(let* ((sym (intern-soft comp))
|
||||||
|
|
@ -1167,32 +1250,28 @@ is used."
|
||||||
(desc (if built-in
|
(desc (if built-in
|
||||||
(aref (assoc-default sym package--builtins) 2)
|
(aref (assoc-default sym package--builtins) 2)
|
||||||
(and id (package-desc-summary id))))
|
(and id (package-desc-summary id))))
|
||||||
(sep (make-string (1+ (- (helm-in-buffer-get-longest-candidate)
|
(sep (helm-make-separator comp)))
|
||||||
(length comp)))
|
|
||||||
? )))
|
|
||||||
(list comp
|
(list comp
|
||||||
(propertize
|
(propertize
|
||||||
(if status
|
(if status
|
||||||
(format "%s " (substring status 0 1))
|
(format "%s " (substring status 0 1))
|
||||||
"b ")
|
"b ")
|
||||||
'face 'font-lock-property-name-face)
|
'face 'helm-completions-annotations)
|
||||||
(or (helm-aand desc
|
(or (helm-aand desc
|
||||||
(propertize it 'face 'font-lock-warning-face)
|
(propertize it 'face 'helm-completions-detailed)
|
||||||
(propertize " " 'display (concat sep it)))
|
(propertize " " 'display (concat sep it)))
|
||||||
"")))))
|
"")))))
|
||||||
|
|
||||||
(defun helm-completion-theme-affixation (_completions)
|
(defun helm-completion-theme-affixation (_completions)
|
||||||
(lambda (comp)
|
(lambda (comp)
|
||||||
(let* ((sym (intern-soft comp))
|
(let* ((sym (intern-soft comp))
|
||||||
(sep (make-string (1+ (- (helm-in-buffer-get-longest-candidate)
|
(sep (helm-make-separator comp))
|
||||||
(length comp)))
|
|
||||||
? ))
|
|
||||||
(doc (if (custom-theme-p sym)
|
(doc (if (custom-theme-p sym)
|
||||||
(helm-get-first-line-documentation sym)
|
(helm-get-first-line-documentation sym)
|
||||||
(helm--get-theme-doc-1 sym))))
|
(helm--get-theme-doc-1 sym))))
|
||||||
(list comp
|
(list comp
|
||||||
""
|
""
|
||||||
(helm-aand (propertize doc 'face 'font-lock-warning-face)
|
(helm-aand (propertize doc 'face 'helm-completions-detailed)
|
||||||
(propertize " " 'display (concat sep it)))))))
|
(propertize " " 'display (concat sep it)))))))
|
||||||
|
|
||||||
(defun helm--get-theme-doc-1 (sym)
|
(defun helm--get-theme-doc-1 (sym)
|
||||||
|
|
@ -1227,23 +1306,27 @@ is used."
|
||||||
(buffer-substring beg end))))
|
(buffer-substring beg end))))
|
||||||
|
|
||||||
(defun helm-completion-coding-system-affixation (_comps)
|
(defun helm-completion-coding-system-affixation (_comps)
|
||||||
|
(require 'mule-diag)
|
||||||
(lambda (comp)
|
(lambda (comp)
|
||||||
(let ((doc (with-output-to-string
|
(let ((doc (with-output-to-string
|
||||||
(with-current-buffer standard-output
|
(with-current-buffer standard-output
|
||||||
(print-coding-system-briefly (intern comp) 'tightly))))
|
(print-coding-system-briefly (intern comp) 'tightly))))
|
||||||
(sep (make-string (1+ (- (helm-in-buffer-get-longest-candidate)
|
(sep (helm-make-separator comp)))
|
||||||
(length comp)))
|
|
||||||
? )))
|
|
||||||
(list comp "" (helm-aand (replace-regexp-in-string "^ *" "" doc)
|
(list comp "" (helm-aand (replace-regexp-in-string "^ *" "" doc)
|
||||||
(replace-regexp-in-string "[\n]" "" it)
|
(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)))))))
|
(propertize " " 'display (concat sep it)))))))
|
||||||
|
|
||||||
(defun helm-completion-color-affixation (_comps)
|
(defun helm-completion-color-affixation (_comps)
|
||||||
(lambda (comp)
|
(lambda (comp)
|
||||||
(let ((sep (make-string (1+ (- (helm-in-buffer-get-longest-candidate)
|
(let ((sep (helm-make-separator comp))
|
||||||
(length comp)))
|
|
||||||
? ))
|
|
||||||
(rgb (condition-case nil
|
(rgb (condition-case nil
|
||||||
(helm-acase comp
|
(helm-acase comp
|
||||||
("foreground at point" (with-helm-current-buffer
|
("foreground at point" (with-helm-current-buffer
|
||||||
|
|
@ -1258,8 +1341,45 @@ is used."
|
||||||
(helm-aand (propertize rgb 'face `(:background ,rgb
|
(helm-aand (propertize rgb 'face `(:background ,rgb
|
||||||
:distant-foreground "black"))
|
:distant-foreground "black"))
|
||||||
(propertize " " 'display (concat sep it)))))))
|
(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
|
(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
|
This handler should be used when candidate list doesn't need to be rebuilt
|
||||||
dynamically otherwise use `helm-completing-read-default-2'."
|
dynamically otherwise use `helm-completing-read-default-2'."
|
||||||
(let* ((history (or (car-safe hist) hist))
|
(let* ((history (or (car-safe hist) hist))
|
||||||
(initial-input (helm-aif (pcase init
|
(initial-input (helm-acase init
|
||||||
((pred (stringp)) init)
|
((guard (stringp it)) it)
|
||||||
;; INIT is a cons cell.
|
((guard (consp it)) (car it))))
|
||||||
(`(,l . ,_ll) l))
|
|
||||||
it))
|
|
||||||
(minibuffer-completion-table collection)
|
(minibuffer-completion-table collection)
|
||||||
(metadata (or (completion-metadata (or initial-input "") collection test)
|
(metadata (or (completion-metadata (or initial-input "") collection test)
|
||||||
'(metadata)))
|
'(metadata)))
|
||||||
|
|
@ -1344,7 +1462,7 @@ dynamically otherwise use `helm-completing-read-default-2'."
|
||||||
:quit-when-no-cand (eq require-match t)
|
:quit-when-no-cand (eq require-match t)
|
||||||
:nomark (null helm-comp-read-use-marked)
|
:nomark (null helm-comp-read-use-marked)
|
||||||
:candidates-in-buffer cands-in-buffer
|
: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
|
:exec-when-only-one exec-when-only-one
|
||||||
:fuzzy (eq helm-completion-style 'helm-fuzzy)
|
:fuzzy (eq helm-completion-style 'helm-fuzzy)
|
||||||
:buffer buffer
|
:buffer buffer
|
||||||
|
|
@ -1367,11 +1485,11 @@ dynamically otherwise use `helm-completing-read-default-2'."
|
||||||
Call `helm-comp-read' with same args as `completing-read'.
|
Call `helm-comp-read' with same args as `completing-read'.
|
||||||
For the meaning of optional args see `helm-completing-read-default-1'.
|
For the meaning of optional args see `helm-completing-read-default-1'.
|
||||||
This handler uses dynamic matching which allows honouring `completion-styles'."
|
This handler uses dynamic matching which allows honouring `completion-styles'."
|
||||||
(let* ((history (or (car-safe hist) hist))
|
(let* ((completion-lazy-hilit t)
|
||||||
(input (pcase init
|
(history (or (car-safe hist) hist))
|
||||||
((pred (stringp)) init)
|
(input (helm-acase init
|
||||||
;; INIT is a cons cell.
|
((guard (stringp it)) it)
|
||||||
(`(,l . ,_ll) l)))
|
((guard (consp it)) (car it))))
|
||||||
(completion-flex-nospace t)
|
(completion-flex-nospace t)
|
||||||
(minibuffer-completion-table collection)
|
(minibuffer-completion-table collection)
|
||||||
;; (completion-styles
|
;; (completion-styles
|
||||||
|
|
@ -1424,16 +1542,9 @@ This handler uses dynamic matching which allows honouring `completion-styles'."
|
||||||
(append (and default
|
(append (and default
|
||||||
(memq helm-completion-style '(helm helm-fuzzy))
|
(memq helm-completion-style '(helm helm-fuzzy))
|
||||||
(list default))
|
(list default))
|
||||||
(helm-completion--initial-filter
|
(if (and sort-fn (> (length str) 0))
|
||||||
(let ((lst (if (and sort-fn (> (length str) 0))
|
|
||||||
(funcall sort-fn all)
|
(funcall sort-fn all)
|
||||||
all)))
|
all)))))
|
||||||
(if (and default afix)
|
|
||||||
(prog1 (append (list default)
|
|
||||||
(delete default lst))
|
|
||||||
(setq default nil))
|
|
||||||
lst))
|
|
||||||
afun afix category)))))
|
|
||||||
(data (if (memq helm-completion-style '(helm helm-fuzzy))
|
(data (if (memq helm-completion-style '(helm helm-fuzzy))
|
||||||
(funcall compfn (or input "") nil nil)
|
(funcall compfn (or input "") nil nil)
|
||||||
compfn))
|
compfn))
|
||||||
|
|
@ -1442,7 +1553,20 @@ This handler uses dynamic matching which allows honouring `completion-styles'."
|
||||||
(if (or helm-completion--sorting-done
|
(if (or helm-completion--sorting-done
|
||||||
(string= helm-pattern ""))
|
(string= helm-pattern ""))
|
||||||
candidates
|
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
|
(unwind-protect
|
||||||
(helm-comp-read
|
(helm-comp-read
|
||||||
;; Completion-at-point and friends have no prompt.
|
;; Completion-at-point and friends have no prompt.
|
||||||
|
|
@ -1454,21 +1578,29 @@ This handler uses dynamic matching which allows honouring `completion-styles'."
|
||||||
:history history
|
:history history
|
||||||
:nomark (null helm-comp-read-use-marked)
|
:nomark (null helm-comp-read-use-marked)
|
||||||
:reverse-history helm-mode-reverse-history
|
:reverse-history helm-mode-reverse-history
|
||||||
;; In helm h-c-styles default is passed directly in
|
;; If DEF is not provided, fallback to empty string
|
||||||
;; candidates.
|
;; to avoid `thing-at-point' to be appended on top of list.
|
||||||
:default (and (eq helm-completion-style 'emacs) (null afix) default)
|
;; 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
|
:fc-transformer
|
||||||
;; Ensure sort fn is at the end.
|
(append (and (or afix afun (memq category '(file library)))
|
||||||
(append '(helm-cr-default-transformer)
|
(list (lambda (candidates source)
|
||||||
(and helm-completion-in-region-default-sort-fn
|
(helm-completion--initial-filter
|
||||||
(list helm-completion-in-region-default-sort-fn)))
|
(funcall helm-completion-in-region-default-sort-fn
|
||||||
|
candidates source)
|
||||||
|
afun afix category))))
|
||||||
|
'(helm-cr-default-transformer))
|
||||||
:match-dynamic (eq helm-completion-style 'emacs)
|
:match-dynamic (eq helm-completion-style 'emacs)
|
||||||
:diacritics helm-mode-ignore-diacritics
|
:diacritics helm-mode-ignore-diacritics
|
||||||
:fuzzy (eq helm-completion-style 'helm-fuzzy)
|
:fuzzy (eq helm-completion-style 'helm-fuzzy)
|
||||||
:exec-when-only-one exec-when-only-one
|
:exec-when-only-one exec-when-only-one
|
||||||
:quit-when-no-cand (eq require-match t)
|
:quit-when-no-cand (eq require-match t)
|
||||||
:must-match require-match)
|
: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
|
(defun helm-mode-all-the-icons-handler (prompt collection test require-match
|
||||||
init hist default inherit-input-method
|
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.
|
;; otherwise helm have not the time to close its initial session.
|
||||||
(minibuffer-setup-hook
|
(minibuffer-setup-hook
|
||||||
(cl-loop for h in 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)
|
(byte-code-function-p h)
|
||||||
(helm-subr-native-elisp-p h)
|
(helm-subr-native-elisp-p h)
|
||||||
(memq h helm-mode-minibuffer-setup-hook-black-list))
|
(memq h helm-mode-minibuffer-setup-hook-black-list))
|
||||||
|
|
@ -1813,8 +1947,7 @@ Keys description:
|
||||||
(kill-buffer helm-action-buffer))
|
(kill-buffer helm-action-buffer))
|
||||||
(mapc (lambda (hook)
|
(mapc (lambda (hook)
|
||||||
(add-hook 'helm-after-update-hook 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))
|
helm-ff-auto-expand-to-home-or-root))
|
||||||
(let* ((action-fn `(("Sole action (Identity)"
|
(let* ((action-fn `(("Sole action (Identity)"
|
||||||
. (lambda (candidate)
|
. (lambda (candidate)
|
||||||
|
|
@ -1842,6 +1975,18 @@ Keys description:
|
||||||
(replace-regexp-in-string "helm-maybe-exit-minibuffer"
|
(replace-regexp-in-string "helm-maybe-exit-minibuffer"
|
||||||
"helm-confirm-and-exit-minibuffer"
|
"helm-confirm-and-exit-minibuffer"
|
||||||
helm-read-file-name-mode-line-string))
|
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
|
(src-list
|
||||||
(list
|
(list
|
||||||
;; History source.
|
;; History source.
|
||||||
|
|
@ -1859,7 +2004,7 @@ Keys description:
|
||||||
:must-match must-match
|
:must-match must-match
|
||||||
:nomark nomark
|
:nomark nomark
|
||||||
:action action-fn)
|
:action action-fn)
|
||||||
;; Other source.
|
;; List files source.
|
||||||
(helm-build-sync-source name
|
(helm-build-sync-source name
|
||||||
:header-name (lambda (name)
|
:header-name (lambda (name)
|
||||||
(concat name (substitute-command-keys
|
(concat name (substitute-command-keys
|
||||||
|
|
@ -1883,12 +2028,11 @@ Keys description:
|
||||||
(cl-loop with hn = (helm-ff--tramp-hostnames)
|
(cl-loop with hn = (helm-ff--tramp-hostnames)
|
||||||
;; helm-find-files-get-candidates is
|
;; helm-find-files-get-candidates is
|
||||||
;; returning a list of cons cells.
|
;; returning a list of cons cells.
|
||||||
for (d . r) in (helm-find-files-get-candidates
|
for (d . r) in (helm-find-files-get-candidates)
|
||||||
must-match)
|
|
||||||
when (or (member r hn) ; A tramp host
|
when (or (member r hn) ; A tramp host
|
||||||
(funcall test r)) ; Test ok
|
(funcall test r)) ; Test ok
|
||||||
collect (cons d r)))
|
collect (cons d r)))
|
||||||
(helm-find-files-get-candidates must-match)))
|
(helm-find-files-get-candidates)))
|
||||||
:update (lambda ()
|
:update (lambda ()
|
||||||
(remhash helm-ff-default-directory
|
(remhash helm-ff-default-directory
|
||||||
helm-ff--list-directory-cache))
|
helm-ff--list-directory-cache))
|
||||||
|
|
@ -1906,13 +2050,15 @@ Keys description:
|
||||||
:action action-fn)))
|
:action action-fn)))
|
||||||
;; Helm result.
|
;; Helm result.
|
||||||
(result (helm
|
(result (helm
|
||||||
:sources (if helm-mode-reverse-history
|
:sources (append (if helm-mode-reverse-history
|
||||||
(reverse src-list) src-list)
|
(reverse src-list) src-list)
|
||||||
|
(list dummy-src))
|
||||||
:input (if (string-match helm-ff-url-regexp initial-input)
|
:input (if (string-match helm-ff-url-regexp initial-input)
|
||||||
initial-input
|
initial-input
|
||||||
(expand-file-name initial-input))
|
(expand-file-name initial-input))
|
||||||
:prompt prompt
|
:prompt prompt
|
||||||
:candidate-number-limit candidate-number-limit
|
:candidate-number-limit candidate-number-limit
|
||||||
|
:dim-prompt-on-update t
|
||||||
:resume 'noresume
|
:resume 'noresume
|
||||||
:case-fold-search case-fold
|
:case-fold-search case-fold
|
||||||
:default default
|
:default default
|
||||||
|
|
@ -2182,6 +2328,7 @@ When AFUN, AFIX are nil and CATEGORY is not file return COMPS unmodified."
|
||||||
(if (functionp affixations)
|
(if (functionp affixations)
|
||||||
(cl-loop for comp in comps
|
(cl-loop for comp in comps
|
||||||
for cand = (funcall affixations comp)
|
for cand = (funcall affixations comp)
|
||||||
|
when cand
|
||||||
collect (cons (propertize (concat (nth 1 cand) ;prefix
|
collect (cons (propertize (concat (nth 1 cand) ;prefix
|
||||||
(nth 0 cand) ;comp
|
(nth 0 cand) ;comp
|
||||||
(nth 2 cand)) ;suffix
|
(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.
|
;; completing against a quoted symbol.
|
||||||
(mapcar (lambda (s)
|
(mapcar (lambda (s)
|
||||||
(let ((ann (funcall afun s)))
|
(let ((ann (funcall afun s)))
|
||||||
(if ann
|
(or (helm-aand
|
||||||
(cons
|
|
||||||
(concat
|
|
||||||
s
|
|
||||||
(propertize
|
|
||||||
" " 'display
|
|
||||||
(propertize
|
|
||||||
ann
|
ann
|
||||||
'face 'completions-annotations)))
|
(propertize ann 'face 'helm-completions-annotations)
|
||||||
s)
|
(cons (concat s (propertize " " 'display it)) s))
|
||||||
s)))
|
s)))
|
||||||
comps))
|
comps))
|
||||||
(t 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)
|
(defun helm-completion-try-completion (string table pred point)
|
||||||
"The try completion function for `completing-styles-alist'.
|
"The try completion function for `completing-styles-alist'.
|
||||||
Actually does nothing."
|
Currently does nothing."
|
||||||
;; AFAIU the try-completions style functions
|
;; AFAIU the try-completions style functions
|
||||||
;; are here to check if what is at point is suitable for TABLE but
|
;; 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
|
;; 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)
|
(defun helm-completion-all-completions (string table pred point)
|
||||||
"The all completions function for `completing-styles-alist'."
|
"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)
|
||||||
;; (cl-multiple-value-bind (all _pattern prefix _suffix _carbounds)
|
(helm-completion--multi-all-completions string table pred point)
|
||||||
(pcase-let ((`(,all ,_pattern ,prefix ,_suffix ,_carbounds)
|
|
||||||
(helm-completion--multi-all-completions string table pred point)))
|
|
||||||
(when all (nconc all (length prefix)))))
|
(when all (nconc all (length prefix)))))
|
||||||
|
|
||||||
(defun helm-completion--multi-all-completions-1 (string collection &optional predicate)
|
(defun helm-completion--multi-all-completions-1 (string collection &optional predicate)
|
||||||
|
|
@ -2299,7 +2438,7 @@ Actually does nothing."
|
||||||
(suffix (substring afterpoint (cdr bounds)))
|
(suffix (substring afterpoint (cdr bounds)))
|
||||||
(all (helm-completion--multi-all-completions-1
|
(all (helm-completion--multi-all-completions-1
|
||||||
;; Using `regexp-quote' on STRING fixes bug#2355 but
|
;; 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
|
;; Helm-3.7.1 and emacs-27+ it seems using plain STRING
|
||||||
;; works for both so use it.
|
;; works for both so use it.
|
||||||
;;(regexp-quote string)
|
;;(regexp-quote string)
|
||||||
|
|
@ -2329,8 +2468,8 @@ Actually does nothing."
|
||||||
;; It is needed here to make minibuffer-complete work in emacs-26,
|
;; It is needed here to make minibuffer-complete work in emacs-26,
|
||||||
;; e.g. with regular M-x.
|
;; e.g. with regular M-x.
|
||||||
(unless (string-match-p " " string)
|
(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-all-completions string table pred point)
|
||||||
(when minibuffer-completing-file-name
|
(when minibuffer-completing-file-name
|
||||||
(setq all (completion-pcm--filename-try-filter all)))
|
(setq all (completion-pcm--filename-try-filter all)))
|
||||||
(completion-pcm--merge-try pattern all prefix suffix))))
|
(completion-pcm--merge-try pattern all prefix suffix))))
|
||||||
|
|
@ -2339,10 +2478,10 @@ Actually does nothing."
|
||||||
"The all completions function for `completing-styles-alist'."
|
"The all completions function for `completing-styles-alist'."
|
||||||
;; FIXME: No need to bind all these value.
|
;; FIXME: No need to bind all these value.
|
||||||
(unless (string-match-p " " string)
|
(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
|
(helm-completion--flex-all-completions
|
||||||
string table pred point
|
string table pred point
|
||||||
#'helm-completion--flex-transform-pattern)))
|
#'helm-completion--flex-transform-pattern)
|
||||||
(let ((regexp (completion-pcm--pattern->regex pattern 'group)))
|
(let ((regexp (completion-pcm--pattern->regex pattern 'group)))
|
||||||
(when all (nconc (helm-flex-add-score-as-prop all regexp)
|
(when all (nconc (helm-flex-add-score-as-prop all regexp)
|
||||||
(length prefix)))))))
|
(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
|
;; relaying on crap old completion-styles emacs22 which
|
||||||
;; add suffix after prefix. e.g. def|else.
|
;; add suffix after prefix. e.g. def|else.
|
||||||
(initial-input (buffer-substring-no-properties start (point)))
|
(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)
|
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
|
(customize-set-variable 'helm-completion-style
|
||||||
(if (cdr-safe it) (car it) it)))
|
(if (cdr-safe it) (car it) it)))
|
||||||
;; This hook force usage of the display part of candidate with
|
;; 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))
|
(input (buffer-substring-no-properties start end))
|
||||||
(prefix (and (eq helm-completion-style 'emacs) initial-input))
|
(prefix (and (eq helm-completion-style 'emacs) initial-input))
|
||||||
(point (point))
|
(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))
|
(crm (eq current-command 'crm-complete))
|
||||||
(str-command (helm-symbol-name current-command))
|
(str-command (helm-symbol-name current-command))
|
||||||
(buf-name (format "*helm-mode-%s*" str-command))
|
(buf-name (format "*helm-mode-%s*" str-command))
|
||||||
(require-match (or (and (boundp 'require-match) require-match)
|
(require-match (cond ((boundp 'require-match) require-match)
|
||||||
minibuffer-completion-confirm
|
(minibuffer-completion-confirm)
|
||||||
;; If prompt have not been propagated here, that's
|
;; If prompt have not been propagated here, that's
|
||||||
;; probably mean we have no prompt and we are in
|
;; probably mean we have no prompt and we are in
|
||||||
;; completion-at-point or friend, so use a non--nil
|
;; completion-at-point or friend, so use a non--nil
|
||||||
;; value for require-match.
|
;; value for require-match.
|
||||||
(not (boundp 'prompt))))
|
((not (boundp 'prompt)))))
|
||||||
(metadata (completion-metadata input collection predicate))
|
(metadata (completion-metadata input collection predicate))
|
||||||
;; `completion-extra-properties' is let-bounded in `completion-at-point'.
|
;; `completion-extra-properties' is let-bounded in `completion-at-point'.
|
||||||
;; `afun' is a closure to call against each string in `data'.
|
;; `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.
|
;; completion-in-region, try anyway never know.
|
||||||
(afix (or (plist-get completion-extra-properties :affixation-function)
|
(afix (or (plist-get completion-extra-properties :affixation-function)
|
||||||
(completion-metadata-get metadata '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)
|
(category (or (eq (completion-metadata-get metadata 'category) 'file)
|
||||||
(eq (plist-get completion-extra-properties :category) 'file)))
|
(eq (plist-get completion-extra-properties :category) 'file)))
|
||||||
(file-comp-p (or (eq 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).
|
;; so data looks like this: '(a b c d . 0) and (last data) == (d . 0).
|
||||||
base-size
|
base-size
|
||||||
(compfn (lambda (str _predicate _action)
|
(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
|
(comps
|
||||||
(completion-all-completions
|
(completion-all-completions
|
||||||
str ; This is helm-pattern
|
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))
|
(unless base-size (setq base-size bs))
|
||||||
(setq helm-completion--sorting-done (and sort-fn t))
|
(setq helm-completion--sorting-done (and sort-fn t))
|
||||||
(setq all (copy-sequence comps))
|
(setq all (copy-sequence comps))
|
||||||
(helm-completion--initial-filter
|
|
||||||
(if (and sort-fn (> (length str) 0))
|
(if (and sort-fn (> (length str) 0))
|
||||||
(funcall sort-fn all)
|
(funcall sort-fn all)
|
||||||
all)
|
all))))
|
||||||
afun afix category))))
|
|
||||||
(data (if (memq helm-completion-style '(helm helm-fuzzy))
|
(data (if (memq helm-completion-style '(helm helm-fuzzy))
|
||||||
(funcall compfn input nil nil)
|
(funcall compfn input nil nil)
|
||||||
compfn))
|
compfn))
|
||||||
|
|
@ -2523,27 +2658,29 @@ Can be used for `completion-in-region-function' by advicing it with an
|
||||||
:initial-input
|
:initial-input
|
||||||
(cond ((and file-comp-p
|
(cond ((and file-comp-p
|
||||||
(not (string-match "/\\'" initial-input)))
|
(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))
|
(if (memq helm-completion-style '(helm helm-fuzzy))
|
||||||
(helm-basename initial-input)
|
(helm-basename initial-input)
|
||||||
initial-input))
|
initial-input)))
|
||||||
init-space-suffix))
|
|
||||||
((string-match "/\\'" initial-input)
|
((string-match "/\\'" initial-input)
|
||||||
(and (eq helm-completion-style 'emacs) initial-input))
|
(and (eq helm-completion-style 'emacs) initial-input))
|
||||||
((or (null require-match)
|
((or (null require-match)
|
||||||
(stringp require-match))
|
(stringp require-match))
|
||||||
(helm-mode--completion-in-region-initial-input initial-input))
|
(helm-mode--completion-in-region-initial-input initial-input))
|
||||||
(t (concat (helm-mode--completion-in-region-initial-input initial-input)
|
(t (helm-mode--completion-in-region-initial-input initial-input)))
|
||||||
init-space-suffix)))
|
|
||||||
:buffer buf-name
|
:buffer buf-name
|
||||||
:fc-transformer
|
:fc-transformer
|
||||||
;; Ensure sort fn is at the end.
|
(append (and (or afix afun (memq category '(file library)))
|
||||||
(append '(helm-cr-default-transformer)
|
(list (lambda (candidates source)
|
||||||
(and helm-completion-in-region-default-sort-fn
|
(helm-completion--initial-filter
|
||||||
(list helm-completion-in-region-default-sort-fn)))
|
(funcall helm-completion-in-region-default-sort-fn
|
||||||
|
candidates source)
|
||||||
|
afun afix category))))
|
||||||
|
'(helm-cr-default-transformer))
|
||||||
:match-dynamic (eq helm-completion-style 'emacs)
|
:match-dynamic (eq helm-completion-style 'emacs)
|
||||||
:fuzzy (eq helm-completion-style 'helm-fuzzy)
|
:fuzzy (eq helm-completion-style 'helm-fuzzy)
|
||||||
:exec-when-only-one t
|
:exec-when-only-one t
|
||||||
|
:keymap helm-comp-in-region-map
|
||||||
:quit-when-no-cand
|
:quit-when-no-cand
|
||||||
(lambda ()
|
(lambda ()
|
||||||
;; Delay message to overwrite "Quit".
|
;; 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
|
(helm-completion-in-region--insert-result
|
||||||
result start point end base-size))
|
result start point end base-size))
|
||||||
;; Allow running extra property `:exit-function' (Bug#2265,
|
;; Allow running extra property `:exit-function' (Bug#2265,
|
||||||
;; Bug#2356). Function is called with 'exact if for a unique
|
;; Bug#2356). Function is called with 'exact if the return value of
|
||||||
;; match which is exact, the return value of `try-completion'
|
;; `try-completion' is a string ending with / (possibly a directory
|
||||||
;; is t or a string ending with "/" i.e. possibly a directory
|
;; Bug#2274), otherwise it is always called with 'finished. However it
|
||||||
;; (Bug#2274),
|
;; is still not clear what to use, the documentation on this beeing
|
||||||
;; otherwise it is called with 'finished.
|
;; really bad (see bug#2646).
|
||||||
(when (and (stringp string) exit-fun)
|
(when (and (stringp string) exit-fun)
|
||||||
(let ((tcomp (try-completion initial-input collection)))
|
|
||||||
(funcall exit-fun string
|
(funcall exit-fun string
|
||||||
(if (or (eq tcomp t) ; Unique.
|
(helm-acase (try-completion initial-input collection predicate)
|
||||||
(and (stringp tcomp)
|
((guard (and (stringp it)
|
||||||
(string-match "/\\'" tcomp))) ; A directory.
|
(or (string-match "/\\'" it)
|
||||||
'exact 'finished))))
|
;; Fix bug#2669.
|
||||||
|
(string-match "/\\'" string))))
|
||||||
|
'exact)
|
||||||
|
(t 'finished))))
|
||||||
(remove-hook 'helm-before-action-hook 'helm-completion-in-region--selection)
|
(remove-hook 'helm-before-action-hook 'helm-completion-in-region--selection)
|
||||||
(customize-set-variable 'helm-completion-style old--helm-completion-style)
|
(customize-set-variable 'helm-completion-style old--helm-completion-style)
|
||||||
(setq helm-completion--sorting-done nil)
|
(setq helm-completion--sorting-done nil)
|
||||||
Some files were not shown because too many files have changed in this diff Show more
Reference in a new issue