Compare commits
4 commits
cb49eaf0af
...
fad5a5f91d
| Author | SHA1 | Date | |
|---|---|---|---|
 KemoNine
|
fad5a5f91d | ||
|
KemoNine
|
f1e597933b | ||
|
KemoNine
|
f0497a5370 | ||
|
KemoNine
|
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"))
|
||||
:commit "ee414384938ccf2ce93c77d717b85dc5538a257d" :authors
|
||||
:commit "39ef44f810c34e8900978788467cc675870bcd19" :authors
|
||||
'(("Dominic Charlesworth" . "dgc336@gmail.com"))
|
||||
:maintainers
|
||||
'(("Dominic Charlesworth" . "dgc336@gmail.com"))
|
||||
|
|
@ -168,6 +168,12 @@
|
|||
("dll" all-the-icons-faicon "cogs" :face all-the-icons-silver)
|
||||
("ds_store" all-the-icons-faicon "cogs" :face all-the-icons-silver)
|
||||
;; Source Codes
|
||||
("ada" all-the-icons-fileicon "ada" :v-adjust 0.0 :face all-the-icons-blue)
|
||||
("adb" all-the-icons-fileicon "ada" :v-adjust 0.0 :face all-the-icons-blue)
|
||||
("adc" all-the-icons-fileicon "ada" :v-adjust 0.0 :face all-the-icons-blue)
|
||||
("ads" all-the-icons-fileicon "ada" :v-adjust 0.0 :face all-the-icons-blue)
|
||||
("gpr" all-the-icons-fileicon "ada" :v-adjust 0.0 :face all-the-icons-green)
|
||||
("cgpr" all-the-icons-fileicon "ada" :v-adjust 0.0 :face all-the-icons-green)
|
||||
("scpt" all-the-icons-fileicon "apple" :face all-the-icons-pink)
|
||||
("aup" all-the-icons-fileicon "audacity" :face all-the-icons-yellow)
|
||||
("elm" all-the-icons-fileicon "elm" :face all-the-icons-blue)
|
||||
|
|
@ -184,7 +190,6 @@
|
|||
("eclass" all-the-icons-fileicon "gentoo" :face all-the-icons-blue)
|
||||
("go" all-the-icons-fileicon "go" :height 1.0 :face all-the-icons-blue)
|
||||
("jl" all-the-icons-fileicon "julia" :face all-the-icons-purple :v-adjust 0.0)
|
||||
("magik" all-the-icons-faicon "magic" :face all-the-icons-blue)
|
||||
("matlab" all-the-icons-fileicon "matlab" :face all-the-icons-orange)
|
||||
("nix" all-the-icons-fileicon "nix" :face all-the-icons-blue)
|
||||
("pl" all-the-icons-alltheicon "perl" :face all-the-icons-lorange)
|
||||
|
|
@ -683,6 +688,8 @@ for performance sake.")
|
|||
(perl-mode all-the-icons-alltheicon "perl" :face all-the-icons-lorange)
|
||||
(cperl-mode all-the-icons-alltheicon "perl" :face all-the-icons-lorange)
|
||||
(php-mode all-the-icons-fileicon "php" :face all-the-icons-lsilver)
|
||||
(php-ts-mode all-the-icons-fileicon "php" :face all-the-icons-lsilver)
|
||||
(phps-mode all-the-icons-fileicon "php" :face all-the-icons-lsilver)
|
||||
(prolog-mode all-the-icons-alltheicon "prolog" :height 1.1 :face all-the-icons-lmaroon)
|
||||
(python-mode all-the-icons-alltheicon "python" :height 1.0 :face all-the-icons-dblue)
|
||||
(python-ts-mode all-the-icons-alltheicon "python" :height 1.0 :face all-the-icons-dblue)
|
||||
|
|
@ -695,6 +702,10 @@ for performance sake.")
|
|||
(scheme-mode all-the-icons-fileicon "scheme" :height 1.2 :face all-the-icons-red)
|
||||
(swift-mode all-the-icons-alltheicon "swift" :height 1.0 :v-adjust -0.1 :face all-the-icons-green)
|
||||
(svelte-mode all-the-icons-fileicon "svelte" :v-adjust 0.0 :face all-the-icons-red)
|
||||
(ada-mode all-the-icons-fileicon "ada" :v-adjust 0.0 :face all-the-icons-blue)
|
||||
(ada-ts-mode all-the-icons-fileicon "ada" :v-adjust 0.0 :face all-the-icons-blue)
|
||||
(gpr-mode all-the-icons-fileicon "ada" :v-adjust 0.0 :face all-the-icons-green)
|
||||
(gpr-ts-mode all-the-icons-fileicon "ada" :v-adjust 0.0 :face all-the-icons-green)
|
||||
(c-mode all-the-icons-alltheicon "c-line" :face all-the-icons-blue)
|
||||
(c-ts-mode all-the-icons-alltheicon "c-line" :face all-the-icons-blue)
|
||||
(c++-mode all-the-icons-alltheicon "cplusplus-line" :v-adjust -0.2 :face all-the-icons-blue)
|
||||
|
|
@ -773,8 +784,6 @@ for performance sake.")
|
|||
(emms-tag-editor-mode all-the-icons-faicon "music" :face all-the-icons-silver)
|
||||
(emms-playlist-mode all-the-icons-faicon "music" :face all-the-icons-silver)
|
||||
(lilypond-mode all-the-icons-faicon "music" :face all-the-icons-green)
|
||||
(magik-session-mode all-the-icons-alltheicon "terminal" :face all-the-icons-blue)
|
||||
(magik-cb-mode all-the-icons-faicon "book" :face all-the-icons-blue)
|
||||
(meson-mode all-the-icons-fileicon "meson" :face all-the-icons-purple)
|
||||
(man-common all-the-icons-fileicon "man-page" :face all-the-icons-blue)
|
||||
(ess-r-mode all-the-icons-fileicon "R" :face all-the-icons-lblue)))
|
||||
File diff suppressed because it is too large
Load diff
|
|
@ -138,6 +138,11 @@ Same as `byte-compile-file' but asynchronous.
|
|||
(fn FILE)" t)
|
||||
(register-definition-prefixes "async-bytecomp" '("async-"))
|
||||
|
||||
|
||||
;;; Generated autoloads from async-package.el
|
||||
|
||||
(register-definition-prefixes "async-package" '("async-package-"))
|
||||
|
||||
|
||||
;;; Generated autoloads from dired-async.el
|
||||
|
||||
|
|
@ -60,6 +60,33 @@ all packages are always compiled asynchronously."
|
|||
(defvar async-bytecomp-load-variable-regexp "\\`load-path\\'"
|
||||
"The variable used by `async-inject-variables' when (re)compiling async.")
|
||||
|
||||
(defun async-bytecomp--file-to-comp-buffer (file-or-dir &optional quiet type)
|
||||
(let ((bn (file-name-nondirectory file-or-dir))
|
||||
(action-name (pcase type
|
||||
('file "File")
|
||||
('directory "Directory"))))
|
||||
(if (file-exists-p async-byte-compile-log-file)
|
||||
(let ((buf (get-buffer-create byte-compile-log-buffer))
|
||||
(n 0))
|
||||
(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)
|
||||
(unless quiet
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "^.*:Error:" nil t)
|
||||
(cl-incf n)))
|
||||
(if (> n 0)
|
||||
(message "Failed to compile %d files in directory `%s'" n bn)
|
||||
(message "%s `%s' compiled asynchronously with warnings"
|
||||
action-name bn)))))
|
||||
(unless quiet
|
||||
(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.
|
||||
|
|
@ -73,26 +100,7 @@ All *.elc files are systematically deleted before proceeding."
|
|||
(load "async")
|
||||
(let ((call-back
|
||||
(lambda (&optional _ignore)
|
||||
(if (file-exists-p async-byte-compile-log-file)
|
||||
(let ((buf (get-buffer-create byte-compile-log-buffer))
|
||||
(n 0))
|
||||
(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)
|
||||
(unless quiet
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "^.*:Error:" nil t)
|
||||
(cl-incf n)))
|
||||
(if (> n 0)
|
||||
(message "Failed to compile %d files in directory `%s'" n directory)
|
||||
(message "Directory `%s' compiled asynchronously with warnings" directory)))))
|
||||
(unless quiet
|
||||
(message "Directory `%s' compiled asynchronously with success" directory))))))
|
||||
(async-bytecomp--file-to-comp-buffer directory quiet 'directory))))
|
||||
(async-start
|
||||
`(lambda ()
|
||||
(require 'bytecomp)
|
||||
|
|
@ -140,13 +148,10 @@ All *.elc files are systematically deleted before proceeding."
|
|||
(memq cur-package (async-bytecomp--get-package-deps
|
||||
async-bytecomp-allowed-packages)))
|
||||
(progn
|
||||
;; FIXME: Why do we use (eq cur-package 'async) once
|
||||
;; and (string= cur-package "async") afterwards?
|
||||
(when (eq cur-package 'async)
|
||||
(fmakunbound 'async-byte-recompile-directory))
|
||||
;; Add to `load-path' the latest version of async and
|
||||
;; reload it when reinstalling async.
|
||||
(when (string= cur-package "async")
|
||||
(fmakunbound 'async-byte-recompile-directory)
|
||||
;; Add to `load-path' the latest version of async and
|
||||
;; reload it when reinstalling async.
|
||||
(cl-pushnew pkg-dir load-path)
|
||||
(load "async-bytecomp"))
|
||||
;; `async-byte-recompile-directory' will add directory
|
||||
|
|
@ -173,28 +178,13 @@ Same as `byte-compile-file' but asynchronous."
|
|||
(interactive "fFile: ")
|
||||
(let ((call-back
|
||||
(lambda (&optional _ignore)
|
||||
(let ((bn (file-name-nondirectory file)))
|
||||
(if (file-exists-p async-byte-compile-log-file)
|
||||
(let ((buf (get-buffer-create byte-compile-log-buffer))
|
||||
start)
|
||||
(with-current-buffer buf
|
||||
(goto-char (setq start (point-max)))
|
||||
(let ((inhibit-read-only t))
|
||||
(insert-file-contents async-byte-compile-log-file)
|
||||
(compilation-mode))
|
||||
(display-buffer buf)
|
||||
(delete-file async-byte-compile-log-file)
|
||||
(save-excursion
|
||||
(goto-char start)
|
||||
(if (re-search-forward "^.*:Error:" nil t)
|
||||
(message "Failed to compile `%s'" bn)
|
||||
(message "`%s' compiled asynchronously with warnings" bn)))))
|
||||
(message "`%s' compiled asynchronously with success" bn))))))
|
||||
(async-bytecomp--file-to-comp-buffer file nil 'file))))
|
||||
(async-start
|
||||
`(lambda ()
|
||||
(require 'bytecomp)
|
||||
,(async-inject-variables async-bytecomp-load-variable-regexp)
|
||||
(let ((default-directory ,(file-name-directory file)))
|
||||
(let ((default-directory ,(file-name-directory file))
|
||||
error-data)
|
||||
(add-to-list 'load-path default-directory)
|
||||
(byte-compile-file ,file)
|
||||
(when (get-buffer byte-compile-log-buffer)
|
||||
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"))
|
||||
:commit "a368df08d34ae0c0a36fc3e90b1ecda252915257" :authors
|
||||
:commit "93957f5b0f2ed22aeef02972de860fb9c45b4422" :authors
|
||||
'(("John Wiegley" . "jwiegley@gmail.com"))
|
||||
:maintainers
|
||||
'(("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."
|
||||
:type 'boolean)
|
||||
|
||||
(defvar async-process-noquery-on-exit nil
|
||||
"Used as the :noquery argument to `make-process'.
|
||||
|
||||
Intended to be let-bound around a call to `async-start' or
|
||||
`async-start-process'. If non-nil, the child Emacs process will
|
||||
be silently killed if the user exits the parent Emacs.")
|
||||
|
||||
(defvar async-debug nil)
|
||||
(defvar async-send-over-pipe t)
|
||||
(defvar async-in-child-emacs nil)
|
||||
|
|
@ -110,14 +117,17 @@ is returned unmodified."
|
|||
collect elm))
|
||||
(t object)))
|
||||
|
||||
(defvar async-inject-variables-exclude-regexps '("-syntax-table\\'")
|
||||
"A list of regexps that `async-inject-variables' should ignore.")
|
||||
|
||||
(defun async-inject-variables
|
||||
(include-regexp &optional predicate exclude-regexp noprops)
|
||||
"Return a `setq' form that replicates part of the calling environment.
|
||||
|
||||
It sets the value for every variable matching INCLUDE-REGEXP and
|
||||
also PREDICATE. It will not perform injection for any variable
|
||||
matching EXCLUDE-REGEXP (if present) or representing a `syntax-table'
|
||||
i.e. ending by \"-syntax-table\".
|
||||
matching EXCLUDE-REGEXP (if present) and variables matching one of
|
||||
`async-inject-variables-exclude-regexps'.
|
||||
When NOPROPS is non nil it tries to strip out text properties of each
|
||||
variable's value with `async-variables-noprops-function'.
|
||||
|
||||
|
|
@ -136,14 +146,16 @@ It is intended to be used as follows:
|
|||
,@(let (bindings)
|
||||
(mapatoms
|
||||
(lambda (sym)
|
||||
(let* ((sname (and (boundp sym) (symbol-name sym)))
|
||||
(value (and sname (symbol-value sym))))
|
||||
(let ((sname (and (boundp sym) (symbol-name sym)))
|
||||
value)
|
||||
(when (and sname
|
||||
(or (null include-regexp)
|
||||
(string-match include-regexp sname))
|
||||
(or (null exclude-regexp)
|
||||
(not (string-match exclude-regexp sname)))
|
||||
(not (string-match "-syntax-table\\'" sname)))
|
||||
(cl-loop for re in async-inject-variables-exclude-regexps
|
||||
never (string-match-p re sname)))
|
||||
(setq value (symbol-value sym))
|
||||
(unless (or (stringp value)
|
||||
(memq value '(nil t))
|
||||
(numberp value)
|
||||
|
|
@ -426,7 +438,8 @@ working directory."
|
|||
:name name
|
||||
:buffer buf
|
||||
:stderr buf-err
|
||||
:command (cons program program-args)))))
|
||||
:command (cons program program-args)
|
||||
:noquery async-process-noquery-on-exit))))
|
||||
(set-process-sentinel
|
||||
(get-buffer-process buf-err)
|
||||
(lambda (proc _change)
|
||||
|
|
@ -387,6 +387,7 @@ ESC or `q' to not overwrite any of the remaining files,
|
|||
(dired-copy-preserve-time
|
||||
,dired-copy-preserve-time)
|
||||
(dired-create-destination-dirs ',create-dir)
|
||||
(dired-vc-rename-file ,dired-vc-rename-file)
|
||||
auth-source-save-behavior)
|
||||
(setq overwrite-backup-query nil)
|
||||
;; Inline `backup-file' as long as it is not
|
||||
|
|
@ -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:
|
||||
|
||||
(add-to-list 'load-path (directory-file-name
|
||||
(or (file-name-directory #$) (car load-path))))
|
||||
(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path)))
|
||||
|
||||
|
||||
|
||||
;;;### (autoloads nil "centaur-tabs" "centaur-tabs.el" (0 0 0 0))
|
||||
;;; Generated autoloads from centaur-tabs.el
|
||||
|
||||
(autoload 'centaur-tabs-local-mode "centaur-tabs" "\
|
||||
|
|
@ -18,8 +20,7 @@ the tab bar. The tab bar is locally hidden otherwise. When turned
|
|||
off, if a local header line is hidden or the tab bar is locally
|
||||
hidden, it is shown again. Signal an error if Centaur-Tabs mode is off.
|
||||
|
||||
\(fn &optional ARG)" t nil)
|
||||
|
||||
(fn &optional ARG)" t)
|
||||
(defvar centaur-tabs-mode nil "\
|
||||
Non-nil if Centaur-Tabs mode is enabled.
|
||||
See the `centaur-tabs-mode' command
|
||||
|
|
@ -27,9 +28,7 @@ for a description of this minor mode.
|
|||
Setting this variable directly does not take effect;
|
||||
either customize it (see the info node `Easy Customization')
|
||||
or call the function `centaur-tabs-mode'.")
|
||||
|
||||
(custom-autoload 'centaur-tabs-mode "centaur-tabs" nil)
|
||||
|
||||
(autoload 'centaur-tabs-mode "centaur-tabs" "\
|
||||
Toggle display of a tab bar in the header line.
|
||||
With prefix argument ARG, turn on if positive, otherwise off.
|
||||
|
|
@ -37,67 +36,50 @@ Returns non-nil if the new state is enabled.
|
|||
|
||||
\\{centaur-tabs-mode-map}
|
||||
|
||||
\(fn &optional ARG)" t nil)
|
||||
|
||||
(fn &optional ARG)" t)
|
||||
(register-definition-prefixes "centaur-tabs" '("centaur-tabs-"))
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil "centaur-tabs-elements" "centaur-tabs-elements.el"
|
||||
;;;;;; (0 0 0 0))
|
||||
;;; Generated autoloads from centaur-tabs-elements.el
|
||||
|
||||
(register-definition-prefixes "centaur-tabs-elements" '("cent"))
|
||||
(register-definition-prefixes "centaur-tabs-elements" '("centaur-tabs-"))
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil "centaur-tabs-functions" "centaur-tabs-functions.el"
|
||||
;;;;;; (0 0 0 0))
|
||||
;;; Generated autoloads from centaur-tabs-functions.el
|
||||
|
||||
(autoload 'centaur-tabs-backward "centaur-tabs-functions" "\
|
||||
Select the previous available tab.
|
||||
Depend on the setting of the option `centaur-tabs-cycle-scope'." t nil)
|
||||
|
||||
Depend on the setting of the option `centaur-tabs-cycle-scope'." t)
|
||||
(autoload 'centaur-tabs-forward "centaur-tabs-functions" "\
|
||||
Select the next available tab.
|
||||
Depend on the setting of the option `centaur-tabs-cycle-scope'." t nil)
|
||||
|
||||
Depend on the setting of the option `centaur-tabs-cycle-scope'." t)
|
||||
(autoload 'centaur-tabs-backward-group "centaur-tabs-functions" "\
|
||||
Go to selected tab in the previous available group." t nil)
|
||||
|
||||
Go to selected tab in the previous available group." t)
|
||||
(autoload 'centaur-tabs-forward-group "centaur-tabs-functions" "\
|
||||
Go to selected tab in the next available group." t nil)
|
||||
|
||||
Go to selected tab in the next available group." t)
|
||||
(autoload 'centaur-tabs-backward-tab "centaur-tabs-functions" "\
|
||||
Select the previous visible tab." t nil)
|
||||
|
||||
Select the previous visible tab." t)
|
||||
(autoload 'centaur-tabs-forward-tab "centaur-tabs-functions" "\
|
||||
Select the next visible tab." t nil)
|
||||
|
||||
Select the next visible tab." t)
|
||||
(register-definition-prefixes "centaur-tabs-functions" '("centaur-tabs-"))
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil "centaur-tabs-interactive" "centaur-tabs-interactive.el"
|
||||
;;;;;; (0 0 0 0))
|
||||
;;; Generated autoloads from centaur-tabs-interactive.el
|
||||
|
||||
(autoload 'centaur-tabs-counsel-switch-group "centaur-tabs-interactive" "\
|
||||
Display a list of current buffer groups using Counsel." t nil)
|
||||
|
||||
Display a list of current buffer groups using Counsel." t)
|
||||
(register-definition-prefixes "centaur-tabs-interactive" '("centaur-tabs-"))
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil nil ("centaur-tabs-pkg.el") (0 0 0 0))
|
||||
;;; End of scraped data
|
||||
|
||||
(provide 'centaur-tabs-autoloads)
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; coding: utf-8
|
||||
;; no-native-compile: t
|
||||
;; coding: utf-8-emacs-unix
|
||||
;; End:
|
||||
|
||||
;;; centaur-tabs-autoloads.el ends here
|
||||
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
|
||||
File diff suppressed because it is too large
Load diff
|
|
@ -1,10 +1,10 @@
|
|||
;;; centaur-tabs-interactive.el --- centaur-tabs interactive functions and plugins support lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2019-2020 Emmanuel Bustos
|
||||
;; Copyright (C) 2019-2024 Emmanuel Bustos
|
||||
;; Copyright (C) 2024 Jen-Chieh Shen
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;;
|
||||
;; This program is free software; you can redistribute it and/or
|
||||
;; modify it under the terms of the GNU General Public License as
|
||||
;; published by the Free Software Foundation; either version 2, or
|
||||
|
|
@ -19,34 +19,73 @@
|
|||
;; along with this program; see the file COPYING. If not, write to
|
||||
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
|
||||
;; Floor, Boston, MA 02110-1301, USA.
|
||||
;;
|
||||
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; This file contains centaur-tabs interactive functions and plugins support
|
||||
;;
|
||||
|
||||
;;; Code:
|
||||
;;; Requires
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'centaur-tabs-elements)
|
||||
(require 'centaur-tabs-functions)
|
||||
|
||||
;; Compiler pacifier
|
||||
(declare-function ivy-read "ext:ivy.el" t t)
|
||||
(declare-function helm-build-sync-source "ext:helm-source.el" t t)
|
||||
(defvar helm-source-centaur-tabs-group)
|
||||
(declare-function projectile-project-root "ext:projectile.el" t t)
|
||||
(declare-function projectile-project-name "ext:projectile.el" t t)
|
||||
|
||||
(declare-function centaur-tabs-do-select "centaur-tabs-functions.el")
|
||||
(declare-function centaur-tabs-get-tab-from-event "centaur-tabs-functions.el")
|
||||
(declare-function centaur-tabs-tab-value "centaur-tabs-functions.el")
|
||||
(declare-function centaur-tabs-get-tabset "centaur-tabs-functions.el")
|
||||
(declare-function centaur-tabs-buffer-show-groups "centaur-tabs-functions.el")
|
||||
(declare-function centaur-tabs-buffer-close-tab "centaur-tabs-functions.el")
|
||||
(declare-function centaur-tabs-view "centaur-tabs-functions.el")
|
||||
(declare-function centaur-tabs-get-extensions "centaur-tabs-functions.el")
|
||||
(declare-function centaur-tabs-selected-tab "centaur-tabs-functions.el")
|
||||
(declare-function centaur-tabs-display-update "centaur-tabs-functions.el")
|
||||
(declare-function centaur-tabs-set-template "centaur-tabs-functions.el")
|
||||
(declare-function centaur-tabs-buffer-select-tab "centaur-tabs-functions.el")
|
||||
(declare-function centaur-tabs-tabs "centaur-tabs-functions.el")
|
||||
(declare-function centaur-tabs-tab-tabset "centaur-tabs-functions.el")
|
||||
(declare-function centaur-tabs-get-tabsets-tabset "centaur-tabs-functions.el")
|
||||
(declare-function centaur-tabs-current-tabset "centaur-tabs-functions.el")
|
||||
(declare-function centaur-tabs-completing-read "centaur-tabs-functions.el")
|
||||
(declare-function centaur-tabs-get-groups "centaur-tabs-functions.el")
|
||||
(declare-function centaur-tabs-forward-group "centaur-tabs-functions.el")
|
||||
(declare-function centaur-tabs-backward-group "centaur-tabs-functions.el")
|
||||
(declare-function centaur-tabs-forward-tab "centaur-tabs-functions.el")
|
||||
(declare-function centaur-tabs-backward-tab "centaur-tabs-functions.el")
|
||||
|
||||
(defvar centaur-tabs-cycle-scope)
|
||||
(defvar centaur-tabs-current-tabset)
|
||||
(defvar centaur-tabs-last-focused-buffer-group)
|
||||
(defvar centaur-tabs-buffer-list-function)
|
||||
(defvar centaur-tabs-buffer-groups-function)
|
||||
(defvar centaur-tabs--buffer-show-groups)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;; Interactive functions ;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defun centaur-tabs-switch-group (&optional groupname)
|
||||
"Switch tab groups using ido. GROUPNAME can optionaly be provided."
|
||||
(interactive)
|
||||
(let* ((tab-buffer-list (cl-mapcar
|
||||
#'(lambda (b)
|
||||
(with-current-buffer b
|
||||
(list (current-buffer)
|
||||
(buffer-name)
|
||||
(funcall centaur-tabs-buffer-groups-function) )))
|
||||
(funcall centaur-tabs-buffer-list-function)))
|
||||
(groups (centaur-tabs-get-groups))
|
||||
(group-name (or groupname (centaur-tabs-completing-read "Groups: " groups))) )
|
||||
(let* ((tab-buffer-list (mapcar
|
||||
#'(lambda (b)
|
||||
(with-current-buffer b
|
||||
(list (current-buffer)
|
||||
(buffer-name)
|
||||
(funcall centaur-tabs-buffer-groups-function) )))
|
||||
(funcall centaur-tabs-buffer-list-function)))
|
||||
(groups (centaur-tabs-get-groups))
|
||||
(group-name (or groupname (centaur-tabs-completing-read "Groups: " groups))) )
|
||||
(catch 'done
|
||||
(mapc
|
||||
#'(lambda (group)
|
||||
(when (equal group-name (car (car (cdr (cdr group)))))
|
||||
(throw 'done (switch-to-buffer (car (cdr group))))))
|
||||
tab-buffer-list) )))
|
||||
(mapc #'(lambda (group)
|
||||
(when (equal group-name (car (car (cdr (cdr group)))))
|
||||
(throw 'done (switch-to-buffer (car (cdr group))))))
|
||||
tab-buffer-list) )))
|
||||
|
||||
(defun centaur-tabs-select-end-tab ()
|
||||
"Select end tab of current tabset."
|
||||
|
|
@ -59,20 +98,21 @@ If BACKWARD is non-nil, move backward, otherwise move forward.
|
|||
TYPE is default option."
|
||||
(interactive)
|
||||
(let* ((tabset (centaur-tabs-current-tabset t))
|
||||
(ttabset (centaur-tabs-get-tabsets-tabset))
|
||||
(_cycle (if (and (eq centaur-tabs-cycle-scope 'groups)
|
||||
(not (cdr (centaur-tabs-tabs ttabset))))
|
||||
'tabs
|
||||
centaur-tabs-cycle-scope))
|
||||
_selected tab)
|
||||
(ttabset (centaur-tabs-get-tabsets-tabset))
|
||||
(_cycle (if (and (eq centaur-tabs-cycle-scope 'groups)
|
||||
(not (cdr (centaur-tabs-tabs ttabset))))
|
||||
'tabs
|
||||
centaur-tabs-cycle-scope))
|
||||
_selected tab)
|
||||
(when tabset
|
||||
(setq tabset (centaur-tabs-tabs tabset)
|
||||
tab (car (if backward (last tabset) tabset)))
|
||||
tab (car (if backward (last tabset) tabset)))
|
||||
(centaur-tabs-buffer-select-tab tab))))
|
||||
|
||||
(defun centaur-tabs-backward-tab-other-window (&optional reversed)
|
||||
"Move to left tab in other window.
|
||||
Optional argument REVERSED default is move backward, if reversed is non-nil move forward."
|
||||
Optional argument REVERSED default is move backward, if reversed is non-nil
|
||||
move forward."
|
||||
(interactive)
|
||||
(other-window 1)
|
||||
(if reversed
|
||||
|
|
@ -89,21 +129,21 @@ Optional argument REVERSED default is move backward, if reversed is non-nil move
|
|||
"Move current tab one place right, unless it's already the rightmost."
|
||||
(interactive)
|
||||
(let* ((bufset (centaur-tabs-current-tabset t))
|
||||
(old-bufs (centaur-tabs-tabs bufset))
|
||||
(new-bufs (list))
|
||||
the-buffer)
|
||||
(old-bufs (centaur-tabs-tabs bufset))
|
||||
(new-bufs (list))
|
||||
the-buffer)
|
||||
(while (and
|
||||
old-bufs
|
||||
(not (string= (buffer-name) (format "%s" (car (car old-bufs))))))
|
||||
old-bufs
|
||||
(not (string= (buffer-name) (format "%s" (car (car old-bufs))))))
|
||||
(push (car old-bufs) new-bufs)
|
||||
(setq old-bufs (cdr old-bufs)))
|
||||
(if old-bufs ; if this is false, then the current tab's buffer name is mysteriously missing
|
||||
(progn
|
||||
(setq the-buffer (car old-bufs))
|
||||
(setq old-bufs (cdr old-bufs))
|
||||
(if old-bufs ; if this is false, then the current tab is the rightmost
|
||||
(push (car old-bufs) new-bufs))
|
||||
(push the-buffer new-bufs)) ; this is the tab that was to be moved
|
||||
(progn
|
||||
(setq the-buffer (car old-bufs))
|
||||
(setq old-bufs (cdr old-bufs))
|
||||
(if old-bufs ; if this is false, then the current tab is the rightmost
|
||||
(push (car old-bufs) new-bufs))
|
||||
(push the-buffer new-bufs)) ; this is the tab that was to be moved
|
||||
(error "Error: current buffer's name was not found in Centaur-Tabs's buffer list"))
|
||||
(setq new-bufs (reverse new-bufs))
|
||||
(setq new-bufs (append new-bufs (cdr old-bufs)))
|
||||
|
|
@ -115,27 +155,27 @@ Optional argument REVERSED default is move backward, if reversed is non-nil move
|
|||
"Move current tab one place left, unless it's already the leftmost."
|
||||
(interactive)
|
||||
(let* ((bufset (centaur-tabs-current-tabset t))
|
||||
(old-bufs (centaur-tabs-tabs bufset))
|
||||
(first-buf (car old-bufs))
|
||||
(new-bufs (list))
|
||||
not-yet-this-buf)
|
||||
(old-bufs (centaur-tabs-tabs bufset))
|
||||
(first-buf (car old-bufs))
|
||||
(new-bufs (list))
|
||||
not-yet-this-buf)
|
||||
(if (string= (buffer-name) (format "%s" (car first-buf)))
|
||||
old-bufs ; the current tab is the leftmost
|
||||
old-bufs ; the current tab is the leftmost
|
||||
(setq not-yet-this-buf first-buf)
|
||||
(setq old-bufs (cdr old-bufs))
|
||||
(while (and
|
||||
old-bufs
|
||||
(not (string= (buffer-name) (format "%s" (car (car old-bufs))))))
|
||||
(push not-yet-this-buf new-bufs)
|
||||
(setq not-yet-this-buf (car old-bufs))
|
||||
(setq old-bufs (cdr old-bufs)))
|
||||
old-bufs
|
||||
(not (string= (buffer-name) (format "%s" (car (car old-bufs))))))
|
||||
(push not-yet-this-buf new-bufs)
|
||||
(setq not-yet-this-buf (car old-bufs))
|
||||
(setq old-bufs (cdr old-bufs)))
|
||||
(if old-bufs ; if this is false, then the current tab's buffer name is mysteriously missing
|
||||
(progn
|
||||
(push (car old-bufs) new-bufs) ; this is the tab that was to be moved
|
||||
(push not-yet-this-buf new-bufs)
|
||||
(setq new-bufs (reverse new-bufs))
|
||||
(setq new-bufs (append new-bufs (cdr old-bufs))))
|
||||
(error "Error: current buffer's name was not found in Centaur-Tabs's buffer list"))
|
||||
(progn
|
||||
(push (car old-bufs) new-bufs) ; this is the tab that was to be moved
|
||||
(push not-yet-this-buf new-bufs)
|
||||
(setq new-bufs (reverse new-bufs))
|
||||
(setq new-bufs (append new-bufs (cdr old-bufs))))
|
||||
(error "Error: current buffer's name was not found in Centaur-Tabs's buffer list"))
|
||||
(set bufset new-bufs)
|
||||
(centaur-tabs-set-template bufset nil)
|
||||
(centaur-tabs-display-update))))
|
||||
|
|
@ -144,12 +184,11 @@ Optional argument REVERSED default is move backward, if reversed is non-nil move
|
|||
"If buffer match MATCH-RULE, kill it."
|
||||
`(save-excursion
|
||||
(mapc #'(lambda (buffer)
|
||||
(with-current-buffer buffer
|
||||
(when (string-equal current-group-name (cdr (centaur-tabs-selected-tab (centaur-tabs-current-tabset t))))
|
||||
(when (funcall ,match-rule buffer)
|
||||
(kill-buffer buffer))
|
||||
)))
|
||||
(buffer-list))))
|
||||
(with-current-buffer buffer
|
||||
(when (string-equal current-group-name (cdr (centaur-tabs-selected-tab (centaur-tabs-current-tabset t))))
|
||||
(when (funcall ,match-rule buffer)
|
||||
(kill-buffer buffer)))))
|
||||
(buffer-list))))
|
||||
|
||||
(defun centaur-tabs-kill-all-buffers-in-current-group ()
|
||||
"Kill all buffers in current group."
|
||||
|
|
@ -159,67 +198,59 @@ Optional argument REVERSED default is move backward, if reversed is non-nil move
|
|||
(centaur-tabs-kill-buffer-match-rule
|
||||
(lambda (_buffer) t))
|
||||
;; Switch to next group.
|
||||
(centaur-tabs-forward-group)
|
||||
))
|
||||
(centaur-tabs-forward-group)))
|
||||
|
||||
(defun centaur-tabs-kill-other-buffers-in-current-group ()
|
||||
"Kill all buffers except current buffer in current group."
|
||||
(interactive)
|
||||
(let* ((current-group-name (cdr (centaur-tabs-selected-tab (centaur-tabs-current-tabset t))))
|
||||
(currentbuffer (current-buffer)))
|
||||
(currentbuffer (current-buffer)))
|
||||
;; Kill all buffers in current group.
|
||||
(centaur-tabs-kill-buffer-match-rule
|
||||
(lambda (buffer) (not (equal buffer currentbuffer))))
|
||||
))
|
||||
(lambda (buffer) (not (equal buffer currentbuffer))))))
|
||||
|
||||
(defun centaur-tabs-kill-unmodified-buffers-in-current-group ()
|
||||
"Kill all unmodified buffer in current group."
|
||||
(interactive)
|
||||
(let* ((current-group-name (cdr (centaur-tabs-selected-tab (centaur-tabs-current-tabset t))))
|
||||
(currentbuffer (current-buffer)))
|
||||
(currentbuffer (current-buffer)))
|
||||
;; Kill all buffers in current group.
|
||||
(centaur-tabs-kill-buffer-match-rule
|
||||
(lambda (buffer) (not (buffer-modified-p buffer))))
|
||||
))
|
||||
|
||||
(lambda (buffer) (not (buffer-modified-p buffer))))))
|
||||
|
||||
(defun centaur-tabs-kill-match-buffers-in-current-group ()
|
||||
"Kill all buffers match extension in current group."
|
||||
(interactive)
|
||||
(let* ((current-group-name (cdr (centaur-tabs-selected-tab (centaur-tabs-current-tabset t))))
|
||||
(extension-names (centaur-tabs-get-extensions))
|
||||
match-extension)
|
||||
(extension-names (centaur-tabs-get-extensions))
|
||||
match-extension)
|
||||
;; Read extension need to kill.
|
||||
(setq match-extension (centaur-tabs-completing-read "Kill buffers suffix with: " extension-names))
|
||||
;; Kill all buffers match extension in current group.
|
||||
(centaur-tabs-kill-buffer-match-rule
|
||||
(lambda (buffer)
|
||||
(let ((filename (buffer-file-name buffer)))
|
||||
(and filename (string-equal (file-name-extension filename) match-extension))
|
||||
)))
|
||||
(and filename (string-equal (file-name-extension filename) match-extension)))))
|
||||
;; Switch to next group if last file killed.
|
||||
(when (equal (length extension-names) 1)
|
||||
(centaur-tabs-forward-group))
|
||||
))
|
||||
(centaur-tabs-forward-group))))
|
||||
|
||||
(defun centaur-tabs-keep-match-buffers-in-current-group ()
|
||||
"Keep all buffers match extension in current group."
|
||||
(interactive)
|
||||
(let* ((current-group-name (cdr (centaur-tabs-selected-tab (centaur-tabs-current-tabset t))))
|
||||
(extension-names (centaur-tabs-get-extensions))
|
||||
match-extension)
|
||||
(extension-names (centaur-tabs-get-extensions))
|
||||
match-extension)
|
||||
;; Read extension need to kill.
|
||||
(setq match-extension (centaur-tabs-completing-read "Just keep buffers suffix with: " extension-names))
|
||||
;; Kill all buffers match extension in current group.
|
||||
(centaur-tabs-kill-buffer-match-rule
|
||||
(lambda (buffer)
|
||||
(let ((filename (buffer-file-name buffer)))
|
||||
(and filename (not (string-equal (file-name-extension filename) match-extension)))
|
||||
)))
|
||||
(and filename (not (string-equal (file-name-extension filename) match-extension))))))
|
||||
;; Switch to next group if last file killed.
|
||||
(when (equal (length extension-names) 1)
|
||||
(centaur-tabs-forward-group))
|
||||
))
|
||||
(centaur-tabs-forward-group))))
|
||||
|
||||
(defun centaur-tabs-select-visible-nth-tab (tab-index)
|
||||
"Select visible tab with TAB-INDEX'.
|
||||
|
|
@ -232,9 +263,9 @@ If `tab-index' is 0, select last tab."
|
|||
(switch-to-buffer
|
||||
(car
|
||||
(if (or (equal tab-index 0)
|
||||
(> tab-index (length visible-tabs)))
|
||||
(car (last visible-tabs))
|
||||
(nth (- tab-index 1) visible-tabs))))))
|
||||
(> tab-index (length visible-tabs)))
|
||||
(car (last visible-tabs))
|
||||
(nth (- tab-index 1) visible-tabs))))))
|
||||
|
||||
(defun centaur-tabs-select-visible-tab ()
|
||||
"Bind this function with number keystroke, such as s-1, s-2, s-3 ... etc.
|
||||
|
|
@ -246,15 +277,15 @@ Note that this function switches to the visible range,
|
|||
not the actual logical index position of the current group."
|
||||
(interactive)
|
||||
(let* ((event last-command-event)
|
||||
(key (make-vector 1 event))
|
||||
(key-desc (key-description key)))
|
||||
(key (make-vector 1 event))
|
||||
(key-desc (key-description key)))
|
||||
(centaur-tabs-select-visible-nth-tab
|
||||
(string-to-number (car (last (split-string key-desc "-")))))))
|
||||
|
||||
;; ace-jump style tab switching
|
||||
|
||||
(defvar centaur-tabs-ace-jump-active nil
|
||||
"t if centaur-tabs-ace-jump is invoked.")
|
||||
"Set to t if `centaur-tabs-ace-jump' is invoked.")
|
||||
|
||||
(defvar centaur-tabs-dim-overlay nil
|
||||
"Holds the overlay for dimming buffer when invoking centaur-tabs-ace-jump.")
|
||||
|
|
@ -265,91 +296,91 @@ not the actual logical index position of the current group."
|
|||
(when centaur-tabs-dim-overlay
|
||||
(delete-overlay centaur-tabs-dim-overlay))
|
||||
(setq centaur-tabs-dim-overlay
|
||||
(let ((ol (make-overlay (window-start) (window-end))))
|
||||
(overlay-put ol 'face 'centaur-tabs-dim-buffer-face)
|
||||
ol))))
|
||||
(let ((ol (make-overlay (window-start) (window-end))))
|
||||
(overlay-put ol 'face 'centaur-tabs-dim-buffer-face)
|
||||
ol))))
|
||||
|
||||
(defun centaur-tabs-swap-tab (tab)
|
||||
"Swap the position of current tab with TAB.
|
||||
TAB has to be in the same group as the current tab."
|
||||
(if (eq (centaur-tabs-tab-tabset tab) (centaur-tabs-current-tabset t))
|
||||
(let* ((group (centaur-tabs-current-tabset t))
|
||||
(tabs (cl-copy-list (centaur-tabs-tabs group)))
|
||||
(current (centaur-tabs-selected-tab group))
|
||||
(current-index (cl-position current tabs))
|
||||
(target-index (cl-position tab tabs)))
|
||||
(if (eq tab current)
|
||||
(message "Can't swap with current tab itself.")
|
||||
(setcar (nthcdr current-index tabs) tab)
|
||||
(setcar (nthcdr target-index tabs) current)
|
||||
(set group tabs)
|
||||
(centaur-tabs-set-template (centaur-tabs-current-tabset t) nil)
|
||||
(centaur-tabs-display-update)))
|
||||
(tabs (cl-copy-list (centaur-tabs-tabs group)))
|
||||
(current (centaur-tabs-selected-tab group))
|
||||
(current-index (cl-position current tabs))
|
||||
(target-index (cl-position tab tabs)))
|
||||
(if (eq tab current)
|
||||
(message "Can't swap with current tab itself.")
|
||||
(setcar (nthcdr current-index tabs) tab)
|
||||
(setcar (nthcdr target-index tabs) current)
|
||||
(set group tabs)
|
||||
(centaur-tabs-set-template (centaur-tabs-current-tabset t) nil)
|
||||
(centaur-tabs-display-update)))
|
||||
(message "Error: %s is not in the same group as the current tab." tab)))
|
||||
|
||||
(defun centaur-tabs-ace-action (action)
|
||||
"Preform ACTION on a visible tab. Ace-jump style.
|
||||
ACTION has to be one of value in `centuar-tabs-ace-dispatch-alist'"
|
||||
"Preform ACTION on a visible tab. Ace-jump style.
|
||||
ACTION has to be one of value in `centaur-tabs-ace-dispatch-alist'"
|
||||
(when (centaur-tabs-current-tabset t)
|
||||
(when centaur-tabs-ace-jump-dim-buffer
|
||||
(centaur-tabs--dim-window))
|
||||
(cond ((eq action 'jump-to-tab)
|
||||
(message "Jump to tab: "))
|
||||
((eq action 'close-tab)
|
||||
(message "Close tab: "))
|
||||
((eq action 'swap-tab)
|
||||
(message "Swap current tab with: ")))
|
||||
(message "Jump to tab: "))
|
||||
((eq action 'close-tab)
|
||||
(message "Close tab: "))
|
||||
((eq action 'swap-tab)
|
||||
(message "Swap current tab with: ")))
|
||||
|
||||
(let ((centaur-tabs-ace-jump-active t))
|
||||
(catch 'done
|
||||
(while t
|
||||
(centaur-tabs-set-template (centaur-tabs-current-tabset t) nil)
|
||||
(centaur-tabs-display-update)
|
||||
(let ((char (read-key)) (action-cache))
|
||||
(cond
|
||||
;; tab keys
|
||||
((memq char centaur-tabs-ace-jump-keys)
|
||||
(let ((sel (nth (cl-position char centaur-tabs-ace-jump-keys) (centaur-tabs-view (centaur-tabs-current-tabset t)))))
|
||||
(cond ((eq sel nil)
|
||||
(message "Tab %s does not exist" (key-description (vector char))))
|
||||
((eq action 'jump-to-tab)
|
||||
(centaur-tabs-buffer-select-tab sel))
|
||||
((eq action 'close-tab)
|
||||
(centaur-tabs-buffer-close-tab sel))
|
||||
((eq action 'swap-tab)
|
||||
(centaur-tabs-swap-tab sel))))
|
||||
(throw 'done nil))
|
||||
;; actions
|
||||
((setq action-cache (assoc char centuar-tabs-ace-dispatch-alist))
|
||||
(setq action-cache (cadr action-cache))
|
||||
(cond ((eq action-cache 'exit) ; exit
|
||||
(message "Quit")
|
||||
(throw 'done nil))
|
||||
((eq action-cache 'forward-group) ; forward group
|
||||
(message "Forward group")
|
||||
(centaur-tabs-forward-group)
|
||||
(centaur-tabs--dim-window))
|
||||
((eq action-cache 'backward-group) ; backward group
|
||||
(message "Backward group")
|
||||
(centaur-tabs-backward-group)
|
||||
(centaur-tabs--dim-window))
|
||||
((eq action-cache 'show-help) ; help menu
|
||||
(message "%s" (mapconcat
|
||||
(lambda (elem) (format "%s: %s"
|
||||
(key-description (vector (car elem)))
|
||||
(caddr elem)))
|
||||
centuar-tabs-ace-dispatch-alist
|
||||
"\n")))
|
||||
(t (setq action action-cache) ; other actions
|
||||
(cond ((eq action-cache 'jump-to-tab)
|
||||
(message "Jump to tab: "))
|
||||
((eq action-cache 'close-tab)
|
||||
(message "Close tab: "))
|
||||
((eq action-cache 'swap-tab)
|
||||
(message "Swap current tab with: "))))))
|
||||
;; no match, repeat
|
||||
(t
|
||||
(message "No such candidate: %s, hit ? for help." (key-description (vector char)))))))))
|
||||
(while t
|
||||
(centaur-tabs-set-template (centaur-tabs-current-tabset t) nil)
|
||||
(centaur-tabs-display-update)
|
||||
(let ((char (read-key)) (action-cache))
|
||||
(cond
|
||||
;; tab keys
|
||||
((memq char centaur-tabs-ace-jump-keys)
|
||||
(let ((sel (nth (cl-position char centaur-tabs-ace-jump-keys) (centaur-tabs-view (centaur-tabs-current-tabset t)))))
|
||||
(cond ((eq sel nil)
|
||||
(message "Tab %s does not exist" (key-description (vector char))))
|
||||
((eq action 'jump-to-tab)
|
||||
(centaur-tabs-buffer-select-tab sel))
|
||||
((eq action 'close-tab)
|
||||
(centaur-tabs-buffer-close-tab sel))
|
||||
((eq action 'swap-tab)
|
||||
(centaur-tabs-swap-tab sel))))
|
||||
(throw 'done nil))
|
||||
;; actions
|
||||
((setq action-cache (assoc char centaur-tabs-ace-dispatch-alist))
|
||||
(setq action-cache (cadr action-cache))
|
||||
(cond ((eq action-cache 'exit) ; exit
|
||||
(message "Quit")
|
||||
(throw 'done nil))
|
||||
((eq action-cache 'forward-group) ; forward group
|
||||
(message "Forward group")
|
||||
(centaur-tabs-forward-group)
|
||||
(centaur-tabs--dim-window))
|
||||
((eq action-cache 'backward-group) ; backward group
|
||||
(message "Backward group")
|
||||
(centaur-tabs-backward-group)
|
||||
(centaur-tabs--dim-window))
|
||||
((eq action-cache 'show-help) ; help menu
|
||||
(message "%s" (mapconcat
|
||||
(lambda (elem) (format "%s: %s"
|
||||
(key-description (vector (car elem)))
|
||||
(caddr elem)))
|
||||
centaur-tabs-ace-dispatch-alist
|
||||
"\n")))
|
||||
(t (setq action action-cache) ; other actions
|
||||
(cond ((eq action-cache 'jump-to-tab)
|
||||
(message "Jump to tab: "))
|
||||
((eq action-cache 'close-tab)
|
||||
(message "Close tab: "))
|
||||
((eq action-cache 'swap-tab)
|
||||
(message "Swap current tab with: "))))))
|
||||
;; no match, repeat
|
||||
(t
|
||||
(message "No such candidate: %s, hit ? for help." (key-description (vector char)))))))))
|
||||
(centaur-tabs-set-template (centaur-tabs-current-tabset t) nil)
|
||||
(when centaur-tabs-ace-jump-dim-buffer
|
||||
(delete-overlay centaur-tabs-dim-overlay)
|
||||
|
|
@ -357,21 +388,19 @@ ACTION has to be one of value in `centuar-tabs-ace-dispatch-alist'"
|
|||
(centaur-tabs-display-update)))
|
||||
|
||||
(defun centaur-tabs-ace-jump (&optional arg)
|
||||
"Select a tab and perform an action. Ace-jump style.
|
||||
If no ARG is provided, select that tab.
|
||||
If prefixed with one `universal-argument', swap the current
|
||||
tab with the selected tab.
|
||||
If prefixed with two `universal-argument's, close
|
||||
selected tab."
|
||||
"Select a tab and perform an action. Ace-jump style.
|
||||
If no ARG is provided, select that tab. If prefixed with one
|
||||
`universal-argument', swap the current tab with the selected tab.
|
||||
If prefixed with two `universal-argument's, close selected tab."
|
||||
(interactive "p")
|
||||
(cond ((eq arg 1)
|
||||
(centaur-tabs-ace-action 'jump-to-tab))
|
||||
((eq arg 4)
|
||||
(centaur-tabs-ace-action 'swap-tab))
|
||||
((eq arg 16)
|
||||
(centaur-tabs-ace-action 'close-tab))
|
||||
(t
|
||||
(centaur-tabs-ace-action 'jump-to-tab))))
|
||||
(centaur-tabs-ace-action 'jump-to-tab))
|
||||
((eq arg 4)
|
||||
(centaur-tabs-ace-action 'swap-tab))
|
||||
((eq arg 16)
|
||||
(centaur-tabs-ace-action 'close-tab))
|
||||
(t
|
||||
(centaur-tabs-ace-action 'jump-to-tab))))
|
||||
|
||||
(defun centaur-tabs-group-buffer-groups ()
|
||||
"Use centaur-tabs's own buffer grouping function."
|
||||
|
|
@ -390,21 +419,24 @@ Should be buffer local and speed up calculation of buffer groups.")
|
|||
(symbol-value 'centaur-tabs-projectile-buffer-group-calc)
|
||||
(set (make-local-variable 'centaur-tabs-projectile-buffer-group-calc)
|
||||
|
||||
(cond
|
||||
((or (get-buffer-process (current-buffer)) (memq major-mode '(comint-mode compilation-mode))) '("Term"))
|
||||
((string-equal "*" (substring (buffer-name) 0 1)) '("Misc"))
|
||||
((condition-case _err
|
||||
(projectile-project-root)
|
||||
(error nil)) (list (projectile-project-name)))
|
||||
((memq major-mode '(emacs-lisp-mode python-mode emacs-lisp-mode c-mode
|
||||
c++-mode javascript-mode js-mode
|
||||
js2-mode makefile-mode
|
||||
lua-mode vala-mode)) '("Coding"))
|
||||
((memq major-mode '(nxhtml-mode html-mode
|
||||
mhtml-mode css-mode)) '("HTML"))
|
||||
((memq major-mode '(org-mode calendar-mode diary-mode)) '("Org"))
|
||||
((memq major-mode '(dired-mode)) '("Dir"))
|
||||
(t '("Other"))))
|
||||
(cond
|
||||
((or (get-buffer-process (current-buffer)) (memq major-mode '(comint-mode compilation-mode))) '("Term"))
|
||||
((string-equal "*" (substring (buffer-name) 0 1)) '("Misc"))
|
||||
((condition-case _err
|
||||
(projectile-project-root)
|
||||
(error nil))
|
||||
(list (projectile-project-name)))
|
||||
((memq major-mode '(emacs-lisp-mode python-mode emacs-lisp-mode c-mode
|
||||
c++-mode javascript-mode js-mode
|
||||
js2-mode makefile-mode
|
||||
lua-mode vala-mode))
|
||||
'("Coding"))
|
||||
((memq major-mode '( nxhtml-mode html-mode
|
||||
mhtml-mode css-mode))
|
||||
'("HTML"))
|
||||
((memq major-mode '(org-mode calendar-mode diary-mode)) '("Org"))
|
||||
((memq major-mode '(dired-mode)) '("Dir"))
|
||||
(t '("Other"))))
|
||||
(symbol-value 'centaur-tabs-projectile-buffer-group-calc)))
|
||||
|
||||
(defun centaur-tabs-group-by-projectile-project()
|
||||
|
|
@ -426,11 +458,11 @@ Should be buffer local and speed up calculation of buffer groups.")
|
|||
"Display a list of current buffer groups in Helm."
|
||||
(interactive)
|
||||
(setq helm-source-centaur-tabs-group
|
||||
(when (featurep 'helm)
|
||||
(require 'helm)
|
||||
(helm-build-sync-source "Centaur-Tabs Group"
|
||||
:candidates #'centaur-tabs-get-groups
|
||||
:action '(("Switch to group" . centaur-tabs-switch-group))))))
|
||||
(when (featurep 'helm)
|
||||
(require 'helm)
|
||||
(helm-build-sync-source "Centaur-Tabs Group"
|
||||
:candidates #'centaur-tabs-get-groups
|
||||
:action '(("Switch to group" . centaur-tabs-switch-group))))))
|
||||
|
||||
;; Ivy source for switching group in ivy.
|
||||
|
||||
|
|
@ -446,9 +478,9 @@ Should be buffer local and speed up calculation of buffer groups.")
|
|||
:action #'centaur-tabs-switch-group
|
||||
:caller 'centaur-tabs-counsel-switch-group)))
|
||||
|
||||
|
||||
(defun centaur-tabs-extract-window-to-new-frame()
|
||||
"Kill the current window in the current frame, and open the current buffer in a new frame."
|
||||
"Kill the current window in the current frame, and open the current buffer
|
||||
in a new frame."
|
||||
(interactive)
|
||||
(unless (centaur-tabs--one-window-p)
|
||||
(let ((buffer (current-buffer)))
|
||||
|
|
@ -462,12 +494,11 @@ Should be buffer local and speed up calculation of buffer groups.")
|
|||
(let* ((filename (if (equal major-mode 'dired-mode)
|
||||
default-directory
|
||||
(buffer-file-name)))
|
||||
(filename (expand-file-name filename)))
|
||||
(filename (expand-file-name filename)))
|
||||
(when filename
|
||||
(kill-new filename)
|
||||
(message "Copied buffer file name '%s' to the kill ring." filename))))
|
||||
|
||||
|
||||
(defun centaur-tabs-open-directory-in-external-application ()
|
||||
"Open the current directory in a external application."
|
||||
(interactive)
|
||||
|
|
@ -476,7 +507,7 @@ Should be buffer local and speed up calculation of buffer groups.")
|
|||
(defun centaur-tabs-open-in-external-application ()
|
||||
"Open the file of the current buffer according to its mime type."
|
||||
(interactive)
|
||||
(let ((path (if (buffer-file-name) (buffer-file-name) default-directory)))
|
||||
(let ((path (or (buffer-file-name) default-directory)))
|
||||
(centaur-tabs--open-externally path)))
|
||||
|
||||
(defun centaur-tabs--open-externally (file-or-path)
|
||||
|
|
@ -492,10 +523,9 @@ Modified copy of `treemacs-visit-node-in-external-application`."
|
|||
(shell-command (format "open \"%s\"" path)))
|
||||
('gnu/linux
|
||||
(let ((process-connection-type nil))
|
||||
(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))))))
|
||||
|
||||
|
||||
(defun centaur-tabs--copy-directory-name-to-clipboard ()
|
||||
"Copy the current directory name to the clipboard."
|
||||
(interactive)
|
||||
|
|
@ -507,22 +537,17 @@ Modified copy of `treemacs-visit-node-in-external-application`."
|
|||
"Menu definition with a list of tab groups."
|
||||
(mapcar (lambda (s) `[,s ,s]) (sort (centaur-tabs-get-groups) #'string<)))
|
||||
|
||||
|
||||
(defun centaur-tabs--tab-submenu-tabs-definition ()
|
||||
"Menu definition with a list of tabs for the current group."
|
||||
(let* ((tabset (centaur-tabs-get-tabset centaur-tabs-last-focused-buffer-group))
|
||||
(tabs-in-group (centaur-tabs-tabs tabset))
|
||||
(tabs-in-group (centaur-tabs-tabs tabset))
|
||||
(buffers (mapcar #'centaur-tabs-tab-value tabs-in-group))
|
||||
(sorted-tabnames (sort (mapcar #'buffer-name buffers) #'string<)))
|
||||
(sorted-tabnames (sort (mapcar #'buffer-name buffers) #'string<)))
|
||||
(mapcar (lambda (s) `[,s ,s]) sorted-tabnames)))
|
||||
|
||||
|
||||
|
||||
(defvar centaur-tabs--groups-submenu-key "Tab groups")
|
||||
(defvar centaur-tabs--tabs-submenu-key "Go to tab of group")
|
||||
|
||||
|
||||
|
||||
(defun centaur-tabs--kill-this-buffer-dont-ask()
|
||||
"Kill the current buffer without confirmation."
|
||||
(interactive)
|
||||
|
|
@ -530,7 +555,6 @@ Modified copy of `treemacs-visit-node-in-external-application`."
|
|||
(centaur-tabs-display-update)
|
||||
(redisplay t))
|
||||
|
||||
|
||||
(defun centaur-tabs--tab-menu-definition ()
|
||||
"Definition of the context menu of a tab."
|
||||
`(["Kill this buffer" centaur-tabs--kill-this-buffer-dont-ask]
|
||||
|
|
@ -558,13 +582,12 @@ Modified copy of `treemacs-visit-node-in-external-application`."
|
|||
:active default-directory]
|
||||
"----"
|
||||
,( append (list centaur-tabs--groups-submenu-key) (centaur-tabs--tab-submenu-groups-definition))
|
||||
,( append (list centaur-tabs--tabs-submenu-key) (centaur-tabs--tab-submenu-tabs-definition))
|
||||
))
|
||||
,( append (list centaur-tabs--tabs-submenu-key) (centaur-tabs--tab-submenu-tabs-definition))))
|
||||
|
||||
(defun centaur-tabs--one-window-p ()
|
||||
"Like `one-window-p`, but taking into account side windows like treemacs."
|
||||
(let* ((mainwindow (window-main-window))
|
||||
(child-count (window-child-count mainwindow)))
|
||||
(child-count (window-child-count mainwindow)))
|
||||
(= 0 child-count)))
|
||||
|
||||
(defun centaur-tabs--get-tab-from-name (tabname)
|
||||
|
|
@ -574,54 +597,46 @@ Modified copy of `treemacs-visit-node-in-external-application`."
|
|||
(lambda (tab) (string= tabname (buffer-name (centaur-tabs-tab-value tab))))
|
||||
seq)))
|
||||
|
||||
|
||||
(defun centaur-tabs--tab-menu (event)
|
||||
"Show a context menu for the clicked tab or button. The clicked tab, identified by EVENT, is selected."
|
||||
"Show a context menu for the clicked tab or button.
|
||||
The clicked tab, identified by EVENT, is selected."
|
||||
(interactive "e" )
|
||||
|
||||
(let ((click-on-tab-p (ignore-errors (centaur-tabs-get-tab-from-event event))))
|
||||
|
||||
(when (not click-on-tab-p)
|
||||
(centaur-tabs--groups-menu))
|
||||
|
||||
(when click-on-tab-p
|
||||
(centaur-tabs-do-select event)
|
||||
(redisplay t)
|
||||
|
||||
(let*
|
||||
((menu (easy-menu-create-menu nil (centaur-tabs--tab-menu-definition)))
|
||||
(choice (x-popup-menu t menu))
|
||||
(action (lookup-key menu (apply 'vector choice)))
|
||||
(action-is-command-p (and (commandp action) (functionp action))))
|
||||
(when action-is-command-p
|
||||
(call-interactively action))
|
||||
(when (not action-is-command-p)
|
||||
(let* ((menu-key (first choice))
|
||||
(choice-is-group-p (string= centaur-tabs--groups-submenu-key (symbol-name menu-key)))
|
||||
(name (car (last choice)))
|
||||
(name-as-string (symbol-name name)))
|
||||
(if choice-is-group-p
|
||||
(centaur-tabs-switch-group name-as-string)
|
||||
(switch-to-buffer name-as-string))))))))
|
||||
|
||||
((menu (easy-menu-create-menu nil (centaur-tabs--tab-menu-definition)))
|
||||
(choice (x-popup-menu t menu))
|
||||
(action (lookup-key menu (apply 'vector choice)))
|
||||
(action-is-command-p (and (commandp action) (functionp action))))
|
||||
(when action-is-command-p
|
||||
(call-interactively action))
|
||||
(when (not action-is-command-p)
|
||||
(let* ((menu-key (cl-first choice))
|
||||
(choice-is-group-p (string= centaur-tabs--groups-submenu-key (symbol-name menu-key)))
|
||||
(name (car (last choice)))
|
||||
(name-as-string (symbol-name name)))
|
||||
(if choice-is-group-p
|
||||
(centaur-tabs-switch-group name-as-string)
|
||||
(switch-to-buffer name-as-string))))))))
|
||||
|
||||
(defun centaur-tabs--groups-menu ()
|
||||
"Show a popup menu with the centaur tabs groups."
|
||||
(interactive)
|
||||
|
||||
(let*
|
||||
((sorted-groups (centaur-tabs--tab-submenu-groups-definition))
|
||||
(menu (easy-menu-create-menu "Tab groups" (centaur-tabs--tab-submenu-groups-definition)))
|
||||
(choice (x-popup-menu t menu))
|
||||
(action (lookup-key menu (apply 'vector choice)))
|
||||
(action-is-command-p (and (commandp action) (functionp action))))
|
||||
(let* ((sorted-groups (centaur-tabs--tab-submenu-groups-definition))
|
||||
(menu (easy-menu-create-menu "Tab groups"
|
||||
(centaur-tabs--tab-submenu-groups-definition)))
|
||||
(choice (x-popup-menu t menu))
|
||||
(action (lookup-key menu (apply 'vector choice)))
|
||||
(action-is-command-p (and (commandp action) (functionp action))))
|
||||
(when action-is-command-p
|
||||
(call-interactively action))
|
||||
(when (not action-is-command-p)
|
||||
(let ((group (car (last choice))))
|
||||
(centaur-tabs-switch-group (format "%s" group))))))
|
||||
|
||||
(centaur-tabs-switch-group (format "%s" group))))))
|
||||
|
||||
(provide 'centaur-tabs-interactive)
|
||||
|
||||
;;; 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; -*-
|
||||
|
||||
;; Copyright (C) 2019 Emmanuel Bustos
|
||||
;; Copyright (C) 2019-2024 Emmanuel Bustos
|
||||
;; Copyright (C) 2024 Jen-Chieh Shen
|
||||
|
||||
;; Filename: centaur-tabs.el
|
||||
;; Description: Provide an out of box configuration to use highly customizable tabs.
|
||||
;; URL: https://github.com/ema2159/centaur-tabs
|
||||
;; Author: Emmanuel Bustos <ema2159@gmail.com>
|
||||
;; Maintainer: Emmanuel Bustos <ema2159@gmail.com>
|
||||
;; Maintainer: Jen-Chieh Shen <jcs090218@gmail.com>
|
||||
;; Created: 2019-21-19 22:14:34
|
||||
;; Version: 5
|
||||
;; Version: 3.3
|
||||
;; Known Compatibility: GNU Emacs 26.2
|
||||
;; Package-Requires: ((emacs "24.4") (powerline "2.4") (cl-lib "0.5"))
|
||||
;;
|
||||
;;
|
||||
;; Package-Requires: ((emacs "27.1") (powerline "2.4"))
|
||||
;; Keywords: frames
|
||||
|
||||
;;; This file is NOT part of GNU Emacs
|
||||
|
||||
|
|
@ -54,10 +54,15 @@
|
|||
;;
|
||||
|
||||
;;; Code:
|
||||
;;; Requires
|
||||
|
||||
(require 'centaur-tabs-elements)
|
||||
(require 'centaur-tabs-functions)
|
||||
(require 'centaur-tabs-interactive)
|
||||
|
||||
;; Compiler pacifier
|
||||
(declare-function undo-tree-undo-1 "ext:undo-tree.el")
|
||||
(declare-function undo-tree-redo-1 "ext:undo-tree.el")
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;; Centaur-Tabs source code ;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgroup centaur-tabs nil
|
||||
|
|
@ -66,15 +71,17 @@
|
|||
|
||||
(defvar centaur-tabs--buffer-show-groups nil)
|
||||
|
||||
;;; Minor modes
|
||||
;;
|
||||
;;; Minor modes
|
||||
|
||||
(defsubst centaur-tabs-mode-on-p ()
|
||||
"Return non-nil if Centaur-Tabs mode is on."
|
||||
(eq (default-value centaur-tabs-display-line-format)
|
||||
centaur-tabs-header-line-format))
|
||||
|
||||
;;; Centaur-Tabs-Local mode
|
||||
;;
|
||||
;;; Centaur-Tabs-Local mode
|
||||
|
||||
(defvar centaur-tabs--local-hlf nil)
|
||||
|
||||
;;;###autoload
|
||||
|
|
@ -93,24 +100,24 @@ hidden, it is shown again. Signal an error if Centaur-Tabs mode is off."
|
|||
;;; ON
|
||||
(if centaur-tabs-local-mode
|
||||
(if (and (local-variable-p centaur-tabs-display-line-format)
|
||||
(eval centaur-tabs-display-line-format))
|
||||
;; A local header line exists, hide it to show the tab bar.
|
||||
(progn
|
||||
;; Fail in case of an inconsistency because another local
|
||||
;; header line is already hidden.
|
||||
(when (local-variable-p 'centaur-tabs--local-hlf)
|
||||
(error "Another local header line is already hidden"))
|
||||
(set (make-local-variable 'centaur-tabs--local-hlf)
|
||||
(eval centaur-tabs-display-line-format))
|
||||
(kill-local-variable centaur-tabs-display-line-format))
|
||||
;; Otherwise hide the tab bar in this buffer.
|
||||
(set centaur-tabs-display-line-format nil))
|
||||
(eval centaur-tabs-display-line-format))
|
||||
;; A local header line exists, hide it to show the tab bar.
|
||||
(progn
|
||||
;; Fail in case of an inconsistency because another local
|
||||
;; header line is already hidden.
|
||||
(when (local-variable-p 'centaur-tabs--local-hlf)
|
||||
(error "Another local header line is already hidden"))
|
||||
(set (make-local-variable 'centaur-tabs--local-hlf)
|
||||
(eval centaur-tabs-display-line-format))
|
||||
(kill-local-variable centaur-tabs-display-line-format))
|
||||
;; Otherwise hide the tab bar in this buffer.
|
||||
(set centaur-tabs-display-line-format nil))
|
||||
;;; OFF
|
||||
(if (local-variable-p 'centaur-tabs--local-hlf)
|
||||
;; A local header line is hidden, show it again.
|
||||
(progn
|
||||
(set centaur-tabs-display-line-format centaur-tabs--local-hlf)
|
||||
(kill-local-variable 'centaur-tabs--local-hlf))
|
||||
;; A local header line is hidden, show it again.
|
||||
(progn
|
||||
(set centaur-tabs-display-line-format centaur-tabs--local-hlf)
|
||||
(kill-local-variable 'centaur-tabs--local-hlf))
|
||||
;; The tab bar is locally hidden, show it again.
|
||||
(kill-local-variable centaur-tabs-display-line-format))))
|
||||
|
||||
|
|
@ -132,87 +139,92 @@ Returns non-nil if the new state is enabled.
|
|||
(if centaur-tabs-mode
|
||||
;;; ON
|
||||
(unless (centaur-tabs-mode-on-p)
|
||||
;; Save current default value of `centaur-tabs-display-line-format'.
|
||||
(setq centaur-tabs--global-hlf (default-value centaur-tabs-display-line-format))
|
||||
(centaur-tabs-init-tabsets-store)
|
||||
(set-default centaur-tabs-display-line-format centaur-tabs-header-line-format))
|
||||
;; Save current default value of `centaur-tabs-display-line-format'.
|
||||
(setq centaur-tabs--global-hlf (default-value centaur-tabs-display-line-format))
|
||||
(centaur-tabs-init-tabsets-store)
|
||||
(set-default centaur-tabs-display-line-format centaur-tabs-header-line-format))
|
||||
;;; OFF
|
||||
(when (centaur-tabs-mode-on-p)
|
||||
;; Turn off Centaur-Tabs-Local mode globally.
|
||||
(mapc #'(lambda (b)
|
||||
(condition-case nil
|
||||
(with-current-buffer b
|
||||
(and centaur-tabs-local-mode
|
||||
(centaur-tabs-local-mode -1)))
|
||||
(error nil)))
|
||||
(buffer-list))
|
||||
(condition-case nil
|
||||
(with-current-buffer b
|
||||
(and centaur-tabs-local-mode
|
||||
(centaur-tabs-local-mode -1)))
|
||||
(error nil)))
|
||||
(buffer-list))
|
||||
;; Restore previous `centaur-tabs-display-line-format'.
|
||||
(set-default centaur-tabs-display-line-format centaur-tabs--global-hlf)
|
||||
(centaur-tabs-free-tabsets-store))
|
||||
))
|
||||
(centaur-tabs-free-tabsets-store)))
|
||||
;; Make sure it refresh every windows!
|
||||
(force-window-update))
|
||||
|
||||
;;; Tab bar buffer setup
|
||||
;;
|
||||
;;; Tab bar buffer setup
|
||||
|
||||
(defun centaur-tabs-buffer-init ()
|
||||
"Initialize tab bar buffer data.
|
||||
Run as `centaur-tabs-init-hook'."
|
||||
(setq centaur-tabs--buffers nil
|
||||
centaur-tabs-current-tabset-function 'centaur-tabs-buffer-tabs
|
||||
centaur-tabs-tab-label-function 'centaur-tabs-buffer-tab-label
|
||||
centaur-tabs-select-tab-function 'centaur-tabs-buffer-select-tab
|
||||
)
|
||||
centaur-tabs-current-tabset-function 'centaur-tabs-buffer-tabs
|
||||
centaur-tabs-tab-label-function 'centaur-tabs-buffer-tab-label
|
||||
centaur-tabs-select-tab-function 'centaur-tabs-buffer-select-tab)
|
||||
;; If set, initialize selected overline
|
||||
(when (eq centaur-tabs-set-bar 'under)
|
||||
(set-face-attribute 'centaur-tabs-selected nil
|
||||
:underline (face-background 'centaur-tabs-active-bar-face nil 'default)
|
||||
:overline nil)
|
||||
:underline (face-background 'centaur-tabs-active-bar-face nil 'default)
|
||||
:overline nil)
|
||||
(set-face-attribute 'centaur-tabs-selected-modified nil
|
||||
:underline (face-background 'centaur-tabs-active-bar-face nil 'default)
|
||||
:overline nil)
|
||||
:underline (face-background 'centaur-tabs-active-bar-face nil 'default)
|
||||
:overline nil)
|
||||
(set-face-attribute 'centaur-tabs-unselected nil
|
||||
:underline nil
|
||||
:overline nil)
|
||||
:underline nil
|
||||
:overline nil)
|
||||
(set-face-attribute 'centaur-tabs-unselected-modified nil
|
||||
:underline nil
|
||||
:overline nil))
|
||||
:underline nil
|
||||
:overline nil))
|
||||
(when (eq centaur-tabs-set-bar 'over)
|
||||
(set-face-attribute 'centaur-tabs-selected nil
|
||||
:overline (face-background 'centaur-tabs-active-bar-face nil 'default)
|
||||
:underline nil)
|
||||
:overline (face-background 'centaur-tabs-active-bar-face nil 'default)
|
||||
:underline nil)
|
||||
(set-face-attribute 'centaur-tabs-selected-modified nil
|
||||
:overline (face-background 'centaur-tabs-active-bar-face nil 'default)
|
||||
:underline nil)
|
||||
:overline (face-background 'centaur-tabs-active-bar-face nil 'default)
|
||||
:underline nil)
|
||||
(set-face-attribute 'centaur-tabs-unselected nil
|
||||
:overline nil
|
||||
:underline nil)
|
||||
:overline nil
|
||||
:underline nil)
|
||||
(set-face-attribute 'centaur-tabs-unselected-modified nil
|
||||
:overline nil
|
||||
:underline nil))
|
||||
:overline nil
|
||||
:underline nil))
|
||||
(add-function :after after-focus-change-function #'centaur-tabs-after-focus)
|
||||
(add-hook 'window-buffer-change-functions #'centaur-tabs-on-window-buffer-change)
|
||||
(add-hook 'after-save-hook #'centaur-tabs-on-saving-buffer)
|
||||
(add-hook 'first-change-hook #'centaur-tabs-on-modifying-buffer)
|
||||
(add-hook 'kill-buffer-hook #'centaur-tabs-buffer-track-killed)
|
||||
(advice-add #'undo :after #'centaur-tabs-after-modifying-buffer)
|
||||
(advice-add #'undo-tree-undo-1 :after #'centaur-tabs-after-modifying-buffer)
|
||||
(advice-add #'undo-tree-redo-1 :after #'centaur-tabs-after-modifying-buffer))
|
||||
(advice-add #'undo :after #'centaur-tabs-on-modifying-buffer)
|
||||
(advice-add #'undo-tree-undo-1 :after #'centaur-tabs-on-modifying-buffer)
|
||||
(advice-add #'undo-tree-redo-1 :after #'centaur-tabs-on-modifying-buffer)
|
||||
(advice-add 'load-theme :after #'centaur-tabs--after-load-theme))
|
||||
|
||||
(defun centaur-tabs-buffer-quit ()
|
||||
"Quit tab bar buffer.
|
||||
Run as `centaur-tabs-quit-hook'."
|
||||
(setq centaur-tabs--buffers nil
|
||||
centaur-tabs-current-tabset-function nil
|
||||
centaur-tabs-tab-label-function nil
|
||||
centaur-tabs-select-tab-function nil
|
||||
)
|
||||
(remove-hook 'after-save-hook 'centaur-tabs-after-modifying-buffer)
|
||||
centaur-tabs-current-tabset-function nil
|
||||
centaur-tabs-tab-label-function nil
|
||||
centaur-tabs-select-tab-function nil)
|
||||
(remove-function after-focus-change-function #'centaur-tabs-after-focus)
|
||||
(remove-hook 'window-buffer-change-functions #'centaur-tabs-on-window-buffer-change)
|
||||
(remove-hook 'after-save-hook 'centaur-tabs-on-modifying-buffer)
|
||||
(remove-hook 'first-change-hook 'centaur-tabs-on-modifying-buffer)
|
||||
(remove-hook 'kill-buffer-hook 'centaur-tabs-buffer-track-killed)
|
||||
(advice-remove #'undo #'centaur-tabs-after-modifying-buffer)
|
||||
(advice-remove #'undo-tree-undo-1 #'centaur-tabs-after-modifying-buffer)
|
||||
(advice-remove #'undo-tree-redo-1 #'centaur-tabs-after-modifying-buffer))
|
||||
(advice-remove #'undo #'centaur-tabs-on-modifying-buffer)
|
||||
(advice-remove #'undo-tree-undo-1 #'centaur-tabs-on-modifying-buffer)
|
||||
(advice-remove #'undo-tree-redo-1 #'centaur-tabs-on-modifying-buffer)
|
||||
(advice-remove 'load-theme #'centaur-tabs--after-load-theme))
|
||||
|
||||
(add-hook 'centaur-tabs-init-hook #'centaur-tabs-buffer-init)
|
||||
(add-hook 'centaur-tabs-quit-hook #'centaur-tabs-buffer-quit)
|
||||
|
||||
(provide 'centaur-tabs)
|
||||
|
||||
;;; centaur-tabs.el ends here
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
(define-package "dash" "20240103.1301" "A modern list library for Emacs"
|
||||
(define-package "dash" "20240510.1327" "A modern list library for Emacs"
|
||||
'((emacs "24"))
|
||||
:commit "e32a70ca636bad42232b6c79f1491dc86802a721" :authors
|
||||
:commit "1de9dcb83eacfb162b6d9a118a4770b1281bcd84" :authors
|
||||
'(("Magnar Sveen" . "magnars@gmail.com"))
|
||||
:maintainers
|
||||
'(("Magnar Sveen" . "magnars@gmail.com"))
|
||||
|
|
@ -2108,7 +2108,7 @@ last item in second form, etc."
|
|||
|
||||
Insert X at the position signified by the symbol `it' in the first
|
||||
form. If there are more forms, insert the first form at the position
|
||||
signified by `it' in in second form, etc."
|
||||
signified by `it' in the second form, etc."
|
||||
(declare (debug (form body)))
|
||||
`(-as-> ,x it ,@forms))
|
||||
|
||||
|
|
@ -3298,6 +3298,8 @@ Return the sorted list. LIST is NOT modified by side effects.
|
|||
COMPARATOR is called with two elements of LIST, and should return non-nil
|
||||
if the first element should sort before the second."
|
||||
(declare (important-return-value t))
|
||||
;; Not yet worth changing to (sort list :lessp comparator);
|
||||
;; still seems as fast or slightly faster.
|
||||
(sort (copy-sequence list) comparator))
|
||||
|
||||
(defmacro --sort (form list)
|
||||
|
|
@ -1,4 +1,4 @@
|
|||
This is dash.info, produced by makeinfo version 6.7 from dash.texi.
|
||||
This is dash.info, produced by makeinfo version 6.8 from dash.texi.
|
||||
|
||||
This manual is for Dash version 2.19.1.
|
||||
|
||||
|
|
@ -2427,7 +2427,7 @@ readability.
|
|||
|
||||
Insert X at the position signified by the symbol ‘it’ in the first
|
||||
form. If there are more forms, insert the first form at the
|
||||
position signified by ‘it’ in in second form, etc.
|
||||
position signified by ‘it’ in the second form, etc.
|
||||
|
||||
(--> "def" (concat "abc" it "ghi"))
|
||||
⇒ "abcdefghi"
|
||||
|
|
@ -4892,53 +4892,53 @@ Node: Threading macros84441
|
|||
Ref: ->84666
|
||||
Ref: ->>85154
|
||||
Ref: -->85657
|
||||
Ref: -as->86213
|
||||
Ref: -some->86667
|
||||
Ref: -some->>87052
|
||||
Ref: -some-->87499
|
||||
Ref: -doto88066
|
||||
Node: Binding88619
|
||||
Ref: -when-let88826
|
||||
Ref: -when-let*89287
|
||||
Ref: -if-let89816
|
||||
Ref: -if-let*90182
|
||||
Ref: -let90805
|
||||
Ref: -let*96895
|
||||
Ref: -lambda97832
|
||||
Ref: -setq98638
|
||||
Node: Side effects99439
|
||||
Ref: -each99633
|
||||
Ref: -each-while100160
|
||||
Ref: -each-indexed100780
|
||||
Ref: -each-r101372
|
||||
Ref: -each-r-while101814
|
||||
Ref: -dotimes102458
|
||||
Node: Destructive operations103011
|
||||
Ref: !cons103229
|
||||
Ref: !cdr103433
|
||||
Node: Function combinators103626
|
||||
Ref: -partial103830
|
||||
Ref: -rpartial104348
|
||||
Ref: -juxt104996
|
||||
Ref: -compose105448
|
||||
Ref: -applify106055
|
||||
Ref: -on106485
|
||||
Ref: -flip107257
|
||||
Ref: -rotate-args107781
|
||||
Ref: -const108410
|
||||
Ref: -cut108752
|
||||
Ref: -not109232
|
||||
Ref: -orfn109776
|
||||
Ref: -andfn110569
|
||||
Ref: -iteratefn111356
|
||||
Ref: -fixfn112058
|
||||
Ref: -prodfn113632
|
||||
Node: Development114783
|
||||
Node: Contribute115072
|
||||
Node: Contributors116084
|
||||
Node: FDL118177
|
||||
Node: GPL143497
|
||||
Node: Index181246
|
||||
Ref: -as->86214
|
||||
Ref: -some->86668
|
||||
Ref: -some->>87053
|
||||
Ref: -some-->87500
|
||||
Ref: -doto88067
|
||||
Node: Binding88620
|
||||
Ref: -when-let88827
|
||||
Ref: -when-let*89288
|
||||
Ref: -if-let89817
|
||||
Ref: -if-let*90183
|
||||
Ref: -let90806
|
||||
Ref: -let*96896
|
||||
Ref: -lambda97833
|
||||
Ref: -setq98639
|
||||
Node: Side effects99440
|
||||
Ref: -each99634
|
||||
Ref: -each-while100161
|
||||
Ref: -each-indexed100781
|
||||
Ref: -each-r101373
|
||||
Ref: -each-r-while101815
|
||||
Ref: -dotimes102459
|
||||
Node: Destructive operations103012
|
||||
Ref: !cons103230
|
||||
Ref: !cdr103434
|
||||
Node: Function combinators103627
|
||||
Ref: -partial103831
|
||||
Ref: -rpartial104349
|
||||
Ref: -juxt104997
|
||||
Ref: -compose105449
|
||||
Ref: -applify106056
|
||||
Ref: -on106486
|
||||
Ref: -flip107258
|
||||
Ref: -rotate-args107782
|
||||
Ref: -const108411
|
||||
Ref: -cut108753
|
||||
Ref: -not109233
|
||||
Ref: -orfn109777
|
||||
Ref: -andfn110570
|
||||
Ref: -iteratefn111357
|
||||
Ref: -fixfn112059
|
||||
Ref: -prodfn113633
|
||||
Node: Development114784
|
||||
Node: Contribute115073
|
||||
Node: Contributors116085
|
||||
Node: FDL118178
|
||||
Node: GPL143498
|
||||
Node: Index181247
|
||||
|
||||
End Tag Table
|
||||
|
||||
|
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"))
|
||||
:commit "e34ce1b4730fb88a33a571b9065114b7a77645f0" :authors
|
||||
:commit "3852301f9c6f3104d9cc98389612b5ef3452a7de" :authors
|
||||
'(("Rakan Al-Hneiti" . "rakan.alhneiti@gmail.com"))
|
||||
:maintainers
|
||||
'(("Jesús Martínez" . "jesusmartinez93@gmail.com"))
|
||||
'(("Jesús Martínez" . "jesusmartinez93@gmail.com")
|
||||
("Jen-Chieh" . "jcs090218@gmail.com"))
|
||||
:maintainer
|
||||
'("Jesús Martínez" . "jesusmartinez93@gmail.com")
|
||||
:keywords
|
||||
|
|
@ -70,15 +70,6 @@
|
|||
(declare-function string-pixel-width "subr-x.el") ; TODO: remove this after 29.1
|
||||
(declare-function shr-string-pixel-width "shr.el") ; TODO: remove this after 29.1
|
||||
|
||||
(make-obsolete-variable 'dashboard-set-navigator
|
||||
'dashboard-startupify-list "1.9.0")
|
||||
|
||||
(make-obsolete-variable 'dashboard-set-init-info
|
||||
'dashboard-startupify-list "1.9.0")
|
||||
|
||||
(make-obsolete-variable 'dashboard-set-footer
|
||||
'dashboard-startupify-list "1.9.0")
|
||||
|
||||
(defvar recentf-list nil)
|
||||
|
||||
(defvar dashboard-buffer-name)
|
||||
|
|
@ -133,6 +124,27 @@ See `create-image' and Info node `(elisp)Image Descriptors'."
|
|||
:type 'boolean
|
||||
:group 'dashboard)
|
||||
|
||||
(defcustom dashboard-set-navigator nil
|
||||
"When non nil, a navigator will be displayed under the banner."
|
||||
:type 'boolean
|
||||
:group 'dashboard)
|
||||
(make-obsolete-variable 'dashboard-set-navigator
|
||||
'dashboard-startupify-list "1.9.0")
|
||||
|
||||
(defcustom dashboard-set-init-info t
|
||||
"When non nil, init info will be displayed under the banner."
|
||||
:type 'boolean
|
||||
:group 'dashboard)
|
||||
(make-obsolete-variable 'dashboard-set-init-info
|
||||
'dashboard-startupify-list "1.9.0")
|
||||
|
||||
(defcustom dashboard-set-footer t
|
||||
"When non nil, a footer will be displayed at the bottom."
|
||||
:type 'boolean
|
||||
:group 'dashboard)
|
||||
(make-obsolete-variable 'dashboard-set-footer
|
||||
'dashboard-startupify-list "1.9.0")
|
||||
|
||||
(defcustom dashboard-footer-messages
|
||||
'("The one true editor, Emacs!"
|
||||
"Who the hell uses VIM anyway? Go Evil!"
|
||||
|
|
@ -181,7 +193,7 @@ The value can be one of: `all-the-icons', `nerd-icons'."
|
|||
Will be of the form `(list-type . icon-name-string)`.
|
||||
If nil it is disabled. Possible values for list-type are:
|
||||
`recents' `bookmarks' `projects' `agenda' `registers'"
|
||||
:type '(repeat (alist :key-type symbol :value-type string))
|
||||
:type '(alist :key-type symbol :value-type string)
|
||||
:group 'dashboard)
|
||||
|
||||
(defcustom dashboard-heading-icon-height 1.2
|
||||
|
|
@ -245,7 +257,16 @@ The format is: `icon title help action face prefix suffix`.
|
|||
Example:
|
||||
`((\"☆\" \"Star\" \"Show stars\" (lambda (&rest _)
|
||||
(show-stars)) warning \"[\" \"]\"))"
|
||||
:type '(repeat (repeat (list string string string function symbol string string)))
|
||||
:type '(repeat (repeat (list string
|
||||
string
|
||||
string
|
||||
function
|
||||
(choice face
|
||||
(repeat :tag "Anonymous face" sexp))
|
||||
(choice string
|
||||
(const nil))
|
||||
(choice string
|
||||
(const nil)))))
|
||||
:group 'dashboard)
|
||||
|
||||
(defcustom dashboard-init-info
|
||||
|
|
@ -335,8 +356,10 @@ ARGS should be a plist containing `:height', `:v-adjust', or `:face' properties.
|
|||
:v-adjust -0.05
|
||||
:face 'dashboard-footer-icon-face)))
|
||||
(propertize ">" 'face 'dashboard-footer-icon-face))
|
||||
"Footer's icon."
|
||||
:type 'string
|
||||
"Footer's icon.
|
||||
It can be a string or a string list for display random icons."
|
||||
:type '(choice string
|
||||
(repeat string))
|
||||
:group 'dashboard)
|
||||
|
||||
(defcustom dashboard-heading-shorcut-format " (%s)"
|
||||
|
|
@ -411,7 +434,9 @@ installed."
|
|||
Will be of the form `(list-type . list-size)'.
|
||||
If nil it is disabled. Possible values for list-type are:
|
||||
`recents' `bookmarks' `projects' `agenda' `registers'."
|
||||
:type '(repeat (alist :key-type symbol :value-type integer))
|
||||
:type '(repeat (choice
|
||||
symbol
|
||||
(cons symbol integer)))
|
||||
:group 'dashboard)
|
||||
|
||||
(defcustom dashboard-item-shortcuts
|
||||
|
|
@ -423,8 +448,8 @@ If nil it is disabled. Possible values for list-type are:
|
|||
"Association list of items and their corresponding shortcuts.
|
||||
Will be of the form `(list-type . keys)' as understood by `(kbd keys)'.
|
||||
If nil, shortcuts are disabled. If an entry's value is nil, that item's
|
||||
shortcut is disbaled. See `dashboard-items' for possible values of list-type.'"
|
||||
:type '(repeat (alist :key-type symbol :value-type string))
|
||||
shortcut is disabled. See `dashboard-items' for possible values of list-type.'"
|
||||
:type '(alist :key-type symbol :value-type string)
|
||||
:group 'dashboard)
|
||||
|
||||
(defcustom dashboard-item-names nil
|
||||
|
|
@ -574,7 +599,8 @@ Optionally, provide NO-NEXT-LINE to move the cursor forward a line."
|
|||
`(progn
|
||||
(eval-when-compile (defvar dashboard-mode-map))
|
||||
(defun ,sym nil
|
||||
,(concat "Jump to " name ". This code is dynamically generated in `dashboard-insert-shortcut'.")
|
||||
,(concat "Jump to " name ".
|
||||
This code is dynamically generated in `dashboard-insert-shortcut'.")
|
||||
(interactive)
|
||||
(unless (search-forward ,search-label (point-max) t)
|
||||
(search-backward ,search-label (point-min) t))
|
||||
|
|
@ -599,9 +625,12 @@ If MESSAGEBUF is not nil then MSG is also written in message buffer."
|
|||
"Insert a page break line in dashboard buffer."
|
||||
(dashboard-append dashboard-page-separator))
|
||||
|
||||
(defun dashboard-insert-newline (&optional n)
|
||||
"Insert N times of newlines."
|
||||
(dotimes (_ (or n 1))
|
||||
(defun dashboard-insert-newline (&optional times)
|
||||
"When called without an argument, insert a newline.
|
||||
When called with TIMES return a function that insert TIMES number of newlines."
|
||||
(if times
|
||||
(lambda ()
|
||||
(insert (make-string times (string-to-char "\n") t)))
|
||||
(insert "\n")))
|
||||
|
||||
(defun dashboard-insert-heading (heading &optional shortcut icon)
|
||||
|
|
@ -715,7 +744,9 @@ If MESSAGEBUF is not nil then MSG is also written in message buffer."
|
|||
(list :text (dashboard-get-banner-path 1)))))
|
||||
((and
|
||||
(pred listp)
|
||||
(pred (lambda (c) (not (proper-list-p c))))
|
||||
(pred (lambda (c)
|
||||
(and (not (proper-list-p c))
|
||||
(not (null c)))))
|
||||
`(,img . ,txt))
|
||||
(list :image (if (dashboard--image-supported-p img)
|
||||
img
|
||||
|
|
@ -725,12 +756,16 @@ If MESSAGEBUF is not nil then MSG is also written in message buffer."
|
|||
txt
|
||||
(message "could not find banner %s, use default instead" txt)
|
||||
(dashboard-get-banner-path 1))))
|
||||
((pred proper-list-p)
|
||||
((and
|
||||
(pred proper-list-p)
|
||||
(pred (lambda (l) (not (null l)))))
|
||||
|
||||
(let* ((max (length banner))
|
||||
(choose (nth (random max) banner)))
|
||||
(dashboard-choose-banner choose)))
|
||||
(_
|
||||
(message "unsupported banner config %s" banner))))
|
||||
(user-error "Unsupported banner type: `%s'" banner)
|
||||
nil)))
|
||||
|
||||
(defun dashboard--image-animated-p (image-path)
|
||||
"Return if image is a gif or webp.
|
||||
|
|
@ -850,7 +885,8 @@ Argument IMAGE-PATH path to the image."
|
|||
(when (and icon title
|
||||
(not (string-equal icon ""))
|
||||
(not (string-equal title "")))
|
||||
(propertize " " 'face 'variable-pitch))
|
||||
(propertize " " 'face `(:inherit (variable-pitch
|
||||
,face))))
|
||||
(when title (propertize title 'face face)))
|
||||
:help-echo help
|
||||
:action action
|
||||
|
|
@ -872,7 +908,10 @@ ACTION is theaction taken when the user activates the widget button.
|
|||
WIDGET-PARAMS are passed to the \"widget-create\" function."
|
||||
`(progn
|
||||
(dashboard-insert-heading ,section-name
|
||||
(if (and ,list ,shortcut-char dashboard-show-shortcuts) ,shortcut-char))
|
||||
(when (and ,list
|
||||
,shortcut-char
|
||||
dashboard-show-shortcuts)
|
||||
,shortcut-char))
|
||||
(if ,list
|
||||
(when (and (dashboard-insert-section-list
|
||||
,section-name
|
||||
|
|
@ -928,10 +967,19 @@ to widget creation."
|
|||
"Return a random footer from `dashboard-footer-messages'."
|
||||
(nth (random (length dashboard-footer-messages)) dashboard-footer-messages))
|
||||
|
||||
(defun dashboard-footer-icon ()
|
||||
"Return footer icon or a random icon if `dashboard-footer-messages' is a list."
|
||||
(if (and (not (null dashboard-footer-icon))
|
||||
(listp dashboard-footer-icon))
|
||||
(dashboard-replace-displayable
|
||||
(nth (random (length dashboard-footer-icon))
|
||||
dashboard-footer-icon))
|
||||
(dashboard-replace-displayable dashboard-footer-icon)))
|
||||
|
||||
(defun dashboard-insert-footer ()
|
||||
"Insert footer of dashboard."
|
||||
(when-let ((footer (dashboard-random-footer))
|
||||
(footer-icon (dashboard-replace-displayable dashboard-footer-icon)))
|
||||
(footer-icon (dashboard-footer-icon)))
|
||||
(dashboard-insert-center
|
||||
(if (string-empty-p footer-icon) footer-icon
|
||||
(concat footer-icon " "))
|
||||
|
|
@ -1340,7 +1388,9 @@ Any custom function would receives the tags from `org-get-tags'"
|
|||
|
||||
(defun dashboard-agenda-entry-format ()
|
||||
"Format agenda entry to show it on dashboard.
|
||||
Also,it set text properties that latter are used to sort entries and perform different actions."
|
||||
|
||||
Also,it set text properties that latter are used to sort entries and perform
|
||||
different actions."
|
||||
(let* ((scheduled-time (org-get-scheduled-time (point)))
|
||||
(deadline-time (org-get-deadline-time (point)))
|
||||
(entry-timestamp (dashboard-agenda--entry-timestamp (point)))
|
||||
|
|
@ -132,7 +132,7 @@
|
|||
dashboard-insert-items
|
||||
dashboard-insert-newline
|
||||
dashboard-insert-footer)
|
||||
"List of dashboard widgets (in order) to insert in dashboard buffer.
|
||||
"List of dashboard widgets (in order) to insert in dashboard buffer.
|
||||
Avalaible functions:
|
||||
`dashboard-insert-newline'
|
||||
`dashboard-insert-page-break'
|
||||
|
|
@ -143,10 +143,15 @@ Avalaible functions:
|
|||
`dashboard-insert-items'
|
||||
`dashboard-insert-footer'
|
||||
|
||||
You can also add your custom function or a lambda to the list.
|
||||
It must be a function or a cons cell where specify function and
|
||||
its arg.
|
||||
|
||||
Also you can add your custom function or a lambda to the list.
|
||||
example:
|
||||
(lambda () (delete-char -1))"
|
||||
:type '(repeat function)
|
||||
:type '(repeat (choice
|
||||
function
|
||||
(cons function sexp)))
|
||||
:group 'dashboard)
|
||||
|
||||
(defcustom dashboard-navigation-cycle nil
|
||||
|
|
@ -154,8 +159,10 @@ example:
|
|||
:type 'boolean
|
||||
:group 'dashboard)
|
||||
|
||||
(defconst dashboard-buffer-name "*dashboard*"
|
||||
"Dashboard's buffer name.")
|
||||
(defcustom dashboard-buffer-name "*dashboard*"
|
||||
"Dashboard's buffer name."
|
||||
:type 'string
|
||||
:group 'dashboard)
|
||||
|
||||
(defvar dashboard-force-refresh nil
|
||||
"If non-nil, force refresh dashboard buffer.")
|
||||
|
|
@ -191,16 +198,16 @@ example:
|
|||
(save-excursion
|
||||
(if-let* ((sep (dashboard--separator))
|
||||
((and (search-backward sep nil t)
|
||||
(search-forward sep nil t))))
|
||||
(let ((ln (thing-at-point 'line)))
|
||||
(cond ((string-match-p "Recent Files:" ln) 'recents)
|
||||
((string-match-p "Bookmarks:" ln) 'bookmarks)
|
||||
((string-match-p "Projects:" ln) 'projects)
|
||||
((string-match-p "Agenda for " ln) 'agenda)
|
||||
((string-match-p "Registers:" ln) 'registers)
|
||||
((string-match-p "List Directories:" ln) 'ls-directories)
|
||||
((string-match-p "List Files:" ln) 'ls-files)
|
||||
(t (user-error "Unknown section from dashboard"))))
|
||||
(search-forward sep nil t)))
|
||||
(ln (thing-at-point 'line t)))
|
||||
(cond ((string-match-p "Recent Files:" ln) 'recents)
|
||||
((string-match-p "Bookmarks:" ln) 'bookmarks)
|
||||
((string-match-p "Projects:" ln) 'projects)
|
||||
((string-match-p "Agenda for " ln) 'agenda)
|
||||
((string-match-p "Registers:" ln) 'registers)
|
||||
((string-match-p "List Directories:" ln) 'ls-directories)
|
||||
((string-match-p "List Files:" ln) 'ls-files)
|
||||
(t (user-error "Unknown section from dashboard")))
|
||||
(user-error "Failed searching dashboard section"))))
|
||||
|
||||
;;
|
||||
|
|
@ -500,8 +507,11 @@ See `dashboard-item-generators' for all items available."
|
|||
(erase-buffer)
|
||||
(setq dashboard--section-starts nil)
|
||||
|
||||
(mapc (lambda (fn)
|
||||
(funcall fn))
|
||||
(mapc (lambda (entry)
|
||||
(if (and (listp entry)
|
||||
(not (functionp entry)))
|
||||
(apply (car entry) `(,(cdr entry)))
|
||||
(funcall entry)))
|
||||
dashboard-startupify-list)
|
||||
|
||||
(when dashboard-vertically-center-content
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
(define-package "devdocs" "20240301.1838" "Emacs viewer for DevDocs"
|
||||
(define-package "devdocs" "20240428.711" "Emacs viewer for DevDocs"
|
||||
'((emacs "27.1"))
|
||||
:commit "3424436f333955b39a0803ce9781aaffaae003f5" :authors
|
||||
:commit "c14d1306648d3ae09ee3a3b3f45592334943cfeb" :authors
|
||||
'(("Augusto Stoffel" . "arstoffel@gmail.com"))
|
||||
:maintainers
|
||||
'(("Augusto Stoffel" . "arstoffel@gmail.com"))
|
||||
|
|
@ -1,12 +1,12 @@
|
|||
;;; devdocs.el --- Emacs viewer for DevDocs -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2021 Free Software Foundation, Inc.
|
||||
;; Copyright (C) 2021-2024 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Augusto Stoffel <arstoffel@gmail.com>
|
||||
;; Keywords: help
|
||||
;; URL: https://github.com/astoff/devdocs.el
|
||||
;; Package-Requires: ((emacs "27.1"))
|
||||
;; Version: 0.5
|
||||
;; Version: 0.6.1
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
|
|
@ -82,7 +82,7 @@ name and a count."
|
|||
:type '(choice (const :tag "Count in parentheses, italicized"
|
||||
#("%s (%s)" 3 7 (face italic)))
|
||||
(const :tag "Invisible cookie"
|
||||
#("%s (%s)" 2 7 (invisible t)))
|
||||
#("%s#%s" 2 5 (invisible t)))
|
||||
string))
|
||||
|
||||
(defcustom devdocs-fontify-code-blocks t
|
||||
|
|
@ -94,6 +94,9 @@ Fontification is done using the `org-src' library, which see."
|
|||
"Whether to select the DevDocs window for viewing."
|
||||
:type 'boolean)
|
||||
|
||||
(defvar devdocs-extra-rendering-functions '()
|
||||
"Extra functions for `shr-external-rendering-functions'.")
|
||||
|
||||
(defface devdocs-code-block '((t nil))
|
||||
"Additional face to apply to code blocks in DevDocs buffers.")
|
||||
|
||||
|
|
@ -316,7 +319,10 @@ already installed, reinstall it."
|
|||
"Go to the original position in a DevDocs buffer."
|
||||
(interactive)
|
||||
(goto-char (point-min))
|
||||
(when-let ((pred (if (fboundp 'shr--set-target-ids) #'member t)) ;; shr change in Emacs 29
|
||||
(when-let ((frag (let-alist (car devdocs--stack)
|
||||
(or .fragment (devdocs--path-fragment .path))))
|
||||
(shr-target-id (url-unhex-string frag))
|
||||
(pred (if (fboundp 'shr--set-target-ids) #'member t)) ;; shr change in Emacs 29
|
||||
(match (text-property-search-forward 'shr-target-id shr-target-id pred)))
|
||||
(goto-char (prop-match-beginning match))))
|
||||
|
||||
|
|
@ -477,15 +483,18 @@ fragment part of ENTRY.path."
|
|||
(unless (eq major-mode 'devdocs-mode)
|
||||
(devdocs-mode))
|
||||
(let-alist entry
|
||||
(let ((inhibit-read-only t)
|
||||
(shr-external-rendering-functions `((pre . devdocs--shr-tag-pre)
|
||||
,@shr-external-rendering-functions))
|
||||
(file (expand-file-name (format "%s/%s.html"
|
||||
.doc.slug
|
||||
(url-hexify-string (devdocs--path-file .path)))
|
||||
devdocs-data-dir)))
|
||||
(let* ((inhibit-read-only t)
|
||||
(extra-rendering-functions (cdr (assoc
|
||||
(intern .doc.type)
|
||||
devdocs-extra-rendering-functions)))
|
||||
(shr-external-rendering-functions `((pre . devdocs--shr-tag-pre)
|
||||
,@extra-rendering-functions
|
||||
,@shr-external-rendering-functions))
|
||||
(file (expand-file-name (format "%s/%s.html"
|
||||
.doc.slug
|
||||
(url-hexify-string (devdocs--path-file .path)))
|
||||
devdocs-data-dir)))
|
||||
(erase-buffer)
|
||||
(setq-local shr-target-id (url-unhex-string (or .fragment (devdocs--path-fragment .path))))
|
||||
;; TODO: cl-progv here for shr settings?
|
||||
(shr-insert-document
|
||||
(with-temp-buffer
|
||||
|
|
@ -494,7 +503,9 @@ fragment part of ENTRY.path."
|
|||
(set-buffer-modified-p nil)
|
||||
(setq-local devdocs-current-docs (list .doc.slug))
|
||||
(push entry devdocs--stack)
|
||||
(setq-local list-buffers-directory (format-mode-line devdocs-header-line nil nil (current-buffer)))
|
||||
(setq-local list-buffers-directory (format-mode-line devdocs-header-line
|
||||
nil nil
|
||||
(current-buffer)))
|
||||
(devdocs-goto-target)
|
||||
(current-buffer))))
|
||||
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
(define-package "devdocs-browser" "20231231.1455" "Browse devdocs.io documents using EWW"
|
||||
(define-package "devdocs-browser" "20240511.306" "Browse devdocs.io documents using EWW"
|
||||
'((emacs "27.1"))
|
||||
:commit "afc460e687bec4eb947ab85d207778fc3b9b3bbc" :authors
|
||||
:commit "0655b89651458777354a3b89c1d486e0fda1928d" :authors
|
||||
'(("blahgeek" . "i@blahgeek.com"))
|
||||
:maintainers
|
||||
'(("blahgeek" . "i@blahgeek.com"))
|
||||
|
|
@ -32,6 +32,7 @@
|
|||
(require 'eww)
|
||||
(require 'eldoc)
|
||||
(require 'imenu)
|
||||
(require 'seq)
|
||||
|
||||
|
||||
(defgroup devdocs-browser nil
|
||||
|
|
@ -39,12 +40,40 @@
|
|||
:group 'tools
|
||||
:group 'web)
|
||||
|
||||
(defcustom devdocs-browser-cache-directory
|
||||
|
||||
;; Following are faces for <h1> to <h5> elements.
|
||||
;; We do not reuse `shr-h1' etc. face because:
|
||||
;; - they are only available since emacs 28
|
||||
;; - devdocs documents usually have lower level of headings (e.g. H2 and H3 is more common), so we want different rules as the general version
|
||||
|
||||
(defface devdocs-browser-h1
|
||||
'((t :height 1.3 :weight bold))
|
||||
"Face for <h1> elements for devdocs-browser.")
|
||||
|
||||
(defface devdocs-browser-h2
|
||||
'((t :height 1.2 :weight bold))
|
||||
"Face for <h2> elements for devdocs-browser.")
|
||||
|
||||
(defface devdocs-browser-h3
|
||||
'((t :height 1.1 :weight bold))
|
||||
"Face for <h3> elements for devdocs-browser.")
|
||||
|
||||
(defface devdocs-browser-h4
|
||||
'((t :weight bold))
|
||||
"Face for <h4> elements for devdocs-browser.")
|
||||
|
||||
(defface devdocs-browser-h5
|
||||
'((t :slant italic))
|
||||
"Face for <h5> elements for devdocs-browser.")
|
||||
|
||||
(defcustom devdocs-browser-data-directory
|
||||
(expand-file-name "devdocs-browser" user-emacs-directory)
|
||||
"Directory to store devdocs cache files."
|
||||
"Directory to store devdocs data files."
|
||||
:type 'directory
|
||||
:group 'devdocs-browser)
|
||||
|
||||
(defalias 'devdocs-browser-cache-directory 'devdocs-browser-data-directory)
|
||||
|
||||
(defcustom devdocs-browser-base-url "https://devdocs.io/"
|
||||
"Base URL to fetch json metadata files."
|
||||
:type 'string)
|
||||
|
|
@ -160,37 +189,20 @@ See https://prismjs.com/ for list of language names."
|
|||
(insert (devdocs-browser--eww-fontify-pre dom))
|
||||
(shr-ensure-newline)))
|
||||
|
||||
(defun devdocs-browser--eww-tag-maybe-set-title (dom)
|
||||
"Maybe set DOM as title if it's not set yet."
|
||||
(when (zerop (length (plist-get eww-data :title)))
|
||||
(eww-tag-title dom)))
|
||||
(defun devdocs-browser--eww-tag-header (level dom)
|
||||
"Render function for header DOM with LEVEL (number)."
|
||||
;; use h1/h2/h3 as title if not set yet
|
||||
(when (and (<= level 3)
|
||||
(zerop (length (plist-get eww-data :title))))
|
||||
(eww-tag-title dom))
|
||||
|
||||
(defun devdocs-browser--eww-tag-h1 (dom)
|
||||
"Rendering function for h1 DOM. Maybe use it as title."
|
||||
(devdocs-browser--eww-tag-maybe-set-title dom)
|
||||
(shr-tag-h1 dom))
|
||||
|
||||
(defun devdocs-browser--eww-tag-h2 (dom)
|
||||
"Rendering function for h2 DOM. Maybe use it as title."
|
||||
(devdocs-browser--eww-tag-maybe-set-title dom)
|
||||
(shr-heading dom (if shr-use-fonts
|
||||
'(variable-pitch (:height 1.2 :weight bold))
|
||||
'bold)))
|
||||
|
||||
(defun devdocs-browser--eww-tag-h3 (dom)
|
||||
"Rendering function for h2 DOM. Maybe use it as title."
|
||||
(devdocs-browser--eww-tag-maybe-set-title dom)
|
||||
(shr-heading dom (if shr-use-fonts
|
||||
'(variable-pitch (:height 1.1 :weight bold))
|
||||
'bold)))
|
||||
|
||||
(defun devdocs-browser--eww-tag-h4 (dom)
|
||||
"Rendering function for h4 DOM."
|
||||
(shr-heading dom 'bold))
|
||||
|
||||
(defun devdocs-browser--eww-tag-h5 (dom)
|
||||
"Rendering function for h5 DOM."
|
||||
(shr-heading dom 'italic))
|
||||
;; similar to shr-heading
|
||||
(shr-ensure-paragraph)
|
||||
(let ((start (point)))
|
||||
(shr-fontize-dom dom (intern (concat "devdocs-browser-h" (number-to-string level))))
|
||||
;; this is new since emacs 30, to support outline function
|
||||
(put-text-property start (pos-eol) 'outline-level level))
|
||||
(shr-ensure-paragraph))
|
||||
|
||||
(defun devdocs-browser--eww-tag-generic-ensure-paragraph (dom)
|
||||
"Rendering function for generic DOM while ensuring paragraph."
|
||||
|
|
@ -284,7 +296,7 @@ Can be used as `imenu-create-index-function'."
|
|||
(path (plist-get entry :path))
|
||||
(url (url-generic-parse-url path))
|
||||
(target (url-target url))
|
||||
(_ (equal (url-filename url) (url-filename page-url))))
|
||||
((equal (url-filename url) (url-filename page-url))))
|
||||
(cons name (devdocs-browser--position-by-target target))))
|
||||
entries))))
|
||||
|
||||
|
|
@ -325,13 +337,12 @@ Can be used as `imenu-create-index-function'."
|
|||
(setq-local shr-external-rendering-functions
|
||||
(append shr-external-rendering-functions
|
||||
'((pre . devdocs-browser--eww-tag-pre)
|
||||
(h1 . devdocs-browser--eww-tag-h1)
|
||||
(h2 . devdocs-browser--eww-tag-h2)
|
||||
(h3 . devdocs-browser--eww-tag-h3)
|
||||
(h4 . devdocs-browser--eww-tag-h4)
|
||||
(h5 . devdocs-browser--eww-tag-h5)
|
||||
(summary . devdocs-browser--eww-tag-generic-ensure-paragraph)
|
||||
(section . devdocs-browser--eww-tag-generic-ensure-paragraph))))
|
||||
(section . devdocs-browser--eww-tag-generic-ensure-paragraph))
|
||||
(mapcar (lambda (level)
|
||||
(cons (intern (concat "h" (number-to-string level)))
|
||||
(apply-partially #'devdocs-browser--eww-tag-header level)))
|
||||
(number-sequence 1 5))))
|
||||
(setq-local imenu-create-index-function
|
||||
#'devdocs-browser--imenu-create-index)
|
||||
(when (boundp 'eww-auto-rename-buffer)
|
||||
|
|
@ -351,13 +362,12 @@ Can be used as `imenu-create-index-function'."
|
|||
(defun devdocs-browser--completing-read (prompt collection &optional def)
|
||||
"Helper function for `completing-read'.
|
||||
PROMPT: same meaning, but this function will append ';' at the end;
|
||||
COLLECTION: alist of (name . props), where props is a plist with
|
||||
COLLECTION: alist or hashtable of (name . props), where props is a plist with
|
||||
possibly the following keys: :value, :annotation, :group;
|
||||
if :group is not nil and name starts with '<group>: ', its removed.
|
||||
DEF: same meaning;"
|
||||
;; convert collection to hashtables for faster completion. `complete-with-action' also supports that.
|
||||
(setq collection (delq nil collection))
|
||||
(let* ((collection-ht (make-hash-table :test 'equal :size (length collection)))
|
||||
(let* (collection-ht
|
||||
(annotation-function
|
||||
(lambda (s)
|
||||
(let ((annotation (plist-get (gethash s collection-ht) :annotation)))
|
||||
|
|
@ -372,8 +382,13 @@ DEF: same meaning;"
|
|||
(replace-match "" t t s)
|
||||
s))
|
||||
(t group))))))
|
||||
(mapc (lambda (elem) (puthash (car elem) (cdr elem) collection-ht))
|
||||
collection)
|
||||
(if (hash-table-p collection)
|
||||
(setq collection-ht collection)
|
||||
(setq collection-ht (make-hash-table :test 'equal :size (length collection)))
|
||||
(mapc (lambda (elem)
|
||||
(when elem
|
||||
(puthash (car elem) (cdr elem) collection-ht)))
|
||||
collection))
|
||||
(setq prompt (concat prompt
|
||||
(when def
|
||||
(format " (default %s)" (funcall group-function def t)))
|
||||
|
|
@ -384,7 +399,7 @@ DEF: same meaning;"
|
|||
(if (eq action 'metadata)
|
||||
`(metadata . ((annotation-function . ,annotation-function)
|
||||
(group-function . ,group-function)))
|
||||
(complete-with-action action collection str pred)))
|
||||
(complete-with-action action collection-ht str pred)))
|
||||
nil t ;; require-match
|
||||
nil nil def)))
|
||||
(or (plist-get (gethash res collection-ht) :value)
|
||||
|
|
@ -396,7 +411,7 @@ DEF: same meaning;"
|
|||
|
||||
(defun devdocs-browser--read-json (file-path)
|
||||
"Read json file in FILE-PATH, if it's a relative path, find it in cache dir."
|
||||
(let ((filename (expand-file-name file-path devdocs-browser-cache-directory)))
|
||||
(let ((filename (expand-file-name file-path devdocs-browser-data-directory)))
|
||||
(when (file-exists-p filename)
|
||||
(with-temp-buffer
|
||||
(insert-file-contents filename)
|
||||
|
|
@ -405,7 +420,7 @@ DEF: same meaning;"
|
|||
(defun devdocs-browser--fetch-json (url-path file-path &optional base-url)
|
||||
"Fetch json from BASE-URL / URL-PATH, also save to FILE-PATH.
|
||||
BASE-URL defaults to `devdocs-browser-base-url'."
|
||||
(let ((cache-filename (expand-file-name file-path devdocs-browser-cache-directory)))
|
||||
(let ((cache-filename (expand-file-name file-path devdocs-browser-data-directory)))
|
||||
(unless (file-exists-p (file-name-directory cache-filename))
|
||||
(make-directory (file-name-directory cache-filename) t))
|
||||
(with-temp-file cache-filename
|
||||
|
|
@ -447,13 +462,18 @@ To upgrade docs content, see `devdocs-browser-upgrade-doc'."
|
|||
(equal (plist-get doc :name) slug-or-name)))
|
||||
docs-list)))
|
||||
|
||||
(defvar devdocs-browser--docs-cache '() "Cached doc indexes plist.")
|
||||
(defcustom devdocs-browser-enable-cache t
|
||||
"Whether cache doc indices in memory."
|
||||
:type 'boolean
|
||||
:group 'devdocs-browser)
|
||||
|
||||
(defvar devdocs-browser--docs-cache '() "Cached doc indices plist.")
|
||||
|
||||
(defun devdocs-browser--install-doc-internal (doc)
|
||||
"(Re-)install doc identified by plist DOC. Return t if success."
|
||||
(let* ((slug (plist-get doc :slug))
|
||||
(mtime (plist-get doc :mtime))
|
||||
(docs-dir (expand-file-name devdocs-browser--docs-dir devdocs-browser-cache-directory))
|
||||
(docs-dir (expand-file-name devdocs-browser--docs-dir devdocs-browser-data-directory))
|
||||
(doc-dir (expand-file-name slug docs-dir))
|
||||
success)
|
||||
(unless (file-exists-p docs-dir)
|
||||
|
|
@ -478,7 +498,7 @@ To upgrade docs content, see `devdocs-browser-upgrade-doc'."
|
|||
(message "Failed to install devdocs doc %s" slug))
|
||||
;; remove cache
|
||||
(setq devdocs-browser--docs-cache
|
||||
(lax-plist-put devdocs-browser--docs-cache slug nil))
|
||||
(plist-put devdocs-browser--docs-cache slug nil #'equal))
|
||||
success))
|
||||
|
||||
(defun devdocs-browser--doc-readable-name (doc)
|
||||
|
|
@ -528,12 +548,12 @@ When called interactively, user can choose from the list."
|
|||
(interactive (list (completing-read "Uninstall doc: "
|
||||
(devdocs-browser-list-installed-slugs)
|
||||
nil t)))
|
||||
(let* ((docs-dir (expand-file-name devdocs-browser--docs-dir devdocs-browser-cache-directory))
|
||||
(let* ((docs-dir (expand-file-name devdocs-browser--docs-dir devdocs-browser-data-directory))
|
||||
(doc-dir (expand-file-name slug docs-dir)))
|
||||
(when (file-exists-p doc-dir)
|
||||
(delete-directory doc-dir t)))
|
||||
(setq devdocs-browser--docs-cache
|
||||
(lax-plist-put devdocs-browser--docs-cache slug nil)))
|
||||
(plist-put devdocs-browser--docs-cache slug nil #'equal)))
|
||||
|
||||
(defun devdocs-browser--upgrade-readable-name (old-doc new-doc)
|
||||
"Get human readable name for upgrade from OLD-DOC to NEW-DOC."
|
||||
|
|
@ -602,7 +622,7 @@ You may need to call `devdocs-browser-update-docs' first."
|
|||
|
||||
(defun devdocs-browser-list-installed-slugs ()
|
||||
"Get a list of installed docs' slug name."
|
||||
(let ((dir (expand-file-name devdocs-browser--docs-dir devdocs-browser-cache-directory)))
|
||||
(let ((dir (expand-file-name devdocs-browser--docs-dir devdocs-browser-data-directory)))
|
||||
(when (file-exists-p dir)
|
||||
(directory-files dir nil
|
||||
;; ignore ".", ".." and hidden files
|
||||
|
|
@ -624,9 +644,9 @@ You may need to call `devdocs-browser-update-docs' first."
|
|||
(defun devdocs-browser--load-doc (slug &optional refresh-cache)
|
||||
"Load doc identified by SLUG, reload cache if REFRESH-CACHE is not nil.
|
||||
Result is a plist metadata, with an extra :index field at the beginning."
|
||||
(or (and (not refresh-cache) (lax-plist-get devdocs-browser--docs-cache slug))
|
||||
(or (and (not refresh-cache) (plist-get devdocs-browser--docs-cache slug #'equal))
|
||||
(let* ((docs-dir (expand-file-name devdocs-browser--docs-dir
|
||||
devdocs-browser-cache-directory))
|
||||
devdocs-browser-data-directory))
|
||||
(doc-dir (expand-file-name slug docs-dir))
|
||||
(metadata-filename (expand-file-name devdocs-browser--metadata-filename doc-dir))
|
||||
(metadata nil)
|
||||
|
|
@ -638,15 +658,16 @@ Result is a plist metadata, with an extra :index field at the beginning."
|
|||
(insert-file-contents metadata-filename)
|
||||
(setq metadata (read (current-buffer))))
|
||||
(setq res (append `(:index ,index) metadata))
|
||||
(setq devdocs-browser--docs-cache
|
||||
(lax-plist-put devdocs-browser--docs-cache slug res)))
|
||||
(when devdocs-browser-enable-cache
|
||||
(setq devdocs-browser--docs-cache
|
||||
(plist-put devdocs-browser--docs-cache slug res #'equal))))
|
||||
res)))
|
||||
|
||||
(defun devdocs-browser--download-offline-data-internal (doc)
|
||||
"(re-)Download and extract offline data for DOC."
|
||||
(let* ((slug (plist-get doc :slug))
|
||||
(mtime (plist-get doc :mtime))
|
||||
(docs-dir (expand-file-name devdocs-browser--docs-dir devdocs-browser-cache-directory))
|
||||
(docs-dir (expand-file-name devdocs-browser--docs-dir devdocs-browser-data-directory))
|
||||
(doc-dir (expand-file-name slug docs-dir))
|
||||
(data-dir (expand-file-name devdocs-browser--offline-data-dir-name doc-dir))
|
||||
success)
|
||||
|
|
@ -682,7 +703,7 @@ Result is a plist metadata, with an extra :index field at the beginning."
|
|||
|
||||
(defun devdocs-browser-offline-data-dir (slug)
|
||||
"Return doc SLUG's offline data dir if present, return nil otherwise."
|
||||
(let* ((docs-dir (expand-file-name devdocs-browser--docs-dir devdocs-browser-cache-directory))
|
||||
(let* ((docs-dir (expand-file-name devdocs-browser--docs-dir devdocs-browser-data-directory))
|
||||
(doc-dir (expand-file-name slug docs-dir))
|
||||
(data-dir (expand-file-name devdocs-browser--offline-data-dir-name doc-dir)))
|
||||
(when (file-exists-p data-dir)
|
||||
|
|
@ -778,7 +799,8 @@ When called interactively, user can choose from the list."
|
|||
(let ((current-word-regex
|
||||
(when-let ((word (thing-at-point 'word t)))
|
||||
(concat "\\<" (regexp-quote word) "\\>")))
|
||||
slugs rows def)
|
||||
(rows (make-hash-table :test 'equal))
|
||||
slugs def)
|
||||
(dolist (slug-or-name slug-or-name-list)
|
||||
(when-let* ((doc-simple (devdocs-browser-find-installed-doc slug-or-name))
|
||||
(slug (plist-get doc-simple :slug))
|
||||
|
|
@ -786,25 +808,22 @@ When called interactively, user can choose from the list."
|
|||
(index (plist-get doc :index))
|
||||
(entries (plist-get index :entries)))
|
||||
(setq slugs (push slug slugs))
|
||||
(let ((new-rows
|
||||
(mapcar
|
||||
(lambda (entry)
|
||||
(let* ((name (plist-get entry :name))
|
||||
(path (plist-get entry :path))
|
||||
(type (plist-get entry :type))
|
||||
(title (concat slug ": " name)))
|
||||
(when (and (null def) current-word-regex)
|
||||
(when (string-match-p current-word-regex name)
|
||||
(setq def title)))
|
||||
(cons title `(:value (,doc ,path)
|
||||
:group ,slug
|
||||
:annotation ,type))))
|
||||
entries)))
|
||||
(setq rows (append new-rows rows))
|
||||
(push (cons (format "%s: INDEX PAGE" slug)
|
||||
`(:value (,doc "index")
|
||||
:group ,slug))
|
||||
rows))))
|
||||
(puthash (format "%s: INDEX PAGE" slug)
|
||||
`(:value (,doc "index")
|
||||
:group ,slug)
|
||||
rows)
|
||||
(seq-doseq (entry entries)
|
||||
(let* ((name (plist-get entry :name))
|
||||
(path (plist-get entry :path))
|
||||
(type (plist-get entry :type))
|
||||
(title (concat slug ": " name)))
|
||||
(when (and (null def) current-word-regex)
|
||||
(when (string-match-p current-word-regex name)
|
||||
(setq def title)))
|
||||
(puthash title `(:value (,doc ,path)
|
||||
:group ,slug
|
||||
:annotation ,type)
|
||||
rows)))))
|
||||
(let* ((selected-value
|
||||
(devdocs-browser--completing-read
|
||||
(format "Devdocs browser [%s]" (mapconcat #'identity slugs ","))
|
||||
|
|
@ -812,6 +831,12 @@ When called interactively, user can choose from the list."
|
|||
(when selected-value
|
||||
(apply #'devdocs-browser--eww-open selected-value)))))
|
||||
|
||||
|
||||
(defcustom devdocs-browser-open-fallback-to-all-docs t
|
||||
"When not sure which docs to use, whether `devdocs-browser-open' should use all installed docs, or just ask the user to pick one (like `devdocs-browser-open-in')."
|
||||
:type 'boolean
|
||||
:group 'devdocs-browser)
|
||||
|
||||
;;;###autoload
|
||||
(defun devdocs-browser-open ()
|
||||
"Open entry in active docs.
|
||||
|
|
@ -820,7 +845,12 @@ or `devdocs-browser-major-mode-docs-alist',
|
|||
or the current doc type if called in a devdocs eww buffer.
|
||||
When all of them are nil, all installed docs are used."
|
||||
(interactive)
|
||||
(devdocs-browser-open-in (devdocs-browser--default-active-slugs)))
|
||||
(if devdocs-browser-open-fallback-to-all-docs
|
||||
(devdocs-browser-open-in (devdocs-browser--default-active-slugs))
|
||||
(let ((slugs (devdocs-browser--default-active-slugs 'no-fallback-all)))
|
||||
(if slugs
|
||||
(devdocs-browser-open-in slugs)
|
||||
(call-interactively 'devdocs-browser-open-in)))))
|
||||
|
||||
|
||||
(provide 'devdocs-browser)
|
||||
|
|
@ -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"
|
||||
'((dash "2.5.0"))
|
||||
:commit "523f51b4152a3bf4e60fe57f512732c698b5c96f" :authors
|
||||
(define-package "dired-hacks-utils" "20240629.1906" "Utilities and helpers for dired-hacks collection"
|
||||
'((dash "2.5.0")
|
||||
(emacs "24.3"))
|
||||
:commit "63b04d17936c98cb4ad7ce6bc3331cda8e30c55a" :authors
|
||||
'(("Matúš Goljer" . "matus.goljer@gmail.com"))
|
||||
:maintainers
|
||||
'(("Matúš Goljer" . "matus.goljer@gmail.com"))
|
||||
:maintainer
|
||||
'("Matúš Goljer" . "matus.goljer@gmail.com")
|
||||
:keywords
|
||||
'("files"))
|
||||
'("files")
|
||||
:url "https://github.com/Fuco1/dired-hacks")
|
||||
;; Local Variables:
|
||||
;; no-byte-compile: t
|
||||
;; End:
|
||||
|
|
@ -7,7 +7,8 @@
|
|||
;; Keywords: files
|
||||
;; Version: 0.0.1
|
||||
;; Created: 14th February 2014
|
||||
;; Package-Requires: ((dash "2.5.0"))
|
||||
;; Package-Requires: ((dash "2.5.0") (emacs "24.3"))
|
||||
;; URL: https://github.com/Fuco1/dired-hacks
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
|
|
@ -41,6 +42,7 @@
|
|||
|
||||
(require 'dash)
|
||||
(require 'dired)
|
||||
(require 'dired-aux) ;; for dired-dwim-target-directory
|
||||
|
||||
(defgroup dired-hacks ()
|
||||
"Collection of useful dired additions."
|
||||
|
|
@ -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>
|
||||
;; Maintainer: Matus Goljer <matus.goljer@gmail.com>
|
||||
;; Keywords: files
|
||||
;; Package-Commit: 41d3eb42195d9f0894c20d18cc8e722b099aa1c1
|
||||
;; Package-Version: 20221127.1247
|
||||
;; Package-X-Original-Version: 20170922.817
|
||||
;; Version: 0.0.3
|
||||
;; Created: 16th February 2014
|
||||
;; Package-Requires: ((dash "2.5.0") (dired-hacks-utils "0.0.1"))
|
||||
;; Package-Requires: ((dash "2.5.0") (dired-hacks-utils "0.0.1") (emacs "24"))
|
||||
;; URL: https://github.com/Fuco1/dired-hacks
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
|
|
@ -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 -*-
|
||||
|
||||
;; Copyright (c) 2013 Spotify AB
|
||||
;; Package-Requires: ((emacs "24") (s "1.2.0"))
|
||||
;; Package-Requires: ((emacs "24"))
|
||||
;; Homepage: https://github.com/spotify/dockerfile-mode
|
||||
;; URL: https://github.com/spotify/dockerfile-mode
|
||||
;; Version: 1.7
|
||||
|
|
@ -29,7 +29,6 @@
|
|||
|
||||
(require 'sh-script)
|
||||
(require 'rx)
|
||||
(require 's)
|
||||
|
||||
|
||||
(declare-function cygwin-convert-file-name-to-windows "cygw32.c" (file &optional absolute-p))
|
||||
|
|
@ -166,7 +165,7 @@ by `dockerfile-enable-auto-indent'."
|
|||
|
||||
(defun dockerfile-build-arg-string ()
|
||||
"Create a --build-arg string for each element in `dockerfile-build-args'."
|
||||
(mapconcat (lambda (arg) (concat "--build-arg=" (s-replace "\\=" "=" (shell-quote-argument arg))))
|
||||
(mapconcat (lambda (arg) (concat "--build-arg=" (replace-regexp-in-string "\\\\=" "=" (shell-quote-argument arg))))
|
||||
dockerfile-build-args " "))
|
||||
|
||||
(defun dockerfile-standard-filename (file)
|
||||
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
|
||||
(setq initial-scratch-message (concat initial-scratch-message
|
||||
";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\\n\
|
||||
(setq initial-scratch-message
|
||||
";; This buffer is for text that is not saved, and for Lisp evaluation.\\n\
|
||||
;; You can hit \`C-j' at end of a lisp expression to eval it.\\n\\n\
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\\n\
|
||||
;; This Emacs is Powered by \`HELM' using\\n\
|
||||
;; emacs program \"$EMACS\".\\n\
|
||||
;; This is a minimal \`helm' configuration to discover \`helm' or debug it.\\n\
|
||||
;; You can retrieve this minimal configuration in \"$CONF_FILE\".\\n\
|
||||
;;
|
||||
|
||||
;; Some original Emacs commands are replaced by their \`helm' counterparts:\\n\\n\
|
||||
;; - \`find-file'(C-x C-f) =>\`helm-find-files'\\n\
|
||||
;; - \`occur'(M-s o) =>\`helm-occur'\\n\
|
||||
;; - \`list-buffers'(C-x C-b) =>\`helm-buffers-list'\\n\
|
||||
;; - \`completion-at-point'(M-tab) =>\`helm-lisp-completion-at-point'[1]\\n\
|
||||
;; - \`apropos-command'(C-h a) =>\`helm-apropos'\\n\
|
||||
;; - \`dabbrev-expand'(M-/) =>\`helm-dabbrev'\\n\
|
||||
;; - \`execute-extended-command'(M-x) =>\`helm-M-x'\\n\\n
|
||||
;; Some other Emacs commands are \"helmized\" by \`helm-mode'.\\n\
|
||||
;; [1] Coming with emacs-24.4, \`completion-at-point' is \"helmized\" by \`helm-mode'\\n\
|
||||
;; \`helm-mode' is enabled which mean that most Emacs commands using completion\\n\
|
||||
;; will use helm.\\n\
|
||||
|
||||
;; which provides Helm completion in many places like \`shell-mode'.\\n\
|
||||
;; Find context help for most Helm commands with \`C-h m'.\\n\
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\\n\\n"))
|
||||
;; To start editing a file or to create a new file, visit it with \`C-x C-f'\\n\
|
||||
;; and enter text in its buffer, to save your changes hit \`C-x C-s'.
|
||||
|
||||
;; Find context help for most Helm commands with \`C-h m' while helm is running.\\n\
|
||||
;; You can also retrieve the whole user documentation with \`C-x c h h'.\\n\
|
||||
;; For online documentation see \`https://github.com/emacs-helm/helm/wiki'.\\n\
|
||||
;; \(Put cursor on url, hit \`C-x C-f' and then RETurn).\\n\
|
||||
|
||||
;; To quit this Emacs, hit \'C-x C-c'.\\n\
|
||||
|
||||
;; Note about keybindings in Emacs: \`C-' means \'Control-' and \`M-' \'Alt-'.\\n\
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\\n\\n")
|
||||
|
||||
(setq load-path (quote $LOAD_PATH))
|
||||
|
||||
|
|
@ -233,7 +243,7 @@ cat > $CONF_FILE <<EOF
|
|||
(setq package-load-list
|
||||
(if (equal load-packages '("all"))
|
||||
'(all)
|
||||
(append '((helm-core t) (helm t) (async t) (popup t))
|
||||
(append '((helm-core t) (helm t) (async t) (wfnames t))
|
||||
(mapcar (lambda (p) (list (intern p) t)) load-packages)))))
|
||||
|
||||
(package-initialize))
|
||||
|
|
@ -256,9 +266,6 @@ cat > $CONF_FILE <<EOF
|
|||
(define-key global-map [remap dabbrev-expand] 'helm-dabbrev)
|
||||
(define-key global-map [remap execute-extended-command] 'helm-M-x)
|
||||
(define-key global-map [remap apropos-command] 'helm-apropos)
|
||||
(unless (boundp 'completion-in-region-function)
|
||||
(define-key lisp-interaction-mode-map [remap completion-at-point] 'helm-lisp-completion-at-point)
|
||||
(define-key emacs-lisp-mode-map [remap completion-at-point] 'helm-lisp-completion-at-point))
|
||||
(add-hook 'kill-emacs-hook #'(lambda () (and (file-exists-p "$CONF_FILE") (delete-file "$CONF_FILE"))))
|
||||
EOF
|
||||
|
||||
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-octicon "ext:all-the-icons.el")
|
||||
(declare-function all-the-icons-match-to-alist "ext:all-the-icons.el")
|
||||
(declare-function all-the-icons-faicon "ext:all-the-icons.el")
|
||||
|
||||
(defvar all-the-icons-dir-icon-alist)
|
||||
|
||||
|
|
@ -65,7 +66,7 @@
|
|||
Don't use `setq' to set this."
|
||||
:type 'boolean
|
||||
:set (lambda (var val)
|
||||
(if (featurep 'all-the-icons)
|
||||
(if (require 'all-the-icons nil t)
|
||||
(set var val)
|
||||
(set var nil))))
|
||||
|
||||
|
|
@ -88,6 +89,10 @@ will be honored."
|
|||
helm-bookmark-default-filtered-sources)
|
||||
for fn = (intern (format "%s-builder" s))
|
||||
do (set s (funcall fn)))))
|
||||
|
||||
(defcustom helm-bookmark-annotation-sign "*"
|
||||
"Boomarks with annotation are prefixed with this string."
|
||||
:type 'string)
|
||||
|
||||
(defgroup helm-bookmark-faces nil
|
||||
"Customize the appearance of helm-bookmark."
|
||||
|
|
@ -250,7 +255,8 @@ will be honored."
|
|||
BOOKMARK is a bookmark name or a bookmark record."
|
||||
(or (eq (bookmark-get-handler bookmark) 'bmkext-jump-gnus)
|
||||
(eq (bookmark-get-handler bookmark) 'gnus-summary-bookmark-jump)
|
||||
(eq (bookmark-get-handler bookmark) 'bookmarkp-jump-gnus)))
|
||||
(eq (bookmark-get-handler bookmark) 'bookmarkp-jump-gnus)
|
||||
(eq (bookmark-get-handler bookmark) 'bmkp-jump-gnus)))
|
||||
|
||||
(defun helm-bookmark-mu4e-bookmark-p (bookmark)
|
||||
"Return non nil if BOOKMARK is a mu4e bookmark.
|
||||
|
|
@ -263,21 +269,24 @@ BOOKMARK is a bookmark name or a bookmark record."
|
|||
BOOKMARK is a bookmark name or a bookmark record."
|
||||
(or (eq (bookmark-get-handler bookmark) 'bmkext-jump-w3m)
|
||||
(eq (bookmark-get-handler bookmark) 'bookmark-w3m-bookmark-jump)
|
||||
(eq (bookmark-get-handler bookmark) 'bookmarkp-jump-w3m)))
|
||||
(eq (bookmark-get-handler bookmark) 'bookmarkp-jump-w3m)
|
||||
(eq (bookmark-get-handler bookmark) 'bmkp-jump-w3m)))
|
||||
|
||||
(defun helm-bookmark-woman-bookmark-p (bookmark)
|
||||
"Return non-nil if BOOKMARK is a Woman bookmark.
|
||||
BOOKMARK is a bookmark name or a bookmark record."
|
||||
(or (eq (bookmark-get-handler bookmark) 'bmkext-jump-woman)
|
||||
(eq (bookmark-get-handler bookmark) 'woman-bookmark-jump)
|
||||
(eq (bookmark-get-handler bookmark) 'bookmarkp-jump-woman)))
|
||||
(eq (bookmark-get-handler bookmark) 'bookmarkp-jump-woman)
|
||||
(eq (bookmark-get-handler bookmark) 'bmkp-jump-woman)))
|
||||
|
||||
(defun helm-bookmark-man-bookmark-p (bookmark)
|
||||
"Return non-nil if BOOKMARK is a Man bookmark.
|
||||
BOOKMARK is a bookmark name or a bookmark record."
|
||||
(or (eq (bookmark-get-handler bookmark) 'bmkext-jump-man)
|
||||
(eq (bookmark-get-handler bookmark) 'Man-bookmark-jump)
|
||||
(eq (bookmark-get-handler bookmark) 'bookmarkp-jump-man)))
|
||||
(eq (bookmark-get-handler bookmark) 'bookmarkp-jump-man)
|
||||
(eq (bookmark-get-handler bookmark) 'bmkp-jump-man)))
|
||||
|
||||
(defun helm-bookmark-woman-man-bookmark-p (bookmark)
|
||||
"Return non-nil if BOOKMARK is a Man or Woman bookmark.
|
||||
|
|
@ -302,7 +311,10 @@ BOOKMARK is a bookmark name or a bookmark record.
|
|||
This excludes bookmarks of a more specific kind (Info, Gnus, and W3m)."
|
||||
(let* ((filename (bookmark-get-filename bookmark))
|
||||
(isnonfile (equal filename helm-bookmark--non-file-filename)))
|
||||
(and filename (not isnonfile) (not (bookmark-get-handler bookmark)))))
|
||||
(and filename
|
||||
(not isnonfile)
|
||||
(not (helm-bookmark-org-file-p bookmark))
|
||||
(not (bookmark-get-handler bookmark)))))
|
||||
|
||||
(defun helm-bookmark-org-file-p (bookmark)
|
||||
(let* ((filename (bookmark-get-filename bookmark)))
|
||||
|
|
@ -388,6 +400,10 @@ If `browse-url-browser-function' is set to something else than
|
|||
(defalias 'bookmarkp-jump-w3m #'helm-bookmark-jump-w3m)
|
||||
(defalias 'bookmarkp-jump-woman #'woman-bookmark-jump)
|
||||
(defalias 'bookmarkp-jump-man #'Man-bookmark-jump)
|
||||
(defalias 'bmkp-jump-gnus #'gnus-summary-bookmark-jump)
|
||||
(defalias 'bmkp-jump-w3m #'helm-bookmark-jump-w3m)
|
||||
(defalias 'bmkp-jump-woman #'woman-bookmark-jump)
|
||||
(defalias 'bmkp-jump-man #'Man-bookmark-jump)
|
||||
|
||||
|
||||
;;;; Filtered bookmark sources
|
||||
|
|
@ -619,15 +635,17 @@ If `browse-url-browser-function' is set to something else than
|
|||
all-the-icons-dir-icon-alist))
|
||||
(apply (car it) (cdr it))
|
||||
(all-the-icons-octicon "file-directory")))
|
||||
(isw3m (all-the-icons-faicon "firefox"))
|
||||
((and isfile isinfo) (all-the-icons-octicon "info"))
|
||||
(isfile (all-the-icons-icon-for-file isfile))
|
||||
((or iswoman isman)
|
||||
(all-the-icons-fileicon "man-page"))
|
||||
((or isgnus ismu4e)
|
||||
(all-the-icons-octicon "mail-read"))))
|
||||
(all-the-icons-octicon "mail-read"))
|
||||
(isfile (all-the-icons-icon-for-file (helm-basename isfile)))))
|
||||
;; Add a * if bookmark have annotation
|
||||
if (and isannotation (not (string-equal isannotation "")))
|
||||
do (setq trunc (concat "*" (if helm-bookmark-show-location trunc i)))
|
||||
do (setq trunc (concat helm-bookmark-annotation-sign
|
||||
(if helm-bookmark-show-location trunc i)))
|
||||
for sep = (and helm-bookmark-show-location
|
||||
(make-string (- (+ bookmark-bmenu-file-column 2)
|
||||
(string-width trunc))
|
||||
|
|
@ -749,32 +767,43 @@ renamed."
|
|||
(setq bookmark-alist-modification-count (1+ bookmark-alist-modification-count))
|
||||
(when (bookmark-time-to-save-p) (bookmark-save)))
|
||||
|
||||
(defun helm-bookmark-rename (old &optional new batch)
|
||||
(defun helm-bookmark-rename (old &optional new _batch)
|
||||
"Change bookmark's name from OLD to NEW.
|
||||
Interactively:
|
||||
If called from the keyboard, then prompt for OLD.
|
||||
If called from the menubar, select OLD from a menu.
|
||||
If NEW is nil, then prompt for its string value.
|
||||
|
||||
If BATCH is non-nil, then do not rebuild the menu list.
|
||||
Unused arg _BATCH is kept for backward compatibility.
|
||||
|
||||
While the user enters the new name, repeated `C-w' inserts
|
||||
consecutive words from the buffer into the new bookmark name."
|
||||
(interactive (list (bookmark-completing-read "Old bookmark name")))
|
||||
(bookmark-maybe-historicize-string old)
|
||||
(bookmark-maybe-load-default-file)
|
||||
(save-excursion (skip-chars-forward " ") (setq bookmark-yank-point (point)))
|
||||
(save-excursion
|
||||
(skip-chars-forward " ") (setq bookmark-yank-point (point)))
|
||||
(setq bookmark-current-buffer (current-buffer))
|
||||
(let ((newname (or new (read-from-minibuffer
|
||||
"New name: " nil
|
||||
(let ((now-map (copy-keymap minibuffer-local-map)))
|
||||
(define-key now-map "\C-w" #'bookmark-yank-word)
|
||||
now-map)
|
||||
nil 'bookmark-history))))
|
||||
(bookmark-set-name old newname)
|
||||
(setq bookmark-current-bookmark newname)
|
||||
(unless batch (bookmark-bmenu-surreptitiously-rebuild-list))
|
||||
(helm-bookmark-maybe-save-bookmark) newname))
|
||||
(catch 'skip
|
||||
(let ((newname
|
||||
(or new (read-from-minibuffer
|
||||
;; `format-prompt' is not available in old Emacs.
|
||||
(format "New name [C-RET to skip] (default %s): " old) nil
|
||||
(let ((now-map (copy-keymap minibuffer-local-map)))
|
||||
(define-key now-map "\C-w" #'bookmark-yank-word)
|
||||
(define-key now-map (kbd "C-<return>")
|
||||
#'(lambda () (interactive) (throw 'skip 'skip)))
|
||||
now-map)
|
||||
nil 'bookmark-history old))))
|
||||
(bookmark-set-name old newname)
|
||||
(setq bookmark-current-bookmark newname)
|
||||
(helm-bookmark-maybe-save-bookmark) newname)))
|
||||
|
||||
(defun helm-bookmark-rename-marked (_candidate)
|
||||
"Rename marked bookmarks."
|
||||
(let* ((bmks (helm-marked-candidates))
|
||||
(count 0)
|
||||
(len (length bmks)))
|
||||
(cl-loop for bmk in bmks
|
||||
unless (eq (helm-bookmark-rename bmk) 'skip)
|
||||
do (cl-incf count))
|
||||
(message "(%s/%s) bookmark(s) renamed" count len)))
|
||||
|
||||
(helm-make-command-from-action helm-bookmark-run-edit
|
||||
"Run `helm-bookmark-edit-bookmark' from keyboard."
|
||||
|
|
@ -808,7 +837,65 @@ E.g. prepended with *."
|
|||
(dolist (i (helm-marked-candidates))
|
||||
(bookmark-delete (helm-bookmark-get-bookmark-from-name i)
|
||||
'batch)))
|
||||
|
||||
;;; bookmark annotations
|
||||
;;
|
||||
(defun helm-bookmark-show-annotation (bookmark-name-or-record)
|
||||
"Display the annotation for BOOKMARK-NAME-OR-RECORD in a buffer."
|
||||
(let ((annotation (bookmark-get-annotation bookmark-name-or-record)))
|
||||
(when (and annotation (not (string-equal annotation "")))
|
||||
(let ((buf (get-buffer-create "*Bookmark Annotation*")))
|
||||
(with-current-buffer buf
|
||||
(let ((inhibit-read-only t))
|
||||
(erase-buffer)
|
||||
(insert annotation)
|
||||
(goto-char (point-min))
|
||||
(set-buffer-modified-p nil)
|
||||
(helm-bookmark-annotation-mode)
|
||||
(insert (substitute-command-keys
|
||||
"# Edit this buffer with \\[helm-bookmark-edit-annotation]")
|
||||
(substitute-command-keys
|
||||
"\n# Quit this buffer with \\[helm-bookmark-quit-annotation]\n"))
|
||||
(set (make-local-variable 'bookmark-annotation-name)
|
||||
bookmark-name-or-record)
|
||||
(put 'bookmark-annotation-name 'permanent-local t)))
|
||||
(pop-to-buffer buf)))))
|
||||
|
||||
(defun helm-bookmark-edit-annotation ()
|
||||
"Edit bookmark annotation from the show annotation buffer."
|
||||
(interactive)
|
||||
(setq buffer-read-only nil)
|
||||
(bookmark-edit-annotation-mode)
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(delete-region
|
||||
(point) (save-excursion (forward-line 2) (point)))
|
||||
(insert (funcall bookmark-edit-annotation-text-func
|
||||
bookmark-annotation-name))))
|
||||
(put 'helm-bookmark-edit-annotation 'no-helm-mx t)
|
||||
|
||||
(defun helm-bookmark-quit-annotation ()
|
||||
"Quit bookmark annotation buffer."
|
||||
(interactive)
|
||||
(quit-window t))
|
||||
(put 'helm-bookmark-quit-annotation 'no-helm-mx t)
|
||||
|
||||
(defvar helm-bookmark-annotation-mode-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(set-keymap-parent map text-mode-map)
|
||||
(define-key map (kbd "q") #'helm-bookmark-quit-annotation)
|
||||
(define-key map (kbd "e") #'helm-bookmark-edit-annotation)
|
||||
map)
|
||||
"Map used in show annotation bookmark buffer.")
|
||||
|
||||
(define-derived-mode helm-bookmark-annotation-mode
|
||||
text-mode "helm-annotation-mode"
|
||||
"Mode to display bookmark annotations.
|
||||
|
||||
Special commands:
|
||||
\\{helm-bookmark-annotation-mode-map}"
|
||||
:interactive nil
|
||||
(setq-local buffer-read-only t))
|
||||
|
||||
;;;###autoload
|
||||
(defun helm-bookmarks ()
|
||||
|
|
@ -818,7 +905,7 @@ E.g. prepended with *."
|
|||
helm-source-bookmark-set)
|
||||
:buffer "*helm bookmarks*"
|
||||
:default (buffer-name helm-current-buffer)))
|
||||
|
||||
|
||||
;;;###autoload
|
||||
(defun helm-filtered-bookmarks ()
|
||||
"Preconfigured `helm' for bookmarks (filtered by category).
|
||||
|
|
@ -36,6 +36,7 @@
|
|||
(defvar dired-buffers)
|
||||
(defvar org-directory)
|
||||
(defvar helm-ff-default-directory)
|
||||
(defvar major-mode-remap-alist)
|
||||
|
||||
|
||||
(defgroup helm-buffers nil
|
||||
|
|
@ -100,7 +101,10 @@ When adding a source here it is up to you to ensure the library
|
|||
of this source is accessible and properly loaded."
|
||||
:type '(repeat (choice symbol)))
|
||||
|
||||
(defcustom helm-buffers-end-truncated-string "..."
|
||||
(defcustom helm-buffers-end-truncated-string
|
||||
;; `truncate-string-ellipsis', the function is not available in 27.1
|
||||
;; See issue#2673.
|
||||
(if (char-displayable-p ?…) "…" "...")
|
||||
"The string to display at end of truncated buffer names."
|
||||
:type 'string)
|
||||
|
||||
|
|
@ -148,7 +152,7 @@ you want to keep the recentest order when narrowing candidates."
|
|||
Don't use `setq' to set this."
|
||||
:type 'boolean
|
||||
:set (lambda (var val)
|
||||
(if (featurep 'all-the-icons)
|
||||
(if (require 'all-the-icons nil t)
|
||||
(set var val)
|
||||
(set var nil))))
|
||||
|
||||
|
|
@ -335,6 +339,9 @@ Note that this variable is buffer-local.")
|
|||
when (string-match r candidate)
|
||||
return m)))
|
||||
(buffer (get-buffer-create candidate)))
|
||||
(helm-aif (and (boundp 'major-mode-remap-alist)
|
||||
(cdr (assq mjm major-mode-remap-alist)))
|
||||
(setq mjm it))
|
||||
(if mjm
|
||||
(with-current-buffer buffer (funcall mjm))
|
||||
(set-buffer-major-mode buffer))
|
||||
|
|
@ -379,7 +386,7 @@ Note that this variable is buffer-local.")
|
|||
|
||||
|
||||
(defun helm-buffers-get-visible-buffers ()
|
||||
"Returns buffers visibles on current frame."
|
||||
"Returns buffers visible on visible frames."
|
||||
(let (result)
|
||||
(walk-windows
|
||||
(lambda (x)
|
||||
|
|
@ -388,6 +395,7 @@ Note that this variable is buffer-local.")
|
|||
result))
|
||||
|
||||
(defun helm-buffer-list-1 (&optional visibles)
|
||||
"Return list of all buffers except VISIBLES buffers."
|
||||
(cl-loop for b in (buffer-list)
|
||||
for bn = (buffer-name b)
|
||||
unless (member bn visibles)
|
||||
|
|
@ -431,7 +439,7 @@ The list is reordered with `helm-buffer-list-reorder-fn'."
|
|||
(cond ((eq type 'dired)
|
||||
(all-the-icons-octicon "file-directory"))
|
||||
(buf-fname
|
||||
(all-the-icons-icon-for-file buf-fname))
|
||||
(all-the-icons-icon-for-file buf-name))
|
||||
(t (all-the-icons-octicon "star" :v-adjust 0.0))))))
|
||||
(buf-name (propertize buf-name 'face face1
|
||||
'help-echo help-echo
|
||||
|
|
@ -452,7 +460,7 @@ The list is reordered with `helm-buffer-list-reorder-fn'."
|
|||
(format "(%s %s in `%s')"
|
||||
(process-name proc)
|
||||
(process-status proc) dir)
|
||||
(format "(in `%s')" dir))
|
||||
(format "`%s'" dir))
|
||||
'face face2)))))
|
||||
|
||||
(defun helm-buffer--format-mode-name (buf)
|
||||
|
|
@ -1002,12 +1010,14 @@ vertically."
|
|||
|
||||
(defun helm-buffers-persistent-kill (_buffer)
|
||||
(let ((marked (helm-marked-candidates))
|
||||
(sel (helm-get-selection)))
|
||||
(sel (helm-get-selection))
|
||||
(msg "Buffer `%s' modified, please save it before kill"))
|
||||
(unwind-protect
|
||||
(cl-loop for b in marked
|
||||
do (progn
|
||||
do (if (and (buffer-file-name b) (buffer-modified-p b))
|
||||
(message msg (buffer-name b))
|
||||
;; We need to preselect each marked because
|
||||
;; helm-buffers-persistent-kill is deleting
|
||||
;; helm-buffers-persistent-kill-1 is deleting
|
||||
;; current selection.
|
||||
(helm-preselect
|
||||
(format "^%s"
|
||||
|
|
@ -1025,7 +1035,7 @@ vertically."
|
|||
(if (or (helm-follow-mode-p)
|
||||
(eql current (get-buffer helm-current-buffer))
|
||||
(not (eql current (get-buffer candidate))))
|
||||
(switch-to-buffer candidate)
|
||||
(display-buffer candidate)
|
||||
(if (and helm-persistent-action-display-window
|
||||
(window-dedicated-p
|
||||
(next-window helm-persistent-action-display-window 1)))
|
||||
|
|
@ -1110,19 +1120,18 @@ Can be used by any source that list buffers."
|
|||
(cl-assert (not helm-buffers-in-project-p)
|
||||
nil "You are already browsing this project"))
|
||||
|
||||
;;;###autoload
|
||||
(defun helm-buffers-quit-and-find-file-fn (source)
|
||||
(let* ((sel (helm-get-selection nil nil source))
|
||||
(buf (helm-aand (bufferp sel)
|
||||
(get-buffer sel)
|
||||
(buffer-name it))))
|
||||
(when buf
|
||||
(let* ((sel (get-buffer (helm-get-selection nil nil source)))
|
||||
(bname (and (bufferp sel) (buffer-name sel))))
|
||||
(when bname
|
||||
(or (buffer-file-name sel)
|
||||
(car (rassoc buf dired-buffers))
|
||||
(and (with-current-buffer buf
|
||||
(car (rassoc bname dired-buffers))
|
||||
(and (with-current-buffer bname
|
||||
(eq major-mode 'org-agenda-mode))
|
||||
org-directory
|
||||
(expand-file-name org-directory))
|
||||
(with-current-buffer buf
|
||||
(with-current-buffer bname
|
||||
(expand-file-name default-directory))))))
|
||||
|
||||
;;; Candidate Transformers
|
||||
|
|
@ -36,7 +36,7 @@
|
|||
'global
|
||||
(with-current-buffer (get-buffer "*Faces*")
|
||||
(buffer-substring
|
||||
(next-single-char-property-change (point-min) 'face)
|
||||
(next-single-char-property-change (point-min) 'category)
|
||||
(point-max))))
|
||||
(kill-buffer "*Faces*")))
|
||||
|
||||
|
|
@ -55,6 +55,10 @@ This value can be toggled with
|
|||
\\<helm-M-x-map>\\[helm-M-x-toggle-short-doc] while in helm-M-x session."
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom helm-M-x-history-transformer-sort t
|
||||
"When nil, do not sort helm-M-x's commands history."
|
||||
:type 'boolean)
|
||||
|
||||
|
||||
;;; Faces
|
||||
;;
|
||||
|
|
@ -134,45 +138,59 @@ Note that SORT should not be used when fuzzy matching because
|
|||
fuzzy matching is running its own sort function with a different
|
||||
algorithm."
|
||||
(with-helm-current-buffer
|
||||
(cl-loop with max-len = (when helm-M-x-show-short-doc
|
||||
(helm-in-buffer-get-longest-candidate))
|
||||
with local-map = (helm-M-x-current-mode-map-alist)
|
||||
(cl-loop with local-map = (helm-M-x-current-mode-map-alist)
|
||||
for cand in candidates
|
||||
for local-key = (car (rassq cand local-map))
|
||||
for key = (substitute-command-keys (format "\\[%s]" cand))
|
||||
for sym = (intern (if (consp cand) (car cand) cand))
|
||||
for doc = (when max-len
|
||||
(helm-get-first-line-documentation (intern-soft cand)))
|
||||
for disp = (if (or (eq sym major-mode)
|
||||
(and (memq sym minor-mode-list)
|
||||
(boundp sym)
|
||||
(buffer-local-value sym helm-current-buffer)))
|
||||
(propertize cand 'face 'helm-command-active-mode)
|
||||
cand)
|
||||
unless (and (null ignore-props) (or (get sym 'helm-only) (get sym 'no-helm-mx)))
|
||||
for local-key = (car (rassq cand local-map))
|
||||
for key = (substitute-command-keys (format "\\[%s]" cand))
|
||||
for sym = (intern (if (consp cand) (car cand) cand))
|
||||
for doc = (when helm-M-x-show-short-doc
|
||||
(helm-get-first-line-documentation (intern-soft cand)))
|
||||
for disp = (if (or (eq sym major-mode)
|
||||
(and (memq sym minor-mode-list)
|
||||
(boundp sym)
|
||||
(buffer-local-value
|
||||
sym helm-current-buffer)))
|
||||
(propertize cand 'face 'helm-command-active-mode)
|
||||
cand)
|
||||
unless (and (null ignore-props)
|
||||
(or (get sym 'helm-only) (get sym 'no-helm-mx)
|
||||
(eq sym 'helm-M-x)))
|
||||
collect
|
||||
(cons (cond ((and (string-match "^M-x" key) local-key)
|
||||
(propertize (format "%s%s%s %s"
|
||||
disp
|
||||
(if doc (make-string (+ 1 (- max-len (length cand))) ? ) "")
|
||||
(if doc (propertize doc 'face 'helm-M-x-short-doc) "")
|
||||
(propertize
|
||||
" " 'display
|
||||
(propertize local-key 'face 'helm-M-x-key)))
|
||||
'match-part disp))
|
||||
((string-match "^M-x" key)
|
||||
(propertize (format "%s%s%s"
|
||||
disp
|
||||
(if doc (make-string (+ 1 (- max-len (length cand))) ? ) "")
|
||||
(if doc (propertize doc 'face 'helm-M-x-short-doc) ""))
|
||||
'match-part disp))
|
||||
(t (propertize (format "%s%s%s %s"
|
||||
disp
|
||||
(if doc (make-string (+ 1 (- max-len (length cand))) ? ) "")
|
||||
(if doc (propertize doc 'face 'helm-M-x-short-doc) "")
|
||||
(propertize
|
||||
" " 'display
|
||||
(propertize key 'face 'helm-M-x-key)))
|
||||
(propertize
|
||||
(format "%s%s%s %s"
|
||||
disp
|
||||
(if doc (helm-make-separator cand) "")
|
||||
(if doc
|
||||
(propertize
|
||||
doc 'face 'helm-M-x-short-doc)
|
||||
"")
|
||||
(propertize
|
||||
" " 'display
|
||||
(propertize local-key 'face 'helm-M-x-key)))
|
||||
'match-part disp))
|
||||
((and (string-match "^M-x" key)
|
||||
(not (string= key "M-x")))
|
||||
(propertize
|
||||
(format "%s%s%s"
|
||||
disp
|
||||
(if doc (helm-make-separator cand) "")
|
||||
(if doc
|
||||
(propertize
|
||||
doc 'face 'helm-M-x-short-doc)
|
||||
""))
|
||||
'match-part disp))
|
||||
(t (propertize
|
||||
(format "%s%s%s %s"
|
||||
disp
|
||||
(if doc (helm-make-separator cand) "")
|
||||
(if doc
|
||||
(propertize
|
||||
doc 'face 'helm-M-x-short-doc)
|
||||
"")
|
||||
(propertize
|
||||
" " 'display
|
||||
(propertize key 'face 'helm-M-x-key)))
|
||||
'match-part disp)))
|
||||
cand)
|
||||
into ls
|
||||
|
|
@ -244,7 +262,7 @@ algorithm."
|
|||
(defclass helm-M-x-class (helm-source-in-buffer helm-type-command)
|
||||
((requires-pattern :initform 0)
|
||||
(must-match :initform t)
|
||||
(filtered-candidate-transformer :initform 'helm-M-x-transformer-no-sort)
|
||||
(filtered-candidate-transformer :initform #'helm-M-x-transformer)
|
||||
(persistent-help :initform "Describe this command")
|
||||
(help-message :initform 'helm-M-x-help-message)
|
||||
(nomark :initform t)
|
||||
|
|
@ -265,23 +283,19 @@ algorithm."
|
|||
(defun helm-M-x-read-extended-command (collection &optional predicate history)
|
||||
"Read or execute action on command name in COLLECTION or HISTORY.
|
||||
|
||||
When `helm-M-x-use-completion-styles' is used, Emacs
|
||||
`completion-styles' mechanism is used, otherwise standard helm
|
||||
completion and helm fuzzy matching are used together.
|
||||
Helm completion is not provided when executing or defining kbd macros.
|
||||
|
||||
Helm completion is not provided when executing or defining kbd
|
||||
macros.
|
||||
|
||||
Arg COLLECTION should be an `obarray' but can be any object
|
||||
suitable for `try-completion'. Arg PREDICATE is a function that
|
||||
default to `commandp' see also `try-completion'. Arg HISTORY
|
||||
default to `extended-command-history'."
|
||||
Arg COLLECTION should be an `obarray'.
|
||||
Arg PREDICATE is a function that default to `commandp'.
|
||||
Arg HISTORY default to `extended-command-history'."
|
||||
(setq helm--mode-line-display-prefarg t)
|
||||
(let* ((pred (or predicate #'commandp))
|
||||
(helm-fuzzy-sort-fn (lambda (candidates _source)
|
||||
;; Sort on real candidate otherwise
|
||||
;; "symbol (<binding>)" is used when sorting.
|
||||
(helm-fuzzy-matching-default-sort-fn-1 candidates t)))
|
||||
(if helm-M-x-history-transformer-sort
|
||||
;; Sort on real candidate otherwise
|
||||
;; "symbol (<binding>)" is used when sorting.
|
||||
(helm-fuzzy-matching-default-sort-fn-1 candidates t)
|
||||
candidates)))
|
||||
(sources `(,(helm-make-source "Emacs Commands history" 'helm-M-x-class
|
||||
:data (lambda ()
|
||||
(helm-comp-read-get-candidates
|
||||
|
|
@ -293,6 +307,10 @@ default to `extended-command-history'."
|
|||
;; Ensure using empty string to
|
||||
;; not defeat helm matching fns [1]
|
||||
pred nil nil ""))
|
||||
:filtered-candidate-transformer
|
||||
(if helm-M-x-history-transformer-sort
|
||||
#'helm-M-x-transformer
|
||||
#'helm-M-x-transformer-no-sort)
|
||||
:fuzzy-match helm-M-x-fuzzy-match)
|
||||
,(helm-make-source "Emacs Commands" 'helm-M-x-class
|
||||
:data (lambda ()
|
||||
|
|
@ -300,16 +318,11 @@ default to `extended-command-history'."
|
|||
;; [1] Same comment as above.
|
||||
collection pred nil nil ""))
|
||||
:fuzzy-match helm-M-x-fuzzy-match)))
|
||||
(prompt (concat (cond
|
||||
((eq helm-M-x-prefix-argument '-) "- ")
|
||||
((and (consp helm-M-x-prefix-argument)
|
||||
(eq (car helm-M-x-prefix-argument) 4))
|
||||
"C-u ")
|
||||
((and (consp helm-M-x-prefix-argument)
|
||||
(integerp (car helm-M-x-prefix-argument)))
|
||||
(format "%d " (car helm-M-x-prefix-argument)))
|
||||
((integerp helm-M-x-prefix-argument)
|
||||
(format "%d " helm-M-x-prefix-argument)))
|
||||
(prompt (concat (helm-acase helm-M-x-prefix-argument
|
||||
(- "-")
|
||||
((guard (and (consp it) (car it)))
|
||||
(if (eq guard 4) "C-u " (format "%d " guard)))
|
||||
((guard (integerp it)) (format "%d " it)))
|
||||
"M-x ")))
|
||||
(setq helm-M-x--timer (run-at-time 1 0.1 #'helm-M-x--notify-prefix-arg))
|
||||
;; Fix Bug#2250, add `helm-move-selection-after-hook' which
|
||||
|
|
@ -54,7 +54,7 @@ Helm buffer."
|
|||
(defcustom helm-dabbrev-related-buffer-fn #'helm-dabbrev--same-major-mode-p
|
||||
"A function that decide if a buffer to search in its related to `current-buffer'.
|
||||
|
||||
This is actually determined by comparing `major-mode' of the
|
||||
This is currently determined by comparing `major-mode' of the
|
||||
buffer to search and the `current-buffer'.
|
||||
|
||||
The function take one arg, the buffer which is current, look at
|
||||
|
|
@ -31,7 +31,8 @@
|
|||
["Recent Files" helm-recentf t]
|
||||
["Locate" helm-locate t]
|
||||
["Search Files with find" helm-find t]
|
||||
["Bookmarks" helm-filtered-bookmarks t])
|
||||
["Bookmarks" helm-filtered-bookmarks t]
|
||||
["Locate library" helm-locate-library t])
|
||||
("Buffers"
|
||||
["Find buffers" helm-buffers-list t])
|
||||
("Projects"
|
||||
|
|
@ -47,8 +48,9 @@
|
|||
["Emacs Manual index" helm-info-emacs t]
|
||||
["Gnus Manual index" helm-info-gnus t]
|
||||
["Helm documentation" helm-documentation t])
|
||||
("Elpa"
|
||||
["Elisp packages" helm-packages t])
|
||||
("Packages"
|
||||
["Elisp packages" helm-packages t]
|
||||
["Finder" helm-finder t])
|
||||
("Tools"
|
||||
["Occur" helm-occur t]
|
||||
["Grep current directory with AG" helm-do-grep-ag t]
|
||||
|
|
@ -33,6 +33,9 @@
|
|||
(declare-function helm-comp-read "helm-mode")
|
||||
(declare-function helm-M-x-transformer-no-sort-no-props "helm-command")
|
||||
(defvar helm-M-x-show-short-doc)
|
||||
(defvar completions-detailed)
|
||||
(defvar helm-completions-detailed)
|
||||
|
||||
|
||||
;;; Customizable values
|
||||
|
||||
|
|
@ -157,9 +160,9 @@ display."
|
|||
;; Called each time cursor move in helm-buffer.
|
||||
(defun helm-show-completion ()
|
||||
(with-helm-current-buffer
|
||||
(overlay-put helm-show-completion-overlay
|
||||
'display (substring-no-properties
|
||||
(helm-get-selection)))))
|
||||
(helm-aif (helm-get-selection)
|
||||
(overlay-put helm-show-completion-overlay
|
||||
'display (substring-no-properties it)))))
|
||||
|
||||
(defun helm-show-completion-init-overlay (beg end)
|
||||
(setq helm-show-completion-overlay (make-overlay beg end))
|
||||
|
|
@ -206,6 +209,9 @@ If `helm-turn-on-show-completion' is nil do nothing."
|
|||
'helm-display-function
|
||||
(or helm-show-completion-display-function
|
||||
'helm-default-display-buffer))
|
||||
(with-helm-after-update-hook
|
||||
;; Show immediately first candidate as soon as helm popup.
|
||||
(helm-show-completion))
|
||||
(helm-show-completion-init-overlay ,beg ,end)
|
||||
,@body)
|
||||
,@body)
|
||||
|
|
@ -292,13 +298,10 @@ Return a cons (beg . end)."
|
|||
(when (and pos (< (point) pos))
|
||||
(push-mark pos t t))))
|
||||
|
||||
(defvar helm-lisp-completion--cache nil)
|
||||
(defvar helm-lgst-len nil)
|
||||
;;;###autoload
|
||||
(defun helm-lisp-completion-at-point ()
|
||||
"Preconfigured Helm for Lisp symbol completion at point."
|
||||
(interactive)
|
||||
(setq helm-lgst-len 0)
|
||||
(let* ((target (helm-thing-before-point))
|
||||
(beg (car (helm-bounds-of-thing-before-point)))
|
||||
(end (point))
|
||||
|
|
@ -311,17 +314,12 @@ Return a cons (beg . end)."
|
|||
(helm-quit-if-no-candidate t)
|
||||
(helm-execute-action-at-once-if-one t)
|
||||
(enable-recursive-minibuffers t))
|
||||
(setq helm-lisp-completion--cache (cl-loop for sym in candidates
|
||||
for len = (length sym)
|
||||
when (> len helm-lgst-len)
|
||||
do (setq helm-lgst-len len)
|
||||
collect sym))
|
||||
(if candidates
|
||||
(with-helm-show-completion beg end
|
||||
;; Overlay is initialized now in helm-current-buffer.
|
||||
(helm
|
||||
:sources (helm-build-in-buffer-source "Lisp completion"
|
||||
:data helm-lisp-completion--cache
|
||||
:data candidates
|
||||
:persistent-action `(helm-lisp-completion-persistent-action .
|
||||
,(and (eq helm-elisp-help-function
|
||||
'helm-elisp-show-doc-modeline)
|
||||
|
|
@ -360,17 +358,17 @@ other window according to the value of
|
|||
(helm-elisp-show-help "Toggle show help for the symbol")))
|
||||
|
||||
(defun helm-elisp--show-help-1 (candidate &optional name)
|
||||
(let ((sym (intern-soft candidate)))
|
||||
(pcase sym
|
||||
((and (pred fboundp) (pred boundp))
|
||||
(if (member name `(,helm-describe-function-function ,helm-describe-variable-function))
|
||||
(funcall (intern (format "helm-%s" name)) sym)
|
||||
;; When there is no way to know what to describe
|
||||
;; prefer describe-function.
|
||||
(helm-describe-function sym)))
|
||||
((pred fboundp) (helm-describe-function sym))
|
||||
((pred boundp) (helm-describe-variable sym))
|
||||
((pred facep) (helm-describe-face sym)))))
|
||||
(helm-acase (intern-soft candidate)
|
||||
((guard (and (fboundp it) (boundp it)))
|
||||
(if (member name `(,helm-describe-function-function
|
||||
,helm-describe-variable-function))
|
||||
(funcall (intern (format "helm-%s" name)) it)
|
||||
;; When there is no way to know what to describe
|
||||
;; prefer describe-function.
|
||||
(helm-describe-function it)))
|
||||
((guard (fboundp it)) (helm-describe-function it))
|
||||
((guard (boundp it)) (helm-describe-variable it))
|
||||
((guard (facep it)) (helm-describe-face it))))
|
||||
|
||||
(defun helm-elisp-show-help (candidate &optional name)
|
||||
"Show full help for the function CANDIDATE.
|
||||
|
|
@ -394,17 +392,16 @@ the same time to variable and a function."
|
|||
(defun helm-lisp-completion-transformer (candidates _source)
|
||||
"Helm candidates transformer for Lisp completion."
|
||||
(cl-loop for c in candidates
|
||||
for sym = (intern c)
|
||||
for annot = (pcase sym
|
||||
((pred commandp) " (Com)")
|
||||
((pred class-p) " (Class)")
|
||||
((pred cl-generic-p) " (Gen)")
|
||||
((pred fboundp) " (Fun)")
|
||||
((pred boundp) " (Var)")
|
||||
((pred facep) " (Face)"))
|
||||
for spaces = (make-string (- helm-lgst-len (length c)) ? )
|
||||
collect (cons (concat c spaces annot) c) into lst
|
||||
finally return (sort lst #'helm-generic-sort-fn)))
|
||||
for sym = (intern c)
|
||||
for annot = (helm-acase sym
|
||||
((guard (commandp it)) " (Com)")
|
||||
((guard (class-p it)) " (Class)")
|
||||
((guard (cl-generic-p it)) " (Gen)")
|
||||
((guard (fboundp it)) " (Fun)")
|
||||
((guard (boundp it)) " (Var)")
|
||||
((guard (facep it)) " (Face)"))
|
||||
collect (cons (concat c (helm-make-separator c) annot) c) into lst
|
||||
finally return (sort lst #'helm-generic-sort-fn)))
|
||||
|
||||
;;;###autoload
|
||||
(cl-defun helm-get-first-line-documentation (sym &optional
|
||||
|
|
@ -415,31 +412,37 @@ If SYM is not documented, return \"Not documented\".
|
|||
Argument NAME allows specifiying what function to use to display
|
||||
documentation when SYM name is the same for function and variable."
|
||||
(let ((doc (condition-case _err
|
||||
(pcase sym
|
||||
((pred class-p) (cl--class-docstring (cl--find-class sym)))
|
||||
((and (pred fboundp) (pred boundp))
|
||||
(pcase name
|
||||
("describe-function"
|
||||
(documentation sym t))
|
||||
("describe-variable"
|
||||
(documentation-property sym 'variable-documentation t))
|
||||
(_ (documentation sym t))))
|
||||
((pred custom-theme-p)
|
||||
(documentation-property sym 'theme-documentation t))
|
||||
((pred helm-group-p) (documentation-property
|
||||
sym 'group-documentation t))
|
||||
((pred fboundp) (documentation sym t))
|
||||
((pred boundp) (documentation-property
|
||||
sym 'variable-documentation t))
|
||||
((pred facep) (face-documentation sym)))
|
||||
(helm-acase sym
|
||||
((guard (class-p it))
|
||||
(cl--class-docstring (cl--find-class it)))
|
||||
((guard (and (fboundp it) (boundp it)))
|
||||
(if (string= name "describe-variable")
|
||||
(documentation-property it 'variable-documentation t)
|
||||
(documentation it t)))
|
||||
((guard (custom-theme-p it))
|
||||
(documentation-property it 'theme-documentation t))
|
||||
((guard (and (helm-group-p it) (not (fboundp it))))
|
||||
(documentation-property it 'group-documentation t))
|
||||
((guard (fboundp it))
|
||||
(documentation it t))
|
||||
((guard (boundp it))
|
||||
(documentation-property it 'variable-documentation t))
|
||||
((guard (facep it)) (face-documentation it)))
|
||||
(void-function "Void function -- Not documented"))))
|
||||
(if (and doc (not (string= doc ""))
|
||||
;; `documentation' return "\n\n(args...)"
|
||||
;; for CL-style functions.
|
||||
(not (string-match-p "\\`\n\n" doc)))
|
||||
;; Some commands specify key bindings in their first line.
|
||||
;; Some commands specify key bindings or keymap in their first line,
|
||||
;; e.g.: "\<hexl-mode-map>A mode for editing binary [...]. As a result
|
||||
;; (substitute-command-keys doc) returns a string like "\nUses
|
||||
;; keymap...\nFirst line docstring. See
|
||||
;; <https://debbugs.gnu.org/70163>.
|
||||
(truncate-string-to-width
|
||||
(substitute-command-keys (car (split-string doc "\n")))
|
||||
(helm-acase (split-string (substitute-command-keys doc) "\n")
|
||||
((guard (and (string= (car it) "") (cdr it)))
|
||||
(cadr guard))
|
||||
(t (car it)))
|
||||
end-column nil nil t)
|
||||
(if (or (symbol-function sym) (boundp sym) (facep sym) (helm-group-p sym))
|
||||
"Not documented"
|
||||
|
|
@ -457,7 +460,7 @@ documentation when SYM name is the same for function and variable."
|
|||
"Preconfigured Helm to complete file name at point."
|
||||
(interactive)
|
||||
(require 'helm-mode)
|
||||
(let* ((tap (or (thing-at-point 'filename) ""))
|
||||
(let* ((tap (or (thing-at-point 'filename t) ""))
|
||||
beg
|
||||
(init (and tap
|
||||
(or force
|
||||
|
|
@ -466,8 +469,7 @@ documentation when SYM name is the same for function and variable."
|
|||
(search-backward tap (pos-bol) t)
|
||||
(setq beg (point))
|
||||
(looking-back "[^'`( ]" (1- (point)))))
|
||||
(expand-file-name
|
||||
(substring-no-properties tap))))
|
||||
(expand-file-name tap)))
|
||||
(end (point))
|
||||
(helm-quit-if-no-candidate t)
|
||||
(helm-execute-action-at-once-if-one t)
|
||||
|
|
@ -479,6 +481,7 @@ documentation when SYM name is the same for function and variable."
|
|||
(delete-region beg end) (insert (if (string-match "^~" tap)
|
||||
(abbreviate-file-name completion)
|
||||
completion)))))
|
||||
(make-obsolete 'helm-complete-file-name-at-point 'helm-find-files "3.9.6")
|
||||
|
||||
;;;###autoload
|
||||
(defun helm-lisp-indent ()
|
||||
|
|
@ -490,20 +493,6 @@ documentation when SYM name is the same for function and variable."
|
|||
tab-always-indent)))
|
||||
(indent-for-tab-command current-prefix-arg)))
|
||||
|
||||
;;;###autoload
|
||||
(defun helm-lisp-completion-or-file-name-at-point ()
|
||||
"Preconfigured Helm to complete Lisp symbol or filename at point.
|
||||
Filename completion happens if string start after or between a
|
||||
double quote."
|
||||
(interactive)
|
||||
(let* ((tap (thing-at-point 'filename)))
|
||||
(if (and tap (save-excursion
|
||||
(end-of-line)
|
||||
(search-backward tap (pos-bol) t)
|
||||
(looking-back "[^'`( ]" (1- (point)))))
|
||||
(helm-complete-file-name-at-point)
|
||||
(helm-lisp-completion-at-point))))
|
||||
|
||||
|
||||
;;; Apropos
|
||||
;;
|
||||
|
|
@ -543,18 +532,17 @@ is only used to test DEFAULT."
|
|||
|
||||
(defun helm-apropos-short-doc-transformer (candidates _source)
|
||||
(if helm-apropos-show-short-doc
|
||||
(cl-loop with max-len = (helm-in-buffer-get-longest-candidate)
|
||||
for cand in candidates
|
||||
(cl-loop for cand in candidates
|
||||
for doc = (helm-get-first-line-documentation (intern-soft cand))
|
||||
collect (cons (format "%s%s%s"
|
||||
cand
|
||||
(if doc
|
||||
(make-string (+ 1 (if (zerop max-len)
|
||||
max-len
|
||||
(- max-len (string-width cand))))
|
||||
? )
|
||||
(helm-make-separator cand)
|
||||
"")
|
||||
(if doc (propertize doc 'face 'helm-M-x-short-doc) ""))
|
||||
(if doc
|
||||
(propertize
|
||||
doc 'face 'helm-M-x-short-doc)
|
||||
""))
|
||||
cand))
|
||||
candidates))
|
||||
|
||||
|
|
@ -758,23 +746,23 @@ is only used to test DEFAULT."
|
|||
("Info lookup" . helm-info-lookup-symbol))))
|
||||
|
||||
(defun helm-info-lookup-fallback-source (candidate)
|
||||
(let ((sym (helm-symbolify candidate))
|
||||
src-name fn)
|
||||
(cond ((class-p sym)
|
||||
(setq fn #'helm-describe-function
|
||||
src-name "Describe class"))
|
||||
((cl-generic-p sym)
|
||||
(setq fn #'helm-describe-function
|
||||
src-name "Describe generic function"))
|
||||
((fboundp sym)
|
||||
(setq fn #'helm-describe-function
|
||||
src-name "Describe function"))
|
||||
((facep sym)
|
||||
(setq fn #'helm-describe-face
|
||||
src-name "Describe face"))
|
||||
(t
|
||||
(setq fn #'helm-describe-variable
|
||||
src-name "Describe variable")))
|
||||
(cl-multiple-value-bind (fn src-name)
|
||||
(helm-acase (helm-symbolify candidate)
|
||||
((guard (class-p it))
|
||||
(list #'helm-describe-function
|
||||
"Describe class"))
|
||||
((guard (cl-generic-p it))
|
||||
(list #'helm-describe-function
|
||||
"Describe generic function"))
|
||||
((guard (fboundp it))
|
||||
(list #'helm-describe-function
|
||||
"Describe function"))
|
||||
((guard (facep it))
|
||||
(list #'helm-describe-face
|
||||
"Describe face"))
|
||||
(t
|
||||
(list #'helm-describe-variable
|
||||
"Describe variable")))
|
||||
(helm-build-sync-source src-name
|
||||
:candidates (list candidate)
|
||||
:persistent-action (lambda (candidate)
|
||||
|
|
@ -810,7 +798,10 @@ is only used to test DEFAULT."
|
|||
|
||||
(defun helm-apropos-get-default ()
|
||||
(with-syntax-table emacs-lisp-mode-syntax-table
|
||||
(symbol-name (intern-soft (thing-at-point 'symbol)))))
|
||||
(symbol-name (intern-soft
|
||||
(helm-aand (thing-at-point 'symbol t)
|
||||
(replace-regexp-in-string "\\`[~=]" "" it)
|
||||
(replace-regexp-in-string "[~=]\\'" "" it))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun helm-apropos (default)
|
||||
|
|
@ -853,19 +844,19 @@ a string, i.e. the `symbol-name' of any existing symbol."
|
|||
:persistent-help "Toggle describe function / C-u C-j: Toggle advice"))
|
||||
|
||||
(defun helm-advice-candidates ()
|
||||
(cl-loop for (fname) in ad-advised-functions
|
||||
for function = (intern fname)
|
||||
append
|
||||
(cl-loop for class in ad-advice-classes append
|
||||
(cl-loop for advice in (ad-get-advice-info-field function class)
|
||||
for enabled = (ad-advice-enabled advice)
|
||||
collect
|
||||
(cons (format
|
||||
"%s %s %s"
|
||||
(if enabled "Enabled " "Disabled")
|
||||
(propertize fname 'face 'font-lock-function-name-face)
|
||||
(ad-make-single-advice-docstring advice class nil))
|
||||
(list function class advice))))))
|
||||
(cl-loop for fname in ad-advised-functions
|
||||
for function = (intern fname)
|
||||
append
|
||||
(cl-loop for class in ad-advice-classes append
|
||||
(cl-loop for advice in (ad-get-advice-info-field function class)
|
||||
for enabled = (ad-advice-enabled advice)
|
||||
collect
|
||||
(cons (format
|
||||
"%s %s %s"
|
||||
(if enabled "Enabled " "Disabled")
|
||||
(propertize fname 'face 'font-lock-function-name-face)
|
||||
(ad-make-single-advice-docstring advice class nil))
|
||||
(list function class advice))))))
|
||||
|
||||
(defun helm-advice-persistent-action (func-class-advice)
|
||||
(if current-prefix-arg
|
||||
|
|
@ -902,41 +893,76 @@ a string, i.e. the `symbol-name' of any existing symbol."
|
|||
;;; Locate elisp library
|
||||
;;
|
||||
;;
|
||||
(defvar helm--locate-library-cache nil)
|
||||
(defvar helm--locate-library-doc-cache (make-hash-table :test 'equal))
|
||||
(defun helm-locate-library-scan-list ()
|
||||
(cl-loop for dir in load-path
|
||||
with load-suffixes = '(".el")
|
||||
when (file-directory-p dir)
|
||||
append (directory-files
|
||||
dir t (concat (regexp-opt (get-load-suffixes))
|
||||
"\\'"))))
|
||||
nconc (directory-files
|
||||
dir nil (concat (regexp-opt (find-library-suffixes)) "\\'"))))
|
||||
|
||||
;;;###autoload
|
||||
(defun helm-locate-library ()
|
||||
"Preconfigured helm to locate elisp libraries."
|
||||
(interactive)
|
||||
(helm :sources (helm-build-in-buffer-source "Elisp libraries (Scan)"
|
||||
:data #'helm-locate-library-scan-list
|
||||
:fuzzy-match helm-locate-library-fuzzy-match
|
||||
:keymap helm-generic-files-map
|
||||
:search (unless helm-locate-library-fuzzy-match
|
||||
(lambda (regexp)
|
||||
(re-search-forward
|
||||
(if helm-ff-transformer-show-only-basename
|
||||
(replace-regexp-in-string
|
||||
"\\`\\^" "" regexp)
|
||||
regexp)
|
||||
nil t)))
|
||||
:match-part (lambda (candidate)
|
||||
(with-helm-buffer
|
||||
(if helm-ff-transformer-show-only-basename
|
||||
(helm-basename candidate) candidate)))
|
||||
:filter-one-by-one (lambda (c)
|
||||
(with-helm-buffer
|
||||
(if helm-ff-transformer-show-only-basename
|
||||
(cons (helm-basename c) c) c)))
|
||||
:action (helm-actions-from-type-file))
|
||||
:ff-transformer-show-only-basename nil
|
||||
:buffer "*helm locate library*"))
|
||||
(defun helm-locate-library (&optional arg)
|
||||
"Preconfigured helm to locate elisp libraries.
|
||||
|
||||
When `completions-detailed' or `helm-completions-detailed' is non
|
||||
nil, a description of libraries is provided. The libraries are
|
||||
partially cached in the variables
|
||||
`helm--locate-library-doc-cache' and
|
||||
`helm--locate-library-cache'. TIP: You can make these vars
|
||||
persistent for faster start with the psession package, using M-x
|
||||
psession-make-persistent-variable. NOTE: The caches affect as
|
||||
well `find-libray' and `locate-library' when `helm-mode' is
|
||||
enabled and `completions-detailed' is non nil. There is no need
|
||||
to refresh the caches, they will be updated automatically if some
|
||||
new libraries are found, however when a library update its
|
||||
headers and the description change you can reset the caches with
|
||||
a prefix arg."
|
||||
(interactive "P")
|
||||
(let (done)
|
||||
(when arg
|
||||
(setq helm--locate-library-cache nil)
|
||||
(clrhash helm--locate-library-doc-cache))
|
||||
(helm :sources
|
||||
(helm-build-in-buffer-source "Elisp libraries (Scan)"
|
||||
:data #'helm-locate-library-scan-list
|
||||
:fuzzy-match helm-locate-library-fuzzy-match
|
||||
:keymap helm-generic-files-map
|
||||
:candidate-transformer
|
||||
(lambda (candidates)
|
||||
(cl-loop with reporter = (unless done
|
||||
(make-progress-reporter
|
||||
"Scanning libraries..." 0 (length candidates)))
|
||||
with lgst = (helm-in-buffer-get-longest-candidate)
|
||||
for c in candidates
|
||||
for count from 0
|
||||
for bn = (helm-basename c 2)
|
||||
for sep = (helm-make-separator bn lgst)
|
||||
for path = (or (assoc-default bn helm--locate-library-cache)
|
||||
;; A lock file in LOAD-PATH (bug#2626).
|
||||
(unless (string-match "\\`\\.#" bn)
|
||||
(let ((p (find-library-name bn)))
|
||||
(push (cons bn p) helm--locate-library-cache)
|
||||
p)))
|
||||
for doc = (and path
|
||||
(or completions-detailed helm-completions-detailed)
|
||||
(or (gethash bn helm--locate-library-doc-cache)
|
||||
(puthash bn (helm-locate-lib-get-summary path)
|
||||
helm--locate-library-doc-cache)))
|
||||
for disp = (and path
|
||||
(if (and doc
|
||||
(or completions-detailed helm-completions-detailed))
|
||||
(helm-aand (propertize doc 'face 'font-lock-warning-face)
|
||||
(propertize " " 'display (concat sep it))
|
||||
(concat bn it))
|
||||
bn))
|
||||
when (and disp path)
|
||||
collect (cons disp path)
|
||||
when reporter do (progress-reporter-update reporter count)
|
||||
finally do (setq done t)))
|
||||
:action (helm-actions-from-type-file))
|
||||
:buffer "*helm locate library*")))
|
||||
|
||||
|
||||
;;; Modify variables from Helm
|
||||
;;
|
||||
|
|
@ -86,14 +86,18 @@
|
|||
uid 'face 'font-lock-warning-face))
|
||||
key)))
|
||||
|
||||
(defun helm-epa--select-keys (prompt keys)
|
||||
(cl-defun helm-epa--select-keys (prompt keys)
|
||||
"A helm replacement for `epa--select-keys'."
|
||||
(let ((result (helm :sources (helm-make-source "Epa select keys" 'helm-epa
|
||||
:candidates (lambda ()
|
||||
(helm-epa-get-key-list keys)))
|
||||
(helm-epa-get-key-list keys))
|
||||
:action (lambda (_candidate)
|
||||
(helm-marked-candidates)))
|
||||
:prompt (and prompt (helm-epa--format-prompt prompt))
|
||||
:buffer "*helm epa*")))
|
||||
(unless (equal result "")
|
||||
(if (or (equal result "") (null result))
|
||||
(cl-return-from helm-epa--select-keys
|
||||
(error "No keys selected, aborting"))
|
||||
result)))
|
||||
|
||||
(defun helm-epa--format-prompt (prompt)
|
||||
|
|
@ -104,13 +108,23 @@
|
|||
(replace-regexp-in-string "\\.[\t ]*\\'" "" (cadr split)))
|
||||
(format "%s: " (replace-regexp-in-string "\\.[\t ]*\\'" "" (car split))))))
|
||||
|
||||
(defun helm-epa--read-signature-type-help ()
|
||||
(with-temp-buffer
|
||||
(save-excursion
|
||||
(insert
|
||||
"n: Create a normal signature)\n"
|
||||
"c: Create a cleartext signature)\n"
|
||||
"d: Create a detached signature)"))
|
||||
(while (re-search-forward "^\\(.\\):" nil t)
|
||||
(helm-add-face-text-properties (match-beginning 1) (match-end 1)
|
||||
'font-lock-variable-name-face))
|
||||
(buffer-string)))
|
||||
|
||||
(defun helm-epa--read-signature-type ()
|
||||
"A helm replacement for `epa--read-signature-type'."
|
||||
(let ((answer (helm-read-answer "Signature type:
|
||||
(n - Create a normal signature)
|
||||
(c - Create a cleartext signature)
|
||||
(d - Create a detached signature)"
|
||||
'("n" "c" "d"))))
|
||||
(let ((answer (helm-read-answer "Signature type? [n,c,d,h]"
|
||||
'("n" "c" "d")
|
||||
#'helm-epa--read-signature-type-help)))
|
||||
(helm-acase answer
|
||||
("n" 'normal)
|
||||
("c" 'clear)
|
||||
|
|
@ -145,7 +159,7 @@
|
|||
(progn
|
||||
(advice-add 'epa--select-keys :override #'helm-epa--select-keys)
|
||||
(advice-add 'epa--read-signature-type :override #'helm-epa--read-signature-type))
|
||||
(advice-remove 'epa-select-keys #'helm-epa--select-keys)
|
||||
(advice-remove 'epa--select-keys #'helm-epa--select-keys)
|
||||
(advice-remove 'epa--read-signature-type #'helm-epa--read-signature-type)))
|
||||
|
||||
(defun helm-epa-action-transformer (actions _candidate)
|
||||
|
|
@ -290,7 +290,7 @@ at point."
|
|||
(delete-char -1) (setq del-dot t)
|
||||
(setq helm-ec-target (substring helm-ec-target 0 (1- (length helm-ec-target)))))
|
||||
(cond ((eq first ?\()
|
||||
(helm-lisp-completion-or-file-name-at-point))
|
||||
(helm-lisp-completion-at-point))
|
||||
;; In eshell `pcomplete-parse-arguments' is called
|
||||
;; with `pcomplete-parse-arguments-function'
|
||||
;; locally bound to `eshell-complete-parse-arguments'
|
||||
|
|
@ -23,7 +23,8 @@
|
|||
(require 'edebug)
|
||||
|
||||
(declare-function helm-lisp-completion-at-point "helm-elisp.el")
|
||||
|
||||
(declare-function helm-elisp-show-doc-modeline "helm-elisp.el")
|
||||
(defvar helm-elisp-help-function)
|
||||
|
||||
(defgroup helm-eval nil
|
||||
"Eval related Applications and libraries for Helm."
|
||||
|
|
@ -83,8 +84,13 @@ Should take one arg: the string to display."
|
|||
(define-key map (kbd "<left>") #'backward-char)
|
||||
map))
|
||||
|
||||
(defclass helm-evaluation-result-class (helm-source-dummy)
|
||||
((echo-input-in-header-line
|
||||
:initarg :echo-input-in-header-line
|
||||
:initform 'never)))
|
||||
|
||||
(defun helm-build-evaluation-result-source ()
|
||||
(helm-build-dummy-source "Evaluation Result"
|
||||
(helm-make-source "Evaluation Result" 'helm-evaluation-result-class
|
||||
:multiline t
|
||||
:mode-line "C-RET: nl-and-indent, M-tab: reindent, C-tab:complete, C-p/n: next/prec-line."
|
||||
:filtered-candidate-transformer
|
||||
|
|
@ -92,11 +98,11 @@ Should take one arg: the string to display."
|
|||
(list
|
||||
(condition-case nil
|
||||
(with-helm-current-buffer
|
||||
(pp-to-string
|
||||
(if edebug-active
|
||||
(edebug-eval-expression
|
||||
(read helm-pattern))
|
||||
(eval (read helm-pattern) t))))
|
||||
(pp-to-string
|
||||
(if edebug-active
|
||||
(edebug-eval-expression
|
||||
(read helm-pattern))
|
||||
(eval (read helm-pattern) t))))
|
||||
(error "Error"))))
|
||||
:nohighlight t
|
||||
:keymap helm-eval-expression-map
|
||||
|
|
@ -67,25 +67,24 @@ If this variable is not set by the user, it will be calculated
|
|||
automatically.")
|
||||
|
||||
(defun helm-external-commands-list-1 (&optional sort)
|
||||
"Returns a list of all external commands the user can execute.
|
||||
"Return a list of all external commands the user can execute.
|
||||
If `helm-external-commands-list' is non-nil it will return its
|
||||
contents. Else it calculates all external commands and sets
|
||||
`helm-external-commands-list'."
|
||||
(helm-aif helm-external-commands-list
|
||||
it
|
||||
(setq helm-external-commands-list
|
||||
(cl-loop
|
||||
for dir in (split-string (getenv "PATH") path-separator)
|
||||
when (and (file-exists-p dir) (file-accessible-directory-p dir))
|
||||
for lsdir = (cl-loop for i in (directory-files dir t)
|
||||
for bn = (file-name-nondirectory i)
|
||||
when (and (not (member bn completions))
|
||||
(not (file-directory-p i))
|
||||
(file-executable-p i))
|
||||
collect bn)
|
||||
append lsdir into completions
|
||||
finally return
|
||||
(if sort (sort completions 'string-lessp) completions)))))
|
||||
(or helm-external-commands-list
|
||||
(setq helm-external-commands-list
|
||||
(cl-loop for dir in (split-string (getenv "PATH") path-separator)
|
||||
when (and (file-exists-p dir)
|
||||
(file-accessible-directory-p dir))
|
||||
for lsdir = (cl-loop for i in (directory-files dir t)
|
||||
for bn = (file-name-nondirectory i)
|
||||
when (and (not (member bn completions))
|
||||
(not (file-directory-p i))
|
||||
(file-executable-p i))
|
||||
collect bn)
|
||||
append lsdir into completions
|
||||
finally return
|
||||
(if sort (sort completions 'string-lessp) completions)))))
|
||||
|
||||
(defun helm-run-or-raise (exe &optional files detached)
|
||||
"Run asynchronously EXE or jump to the application window.
|
||||
|
|
@ -132,10 +132,11 @@
|
|||
(cl-assert (executable-find helm-fd-executable) nil "Could not find fd executable")
|
||||
(cl-assert (not (file-remote-p directory)) nil "Fd not supported on remote directories")
|
||||
(let ((default-directory directory))
|
||||
(helm :sources (helm-make-source
|
||||
(format "fd (%s)"
|
||||
(abbreviate-file-name default-directory))
|
||||
'helm-fd-class)
|
||||
(helm :sources (helm-make-source "Fd" 'helm-fd-class
|
||||
:header-name
|
||||
(lambda (name)
|
||||
(format "%s (%s)"
|
||||
name (abbreviate-file-name default-directory))))
|
||||
:buffer "*helm fd*")))
|
||||
|
||||
|
||||
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 "e") 'helm-etags-select)
|
||||
(define-key map (kbd "l") 'helm-locate)
|
||||
(define-key map (kbd "L") 'helm-locate-library)
|
||||
(define-key map (kbd "s") 'helm-surfraw)
|
||||
(define-key map (kbd "r") 'helm-regexp)
|
||||
(define-key map (kbd "m") 'helm-man-woman)
|
||||
|
|
@ -84,6 +85,7 @@ Using `setq' to modify this variable will have no effect."
|
|||
(define-key map (kbd "b") 'helm-resume)
|
||||
(define-key map (kbd "M-g i") 'helm-gid)
|
||||
(define-key map (kbd "@") 'helm-packages)
|
||||
(define-key map (kbd "h p") 'helm-finder)
|
||||
map)
|
||||
"Default keymap for \\[helm-command-prefix] commands.
|
||||
The normal global definition of the character \\[helm-command-prefix] indirects to this keymap.")
|
||||
|
|
@ -533,16 +533,16 @@ Have no effect when grep backend use \"--color=\"."
|
|||
(and rec-com rec-com-ack-p)))))))
|
||||
|
||||
(defun helm-grep--pipe-command-for-grep-command (smartcase pipe-switches &optional grep-cmd)
|
||||
(pcase (or grep-cmd (helm-grep-command))
|
||||
(helm-acase (or grep-cmd (helm-grep-command))
|
||||
;; Use grep for GNU regexp based tools.
|
||||
((or "grep" "zgrep" "git-grep")
|
||||
(("grep" "zgrep" "git-grep")
|
||||
(format "grep --color=always%s %s"
|
||||
(if smartcase " -i" "")
|
||||
pipe-switches))
|
||||
;; Use ack-grep for PCRE based tools.
|
||||
;; Sometimes ack-grep cmd is ack only.
|
||||
((and (pred (string-match-p "ack")) ack)
|
||||
(format "%s --smart-case --color %s" ack pipe-switches))))
|
||||
;; Sometimes ack-grep cmd is ack only so compare by matching ack.
|
||||
((guard (string-match-p "ack" it))
|
||||
(format "%s --smart-case --color %s" it pipe-switches))))
|
||||
|
||||
(defun helm-grep--prepare-cmd-line (only-files &optional include zgrep)
|
||||
(let* ((default-directory (or helm-ff-default-directory
|
||||
|
|
@ -1196,7 +1196,7 @@ of grep."
|
|||
:initform nil
|
||||
:documentation
|
||||
" The grep backend that will be used.
|
||||
It is actually used only as an internal flag
|
||||
It is currently used only as an internal flag
|
||||
and doesn't set the backend by itself.
|
||||
You probably don't want to modify this.")
|
||||
(candidate-number-limit :initform 9999)
|
||||
|
|
@ -1243,7 +1243,7 @@ Argument DEFAULT-INPUT is use as `default' arg of `helm' and
|
|||
INPUT is used as `input' arg of `helm'. See `helm' docstring.
|
||||
|
||||
Arg BACKEND when non-nil specifies which backend to use.
|
||||
It is used actually to specify \\='zgrep' or \\='git'.
|
||||
It is used currently to specify \\='zgrep' or \\='git'.
|
||||
When BACKEND \\='zgrep' is used don't prompt for a choice in
|
||||
recurse, and ignore EXTS, search being made recursively on files
|
||||
matching `helm-zgrep-file-extension-regexp' only."
|
||||
|
|
@ -1635,8 +1635,12 @@ returns if available with current AG version."
|
|||
(helm-default-directory)
|
||||
default-directory))
|
||||
(cmd-line (helm-grep-ag-prepare-cmd-line
|
||||
helm-pattern (or (file-remote-p directory 'localname)
|
||||
directory)
|
||||
;; NOTE Encode directory name and pattern,
|
||||
;; or it may not work with Chinese and maybe other non-utf8
|
||||
;; characters on MSWindows systems issue#2677 and issue#2678.
|
||||
(encode-coding-string helm-pattern locale-coding-system)
|
||||
(or (file-remote-p directory 'localname)
|
||||
(encode-coding-string directory locale-coding-system))
|
||||
type))
|
||||
(start-time (float-time))
|
||||
(proc-name (helm-grep--ag-command)))
|
||||
|
|
@ -1693,18 +1697,27 @@ returns if available with current AG version."
|
|||
proc-name
|
||||
(replace-regexp-in-string "\n" "" event))))))))))
|
||||
|
||||
(defvar helm-grep-ag-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(set-keymap-parent map helm-grep-map)
|
||||
(define-key map (kbd "C-s") 'helm-grep-run-ag-grep-parent-directory)
|
||||
map))
|
||||
|
||||
(defclass helm-grep-ag-class (helm-source-async)
|
||||
((nohighlight :initform t)
|
||||
(pcre :initarg :pcre :initform t
|
||||
:documentation
|
||||
" Backend is using pcre regexp engine when non--nil.")
|
||||
(keymap :initform 'helm-grep-map)
|
||||
(keymap :initform 'helm-grep-ag-map)
|
||||
(history :initform 'helm-grep-ag-history)
|
||||
(help-message :initform 'helm-grep-help-message)
|
||||
(filtered-candidate-transformer :initform #'helm-grep-fc-transformer)
|
||||
(persistent-action :initform 'helm-grep-persistent-action)
|
||||
(persistent-help :initform "Jump to line (`C-u' Record in mark ring)")
|
||||
(candidate-number-limit :initform 99999)
|
||||
(directory :initarg :directory :initform nil
|
||||
:documentation
|
||||
" Directory currently searched.")
|
||||
(requires-pattern :initform 2)
|
||||
(nomark :initform t)
|
||||
(action :initform 'helm-grep-actions)
|
||||
|
|
@ -1728,16 +1741,30 @@ If INPUT is provided, use it as the search string."
|
|||
:header-name (lambda (name)
|
||||
(format "%s [%s]"
|
||||
name (abbreviate-file-name directory)))
|
||||
:directory directory
|
||||
:action (append helm-grep-actions
|
||||
`((,(format "%s grep parent directory"
|
||||
(upcase (helm-grep--ag-command)))
|
||||
. helm-grep-ag-grep-parent-directory)))
|
||||
:candidates-process
|
||||
(lambda () (helm-grep-ag-init directory type))))
|
||||
(helm-set-local-variable 'helm-input-idle-delay helm-grep-input-idle-delay)
|
||||
(helm :sources 'helm-source-grep-ag
|
||||
:keymap helm-grep-map
|
||||
:history 'helm-grep-ag-history
|
||||
:input input
|
||||
:truncate-lines helm-grep-truncate-lines
|
||||
:buffer (format "*helm %s*" (helm-grep--ag-command))))
|
||||
|
||||
(defun helm-grep-ag-grep-parent-directory (_candidate)
|
||||
"Restart helm-grep-ag in the parent of the currently searched directory."
|
||||
(let* ((src (with-helm-buffer (car helm-sources)))
|
||||
(directory (helm-basedir (helm-get-attr 'directory src) t))
|
||||
(input helm-pattern))
|
||||
(helm-grep-ag-1 directory nil input)))
|
||||
|
||||
(helm-make-command-from-action helm-grep-run-ag-grep-parent-directory
|
||||
"Ag grep parent directory." 'helm-grep-ag-grep-parent-directory)
|
||||
|
||||
(defun helm-grep-ag (directory with-types)
|
||||
"Start grep AG in DIRECTORY.
|
||||
When WITH-TYPES is non-nil provide completion on AG types."
|
||||
|
|
@ -588,10 +588,10 @@ On completion (\\[helm-ff-run-complete-fn-at-point]):
|
|||
|
||||
Use of wildcard is supported to run an action over a set of files.
|
||||
|
||||
Example: You can copy all the files with \".el\" extension by using \"*.el\" and
|
||||
Example: You can copy all the files with \".el\" extension by using \"*.el\" and
|
||||
then run copy action.
|
||||
|
||||
Similarly, \"**.el\" (note the two stars) will recursively select all \".el\"
|
||||
Similarly, \"**.el\" (note the two stars) will recursively select all \".el\"
|
||||
files under the current directory.
|
||||
|
||||
Note that when recursively copying files, you may have files with same name
|
||||
|
|
@ -606,7 +606,7 @@ to backup files in current directory.
|
|||
This command is available only when `dired-async-mode' is active.
|
||||
|
||||
When using an action that involves an external backend (e.g. grep), using \"**\"
|
||||
is not recommended (even thought it works fine) because it will be slower to
|
||||
is not recommended (even though it works fine) because it will be slower to
|
||||
select all the files. You are better off leaving the backend to do it, it will
|
||||
be faster. However, if you know you have not many files it is reasonable to use
|
||||
this, also using not recursive wildcard (e.g. \"*.el\") is perfectly fine for
|
||||
|
|
@ -614,14 +614,14 @@ this.
|
|||
|
||||
The \"**\" feature is active by default in the option `helm-file-globstar'. It
|
||||
is different from the Bash \"shopt globstar\" feature in that to list files with
|
||||
a named extension recursively you would write \"**.el\" whereas in Bash it would
|
||||
be \"**/*.el\". Directory selection with \"**/\" like Bash \"shopt globstar\"
|
||||
a named extension recursively you would write \"**.el\" whereas in Bash it would
|
||||
be \"**/*.el\". Directory selection with \"**/\" like Bash \"shopt globstar\"
|
||||
option is not supported yet.
|
||||
|
||||
Helm supports different styles of wildcards:
|
||||
|
||||
- `sh' style, the ones supported by `file-expand-wildcards'.
|
||||
e.g. \"*.el\", \"*.[ch]\" which match respectively all \".el\"
|
||||
e.g. \"*.el\", \"*.[ch]\" which match respectively all \".el\"
|
||||
files or all \".c\" and \".h\" files.
|
||||
|
||||
- `bash' style (partially) In addition to what allowed in `sh'
|
||||
|
|
@ -807,7 +807,7 @@ instead its scp method if you want to avoid out of memory
|
|||
problems and crash Emacs or the whole system. Moreover when using
|
||||
scp method, you will hit a bug when copying more than 3 files at
|
||||
the time, see [[https://github.com/emacs-helm/helm/issues/1945][bug#1945]].
|
||||
The best way actually is using Rsync to copy files from or to
|
||||
The best way currently is using Rsync to copy files from or to
|
||||
remote, see [[Use Rsync to copy files][Use Rsync to copy files]].
|
||||
Also if you often work on remote you may consider using SSHFS
|
||||
instead of relying on tramp.
|
||||
|
|
@ -873,7 +873,7 @@ rsync command line with a prefix arg (see above).
|
|||
|
||||
Since Android doesn't provide anymore mass storage for USB, it is
|
||||
not simple to access files on Android, the best way to do this
|
||||
actually seems to use Adb, here some hints to set this up, read
|
||||
currently seems to use Adb, here some hints to set this up, read
|
||||
in addition the Tramp documentation.
|
||||
|
||||
1) Install Adb, most distribution provide it.
|
||||
|
|
@ -915,6 +915,40 @@ On remote files grep is not well supported by TRAMP unless you suspend updates b
|
|||
entering the pattern and re-enable it once your pattern is ready.
|
||||
To toggle suspend-update, use `\\<helm-map>\\[helm-toggle-suspend-update]'.
|
||||
|
||||
*** Compressing or uncompressing files from helm-find-files
|
||||
|
||||
**** Compressing/uncompressing using Helm commands
|
||||
|
||||
Helm provide commands like dired (reusing dired code)
|
||||
to (un)compress files from `helm-find-files', however these
|
||||
commands are asynchronous.
|
||||
|
||||
You can use `\\<helm-find-files-map>\\[helm-ff-run-compress-marked-files]' to compress marked files.
|
||||
To compress file(s) to an archive use `\\<helm-find-files-map>\\[helm-ff-run-compress-to]'.
|
||||
|
||||
To quickly compress/uncompress small files without quitting Helm use `\\<helm-find-files-map>\\[helm-ff-persistent-compress]'.
|
||||
NOTE: This persistent action is NOT asynchronous, IOW it will block Helm
|
||||
for a while until compression/uncompression finish.
|
||||
|
||||
**** Compressing/uncompressing using external commands in Eshell
|
||||
|
||||
You can use Eshell aliases to uncompress files,
|
||||
see [[Execute Eshell commands on files][Execute Eshell commands on files]] for more infos.
|
||||
|
||||
Here some aliases using commands from the excellent =atools= package:
|
||||
|
||||
alias pack2zip apack -e -F .zip $* &
|
||||
alias pack2gz apack -e -F .tar.gz $* &
|
||||
alias pack2bz apack -e -F .tar.bz $* &
|
||||
alias pack2xz apack -e -F .tar.xz $* &
|
||||
alias unpack aunpack $1 &
|
||||
|
||||
Note the \"&\" at end of commands that make eshell aliases asynchronous.
|
||||
NOTE: Using the ampersand at end of command to make it asynchronous is broken
|
||||
in all emacs versions before emacs-28 (see emacs bug#50209).
|
||||
|
||||
Of course you can use any other commands of your choice as aliases.
|
||||
|
||||
*** Execute Eshell commands on files
|
||||
|
||||
Setting up aliases in Eshell allows you to set up powerful customized commands.
|
||||
|
|
@ -1006,9 +1040,9 @@ Starting at helm version 2.9.7 it is somewhat possible to
|
|||
colorize fnames by listing files without loosing performances with
|
||||
external commands (ls and awk) if your system is compatible.
|
||||
For this you can use `helm-list-dir-external' as value
|
||||
for `helm-list-directory-function'.
|
||||
for `helm-list-remote-directory-fn'.
|
||||
|
||||
See `helm-list-directory-function' documentation for more infos.
|
||||
See `helm-list-remote-directory-fn' documentation for more infos.
|
||||
|
||||
**** Completing host
|
||||
|
||||
|
|
@ -1267,7 +1301,10 @@ If `all-the-icons' package is installed, turning on
|
|||
|\\[helm-ff-sort-by-size]|Sort by size.
|
||||
|\\[helm-ff-toggle-dirs-only]|Show only directories.
|
||||
|\\[helm-ff-toggle-files-only]|Show only files.
|
||||
|\\[helm-ff-sort-by-ext]|Sort by extensions.")
|
||||
|\\[helm-ff-sort-by-ext]|Sort by extensions.
|
||||
|\\[helm-ff-run-compress-to]|Compress file(s) to archive.
|
||||
|\\[helm-ff-run-compress-marked-files]|Compress file(s).
|
||||
|\\[helm-ff-persistent-compress]|Compress file(s) without quitting.")
|
||||
|
||||
;;; Help for file-name-history
|
||||
;;
|
||||
|
|
@ -2251,6 +2288,15 @@ See [[Moving in `helm-buffer'][Moving in `helm-buffer']].
|
|||
(defvar helm-top-help-message
|
||||
"* Helm Top
|
||||
|
||||
** Tips
|
||||
|
||||
*** Auto update
|
||||
|
||||
You can enable auto updating in `helm-top' by turning on
|
||||
`helm-top-poll-mode' either interactively or in your init file
|
||||
with (helm-top-poll-mode 1).
|
||||
Calling `helm-top' with a prefix arg also toggle auto updating.
|
||||
|
||||
** Commands
|
||||
\\<helm-top-map>
|
||||
|Keys|Description
|
||||
|
|
@ -100,7 +100,7 @@ Don't use `setq' to set this."
|
|||
:group 'helm-imenu
|
||||
:type 'boolean
|
||||
:set (lambda (var val)
|
||||
(if (featurep 'all-the-icons)
|
||||
(if (require 'all-the-icons nil t)
|
||||
(set var val)
|
||||
(set var nil))))
|
||||
|
||||
|
|
@ -111,17 +111,17 @@ Don't use `setq' to set this."
|
|||
:group 'helm-imenu
|
||||
:type 'boolean
|
||||
:set (lambda (var val)
|
||||
(if (featurep 'all-the-icons)
|
||||
(if (require 'all-the-icons nil t)
|
||||
(set var val)
|
||||
(set var nil))))
|
||||
|
||||
(defcustom helm-imenu-icon-type-alist
|
||||
'(("Array" . (all-the-icons-material "crop" :face font-lock-builtin-face))
|
||||
("Array" . (all-the-icons-material "crop" :face font-lock-builtin-face))
|
||||
("Boolean" . (all-the-icons-material "crop" :face font-lock-builtin-face))
|
||||
("Arrays" . (all-the-icons-material "crop" :face font-lock-builtin-face))
|
||||
("Boolean" . (all-the-icons-material "crop" :face font-lock-builtin-face))
|
||||
("Booleans" . (all-the-icons-material "crop" :face font-lock-builtin-face))
|
||||
("Class" . (all-the-icons-octicon "package" :face font-lock-type-face))
|
||||
("Class" . (all-the-icons-octicon "package" :face font-lock-type-face))
|
||||
("Classes" . (all-the-icons-octicon "package" :face font-lock-type-face))
|
||||
("Color" . (all-the-icons-material "color_lens" :face font-lock-builtin-face))
|
||||
("Colors" . (all-the-icons-material "color_lens" :face font-lock-builtin-face))
|
||||
("Constant" . (all-the-icons-material "crop" :face font-lock-builtin-face))
|
||||
|
|
@ -157,7 +157,7 @@ Don't use `setq' to set this."
|
|||
("Module" . (all-the-icons-faicon "angle-double-right" :face font-lock-builtin-face))
|
||||
("Modules" . (all-the-icons-faicon "angle-double-right" :face font-lock-builtin-face))
|
||||
("Numeric" . (all-the-icons-material "crop" :face font-lock-builtin-face))
|
||||
("Numeric" . (all-the-icons-material "crop" :face font-lock-builtin-face))
|
||||
("Numerics" . (all-the-icons-material "crop" :face font-lock-builtin-face))
|
||||
("Object" . (all-the-icons-faicon "angle-double-right" :face font-lock-builtin-face))
|
||||
("Objects" . (all-the-icons-faicon "angle-double-right" :face font-lock-builtin-face))
|
||||
("Operator" . (all-the-icons-faicon "calculator" :face font-lock-builtin-face))
|
||||
|
|
@ -167,7 +167,7 @@ Don't use `setq' to set this."
|
|||
("Reference" . (all-the-icons-octicon "book" :face font-lock-variable-name-face))
|
||||
("References" . (all-the-icons-octicon "book" :face font-lock-variable-name-face))
|
||||
("Snippet" . (all-the-icons-material "border_style" :face font-lock-variable-name-face))
|
||||
("Snippet" . (all-the-icons-material "border_style" :face font-lock-variable-name-face))
|
||||
("Snippets" . (all-the-icons-material "border_style" :face font-lock-variable-name-face))
|
||||
("String" . (all-the-icons-material "text_fields" :face font-lock-variable-name-face))
|
||||
("Strings" . (all-the-icons-material "text_fields" :face font-lock-variable-name-face))
|
||||
("Struct" . (all-the-icons-faicon "cog" :face font-lock-type-face))
|
||||
|
|
@ -320,7 +320,8 @@ The sexp should be an `all-the-icons' function with its args."
|
|||
(if (equal (cdr cur) mb)
|
||||
(prog1 nil
|
||||
(helm-set-pattern "")
|
||||
(helm-force-update (concat "\\_<" (car cur) "\\_>")))
|
||||
(helm-force-update
|
||||
(concat "\\_<" (regexp-quote (car cur)) "\\_>")))
|
||||
t)))
|
||||
|
||||
(defun helm-imenu-quit-and-find-file-fn (source)
|
||||
|
|
@ -406,12 +407,11 @@ The sexp should be an `all-the-icons' function with its args."
|
|||
(and (cdr elm)
|
||||
;; Semantic uses overlays whereas imenu uses
|
||||
;; markers (Bug#1706).
|
||||
(setcdr elm (pcase (cdr elm) ; Same as [1].
|
||||
((and ov (pred overlayp))
|
||||
(copy-overlay ov))
|
||||
((and mk (or (pred markerp)
|
||||
(pred integerp)))
|
||||
(copy-marker mk))))
|
||||
(setcdr elm (helm-acase (cdr elm) ; Same as [1].
|
||||
((guard (overlayp it))
|
||||
(copy-overlay it))
|
||||
((guard (or (markerp it) (integerp it)))
|
||||
(copy-marker it))))
|
||||
(list elm))))))
|
||||
|
||||
(defun helm-imenu--get-prop (item)
|
||||
|
|
@ -443,10 +443,9 @@ The icon is found in `helm-imenu-icon-type-alist', if not
|
|||
(cl-loop for (k . v) in candidates
|
||||
;; (k . v) == (symbol-name . marker)
|
||||
for bufname = (buffer-name
|
||||
(pcase v
|
||||
((pred overlayp) (overlay-buffer v))
|
||||
((or (pred markerp) (pred integerp))
|
||||
(marker-buffer v))))
|
||||
(helm-acase v
|
||||
((guard (overlayp it)) (overlay-buffer it))
|
||||
((guard (markerp it)) (marker-buffer it))))
|
||||
for types = (or (helm-imenu--get-prop k)
|
||||
(list (if (with-current-buffer bufname
|
||||
(derived-mode-p 'prog-mode))
|
||||
|
|
@ -141,6 +141,21 @@ If line have a node use the node, otherwise use directly first name found."
|
|||
:initform nil
|
||||
:custom 'string)
|
||||
(init :initform #'helm-info-init)
|
||||
(filtered-candidate-transformer
|
||||
:initform
|
||||
(lambda (candidates _source)
|
||||
(cl-loop for line in candidates
|
||||
when (string-match helm-info--node-regexp line)
|
||||
do (progn
|
||||
(helm-add-face-text-properties
|
||||
(match-beginning 1) (match-end 1)
|
||||
'font-lock-keyword-face
|
||||
nil line)
|
||||
(helm-add-face-text-properties
|
||||
(match-beginning 2) (match-end 2)
|
||||
'font-lock-warning-face
|
||||
nil line))
|
||||
collect line)))
|
||||
(display-to-real :initform #'helm-info-display-to-real)
|
||||
(get-line :initform #'buffer-substring)
|
||||
(action :initform '(("Goto node" . helm-info-goto)))))
|
||||
|
|
@ -301,14 +316,22 @@ Info files are made available."
|
|||
;; Symbol at point is used as default as long as one of the sources
|
||||
;; in `helm-info-default-sources' is member of
|
||||
;; `helm-sources-using-default-as-input'.
|
||||
(cl-loop for src in helm-info-default-sources
|
||||
for name = (if (symbolp src)
|
||||
(assoc 'name (symbol-value src))
|
||||
(assoc 'name src))
|
||||
unless name
|
||||
do (warn "Couldn't build source `%S' without its info file" src))
|
||||
(helm :sources helm-info-default-sources
|
||||
:buffer "*helm info*"))
|
||||
(let* ((current (and Info-current-file
|
||||
(intern-soft
|
||||
(concat "helm-source-info-"
|
||||
(helm-basename Info-current-file)))))
|
||||
(helm-info-default-sources
|
||||
(if (and current (not (memq current helm-info-default-sources)))
|
||||
(cons current helm-info-default-sources)
|
||||
helm-info-default-sources)))
|
||||
(cl-loop for src in helm-info-default-sources
|
||||
for name = (if (symbolp src)
|
||||
(assoc 'name (symbol-value src))
|
||||
(assoc 'name src))
|
||||
unless name
|
||||
do (warn "Couldn't build source `%S' without its info file" src))
|
||||
(helm :sources helm-info-default-sources
|
||||
:buffer "*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:
|
||||
|
||||
Gnu/linux: \"locate %s -e -A --regex %s\"
|
||||
Gnu/linux: \"locate %s -e -A -N --regex %s\"
|
||||
berkeley-unix: \"locate %s %s\"
|
||||
windows-nt: \"es %s %s\"
|
||||
Others: \"locate %s %s\"
|
||||
|
|
@ -69,6 +69,10 @@ for this.
|
|||
The last option must be the one preceding pattern i.e \"-r\" or
|
||||
\"--regex\".
|
||||
|
||||
The option \"-N\" may not be available on old locate versions, it is needed on
|
||||
latest systems as locate send quoted filenames, it is BTW enabled by default, if
|
||||
this option is not recognized on your system, remove it.
|
||||
|
||||
You will be able to pass other options such as \"-b\" or \"l\"
|
||||
during Helm invocation after entering pattern only when multi
|
||||
matching, not when fuzzy matching.
|
||||
|
|
@ -211,7 +215,8 @@ See `helm-locate-with-db' and `helm-locate'."
|
|||
(unless helm-locate-command
|
||||
(setq helm-locate-command
|
||||
(cl-case system-type
|
||||
(gnu/linux "locate %s -e -A --regex %s")
|
||||
;; Use -N option by default (bug#2625)
|
||||
(gnu/linux "locate %s -e -A -N --regex %s")
|
||||
(berkeley-unix "locate %s %s")
|
||||
(windows-nt "es %s %s")
|
||||
(t "locate %s %s")))))
|
||||
|
|
@ -27,6 +27,8 @@
|
|||
(declare-function jabber-chat-with "ext:jabber.el")
|
||||
(declare-function jabber-read-account "ext:jabber.el")
|
||||
(declare-function helm-comp-read "helm-mode")
|
||||
(declare-function outline-back-to-heading "outline.el")
|
||||
(declare-function outline-end-of-heading "outline.el")
|
||||
|
||||
|
||||
(defgroup helm-misc nil
|
||||
|
|
@ -387,6 +389,33 @@ Default action change TZ environment variable locally to emacs."
|
|||
(delete-minibuffer-contents)
|
||||
(insert elm)))
|
||||
|
||||
;;;###autoload
|
||||
(defun helm-outline ()
|
||||
"Basic helm navigation tool for outline buffers."
|
||||
(interactive)
|
||||
(helm :sources (helm-build-sync-source "helm outline"
|
||||
:candidates
|
||||
(lambda ()
|
||||
(with-helm-current-buffer
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(cl-loop while (re-search-forward outline-regexp nil t)
|
||||
for beg = (match-beginning 0)
|
||||
for end = (progn
|
||||
(outline-end-of-heading) (point))
|
||||
collect
|
||||
(cons (buffer-substring beg end) beg)))))
|
||||
:action (lambda (pos)
|
||||
(helm-goto-char pos)
|
||||
(helm-highlight-current-line)))
|
||||
:preselect (save-excursion
|
||||
(when (condition-case _err
|
||||
(outline-back-to-heading)
|
||||
(error nil))
|
||||
(regexp-quote
|
||||
(buffer-substring
|
||||
(point) (progn (outline-end-of-heading) (point))))))
|
||||
:buffer "*helm outline*"))
|
||||
|
||||
(provide 'helm-misc)
|
||||
|
||||
|
|
@ -30,6 +30,10 @@
|
|||
(defvar helm-mode)
|
||||
(defvar password-cache)
|
||||
(defvar package--builtins)
|
||||
(defvar helm--locate-library-doc-cache)
|
||||
(defvar helm--locate-library-cache)
|
||||
(defvar completion-lazy-hilit) ; Emacs-30 only.
|
||||
(defvar eww-bookmarks)
|
||||
|
||||
;; No warnings in Emacs built --without-x
|
||||
(declare-function x-file-dialog "xfns.c")
|
||||
|
|
@ -46,6 +50,7 @@
|
|||
(declare-function package-get-descriptor "package")
|
||||
(declare-function print-coding-system-briefly "mul-diag.el")
|
||||
(declare-function color-rgb-to-hex "color.el")
|
||||
(declare-function find-library-name "find-func.el")
|
||||
|
||||
(defgroup helm-mode nil
|
||||
"Enable helm completion."
|
||||
|
|
@ -62,6 +67,9 @@
|
|||
(dired-do-symlink . helm-read-file-name-handler-1)
|
||||
(dired-do-relsymlink . helm-read-file-name-handler-1)
|
||||
(dired-do-hardlink . helm-read-file-name-handler-1)
|
||||
;; Next two are using completing-read where not needed.
|
||||
(read-multiple-choice--long-answers . nil)
|
||||
(dired-do-touch . nil)
|
||||
(basic-save-buffer . helm-read-file-name-handler-1)
|
||||
(write-file . (default helm-read-file-name-handler-1))
|
||||
(write-region . (default helm-read-file-name-handler-1))
|
||||
|
|
@ -252,6 +260,11 @@ This is mainly needed to prevent \"*Completions*\" buffers to popup.")
|
|||
Not guaranteed to work with Emacs < 27."
|
||||
:type 'boolean
|
||||
:group 'helm-mode)
|
||||
|
||||
(defvar helm-mode-find-file-target-alist
|
||||
'(("switch-to-buffer" . helm-buffers-quit-and-find-file-fn))
|
||||
"An alist composed of (SOURCE_NAME . FUNCTION) elements.
|
||||
Where FUNCTION is a function suitable for `helm-quit-and-find-file'.")
|
||||
|
||||
(defface helm-mode-prefix
|
||||
`((t ,@(and (>= emacs-major-version 27) '(:extend t))
|
||||
|
|
@ -263,6 +276,16 @@ Not guaranteed to work with Emacs < 27."
|
|||
'((t :inherit font-lock-property-name-face))
|
||||
"Face used to highlight invalid functions."
|
||||
:group 'helm-mode)
|
||||
|
||||
(defface helm-completions-detailed
|
||||
'((t :inherit font-lock-warning-face))
|
||||
"Face used to highlight completion-detailed informations."
|
||||
:group 'helm-mode)
|
||||
|
||||
(defface helm-completions-annotations
|
||||
'((t :inherit font-lock-property-name-face))
|
||||
"Face used to highlight annotations in completion."
|
||||
:group 'helm-mode)
|
||||
|
||||
(defvar helm-comp-read-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
|
|
@ -272,6 +295,12 @@ Not guaranteed to work with Emacs < 27."
|
|||
map)
|
||||
"Keymap for `helm-comp-read'.")
|
||||
|
||||
(defvar helm-comp-in-region-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(set-keymap-parent map helm-comp-read-map)
|
||||
map)
|
||||
"Keymap for completion-at-point and friends.")
|
||||
|
||||
(defun helm-mode-delete-char-backward-1 ()
|
||||
(interactive)
|
||||
(condition-case err
|
||||
|
|
@ -349,8 +378,8 @@ NOT `setq'."
|
|||
:set (lambda (var val)
|
||||
(set var val)
|
||||
(if (memq val '(helm helm-fuzzy))
|
||||
(define-key helm-comp-read-map (kbd "DEL") 'helm-mode-delete-char-backward-maybe)
|
||||
(define-key helm-comp-read-map (kbd "DEL") 'delete-backward-char))))
|
||||
(define-key helm-comp-in-region-map (kbd "DEL") 'helm-mode-delete-char-backward-maybe)
|
||||
(define-key helm-comp-in-region-map (kbd "DEL") 'delete-backward-char))))
|
||||
|
||||
(defconst helm-completion--all-styles
|
||||
(let ((flex (if (assq 'flex completion-styles-alist)
|
||||
|
|
@ -366,21 +395,23 @@ NOT `setq'."
|
|||
|
||||
(defcustom helm-completion-styles-alist '((gud-mode . helm)
|
||||
;; See https://github.com/djcb/mu/issues/2181.
|
||||
(mu4e-compose-mode . emacs))
|
||||
(mu4e-compose-mode . emacs)
|
||||
(wfnames-mode . (emacs helm flex)))
|
||||
"Allow configuring `helm-completion-style' per mode or command.
|
||||
|
||||
NOTE: Use a mode for a completion that will be used in a buffer
|
||||
i.e. completion-in-region, whereas you have to specify instead a
|
||||
command to affect the completing-read trigerred by this
|
||||
command. Commands specified in `helm-completing-read-handlers-alist' take
|
||||
precedence on commands you put here.
|
||||
NOTE: Commands involving `completing-read' specified in
|
||||
`helm-completing-read-handlers-alist' take precedence on commands
|
||||
you put here. Specifying a mode instead of a command affect only
|
||||
completion-in-region and not the completing-read's called in this mode, use
|
||||
`helm-completing-read-handlers-alist' for this.
|
||||
|
||||
Each entry is a cons cell like (mode . style) where style must be
|
||||
a suitable value for `helm-completion-style'. When specifying
|
||||
emacs as style for a mode or a command, `completion-styles' can
|
||||
be specified by using a cons cell specifying completion-styles to
|
||||
use with helm emacs style, e.g. (foo-mode . (emacs helm flex))
|
||||
will set `completion-styles' to \\='(helm flex) for foo-mode."
|
||||
Each entry is a cons cell like (mode_or_command . style) where
|
||||
style must be a suitable value for `helm-completion-style'. When
|
||||
specifying emacs as style for a mode or a command,
|
||||
`completion-styles' can be specified by using a cons cell
|
||||
specifying completion-styles to use with helm emacs style,
|
||||
e.g. (foo-mode . (emacs helm flex)) will set `completion-styles'
|
||||
to \\='(helm flex) for foo-mode."
|
||||
:group 'helm-mode
|
||||
:type
|
||||
`(alist :key-type (symbol :tag "Major Mode")
|
||||
|
|
@ -535,42 +566,22 @@ If COLLECTION is an `obarray', a TEST should be needed. See `obarray'."
|
|||
(member (downcase pattern) candidates)
|
||||
(member (upcase pattern) candidates)))
|
||||
|
||||
(defun helm-cr-default-transformer (candidates source)
|
||||
(defun helm-cr-default-transformer (candidates _source)
|
||||
"Default filter candidate function for `helm-comp-read'."
|
||||
(let ((must-match (helm-get-attr 'must-match source)))
|
||||
;; Annotation and affixation are already handled in completion-in-region and
|
||||
;; in helm-completing-read-default-2 when emacs style is in use.
|
||||
;; For helm-completing-read-default-1 we handle them in an extra FCT; This
|
||||
;; allows extracting annotation and affixation from metadata which is not
|
||||
;; accessible from here.
|
||||
(cl-loop for c in candidates
|
||||
for cand = (let ((elm (if (stringp c)
|
||||
(replace-regexp-in-string "\\s\\" "" c)
|
||||
c)))
|
||||
(cond ((and (stringp elm)
|
||||
(string-match "\n" elm))
|
||||
(cons (replace-regexp-in-string "\n" "->" elm) c))
|
||||
(t c)))
|
||||
collect cand into lst
|
||||
finally return
|
||||
;; Unquote helm-pattern when it is added as candidate
|
||||
;; (Bug#2015).
|
||||
(let ((pat (replace-regexp-in-string "\\s\\" "" helm-pattern)))
|
||||
(if (or (string= pat "")
|
||||
(eq must-match t)
|
||||
(helm-cr--pattern-in-candidates-p lst pat))
|
||||
lst
|
||||
(append (list (cons (helm-aand (propertize "[?]" 'face 'helm-ff-prefix)
|
||||
(propertize " " 'display it 'unknown t)
|
||||
(concat it pat))
|
||||
pat))
|
||||
lst))))))
|
||||
|
||||
(defun helm-comp-read--move-to-first-real-candidate ()
|
||||
(helm-aif (helm-get-selection nil 'withprop)
|
||||
;; Avoid error with candidates with an image as display (Bug#2296).
|
||||
(when (helm-candidate-prefixed-p it)
|
||||
(helm-next-line))))
|
||||
;; Annotation and affixation are already handled in completion-in-region and
|
||||
;; in helm-completing-read-default-2 when emacs style is in use.
|
||||
;; For helm-completing-read-default-1 we handle them in an extra FCT; This
|
||||
;; allows extracting annotation and affixation from metadata which is not
|
||||
;; accessible from here.
|
||||
(cl-loop for c in candidates
|
||||
for cand = (let ((elm (if (stringp c)
|
||||
(replace-regexp-in-string "\\s\\" "" c)
|
||||
c)))
|
||||
(cond ((and (stringp elm)
|
||||
(string-match "\n" elm))
|
||||
(cons (replace-regexp-in-string "\n" "->" elm) c))
|
||||
(t c)))
|
||||
collect cand))
|
||||
|
||||
(defun helm-cr-default (default cands)
|
||||
(delq nil
|
||||
|
|
@ -617,7 +628,7 @@ If COLLECTION is an `obarray', a TEST should be needed. See `obarray'."
|
|||
(name "Helm Completions")
|
||||
header-name
|
||||
candidates-in-buffer
|
||||
get-line
|
||||
(get-line #'buffer-substring)
|
||||
diacritics
|
||||
match-part
|
||||
match-dynamic
|
||||
|
|
@ -634,6 +645,7 @@ If COLLECTION is an `obarray', a TEST should be needed. See `obarray'."
|
|||
multiline
|
||||
allow-nest
|
||||
coerce
|
||||
raw-candidate
|
||||
(group 'helm))
|
||||
"Read a string in the minibuffer, with helm completion.
|
||||
|
||||
|
|
@ -756,6 +768,9 @@ Keys description:
|
|||
|
||||
- COERCE: See coerce in `helm-source'.
|
||||
|
||||
- RAW-CANDIDATE: Do not unquote the unknown candidate coming from helm-pattern
|
||||
when non nil.
|
||||
|
||||
- GROUP: See group in `helm-source'.
|
||||
|
||||
Any prefix args passed during `helm-comp-read' invocation will be recorded
|
||||
|
|
@ -786,8 +801,14 @@ that use `helm-comp-read'. See `helm-M-x' for example."
|
|||
nil "Error: History should be specified as a symbol")
|
||||
(when (get-buffer helm-action-buffer)
|
||||
(kill-buffer helm-action-buffer))
|
||||
(unless (memq must-match '(confirm confirm-after-completion t nil))
|
||||
;; Fix completing-read's using something else than `t' e.g. 1 or
|
||||
;; The value of MUST-MATCH is given to
|
||||
;; `helm--set-minibuffer-completion-confirm' which compute it and propagate it
|
||||
;; to `minibuffer-completion-confirm' which is then used by
|
||||
;; `helm-confirm-and-exit-minibuffer'.
|
||||
(unless (or (memq must-match '(confirm confirm-after-completion t nil))
|
||||
(functionp must-match))
|
||||
;; Fix completing-read's using something else than (confirm
|
||||
;; confirm-after-completion t nil) or a function e.g. 1 or
|
||||
;; whatever (bug #2527).
|
||||
(setq must-match t))
|
||||
(let ((action-fn `(("Sole action (Identity)"
|
||||
|
|
@ -846,6 +867,20 @@ that use `helm-comp-read'. See `helm-M-x' for example."
|
|||
:mode-line mode-line
|
||||
:help-message help-message
|
||||
:action action-fn))
|
||||
(dummy-src (helm-build-dummy-source "Unknown candidate"
|
||||
:must-match must-match
|
||||
:keymap keymap
|
||||
:filtered-candidate-transformer
|
||||
(lambda (_candidates _source)
|
||||
(let ((pat (if raw-candidate
|
||||
helm-pattern
|
||||
(replace-regexp-in-string "\\s\\" "" helm-pattern))))
|
||||
(unless (string= pat "")
|
||||
(list (cons (helm-aand (propertize "[?]" 'face 'helm-ff-prefix)
|
||||
(propertize " " 'display it 'unknown t)
|
||||
(concat it pat))
|
||||
pat)))))
|
||||
:action action-fn))
|
||||
(src (helm-build-sync-source name
|
||||
:candidates get-candidates
|
||||
:match-part match-part
|
||||
|
|
@ -903,22 +938,24 @@ that use `helm-comp-read'. See `helm-M-x' for example."
|
|||
(setq src-list (cl-loop for src in src-list
|
||||
collect (cons '(nomark) src))))
|
||||
(when reverse-history (setq src-list (nreverse src-list)))
|
||||
(add-hook 'helm-after-update-hook 'helm-comp-read--move-to-first-real-candidate)
|
||||
(unwind-protect
|
||||
(setq result (helm
|
||||
:sources src-list
|
||||
:input initial-input
|
||||
:default default
|
||||
:preselect preselect
|
||||
:prompt prompt
|
||||
:resume 'noresume
|
||||
:keymap keymap ;; Needed with empty collection.
|
||||
:allow-nest allow-nest
|
||||
:candidate-number-limit candidate-number-limit
|
||||
:case-fold-search case-fold
|
||||
:history (and (symbolp input-history) input-history)
|
||||
:buffer buffer))
|
||||
(remove-hook 'helm-after-update-hook 'helm-comp-read--move-to-first-real-candidate))
|
||||
(unless (eq must-match t)
|
||||
(setq src-list (append src-list (list dummy-src))))
|
||||
(when raw-candidate
|
||||
(cl-loop for src in src-list
|
||||
do (helm-set-attr 'raw-candidate t src)))
|
||||
(setq result (helm
|
||||
:sources src-list
|
||||
:input initial-input
|
||||
:default default
|
||||
:preselect preselect
|
||||
:prompt prompt
|
||||
:resume 'noresume
|
||||
:keymap keymap ;; Needed with empty collection.
|
||||
:allow-nest allow-nest
|
||||
:candidate-number-limit candidate-number-limit
|
||||
:case-fold-search case-fold
|
||||
:history (and (symbolp input-history) input-history)
|
||||
:buffer buffer))
|
||||
;; If `history' is a symbol save it, except when it is t.
|
||||
(when (and result history (symbolp history) (not (eq history t)))
|
||||
(set history
|
||||
|
|
@ -992,6 +1029,9 @@ that use `helm-comp-read'. See `helm-M-x' for example."
|
|||
(symbol-help . (metadata
|
||||
(affixation-function . helm-symbol-completion-table-affixation)
|
||||
(category . symbol-help)))
|
||||
(eww-help . (metadata ;; Emacs-30 only
|
||||
(affixation-function . helm-completion-eww-affixation)
|
||||
(category . eww-help)))
|
||||
(package . (metadata
|
||||
(affixation-function . helm-completion-package-affixation)
|
||||
(category . package)))
|
||||
|
|
@ -1003,7 +1043,13 @@ that use `helm-comp-read'. See `helm-M-x' for example."
|
|||
(category . coding-system)))
|
||||
(color . (metadata
|
||||
(affixation-function . helm-completion-color-affixation)
|
||||
(category . color))))
|
||||
(category . color)))
|
||||
(library . (metadata
|
||||
(affixation-function . helm-completion-library-affixation)
|
||||
(category . library)))
|
||||
(charset . (metadata
|
||||
(affixation-function . helm-completion-charset-affixation)
|
||||
(category . charset))))
|
||||
"Extra metadata for completing-read.
|
||||
|
||||
Alist composed of (CATEGORY . METADATA).
|
||||
|
|
@ -1017,9 +1063,7 @@ like this:
|
|||
FLAGS is a list of variables to renitialize to nil when exiting or quitting.
|
||||
|
||||
It is used to add `affixation-function' or `annotation-function' if original
|
||||
metadata doesn't have some and `completions-detailed' is non nil.
|
||||
When using emacs as `helm-completion-style', this has no effect, keeping same
|
||||
behavior as emacs vanilla.")
|
||||
metadata doesn't have some and `completions-detailed' is non nil.")
|
||||
|
||||
(defvar helm-completing-read-command-categories
|
||||
'(("customize-variable" . symbol-help)
|
||||
|
|
@ -1038,7 +1082,12 @@ behavior as emacs vanilla.")
|
|||
("trace-function-foreground" . symbol-help)
|
||||
("trace-function-background" . symbol-help)
|
||||
("describe-minor-mode" . symbol-help)
|
||||
("where-is" . symbol-help)
|
||||
("execute-extended-command" . symbol-help)
|
||||
("info-lookup-symbol" . symbol-help)
|
||||
("Info-goto-emacs-command-node" . symbol-help)
|
||||
("find-library" . library)
|
||||
("locate-library" . library)
|
||||
("kill-buffer" . buffer)
|
||||
("package-install" . package)
|
||||
("package-vc-install" . package)
|
||||
|
|
@ -1047,7 +1096,20 @@ behavior as emacs vanilla.")
|
|||
("load-theme" . theme)
|
||||
("describe-theme" . theme)
|
||||
("describe-coding-system" . coding-system)
|
||||
("read-color" . color))
|
||||
("set-file-name-coding-system" . coding-system)
|
||||
("set-keyboard-coding-system" . coding-system)
|
||||
("set-terminal-coding-system" . coding-system)
|
||||
("set-process-coding-system" . coding-system)
|
||||
("set-buffer-process-coding-system" . coding-system)
|
||||
("set-buffer-file-coding-system" . coding-system)
|
||||
("set-selection-coding-system" . coding-system)
|
||||
("set-next-selection-coding-system" . coding-system)
|
||||
("set-clipboard-coding-system" . coding-system)
|
||||
("universal-coding-system-argument" . coding-system)
|
||||
("read-color" . color)
|
||||
("list-charset-chars" . charset)
|
||||
;; Emacs-30 only
|
||||
("eww" . eww-help))
|
||||
"An alist to specify metadata category by command.
|
||||
|
||||
Some commands provide a completion-table with no category
|
||||
|
|
@ -1058,9 +1120,10 @@ should be specified as a string and the category as a symbol.")
|
|||
(defvar helm-completing-read--buffer-lgst-mode nil)
|
||||
(defun helm-completing-read-buffer-affixation (completions)
|
||||
(let ((len-mode (or helm-completing-read--buffer-lgst-mode
|
||||
(cl-loop for bn in completions
|
||||
maximize (with-current-buffer bn
|
||||
(length (symbol-name major-mode)))))))
|
||||
(setq helm-completing-read--buffer-lgst-mode
|
||||
(cl-loop for bn in completions
|
||||
maximize (with-current-buffer bn
|
||||
(length (symbol-name major-mode))))))))
|
||||
(lambda (comp)
|
||||
(let* ((buf (get-buffer comp))
|
||||
(fname (buffer-file-name buf))
|
||||
|
|
@ -1070,17 +1133,17 @@ should be specified as a string and the category as a symbol.")
|
|||
"fm " 'face 'font-lock-comment-face))
|
||||
(fname
|
||||
(propertize
|
||||
" f " 'face 'font-lock-property-name-face))
|
||||
" f " 'face 'helm-completions-annotations))
|
||||
(t (propertize "nf " 'face 'font-lock-doc-face))))
|
||||
(mode (with-current-buffer comp
|
||||
(propertize
|
||||
(symbol-name major-mode) 'face 'font-lock-warning-face)))
|
||||
(symbol-name major-mode) 'face 'helm-completions-detailed)))
|
||||
(size (helm-buffer-size buf))
|
||||
(max-len helm-buffer-max-length)
|
||||
(bname (truncate-string-to-width
|
||||
comp helm-buffer-max-length nil nil
|
||||
helm-buffers-end-truncated-string))
|
||||
(suffix (format "%s%s%s%s%s(in %s)"
|
||||
(suffix (format "%s%s%s%s%s `%s'"
|
||||
(make-string (1+ (- max-len (length bname))) ? )
|
||||
(propertize size
|
||||
'face 'helm-buffer-size)
|
||||
|
|
@ -1113,7 +1176,7 @@ the speed avoiding one useless loop on complete list of candidates.
|
|||
|
||||
Returns a function and not a list of completions.
|
||||
|
||||
It affects actually describe-variable/function/command/symbol functions.
|
||||
It affects currently describe-variable/function/command/symbol functions.
|
||||
It uses `helm-get-first-line-documentation' which allow providing documentation
|
||||
for `describe-variable' symbols and align properly documentation when helm style
|
||||
is used."
|
||||
|
|
@ -1128,12 +1191,13 @@ is used."
|
|||
(max-len (and (memq helm-completion-style '(helm helm-fuzzy))
|
||||
(helm-in-buffer-get-longest-candidate)))
|
||||
(sep (if (or (null max-len) (zerop max-len))
|
||||
" --" ; Default separator.
|
||||
(make-string (- max-len (length comp)) ? )))
|
||||
" -- " ; Default separator.
|
||||
(helm-make-separator comp max-len)))
|
||||
(doc (ignore-errors
|
||||
(helm-get-first-line-documentation sym)))
|
||||
(symbol-class (help--symbol-class sym))
|
||||
(group (helm-group-p sym)))
|
||||
(symbol-class (with-helm-current-buffer (help--symbol-class sym)))
|
||||
(group (helm-group-p sym))
|
||||
(key (helm-completion-get-key sym)))
|
||||
(list
|
||||
;; Symbol (comp).
|
||||
(if (or (symbol-function sym) (boundp sym)
|
||||
|
|
@ -1142,22 +1206,41 @@ is used."
|
|||
;; Not already defined function. To test add an advice on a non
|
||||
;; existing function.
|
||||
(propertize comp 'face 'helm-completion-invalid))
|
||||
;; Prefix.
|
||||
(helm-aand (propertize
|
||||
(cond ((and symbol-class group)
|
||||
(concat "g" symbol-class))
|
||||
((and (not (string= symbol-class ""))
|
||||
symbol-class))
|
||||
(group "g")
|
||||
(t "i"))
|
||||
'face 'completions-annotations)
|
||||
(propertize " " 'display (format "%-4s" it)))
|
||||
;; Prefixes.
|
||||
;; " c " command
|
||||
;; " - " obsolete, 'byte-obsolete-info
|
||||
;; " v " var, not a defcustom
|
||||
;; " ' " local-variable-if-set-p
|
||||
;; " * " not default value if buffer local
|
||||
;; " - " 'byte-obsolete-variable
|
||||
(helm-aand (cond ((and symbol-class group)
|
||||
(concat "g" symbol-class))
|
||||
((and (not (string= symbol-class ""))
|
||||
symbol-class))
|
||||
(group "g")
|
||||
(t "i")) ; Not already defined function.
|
||||
(propertize it 'face 'helm-completions-detailed)
|
||||
;; help--symbol-class currently can return at most 8
|
||||
;; characters long symbol class but it is very rare, it is
|
||||
;; generally max 4 (bug#2656).
|
||||
(propertize
|
||||
;; (format "%-4s" it) may make spaces inheriting text props
|
||||
;; with emacs -nw in emacs<29.
|
||||
" " 'display (format "%-4s" it)))
|
||||
;; Suffix.
|
||||
(if doc
|
||||
(helm-aand (propertize doc 'face 'completions-annotations)
|
||||
(propertize " " 'display (concat sep it)))
|
||||
(helm-aand (propertize doc 'face 'helm-completions-detailed)
|
||||
(propertize " " 'display (concat sep it key)))
|
||||
"")))))
|
||||
|
||||
(defun helm-completion-get-key (sym)
|
||||
"Return key description on symbol SYM."
|
||||
(with-helm-current-buffer
|
||||
(let* ((key (and (commandp sym) (where-is-internal sym nil 'first-only)))
|
||||
(binding (and key (key-description key))))
|
||||
(when binding
|
||||
(propertize (format " (%s)" binding) 'face 'shadow)))))
|
||||
|
||||
(defun helm-completion-package-affixation (_completions)
|
||||
(lambda (comp)
|
||||
(let* ((sym (intern-soft comp))
|
||||
|
|
@ -1167,32 +1250,28 @@ is used."
|
|||
(desc (if built-in
|
||||
(aref (assoc-default sym package--builtins) 2)
|
||||
(and id (package-desc-summary id))))
|
||||
(sep (make-string (1+ (- (helm-in-buffer-get-longest-candidate)
|
||||
(length comp)))
|
||||
? )))
|
||||
(sep (helm-make-separator comp)))
|
||||
(list comp
|
||||
(propertize
|
||||
(if status
|
||||
(format "%s " (substring status 0 1))
|
||||
"b ")
|
||||
'face 'font-lock-property-name-face)
|
||||
'face 'helm-completions-annotations)
|
||||
(or (helm-aand desc
|
||||
(propertize it 'face 'font-lock-warning-face)
|
||||
(propertize it 'face 'helm-completions-detailed)
|
||||
(propertize " " 'display (concat sep it)))
|
||||
"")))))
|
||||
|
||||
(defun helm-completion-theme-affixation (_completions)
|
||||
(lambda (comp)
|
||||
(let* ((sym (intern-soft comp))
|
||||
(sep (make-string (1+ (- (helm-in-buffer-get-longest-candidate)
|
||||
(length comp)))
|
||||
? ))
|
||||
(sep (helm-make-separator comp))
|
||||
(doc (if (custom-theme-p sym)
|
||||
(helm-get-first-line-documentation sym)
|
||||
(helm--get-theme-doc-1 sym))))
|
||||
(list comp
|
||||
""
|
||||
(helm-aand (propertize doc 'face 'font-lock-warning-face)
|
||||
(helm-aand (propertize doc 'face 'helm-completions-detailed)
|
||||
(propertize " " 'display (concat sep it)))))))
|
||||
|
||||
(defun helm--get-theme-doc-1 (sym)
|
||||
|
|
@ -1227,23 +1306,27 @@ is used."
|
|||
(buffer-substring beg end))))
|
||||
|
||||
(defun helm-completion-coding-system-affixation (_comps)
|
||||
(require 'mule-diag)
|
||||
(lambda (comp)
|
||||
(let ((doc (with-output-to-string
|
||||
(with-current-buffer standard-output
|
||||
(print-coding-system-briefly (intern comp) 'tightly))))
|
||||
(sep (make-string (1+ (- (helm-in-buffer-get-longest-candidate)
|
||||
(length comp)))
|
||||
? )))
|
||||
(sep (helm-make-separator comp)))
|
||||
(list comp "" (helm-aand (replace-regexp-in-string "^ *" "" doc)
|
||||
(replace-regexp-in-string "[\n]" "" it)
|
||||
(propertize it 'face 'font-lock-warning-face)
|
||||
(propertize it 'face 'helm-completions-detailed)
|
||||
(propertize " " 'display (concat sep it)))))))
|
||||
|
||||
(defun helm-completion-charset-affixation (_comps)
|
||||
(lambda (comp)
|
||||
(let ((doc (charset-description (intern comp)))
|
||||
(sep (helm-make-separator comp)))
|
||||
(list comp "" (helm-aand (propertize doc 'face 'helm-completions-detailed)
|
||||
(propertize " " 'display (concat sep it)))))))
|
||||
|
||||
(defun helm-completion-color-affixation (_comps)
|
||||
(lambda (comp)
|
||||
(let ((sep (make-string (1+ (- (helm-in-buffer-get-longest-candidate)
|
||||
(length comp)))
|
||||
? ))
|
||||
(let ((sep (helm-make-separator comp))
|
||||
(rgb (condition-case nil
|
||||
(helm-acase comp
|
||||
("foreground at point" (with-helm-current-buffer
|
||||
|
|
@ -1258,8 +1341,45 @@ is used."
|
|||
(helm-aand (propertize rgb 'face `(:background ,rgb
|
||||
:distant-foreground "black"))
|
||||
(propertize " " 'display (concat sep it)))))))
|
||||
|
||||
(defun helm-completion-library-affixation (_comps)
|
||||
(require 'helm-elisp)
|
||||
(lambda (comp)
|
||||
;; Because find-library-include-other-files default to t, we have all the
|
||||
;; unrelated files and directories coming in ... Even if this modify the
|
||||
;; behavior of find-library-include-other-files remove them for the benefit
|
||||
;; of everybody.
|
||||
(unless (or (string-match "\\(\\.elc\\|/\\)\\'" comp)
|
||||
(string-match "\\`\\.#" comp)) ; (bug#2526)
|
||||
(let* ((sep (helm-make-separator comp))
|
||||
(path (or (assoc-default comp helm--locate-library-cache)
|
||||
(let ((p (find-library-name comp)))
|
||||
(push (cons comp p) helm--locate-library-cache)
|
||||
p)))
|
||||
(doc (or (gethash comp helm--locate-library-doc-cache)
|
||||
(puthash comp (helm-locate-lib-get-summary path)
|
||||
helm--locate-library-doc-cache))))
|
||||
(list comp
|
||||
""
|
||||
(helm-aand (propertize doc 'face 'font-lock-warning-face)
|
||||
(propertize " " 'display (concat sep it))))))))
|
||||
|
||||
(defun helm-completion-eww-affixation (_completions)
|
||||
(lambda (comp)
|
||||
(let* ((title (or (cl-loop for bmk in eww-bookmarks
|
||||
for title = (plist-get bmk :title)
|
||||
for url = (plist-get bmk :url)
|
||||
thereis (and (string= comp url) title))
|
||||
"Unknown title"))
|
||||
(sep (helm-make-separator title 72)))
|
||||
(list (propertize comp 'display
|
||||
(truncate-string-to-width comp 72 nil nil t))
|
||||
(helm-aand (propertize (truncate-string-to-width title 72)
|
||||
'face 'helm-completions-detailed)
|
||||
(propertize " " 'display (concat it sep)))
|
||||
""))))
|
||||
|
||||
;;; Generic completing read
|
||||
;;; Completing read handlers
|
||||
;;
|
||||
;;
|
||||
(defun helm-completing-read-default-1
|
||||
|
|
@ -1284,11 +1404,9 @@ handling properties, see `helm-comp-read'.
|
|||
This handler should be used when candidate list doesn't need to be rebuilt
|
||||
dynamically otherwise use `helm-completing-read-default-2'."
|
||||
(let* ((history (or (car-safe hist) hist))
|
||||
(initial-input (helm-aif (pcase init
|
||||
((pred (stringp)) init)
|
||||
;; INIT is a cons cell.
|
||||
(`(,l . ,_ll) l))
|
||||
it))
|
||||
(initial-input (helm-acase init
|
||||
((guard (stringp it)) it)
|
||||
((guard (consp it)) (car it))))
|
||||
(minibuffer-completion-table collection)
|
||||
(metadata (or (completion-metadata (or initial-input "") collection test)
|
||||
'(metadata)))
|
||||
|
|
@ -1344,7 +1462,7 @@ dynamically otherwise use `helm-completing-read-default-2'."
|
|||
:quit-when-no-cand (eq require-match t)
|
||||
:nomark (null helm-comp-read-use-marked)
|
||||
:candidates-in-buffer cands-in-buffer
|
||||
:get-line get-line
|
||||
:get-line (or get-line #'buffer-substring)
|
||||
:exec-when-only-one exec-when-only-one
|
||||
:fuzzy (eq helm-completion-style 'helm-fuzzy)
|
||||
:buffer buffer
|
||||
|
|
@ -1367,11 +1485,11 @@ dynamically otherwise use `helm-completing-read-default-2'."
|
|||
Call `helm-comp-read' with same args as `completing-read'.
|
||||
For the meaning of optional args see `helm-completing-read-default-1'.
|
||||
This handler uses dynamic matching which allows honouring `completion-styles'."
|
||||
(let* ((history (or (car-safe hist) hist))
|
||||
(input (pcase init
|
||||
((pred (stringp)) init)
|
||||
;; INIT is a cons cell.
|
||||
(`(,l . ,_ll) l)))
|
||||
(let* ((completion-lazy-hilit t)
|
||||
(history (or (car-safe hist) hist))
|
||||
(input (helm-acase init
|
||||
((guard (stringp it)) it)
|
||||
((guard (consp it)) (car it))))
|
||||
(completion-flex-nospace t)
|
||||
(minibuffer-completion-table collection)
|
||||
;; (completion-styles
|
||||
|
|
@ -1424,16 +1542,9 @@ This handler uses dynamic matching which allows honouring `completion-styles'."
|
|||
(append (and default
|
||||
(memq helm-completion-style '(helm helm-fuzzy))
|
||||
(list default))
|
||||
(helm-completion--initial-filter
|
||||
(let ((lst (if (and sort-fn (> (length str) 0))
|
||||
(funcall sort-fn all)
|
||||
all)))
|
||||
(if (and default afix)
|
||||
(prog1 (append (list default)
|
||||
(delete default lst))
|
||||
(setq default nil))
|
||||
lst))
|
||||
afun afix category)))))
|
||||
(if (and sort-fn (> (length str) 0))
|
||||
(funcall sort-fn all)
|
||||
all)))))
|
||||
(data (if (memq helm-completion-style '(helm helm-fuzzy))
|
||||
(funcall compfn (or input "") nil nil)
|
||||
compfn))
|
||||
|
|
@ -1442,7 +1553,20 @@ This handler uses dynamic matching which allows honouring `completion-styles'."
|
|||
(if (or helm-completion--sorting-done
|
||||
(string= helm-pattern ""))
|
||||
candidates
|
||||
(sort candidates 'helm-generic-sort-fn)))))
|
||||
(sort candidates 'helm-generic-sort-fn))))
|
||||
flags)
|
||||
(helm-aif (and (null category)
|
||||
(assoc-default name helm-completing-read-command-categories))
|
||||
(setq metadata `(metadata (category . ,it))
|
||||
category it))
|
||||
(helm-aif (and (or (and (boundp 'completions-detailed) completions-detailed)
|
||||
helm-completions-detailed)
|
||||
(assoc-default category helm-completing-read-extra-metadata))
|
||||
(progn
|
||||
(setq metadata it)
|
||||
(setq afun (completion-metadata-get metadata 'annotation-function)
|
||||
afix (completion-metadata-get metadata 'affixation-function)
|
||||
flags (completion-metadata-get metadata 'flags))))
|
||||
(unwind-protect
|
||||
(helm-comp-read
|
||||
;; Completion-at-point and friends have no prompt.
|
||||
|
|
@ -1454,21 +1578,29 @@ This handler uses dynamic matching which allows honouring `completion-styles'."
|
|||
:history history
|
||||
:nomark (null helm-comp-read-use-marked)
|
||||
:reverse-history helm-mode-reverse-history
|
||||
;; In helm h-c-styles default is passed directly in
|
||||
;; candidates.
|
||||
:default (and (eq helm-completion-style 'emacs) (null afix) default)
|
||||
;; If DEF is not provided, fallback to empty string
|
||||
;; to avoid `thing-at-point' to be appended on top of list.
|
||||
;; FIXME: default is added first in the collection fn, and then it is
|
||||
;; added here and appended to candidates with the get candidates fn of
|
||||
;; helm-comp-read, later when sorting default may move somewhere
|
||||
;; whereas it has to stay on top.
|
||||
:default (or default "")
|
||||
:fc-transformer
|
||||
;; Ensure sort fn is at the end.
|
||||
(append '(helm-cr-default-transformer)
|
||||
(and helm-completion-in-region-default-sort-fn
|
||||
(list helm-completion-in-region-default-sort-fn)))
|
||||
(append (and (or afix afun (memq category '(file library)))
|
||||
(list (lambda (candidates source)
|
||||
(helm-completion--initial-filter
|
||||
(funcall helm-completion-in-region-default-sort-fn
|
||||
candidates source)
|
||||
afun afix category))))
|
||||
'(helm-cr-default-transformer))
|
||||
:match-dynamic (eq helm-completion-style 'emacs)
|
||||
:diacritics helm-mode-ignore-diacritics
|
||||
:fuzzy (eq helm-completion-style 'helm-fuzzy)
|
||||
:exec-when-only-one exec-when-only-one
|
||||
:quit-when-no-cand (eq require-match t)
|
||||
:must-match require-match)
|
||||
(setq helm-completion--sorting-done nil))))
|
||||
(setq helm-completion--sorting-done nil)
|
||||
(dolist (f flags) (set f nil)))))
|
||||
|
||||
(defun helm-mode-all-the-icons-handler (prompt collection test require-match
|
||||
init hist default inherit-input-method
|
||||
|
|
@ -1667,7 +1799,9 @@ See documentation of `completing-read' and `all-completions' for details."
|
|||
;; otherwise helm have not the time to close its initial session.
|
||||
(minibuffer-setup-hook
|
||||
(cl-loop for h in minibuffer-setup-hook
|
||||
unless (or (consp h) ; a lambda.
|
||||
;; lambdas are no more represented as list in
|
||||
;; Emacs-29+ Bug#2666.
|
||||
unless (or (and (not (symbolp h)) (functionp h)) ; a lambda.
|
||||
(byte-code-function-p h)
|
||||
(helm-subr-native-elisp-p h)
|
||||
(memq h helm-mode-minibuffer-setup-hook-black-list))
|
||||
|
|
@ -1813,8 +1947,7 @@ Keys description:
|
|||
(kill-buffer helm-action-buffer))
|
||||
(mapc (lambda (hook)
|
||||
(add-hook 'helm-after-update-hook hook))
|
||||
'(helm-ff-move-to-first-real-candidate
|
||||
helm-ff-update-when-only-one-matched
|
||||
'(helm-ff-update-when-only-one-matched
|
||||
helm-ff-auto-expand-to-home-or-root))
|
||||
(let* ((action-fn `(("Sole action (Identity)"
|
||||
. (lambda (candidate)
|
||||
|
|
@ -1842,6 +1975,18 @@ Keys description:
|
|||
(replace-regexp-in-string "helm-maybe-exit-minibuffer"
|
||||
"helm-confirm-and-exit-minibuffer"
|
||||
helm-read-file-name-mode-line-string))
|
||||
(dummy-src
|
||||
(unless (eq must-match t)
|
||||
;; Non existing file or dir source.
|
||||
(helm-build-dummy-source "New file or directory"
|
||||
:keymap 'helm-read-file-map
|
||||
:must-match must-match
|
||||
:filtered-candidate-transformer
|
||||
(lambda (_candidates _source)
|
||||
(unless (file-exists-p helm-pattern)
|
||||
(list (helm-ff-filter-candidate-one-by-one
|
||||
helm-pattern nil t))))
|
||||
:action action-fn)))
|
||||
(src-list
|
||||
(list
|
||||
;; History source.
|
||||
|
|
@ -1859,7 +2004,7 @@ Keys description:
|
|||
:must-match must-match
|
||||
:nomark nomark
|
||||
:action action-fn)
|
||||
;; Other source.
|
||||
;; List files source.
|
||||
(helm-build-sync-source name
|
||||
:header-name (lambda (name)
|
||||
(concat name (substitute-command-keys
|
||||
|
|
@ -1883,12 +2028,11 @@ Keys description:
|
|||
(cl-loop with hn = (helm-ff--tramp-hostnames)
|
||||
;; helm-find-files-get-candidates is
|
||||
;; returning a list of cons cells.
|
||||
for (d . r) in (helm-find-files-get-candidates
|
||||
must-match)
|
||||
for (d . r) in (helm-find-files-get-candidates)
|
||||
when (or (member r hn) ; A tramp host
|
||||
(funcall test r)) ; Test ok
|
||||
collect (cons d r)))
|
||||
(helm-find-files-get-candidates must-match)))
|
||||
(helm-find-files-get-candidates)))
|
||||
:update (lambda ()
|
||||
(remhash helm-ff-default-directory
|
||||
helm-ff--list-directory-cache))
|
||||
|
|
@ -1906,13 +2050,15 @@ Keys description:
|
|||
:action action-fn)))
|
||||
;; Helm result.
|
||||
(result (helm
|
||||
:sources (if helm-mode-reverse-history
|
||||
(reverse src-list) src-list)
|
||||
:sources (append (if helm-mode-reverse-history
|
||||
(reverse src-list) src-list)
|
||||
(list dummy-src))
|
||||
:input (if (string-match helm-ff-url-regexp initial-input)
|
||||
initial-input
|
||||
(expand-file-name initial-input))
|
||||
:prompt prompt
|
||||
:candidate-number-limit candidate-number-limit
|
||||
:dim-prompt-on-update t
|
||||
:resume 'noresume
|
||||
:case-fold-search case-fold
|
||||
:default default
|
||||
|
|
@ -2182,6 +2328,7 @@ When AFUN, AFIX are nil and CATEGORY is not file return COMPS unmodified."
|
|||
(if (functionp affixations)
|
||||
(cl-loop for comp in comps
|
||||
for cand = (funcall affixations comp)
|
||||
when cand
|
||||
collect (cons (propertize (concat (nth 1 cand) ;prefix
|
||||
(nth 0 cand) ;comp
|
||||
(nth 2 cand)) ;suffix
|
||||
|
|
@ -2198,17 +2345,11 @@ When AFUN, AFIX are nil and CATEGORY is not file return COMPS unmodified."
|
|||
;; completing against a quoted symbol.
|
||||
(mapcar (lambda (s)
|
||||
(let ((ann (funcall afun s)))
|
||||
(if ann
|
||||
(cons
|
||||
(concat
|
||||
s
|
||||
(propertize
|
||||
" " 'display
|
||||
(propertize
|
||||
ann
|
||||
'face 'completions-annotations)))
|
||||
s)
|
||||
s)))
|
||||
(or (helm-aand
|
||||
ann
|
||||
(propertize ann 'face 'helm-completions-annotations)
|
||||
(cons (concat s (propertize " " 'display it)) s))
|
||||
s)))
|
||||
comps))
|
||||
(t comps)))
|
||||
|
||||
|
|
@ -2216,7 +2357,7 @@ When AFUN, AFIX are nil and CATEGORY is not file return COMPS unmodified."
|
|||
|
||||
(defun helm-completion-try-completion (string table pred point)
|
||||
"The try completion function for `completing-styles-alist'.
|
||||
Actually does nothing."
|
||||
Currently does nothing."
|
||||
;; AFAIU the try-completions style functions
|
||||
;; are here to check if what is at point is suitable for TABLE but
|
||||
;; there is no way to pass a multiple pattern from what is at point
|
||||
|
|
@ -2228,10 +2369,8 @@ Actually does nothing."
|
|||
|
||||
(defun helm-completion-all-completions (string table pred point)
|
||||
"The all completions function for `completing-styles-alist'."
|
||||
;; FIXME: No need to bind all these value.
|
||||
;; (cl-multiple-value-bind (all _pattern prefix _suffix _carbounds)
|
||||
(pcase-let ((`(,all ,_pattern ,prefix ,_suffix ,_carbounds)
|
||||
(helm-completion--multi-all-completions string table pred point)))
|
||||
(cl-multiple-value-bind (all _pattern prefix _suffix _carbounds)
|
||||
(helm-completion--multi-all-completions string table pred point)
|
||||
(when all (nconc all (length prefix)))))
|
||||
|
||||
(defun helm-completion--multi-all-completions-1 (string collection &optional predicate)
|
||||
|
|
@ -2299,7 +2438,7 @@ Actually does nothing."
|
|||
(suffix (substring afterpoint (cdr bounds)))
|
||||
(all (helm-completion--multi-all-completions-1
|
||||
;; Using `regexp-quote' on STRING fixes bug#2355 but
|
||||
;; breaks regexp matching in multi match, actually with
|
||||
;; breaks regexp matching in multi match, currently with
|
||||
;; Helm-3.7.1 and emacs-27+ it seems using plain STRING
|
||||
;; works for both so use it.
|
||||
;;(regexp-quote string)
|
||||
|
|
@ -2329,8 +2468,8 @@ Actually does nothing."
|
|||
;; It is needed here to make minibuffer-complete work in emacs-26,
|
||||
;; e.g. with regular M-x.
|
||||
(unless (string-match-p " " string)
|
||||
(pcase-let ((`(,all ,pattern ,prefix ,suffix ,_carbounds)
|
||||
(helm-completion--flex-all-completions string table pred point)))
|
||||
(cl-multiple-value-bind (all pattern prefix suffix _carbounds)
|
||||
(helm-completion--flex-all-completions string table pred point)
|
||||
(when minibuffer-completing-file-name
|
||||
(setq all (completion-pcm--filename-try-filter all)))
|
||||
(completion-pcm--merge-try pattern all prefix suffix))))
|
||||
|
|
@ -2339,10 +2478,10 @@ Actually does nothing."
|
|||
"The all completions function for `completing-styles-alist'."
|
||||
;; FIXME: No need to bind all these value.
|
||||
(unless (string-match-p " " string)
|
||||
(pcase-let ((`(,all ,pattern ,prefix ,_suffix ,_carbounds)
|
||||
(helm-completion--flex-all-completions
|
||||
string table pred point
|
||||
#'helm-completion--flex-transform-pattern)))
|
||||
(cl-multiple-value-bind (all pattern prefix _suffix _carbounds)
|
||||
(helm-completion--flex-all-completions
|
||||
string table pred point
|
||||
#'helm-completion--flex-transform-pattern)
|
||||
(let ((regexp (completion-pcm--pattern->regex pattern 'group)))
|
||||
(when all (nconc (helm-flex-add-score-as-prop all regexp)
|
||||
(length prefix)))))))
|
||||
|
|
@ -2398,8 +2537,19 @@ Can be used for `completion-in-region-function' by advicing it with an
|
|||
;; relaying on crap old completion-styles emacs22 which
|
||||
;; add suffix after prefix. e.g. def|else.
|
||||
(initial-input (buffer-substring-no-properties start (point)))
|
||||
(current-command (or (helm-this-command)
|
||||
this-command
|
||||
;; Some backends are async and
|
||||
;; use a callback, in those
|
||||
;; cases, we can't retrieve from
|
||||
;; frames the last interactive
|
||||
;; command, so fallback to
|
||||
;; `last-command' which may be
|
||||
;; the one that called the callback.
|
||||
last-command))
|
||||
string)
|
||||
(helm-aif (cdr (assq major-mode helm-completion-styles-alist))
|
||||
(helm-aif (cdr (or (assq major-mode helm-completion-styles-alist)
|
||||
(assq current-command helm-completion-styles-alist)))
|
||||
(customize-set-variable 'helm-completion-style
|
||||
(if (cdr-safe it) (car it) it)))
|
||||
;; This hook force usage of the display part of candidate with
|
||||
|
|
@ -2414,26 +2564,16 @@ Can be used for `completion-in-region-function' by advicing it with an
|
|||
(input (buffer-substring-no-properties start end))
|
||||
(prefix (and (eq helm-completion-style 'emacs) initial-input))
|
||||
(point (point))
|
||||
(current-command (or (helm-this-command)
|
||||
this-command
|
||||
;; Some backends are async and
|
||||
;; use a callback, in those
|
||||
;; cases, we can't retrieve from
|
||||
;; frames the last interactive
|
||||
;; command, so fallback to
|
||||
;; `last-command' which may be
|
||||
;; the one that called the callback.
|
||||
last-command))
|
||||
(crm (eq current-command 'crm-complete))
|
||||
(str-command (helm-symbol-name current-command))
|
||||
(buf-name (format "*helm-mode-%s*" str-command))
|
||||
(require-match (or (and (boundp 'require-match) require-match)
|
||||
minibuffer-completion-confirm
|
||||
;; If prompt have not been propagated here, that's
|
||||
;; probably mean we have no prompt and we are in
|
||||
;; completion-at-point or friend, so use a non--nil
|
||||
;; value for require-match.
|
||||
(not (boundp 'prompt))))
|
||||
(require-match (cond ((boundp 'require-match) require-match)
|
||||
(minibuffer-completion-confirm)
|
||||
;; If prompt have not been propagated here, that's
|
||||
;; probably mean we have no prompt and we are in
|
||||
;; completion-at-point or friend, so use a non--nil
|
||||
;; value for require-match.
|
||||
((not (boundp 'prompt)))))
|
||||
(metadata (completion-metadata input collection predicate))
|
||||
;; `completion-extra-properties' is let-bounded in `completion-at-point'.
|
||||
;; `afun' is a closure to call against each string in `data'.
|
||||
|
|
@ -2446,10 +2586,6 @@ Can be used for `completion-in-region-function' by advicing it with an
|
|||
;; completion-in-region, try anyway never know.
|
||||
(afix (or (plist-get completion-extra-properties :affixation-function)
|
||||
(completion-metadata-get metadata 'affixation-function)))
|
||||
(init-space-suffix (unless (or (memq helm-completion-style '(helm-fuzzy emacs))
|
||||
(string-suffix-p " " input)
|
||||
(string= input ""))
|
||||
" "))
|
||||
(category (or (eq (completion-metadata-get metadata 'category) 'file)
|
||||
(eq (plist-get completion-extra-properties :category) 'file)))
|
||||
(file-comp-p (or (eq category 'file)
|
||||
|
|
@ -2458,7 +2594,8 @@ Can be used for `completion-in-region-function' by advicing it with an
|
|||
;; so data looks like this: '(a b c d . 0) and (last data) == (d . 0).
|
||||
base-size
|
||||
(compfn (lambda (str _predicate _action)
|
||||
(let* ((completion-ignore-case (helm-set-case-fold-search))
|
||||
(let* ((completion-lazy-hilit t)
|
||||
(completion-ignore-case (helm-set-case-fold-search))
|
||||
(comps
|
||||
(completion-all-completions
|
||||
str ; This is helm-pattern
|
||||
|
|
@ -2503,11 +2640,9 @@ Can be used for `completion-in-region-function' by advicing it with an
|
|||
(unless base-size (setq base-size bs))
|
||||
(setq helm-completion--sorting-done (and sort-fn t))
|
||||
(setq all (copy-sequence comps))
|
||||
(helm-completion--initial-filter
|
||||
(if (and sort-fn (> (length str) 0))
|
||||
(funcall sort-fn all)
|
||||
all)
|
||||
afun afix category))))
|
||||
(if (and sort-fn (> (length str) 0))
|
||||
(funcall sort-fn all)
|
||||
all))))
|
||||
(data (if (memq helm-completion-style '(helm helm-fuzzy))
|
||||
(funcall compfn input nil nil)
|
||||
compfn))
|
||||
|
|
@ -2523,27 +2658,29 @@ Can be used for `completion-in-region-function' by advicing it with an
|
|||
:initial-input
|
||||
(cond ((and file-comp-p
|
||||
(not (string-match "/\\'" initial-input)))
|
||||
(concat (helm-mode--completion-in-region-initial-input
|
||||
(if (memq helm-completion-style '(helm helm-fuzzy))
|
||||
(helm-basename initial-input)
|
||||
initial-input))
|
||||
init-space-suffix))
|
||||
(helm-mode--completion-in-region-initial-input
|
||||
(if (memq helm-completion-style '(helm helm-fuzzy))
|
||||
(helm-basename initial-input)
|
||||
initial-input)))
|
||||
((string-match "/\\'" initial-input)
|
||||
(and (eq helm-completion-style 'emacs) initial-input))
|
||||
((or (null require-match)
|
||||
(stringp require-match))
|
||||
(helm-mode--completion-in-region-initial-input initial-input))
|
||||
(t (concat (helm-mode--completion-in-region-initial-input initial-input)
|
||||
init-space-suffix)))
|
||||
(t (helm-mode--completion-in-region-initial-input initial-input)))
|
||||
:buffer buf-name
|
||||
:fc-transformer
|
||||
;; Ensure sort fn is at the end.
|
||||
(append '(helm-cr-default-transformer)
|
||||
(and helm-completion-in-region-default-sort-fn
|
||||
(list helm-completion-in-region-default-sort-fn)))
|
||||
(append (and (or afix afun (memq category '(file library)))
|
||||
(list (lambda (candidates source)
|
||||
(helm-completion--initial-filter
|
||||
(funcall helm-completion-in-region-default-sort-fn
|
||||
candidates source)
|
||||
afun afix category))))
|
||||
'(helm-cr-default-transformer))
|
||||
:match-dynamic (eq helm-completion-style 'emacs)
|
||||
:fuzzy (eq helm-completion-style 'helm-fuzzy)
|
||||
:exec-when-only-one t
|
||||
:keymap helm-comp-in-region-map
|
||||
:quit-when-no-cand
|
||||
(lambda ()
|
||||
;; Delay message to overwrite "Quit".
|
||||
|
|
@ -2561,18 +2698,20 @@ Can be used for `completion-in-region-function' by advicing it with an
|
|||
(helm-completion-in-region--insert-result
|
||||
result start point end base-size))
|
||||
;; Allow running extra property `:exit-function' (Bug#2265,
|
||||
;; Bug#2356). Function is called with 'exact if for a unique
|
||||
;; match which is exact, the return value of `try-completion'
|
||||
;; is t or a string ending with "/" i.e. possibly a directory
|
||||
;; (Bug#2274),
|
||||
;; otherwise it is called with 'finished.
|
||||
;; Bug#2356). Function is called with 'exact if the return value of
|
||||
;; `try-completion' is a string ending with / (possibly a directory
|
||||
;; Bug#2274), otherwise it is always called with 'finished. However it
|
||||
;; is still not clear what to use, the documentation on this beeing
|
||||
;; really bad (see bug#2646).
|
||||
(when (and (stringp string) exit-fun)
|
||||
(let ((tcomp (try-completion initial-input collection)))
|
||||
(funcall exit-fun string
|
||||
(if (or (eq tcomp t) ; Unique.
|
||||
(and (stringp tcomp)
|
||||
(string-match "/\\'" tcomp))) ; A directory.
|
||||
'exact 'finished))))
|
||||
(funcall exit-fun string
|
||||
(helm-acase (try-completion initial-input collection predicate)
|
||||
((guard (and (stringp it)
|
||||
(or (string-match "/\\'" it)
|
||||
;; Fix bug#2669.
|
||||
(string-match "/\\'" string))))
|
||||
'exact)
|
||||
(t 'finished))))
|
||||
(remove-hook 'helm-before-action-hook 'helm-completion-in-region--selection)
|
||||
(customize-set-variable 'helm-completion-style old--helm-completion-style)
|
||||
(setq helm-completion--sorting-done nil)
|
||||
Some files were not shown because too many files have changed in this diff Show more
Reference in a new issue