Compare commits
No commits in common. "fad5a5f91dd55277246675f43ce279a14cf482f4" and "cb49eaf0afd1e2e004a6865bf4d7dd93a67187f5" have entirely different histories.
fad5a5f91d
...
cb49eaf0af
|
|
@ -1,6 +1,6 @@
|
|||
(define-package "all-the-icons" "20240623.1800" "A library for inserting Developer icons"
|
||||
(define-package "all-the-icons" "20240108.559" "A library for inserting Developer icons"
|
||||
'((emacs "24.3"))
|
||||
:commit "39ef44f810c34e8900978788467cc675870bcd19" :authors
|
||||
:commit "ee414384938ccf2ce93c77d717b85dc5538a257d" :authors
|
||||
'(("Dominic Charlesworth" . "dgc336@gmail.com"))
|
||||
:maintainers
|
||||
'(("Dominic Charlesworth" . "dgc336@gmail.com"))
|
||||
|
|
@ -168,12 +168,6 @@
|
|||
("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)
|
||||
|
|
@ -190,6 +184,7 @@
|
|||
("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)
|
||||
|
|
@ -688,8 +683,6 @@ 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)
|
||||
|
|
@ -702,10 +695,6 @@ 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)
|
||||
|
|
@ -784,6 +773,8 @@ 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,11 +138,6 @@ 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,33 +60,6 @@ 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.
|
||||
|
|
@ -100,7 +73,26 @@ All *.elc files are systematically deleted before proceeding."
|
|||
(load "async")
|
||||
(let ((call-back
|
||||
(lambda (&optional _ignore)
|
||||
(async-bytecomp--file-to-comp-buffer directory quiet '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 directory)
|
||||
(message "Directory `%s' compiled asynchronously with warnings" directory)))))
|
||||
(unless quiet
|
||||
(message "Directory `%s' compiled asynchronously with success" directory))))))
|
||||
(async-start
|
||||
`(lambda ()
|
||||
(require 'bytecomp)
|
||||
|
|
@ -148,10 +140,13 @@ 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.
|
||||
(fmakunbound 'async-byte-recompile-directory))
|
||||
;; Add to `load-path' the latest version of async and
|
||||
;; reload it when reinstalling async.
|
||||
(when (string= cur-package "async")
|
||||
(cl-pushnew pkg-dir load-path)
|
||||
(load "async-bytecomp"))
|
||||
;; `async-byte-recompile-directory' will add directory
|
||||
|
|
@ -178,13 +173,28 @@ Same as `byte-compile-file' but asynchronous."
|
|||
(interactive "fFile: ")
|
||||
(let ((call-back
|
||||
(lambda (&optional _ignore)
|
||||
(async-bytecomp--file-to-comp-buffer file nil 'file))))
|
||||
(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-start
|
||||
`(lambda ()
|
||||
(require 'bytecomp)
|
||||
,(async-inject-variables async-bytecomp-load-variable-regexp)
|
||||
(let ((default-directory ,(file-name-directory file))
|
||||
error-data)
|
||||
(let ((default-directory ,(file-name-directory file)))
|
||||
(add-to-list 'load-path default-directory)
|
||||
(byte-compile-file ,file)
|
||||
(when (get-buffer byte-compile-log-buffer)
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
(define-package "async" "20240719.640" "Asynchronous processing in Emacs"
|
||||
(define-package "async" "20240312.1716" "Asynchronous processing in Emacs"
|
||||
'((emacs "24.4"))
|
||||
:commit "93957f5b0f2ed22aeef02972de860fb9c45b4422" :authors
|
||||
:commit "a368df08d34ae0c0a36fc3e90b1ecda252915257" :authors
|
||||
'(("John Wiegley" . "jwiegley@gmail.com"))
|
||||
:maintainers
|
||||
'(("Thierry Volpiatto" . "thievol@posteo.net"))
|
||||
|
|
@ -50,13 +50,6 @@ 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)
|
||||
|
|
@ -117,17 +110,14 @@ 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) and variables matching one of
|
||||
`async-inject-variables-exclude-regexps'.
|
||||
matching EXCLUDE-REGEXP (if present) or representing a `syntax-table'
|
||||
i.e. ending by \"-syntax-table\".
|
||||
When NOPROPS is non nil it tries to strip out text properties of each
|
||||
variable's value with `async-variables-noprops-function'.
|
||||
|
||||
|
|
@ -146,16 +136,14 @@ It is intended to be used as follows:
|
|||
,@(let (bindings)
|
||||
(mapatoms
|
||||
(lambda (sym)
|
||||
(let ((sname (and (boundp sym) (symbol-name sym)))
|
||||
value)
|
||||
(let* ((sname (and (boundp sym) (symbol-name sym)))
|
||||
(value (and sname (symbol-value sym))))
|
||||
(when (and sname
|
||||
(or (null include-regexp)
|
||||
(string-match include-regexp sname))
|
||||
(or (null exclude-regexp)
|
||||
(not (string-match exclude-regexp sname)))
|
||||
(cl-loop for re in async-inject-variables-exclude-regexps
|
||||
never (string-match-p re sname)))
|
||||
(setq value (symbol-value sym))
|
||||
(not (string-match "-syntax-table\\'" sname)))
|
||||
(unless (or (stringp value)
|
||||
(memq value '(nil t))
|
||||
(numberp value)
|
||||
|
|
@ -438,8 +426,7 @@ working directory."
|
|||
:name name
|
||||
:buffer buf
|
||||
:stderr buf-err
|
||||
:command (cons program program-args)
|
||||
:noquery async-process-noquery-on-exit))))
|
||||
:command (cons program program-args)))))
|
||||
(set-process-sentinel
|
||||
(get-buffer-process buf-err)
|
||||
(lambda (proc _change)
|
||||
|
|
@ -387,7 +387,6 @@ 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,132 +0,0 @@
|
|||
;;; 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,14 +1,12 @@
|
|||
;;; 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.
|
||||
|
||||
;;; centaur-tabs-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*-
|
||||
;;
|
||||
;;; Code:
|
||||
|
||||
(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path)))
|
||||
|
||||
(add-to-list 'load-path (directory-file-name
|
||||
(or (file-name-directory #$) (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" "\
|
||||
|
|
@ -20,7 +18,8 @@ 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)
|
||||
\(fn &optional ARG)" t nil)
|
||||
|
||||
(defvar centaur-tabs-mode nil "\
|
||||
Non-nil if Centaur-Tabs mode is enabled.
|
||||
See the `centaur-tabs-mode' command
|
||||
|
|
@ -28,7 +27,9 @@ 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.
|
||||
|
|
@ -36,50 +37,67 @@ Returns non-nil if the new state is enabled.
|
|||
|
||||
\\{centaur-tabs-mode-map}
|
||||
|
||||
(fn &optional ARG)" t)
|
||||
\(fn &optional ARG)" t nil)
|
||||
|
||||
(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" '("centaur-tabs-"))
|
||||
(register-definition-prefixes "centaur-tabs-elements" '("cent"))
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (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)
|
||||
Depend on the setting of the option `centaur-tabs-cycle-scope'." t nil)
|
||||
|
||||
(autoload 'centaur-tabs-forward "centaur-tabs-functions" "\
|
||||
Select the next available tab.
|
||||
Depend on the setting of the option `centaur-tabs-cycle-scope'." t)
|
||||
Depend on the setting of the option `centaur-tabs-cycle-scope'." t nil)
|
||||
|
||||
(autoload 'centaur-tabs-backward-group "centaur-tabs-functions" "\
|
||||
Go to selected tab in the previous available group." t)
|
||||
Go to selected tab in the previous available group." t nil)
|
||||
|
||||
(autoload 'centaur-tabs-forward-group "centaur-tabs-functions" "\
|
||||
Go to selected tab in the next available group." t)
|
||||
Go to selected tab in the next available group." t nil)
|
||||
|
||||
(autoload 'centaur-tabs-backward-tab "centaur-tabs-functions" "\
|
||||
Select the previous visible tab." t)
|
||||
Select the previous visible tab." t nil)
|
||||
|
||||
(autoload 'centaur-tabs-forward-tab "centaur-tabs-functions" "\
|
||||
Select the next visible tab." t)
|
||||
Select the next visible tab." t nil)
|
||||
|
||||
(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)
|
||||
Display a list of current buffer groups using Counsel." t nil)
|
||||
|
||||
(register-definition-prefixes "centaur-tabs-interactive" '("centaur-tabs-"))
|
||||
|
||||
;;;***
|
||||
|
||||
;;; End of scraped data
|
||||
|
||||
(provide 'centaur-tabs-autoloads)
|
||||
;;;### (autoloads nil nil ("centaur-tabs-pkg.el") (0 0 0 0))
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; no-native-compile: t
|
||||
;; coding: utf-8-emacs-unix
|
||||
;; coding: utf-8
|
||||
;; End:
|
||||
|
||||
;;; centaur-tabs-autoloads.el ends here
|
||||
865
code/elpa/centaur-tabs-20230607.1501/centaur-tabs-elements.el
Normal file
865
code/elpa/centaur-tabs-20230607.1501/centaur-tabs-elements.el
Normal file
|
|
@ -0,0 +1,865 @@
|
|||
;;; 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
|
||||
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-2024 Emmanuel Bustos
|
||||
;; Copyright (C) 2024 Jen-Chieh Shen
|
||||
;; Copyright (C) 2019-2020 Emmanuel Bustos
|
||||
|
||||
;; 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,73 +19,34 @@
|
|||
;; 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:
|
||||
|
||||
(require 'cl-lib)
|
||||
;;; Requires
|
||||
(require 'centaur-tabs-elements)
|
||||
|
||||
;; Compiler pacifier
|
||||
(declare-function ivy-read "ext:ivy.el" t t)
|
||||
(declare-function helm-build-sync-source "ext:helm-source.el" t t)
|
||||
(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)
|
||||
|
||||
(require 'centaur-tabs-functions)
|
||||
;;;;;;;;;;;;;;;;;;;;;;; Interactive functions ;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defun centaur-tabs-switch-group (&optional groupname)
|
||||
"Switch tab groups using ido. GROUPNAME can optionaly be provided."
|
||||
(interactive)
|
||||
(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))) )
|
||||
(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))) )
|
||||
(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."
|
||||
|
|
@ -98,21 +59,20 @@ 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
|
||||
|
|
@ -129,21 +89,21 @@ move forward."
|
|||
"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)))
|
||||
|
|
@ -155,27 +115,27 @@ move forward."
|
|||
"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))))
|
||||
|
|
@ -184,11 +144,12 @@ move forward."
|
|||
"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."
|
||||
|
|
@ -198,59 +159,67 @@ move forward."
|
|||
(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'.
|
||||
|
|
@ -263,9 +232,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.
|
||||
|
|
@ -277,15 +246,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
|
||||
"Set to t if `centaur-tabs-ace-jump' is invoked.")
|
||||
"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.")
|
||||
|
|
@ -296,91 +265,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 `centaur-tabs-ace-dispatch-alist'"
|
||||
"Preform ACTION on a visible tab. Ace-jump style.
|
||||
ACTION has to be one of value in `centuar-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 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)))))))))
|
||||
(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)))))))))
|
||||
(centaur-tabs-set-template (centaur-tabs-current-tabset t) nil)
|
||||
(when centaur-tabs-ace-jump-dim-buffer
|
||||
(delete-overlay centaur-tabs-dim-overlay)
|
||||
|
|
@ -388,19 +357,21 @@ ACTION has to be one of value in `centaur-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."
|
||||
|
|
@ -419,24 +390,21 @@ 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()
|
||||
|
|
@ -458,11 +426,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.
|
||||
|
||||
|
|
@ -478,9 +446,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)))
|
||||
|
|
@ -494,11 +462,12 @@ in a new frame."
|
|||
(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)
|
||||
|
|
@ -507,7 +476,7 @@ in a new frame."
|
|||
(defun centaur-tabs-open-in-external-application ()
|
||||
"Open the file of the current buffer according to its mime type."
|
||||
(interactive)
|
||||
(let ((path (or (buffer-file-name) default-directory)))
|
||||
(let ((path (if (buffer-file-name) (buffer-file-name) default-directory)))
|
||||
(centaur-tabs--open-externally path)))
|
||||
|
||||
(defun centaur-tabs--open-externally (file-or-path)
|
||||
|
|
@ -523,9 +492,10 @@ 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)
|
||||
|
|
@ -537,17 +507,22 @@ 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)
|
||||
|
|
@ -555,6 +530,7 @@ 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]
|
||||
|
|
@ -582,12 +558,13 @@ 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)
|
||||
|
|
@ -597,46 +574,54 @@ 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 (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))))))))
|
||||
((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))))))))
|
||||
|
||||
|
||||
(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
|
||||
14
code/elpa/centaur-tabs-20230607.1501/centaur-tabs-pkg.el
Normal file
14
code/elpa/centaur-tabs-20230607.1501/centaur-tabs-pkg.el
Normal file
|
|
@ -0,0 +1,14 @@
|
|||
(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,18 +1,18 @@
|
|||
;;; centaur-tabs.el --- Aesthetic, modern looking customizable tabs plugin -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2019-2024 Emmanuel Bustos
|
||||
;; Copyright (C) 2024 Jen-Chieh Shen
|
||||
;; Copyright (C) 2019 Emmanuel Bustos
|
||||
|
||||
;; 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: Jen-Chieh Shen <jcs090218@gmail.com>
|
||||
;; Maintainer: Emmanuel Bustos <ema2159@gmail.com>
|
||||
;; Created: 2019-21-19 22:14:34
|
||||
;; Version: 3.3
|
||||
;; Version: 5
|
||||
;; Known Compatibility: GNU Emacs 26.2
|
||||
;; Package-Requires: ((emacs "27.1") (powerline "2.4"))
|
||||
;; Keywords: frames
|
||||
;; Package-Requires: ((emacs "24.4") (powerline "2.4") (cl-lib "0.5"))
|
||||
;;
|
||||
;;
|
||||
|
||||
;;; This file is NOT part of GNU Emacs
|
||||
|
||||
|
|
@ -54,15 +54,10 @@
|
|||
;;
|
||||
|
||||
;;; 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
|
||||
|
|
@ -71,17 +66,15 @@
|
|||
|
||||
(defvar centaur-tabs--buffer-show-groups nil)
|
||||
|
||||
;;
|
||||
;;; 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
|
||||
|
||||
;;
|
||||
(defvar centaur-tabs--local-hlf nil)
|
||||
|
||||
;;;###autoload
|
||||
|
|
@ -100,24 +93,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))))
|
||||
|
||||
|
|
@ -139,92 +132,87 @@ 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)))
|
||||
;; Make sure it refresh every windows!
|
||||
(force-window-update))
|
||||
(centaur-tabs-free-tabsets-store))
|
||||
))
|
||||
|
||||
;;
|
||||
;;; 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))
|
||||
(add-function :after after-focus-change-function #'centaur-tabs-after-focus)
|
||||
(add-hook 'window-buffer-change-functions #'centaur-tabs-on-window-buffer-change)
|
||||
:overline nil
|
||||
:underline nil))
|
||||
(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-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))
|
||||
(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))
|
||||
|
||||
(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-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)
|
||||
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)
|
||||
(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-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))
|
||||
(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))
|
||||
|
||||
(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,891 +0,0 @@
|
|||
;;; centaur-tabs-elements.el --- centaur-tabs visual components and customizations -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2019-2024 Emmanuel Bustos
|
||||
;; Copyright (C) 2024 Jen-Chieh Shen
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;; This program is free software; you can redistribute it and/or
|
||||
;; modify it under the terms of the GNU General Public License as
|
||||
;; published by the Free Software Foundation; either version 2, or
|
||||
;; (at your option) any later version.
|
||||
;;
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
;; General Public License for more details.
|
||||
;;
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program; see the file COPYING. If not, write to
|
||||
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
|
||||
;; Floor, Boston, MA 02110-1301, USA.
|
||||
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; This file contains the visual components of centaur-tabs
|
||||
;;
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'custom)
|
||||
(require 'color)
|
||||
(require 'powerline)
|
||||
|
||||
;; Compiler pacifier
|
||||
(declare-function all-the-icons-icon-for-file "ext:all-the-icons.el" t t)
|
||||
(declare-function all-the-icons-icon-for-mode "ext:all-the-icons.el" t t)
|
||||
(declare-function nerd-icons-icon-for-file "ext:nerd-icons.el" t t)
|
||||
(declare-function nerd-icons-icon-for-mode "ext:nerd-icons.el" t t)
|
||||
|
||||
;;
|
||||
;;; Faces
|
||||
|
||||
(defface centaur-tabs-default
|
||||
'((t (:background "black" :foreground "black")))
|
||||
"Default face used in the tab bar."
|
||||
:group 'centaur-tabs)
|
||||
|
||||
(defface centaur-tabs-unselected
|
||||
'((t (:background "#3D3C3D" :foreground "grey50")))
|
||||
"Face used for unselected tabs."
|
||||
:group 'centaur-tabs)
|
||||
|
||||
(defface centaur-tabs-selected
|
||||
'((t (:background "#31343E" :foreground "white")))
|
||||
"Face used for the selected tab."
|
||||
:group 'centaur-tabs)
|
||||
|
||||
(defface centaur-tabs-unselected-modified
|
||||
'((t (:background "#3D3C3D" :foreground "grey50")))
|
||||
"Face used for unselected-modified tabs."
|
||||
:group 'centaur-tabs)
|
||||
|
||||
(defface centaur-tabs-selected-modified
|
||||
'((t (:background "#31343E" :foreground "white")))
|
||||
"Face used for the selected-modified tab."
|
||||
:group 'centaur-tabs)
|
||||
|
||||
(defface centaur-tabs-close-unselected
|
||||
'((t (:inherit centaur-tabs-unselected)))
|
||||
"Face used for unselected close button."
|
||||
:group 'centaur-tabs)
|
||||
|
||||
(defface centaur-tabs-close-selected
|
||||
'((t (:inherit centaur-tabs-selected)))
|
||||
"Face used for selected close button."
|
||||
:group 'centaur-tabs)
|
||||
|
||||
(defface centaur-tabs-name-mouse-face
|
||||
'((t nil))
|
||||
"Face used for tab name when hovered with the mouse."
|
||||
:group 'centaur-tabs)
|
||||
|
||||
(defface centaur-tabs-close-mouse-face
|
||||
'((t (:inherit underline)))
|
||||
"Face used for close button when hovered with the mouse."
|
||||
:group 'centaur-tabs)
|
||||
|
||||
(defface centaur-tabs-modified-marker-selected
|
||||
`((t (:inherit centaur-tabs-selected)))
|
||||
"Face used for selected modified marker."
|
||||
:group 'centaur-tabs)
|
||||
|
||||
(defface centaur-tabs-modified-marker-unselected
|
||||
`((t (:inherit centaur-tabs-unselected)))
|
||||
"Face used for unselected modified marker."
|
||||
:group 'centaur-tabs)
|
||||
|
||||
(defface centaur-tabs-active-bar-face
|
||||
'((t (:background "cyan")))
|
||||
"Face used for selected tab bar."
|
||||
:group 'centaur-tabs)
|
||||
|
||||
(defface centaur-tabs-jump-identifier-selected
|
||||
'((t (:inherit centaur-tabs-modified-marker-selected :weight extra-bold)))
|
||||
"Face used for selected tab identifiers when centaur-tabs-ace-jump is invoked."
|
||||
:group 'centaur-tabs)
|
||||
|
||||
(defface centaur-tabs-jump-identifier-unselected
|
||||
'((t (:inherit centaur-tabs-modified-marker-unselected :weight extra-bold)))
|
||||
"Face used for unselected tab identifiers when centaur-tabs-ace-jump is invoked."
|
||||
:group 'centaur-tabs)
|
||||
|
||||
(defface centaur-tabs-dim-buffer-face
|
||||
'((t (:foreground "gray40")))
|
||||
"Face for the buffer when centaur-tabs-ace-jump is invoked."
|
||||
:group 'centaur-tabs)
|
||||
|
||||
;;
|
||||
;;; Tabs' display line
|
||||
|
||||
(defvar centaur-tabs-display-line
|
||||
(if (boundp 'tab-line-format)
|
||||
'tab-line
|
||||
'header-line))
|
||||
|
||||
(defvar centaur-tabs-display-line-format
|
||||
(if (boundp 'tab-line-format)
|
||||
'tab-line-format
|
||||
'header-line-format))
|
||||
|
||||
;;
|
||||
;;; Tabs' characteristics
|
||||
|
||||
(defcustom centaur-tabs-style "bar"
|
||||
"The style of tab."
|
||||
:group 'centaur-tabs
|
||||
:type 'string)
|
||||
|
||||
(defcustom centaur-tabs-label-fixed-length 0
|
||||
"Fixed length of label. Set to 0 if dynamic."
|
||||
:group 'centaur-tabs
|
||||
:type 'int)
|
||||
|
||||
(defcustom centaur-tabs-background-color
|
||||
(face-background 'centaur-tabs-default nil 'default)
|
||||
"*Background color of the tab bar.
|
||||
By default, use the background color specified for the
|
||||
`centaur-tabs-default' face (or inherited from another face), or the
|
||||
background color of the `default' face otherwise."
|
||||
:group 'centaur-tabs
|
||||
:type 'face)
|
||||
|
||||
(defcustom centaur-tabs-height 22
|
||||
"The height of tab."
|
||||
:group 'centaur-tabs
|
||||
:type 'int)
|
||||
|
||||
(defcustom centaur-tabs-bar-height (+ 8 centaur-tabs-height)
|
||||
"The height of bar."
|
||||
:group 'centaur-tabs
|
||||
:type 'int)
|
||||
|
||||
(defcustom centaur-tabs-mouse-pointer 'hand
|
||||
"Cursor to display when hovering the tabs.
|
||||
Default is `'hand'. The following scopes are possible:
|
||||
- arrow
|
||||
- hand
|
||||
- vdrag
|
||||
- hdrag
|
||||
- modeline
|
||||
- hourglass"
|
||||
:group 'centaur-tabs
|
||||
:type 'variable)
|
||||
|
||||
(defcustom centaur-tabs-set-bar nil
|
||||
"When non nil, display a bar to show the currently selected tab.
|
||||
There are three options:
|
||||
- `'left': displays the bar at the left of the currently selected tab.
|
||||
- `'under': displays the bar under the currently selected tab.
|
||||
- `'over': displays the bar over the currently selected tab."
|
||||
:group 'centaur-tabs
|
||||
:type '(choice :tag "Display bar at..."
|
||||
(const :tag "Put bar on the left" left)
|
||||
(const :tag "Put bar as an underline" under)
|
||||
(const :tag "Put bar as an overline" over)))
|
||||
|
||||
;;
|
||||
;;; Icons
|
||||
|
||||
(defcustom centaur-tabs-set-icons nil
|
||||
"When non nil, display an icon based on `centaur-tabs-icon-type' alongside
|
||||
the tab name."
|
||||
:group 'centaur-tabs
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom centaur-tabs-icon-type (and centaur-tabs-set-icons
|
||||
(or (require 'all-the-icons nil t)
|
||||
(require 'nerd-icons nil t)))
|
||||
"Icon type; it should be one of `all-the-icons' and `nerd-icons'."
|
||||
:group 'centaur-tabs
|
||||
:type 'symbol
|
||||
:set
|
||||
(lambda (k v)
|
||||
(pcase v
|
||||
('all-the-icons
|
||||
(unless (require 'all-the-icons nil t)
|
||||
(setq v nil)))
|
||||
('nerd-icons
|
||||
(unless (require 'nerd-icons nil t)
|
||||
(setq v nil)))
|
||||
('type
|
||||
(if (require 'all-the-icons nil t)
|
||||
(setq v 'all-the-icons)
|
||||
(setq v nil))))
|
||||
(set k v)))
|
||||
|
||||
(defvar centaur-tabs-icon-scale-factor 1.0
|
||||
"The base scale factor for the `height' face property of tab icons.")
|
||||
|
||||
(defvar centaur-tabs-icon-v-adjust 0.01
|
||||
"The vertical adjust for tab icons.")
|
||||
|
||||
(defcustom centaur-tabs-gray-out-icons nil
|
||||
"When non nil, enable gray icons for unselected buffer."
|
||||
:group 'centaur-tabs
|
||||
:type '(choice :tag "Gray out icons for unselected..."
|
||||
(const :tag "Buffer" buffer)))
|
||||
|
||||
(defcustom centaur-tabs-plain-icons nil
|
||||
"When non nil, tab icons' color will be the same as tabs' foreground color."
|
||||
:group 'centaur-tabs
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom centaur-tabs-icons-prefix " "
|
||||
"Prefix string before icons."
|
||||
:group 'centaur-tabs
|
||||
:type 'string)
|
||||
|
||||
(defun centaur-tabs--icon-for-file (file &rest args)
|
||||
"Get the formatted icon for FILE.
|
||||
ARGS should be a plist containing `:height', `:v-adjust', or `:face' properties."
|
||||
(pcase centaur-tabs-icon-type
|
||||
('all-the-icons (apply #'all-the-icons-icon-for-file file args))
|
||||
('nerd-icons (apply #'nerd-icons-icon-for-file file args))))
|
||||
|
||||
(defun centaur-tabs--icon-for-mode (mode &rest args)
|
||||
"Get the formatted icon for MODE.
|
||||
|
||||
ARGS should be a plist containining `:height', `:v-adjust' or `:face' properties
|
||||
like in the normal icon inserting functions."
|
||||
(pcase centaur-tabs-icon-type
|
||||
('all-the-icons (apply #'all-the-icons-icon-for-mode mode args))
|
||||
('nerd-icons (apply #'nerd-icons-icon-for-mode mode args))))
|
||||
|
||||
(defun centaur-tabs-icon (tab face selected)
|
||||
"Generate icon for TAB using FACE's background.
|
||||
If icon gray out option enabled, gray out icon if not SELECTED."
|
||||
(if centaur-tabs-icon-type
|
||||
(with-current-buffer (car tab)
|
||||
(let* ((icon
|
||||
(or (ignore-errors
|
||||
(centaur-tabs--icon-for-file
|
||||
(file-name-nondirectory (buffer-file-name))
|
||||
:v-adjust centaur-tabs-icon-v-adjust
|
||||
:height centaur-tabs-icon-scale-factor))
|
||||
(ignore-errors
|
||||
(centaur-tabs--icon-for-mode
|
||||
major-mode
|
||||
:v-adjust centaur-tabs-icon-v-adjust
|
||||
:height centaur-tabs-icon-scale-factor))))
|
||||
(background (face-background face nil 'default))
|
||||
(inactive (cond ((and (not selected)
|
||||
(eq centaur-tabs-gray-out-icons 'buffer))
|
||||
(face-foreground 'mode-line-inactive nil 'default))
|
||||
(centaur-tabs-plain-icons
|
||||
(face-foreground 'centaur-tabs-selected nil 'default))
|
||||
(t 'unspecified)))
|
||||
(underline (and (eq (if (display-graphic-p) centaur-tabs-set-bar) 'under)
|
||||
(face-attribute face :underline)))
|
||||
(overline (and (eq (if (display-graphic-p) centaur-tabs-set-bar) 'over)
|
||||
(face-attribute face :overline))))
|
||||
(if (stringp icon)
|
||||
(progn
|
||||
(propertize icon 'face `(:inherit ,(get-text-property 0 'face icon)
|
||||
:foreground ,inactive
|
||||
:background ,background
|
||||
:underline ,underline
|
||||
:overline ,overline)))
|
||||
"")))
|
||||
""))
|
||||
|
||||
;;
|
||||
;;; Ace-window style tab switching
|
||||
|
||||
(defcustom centaur-tabs-show-jump-identifier 'prompted
|
||||
"Whether to show the tab identifier for centaur-tabs-ace-jump.
|
||||
It has 3 options:
|
||||
- `'nil', never show the jump identifier.
|
||||
- `'prompted', only show it when using centaur-tabs-ace-jump.
|
||||
- `'always', always show it regardless of the status."
|
||||
:group 'centaur-tabs
|
||||
:type '(choice :tag "show identifier when..."
|
||||
(const :tag "Never" nil)
|
||||
(const :tag "Only when prompted" prompted)
|
||||
(const :tag "Always" always)))
|
||||
|
||||
(defcustom centaur-tabs-ace-jump-dim-buffer t
|
||||
"Whether to dim the current buffer when centaur-ace-jump is activated."
|
||||
:type 'boolean
|
||||
:group 'centaur-tabs)
|
||||
|
||||
(defvar centaur-tabs-ace-jump-keys
|
||||
'(?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)
|
||||
"Buffer jump keys used by centaur-tabs-ace-jump.")
|
||||
|
||||
(defvar centaur-tabs-ace-dispatch-alist
|
||||
'((?q exit "Exit")
|
||||
(?\C-g exit "Exit")
|
||||
(?j jump-to-tab "Jump to tab")
|
||||
(?x close-tab "Close tab")
|
||||
(?s swap-tab "Swap tab")
|
||||
(?\[ backward-group "Previous group")
|
||||
(?\] forward-group "Next group")
|
||||
(?? show-help "Show dispatch help"))
|
||||
"Action keys used by centaur-tabs-ace-jump.
|
||||
The value of each element must be in the form:
|
||||
\(key keyword docstring), where keyword must be one of the follows:
|
||||
\(exit, jump-to-tab, close-tab, swap-tab, backward-group,
|
||||
forward-group, show-help).")
|
||||
|
||||
;;
|
||||
;;; Close buttons, modified marker and edges' margins
|
||||
|
||||
(defcustom centaur-tabs-set-close-button t
|
||||
"When non nil, display a clickable close button on the right side of the tabs."
|
||||
:group 'centaur-tabs
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom centaur-tabs-set-left-close-button nil
|
||||
"When non nil, display a clickable close button on the left side of the tabs."
|
||||
:group 'centaur-tabs
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom centaur-tabs-close-button (make-string 1 #x00D7)
|
||||
"Display appearance of the close buttons, if enabled."
|
||||
:group 'centaur-tabs
|
||||
:type 'string)
|
||||
|
||||
(defcustom centaur-tabs-set-modified-marker nil
|
||||
"When non nil, display a marker when the buffer is modified."
|
||||
:group 'centaur-tabs
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom centaur-tabs-modified-marker (make-string 1 #x23FA)
|
||||
"Display appearance of the modified marker, if enabled."
|
||||
:group 'centaur-tabs
|
||||
:type 'string)
|
||||
|
||||
(defcustom centaur-tabs-left-edge-margin " "
|
||||
"Text to display at the left edge of the tabs, or nil for no added margin."
|
||||
:group 'centaur-tabs
|
||||
:type 'string)
|
||||
|
||||
(defcustom centaur-tabs-right-edge-margin " "
|
||||
"Text to display at the right edge of the tabs, or nil for no added margin."
|
||||
:group 'centaur-tabs
|
||||
:type 'string)
|
||||
|
||||
;;
|
||||
;;; Selected tab bar
|
||||
|
||||
(defun centaur-tabs--make-xpm (face width height)
|
||||
"Create an XPM bitmap via FACE WIDTH and HEIGHT.
|
||||
Taken from `doom-modeline'."
|
||||
(when (and (display-graphic-p)
|
||||
(image-type-available-p 'xpm))
|
||||
(propertize
|
||||
" " 'display
|
||||
(let ((data (make-list height (make-list width 1)))
|
||||
(color (or (face-background face nil t) "None")))
|
||||
(ignore-errors
|
||||
(create-image
|
||||
(concat
|
||||
(format
|
||||
"/* XPM */\nstatic char * percent[] = {\n\"%i %i 2 1\",\n\". c %s\",\n\" c %s\","
|
||||
(length (car data)) (length data) color color)
|
||||
(apply #'concat
|
||||
(cl-loop with idx = 0
|
||||
with len = (length data)
|
||||
for dl in data
|
||||
do (cl-incf idx)
|
||||
collect
|
||||
(concat
|
||||
"\""
|
||||
(cl-loop for d in dl
|
||||
if (= d 0) collect (string-to-char " ")
|
||||
else collect (string-to-char "."))
|
||||
(if (eq idx len) "\"};" "\",\n")))))
|
||||
'xpm t :ascent 'center))))))
|
||||
|
||||
(defvar centaur-tabs-active-bar
|
||||
(centaur-tabs--make-xpm 'centaur-tabs-active-bar-face
|
||||
2
|
||||
centaur-tabs-bar-height))
|
||||
|
||||
;;
|
||||
;;; Navigation buttons
|
||||
|
||||
(defcustom centaur-tabs-show-navigation-buttons nil
|
||||
"When non-nil, show the buttons for backward/forward tabs."
|
||||
:group 'centaur-tabs
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom centaur-tabs-down-tab-text " ▾ "
|
||||
"Text icon to show in the down button tab."
|
||||
:group 'centaur-tabs
|
||||
:type 'string)
|
||||
|
||||
(defcustom centaur-tabs-backward-tab-text " ⏴ "
|
||||
"Text icon to show in the backward button tab."
|
||||
:group 'centaur-tabs
|
||||
:type 'string)
|
||||
|
||||
(defcustom centaur-tabs-forward-tab-text " ⏵ "
|
||||
"Text icon to show in the forward button tab."
|
||||
:group 'centaur-tabs
|
||||
:type 'string)
|
||||
|
||||
(defcustom centaur-tabs-show-count nil
|
||||
"When non-nil, show the current index and count of tabs in the current group."
|
||||
:group 'centaur-tabs
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom centaur-tabs-count-format " [%d/%d] "
|
||||
"Format text to display count."
|
||||
:group 'centaur-tabs
|
||||
:type 'string)
|
||||
|
||||
;;
|
||||
;;; New tab button
|
||||
|
||||
(defcustom centaur-tabs-show-new-tab-button t
|
||||
"When non-nil, show the button to create a new tab."
|
||||
:group 'centaur-tabs
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom centaur-tabs-new-tab-text " + "
|
||||
"Text icon to show in the new-tab button."
|
||||
:group 'centaur-tabs
|
||||
:type 'string)
|
||||
|
||||
;;
|
||||
;;; Separators
|
||||
|
||||
(defvar centaur-tabs-style-left nil)
|
||||
(defvar centaur-tabs-style-right nil)
|
||||
|
||||
(defvar ns-use-srgb-colorspace)
|
||||
|
||||
(defvar centaur-tabs-image-apple-rgb
|
||||
(and (eq (window-system) 'ns)
|
||||
ns-use-srgb-colorspace
|
||||
(< 11
|
||||
(string-to-number
|
||||
(and (string-match "darwin\\([0-9]+\\)" system-configuration)
|
||||
(match-string-no-properties 1 system-configuration)))))
|
||||
"Boolean variable to determine whether to use Apple RGB colorspace.
|
||||
used to render images.
|
||||
|
||||
t on macOS 10.7+ and `ns-use-srgb-colorspace' is t, nil otherwise.
|
||||
|
||||
This variable is automatically set, there's no need to modify it.")
|
||||
|
||||
(defun centaur-tabs-separator-interpolate (color1 color2)
|
||||
"Interpolate between COLOR1 and COLOR2.
|
||||
|
||||
COLOR1 and COLOR2 must be supplied as hex strings with a leading #."
|
||||
(let* ((c1 (color-name-to-rgb color1))
|
||||
(c2 (color-name-to-rgb color2))
|
||||
(red (/ (+ (nth 0 c1) (nth 0 c2)) 2))
|
||||
(green (/ (+ (nth 1 c1) (nth 1 c2)) 2))
|
||||
(blue (/ (+ (nth 2 c1) (nth 2 c2)) 2)))
|
||||
(color-rgb-to-hex red green blue)))
|
||||
|
||||
(defun centaur-tabs-separator-color-xyz-to-apple-rgb (X Y Z)
|
||||
"Convert CIE X Y Z colors to Apple RGB color space."
|
||||
(let ((r (+ (* 3.2404542 X) (* -1.5371385 Y) (* -0.4985314 Z)))
|
||||
(g (+ (* -0.9692660 X) (* 1.8760108 Y) (* 0.0415560 Z)))
|
||||
(b (+ (* 0.0556434 X) (* -0.2040259 Y) (* 1.0572252 Z))))
|
||||
(list (expt r (/ 1.8)) (expt g (/ 1.8)) (expt b (/ 1.8)))))
|
||||
|
||||
(defun centaur-tabs-separator-color-srgb-to-apple-rgb (red green blue)
|
||||
"Convert RED GREEN BLUE colors from sRGB color space to Apple RGB.
|
||||
RED, GREEN and BLUE should be between 0.0 and 1.0, inclusive."
|
||||
(apply #'centaur-tabs-separator-color-xyz-to-apple-rgb (color-srgb-to-xyz red green blue)))
|
||||
|
||||
(defun centaur-tabs-separator-hex-color (color)
|
||||
"Get the hexadecimal value of COLOR."
|
||||
(when color
|
||||
(let ((srgb-color (color-name-to-rgb color)))
|
||||
(if centaur-tabs-image-apple-rgb
|
||||
(apply #'color-rgb-to-hex (apply #'centaur-tabs-separator-color-srgb-to-apple-rgb srgb-color))
|
||||
(apply #'color-rgb-to-hex srgb-color)))))
|
||||
|
||||
(defun centaur-tabs-separator-pattern (lst)
|
||||
"Turn LST into an infinite pattern."
|
||||
(when lst
|
||||
(let ((pattern (cl-copy-list lst)))
|
||||
(setcdr (last pattern) pattern))))
|
||||
|
||||
(defun centaur-tabs-separator-pattern-to-string (pattern)
|
||||
"Convert a PATTERN into a string that can be used in an XPM."
|
||||
(concat "\"" (mapconcat #'number-to-string pattern "") "\","))
|
||||
|
||||
(defun centaur-tabs-separator-reverse-pattern (pattern)
|
||||
"Reverse each line in PATTERN."
|
||||
(mapcar 'reverse pattern))
|
||||
|
||||
(defun centaur-tabs-separator-row-pattern (fill total &optional fade)
|
||||
"Make a list that has FILL 0s out of TOTAL 1s with FADE 2s to the right of
|
||||
the fill."
|
||||
(unless fade (setq fade 0))
|
||||
(let ((fill (min fill total))
|
||||
(fade (min fade (max (- total fill) 0))))
|
||||
(append (make-list fill 0)
|
||||
(make-list fade 2)
|
||||
(make-list (- total fill fade) 1))))
|
||||
|
||||
(defun centaur-tabs-separator-pattern-bindings-body (patterns height-exp pattern-height-sym
|
||||
second-pattern-height-sym)
|
||||
"Create let-var bindings and a function body from PATTERNS.
|
||||
The `car' and `cdr' parts of the result can be passed to the
|
||||
function `centaur-tabs-separator-wrap-defun' as its `let-vars'
|
||||
and `body' arguments,respectively. HEIGHT-EXP is an expression
|
||||
calculating the image height and it should contain a free variable `height'.
|
||||
PATTERN-HEIGHT-SYM and SECOND-PATTERN-HEIGHT-SYM are symbols used
|
||||
for let-var binding variables."
|
||||
(let* ((pattern (centaur-tabs-separator-pattern (mapcar 'centaur-tabs-separator-pattern-to-string (car patterns))))
|
||||
(header (mapcar 'centaur-tabs-separator-pattern-to-string (nth 1 patterns)))
|
||||
(footer (mapcar 'centaur-tabs-separator-pattern-to-string (nth 2 patterns)))
|
||||
(second-pattern (centaur-tabs-separator-pattern (mapcar 'centaur-tabs-separator-pattern-to-string (nth 3 patterns))))
|
||||
(center (mapcar 'centaur-tabs-separator-pattern-to-string (nth 4 patterns)))
|
||||
(reserve (+ (length header) (length footer) (length center))))
|
||||
(when pattern
|
||||
(cons `((,pattern-height-sym (max (- ,height-exp ,reserve) 0))
|
||||
(,second-pattern-height-sym (/ ,pattern-height-sym 2))
|
||||
(,pattern-height-sym ,(if second-pattern `(ceiling ,pattern-height-sym 2) `,pattern-height-sym)))
|
||||
(list (when header `(mapconcat 'identity ',header ""))
|
||||
`(mapconcat 'identity
|
||||
(cl-subseq ',pattern 0 ,pattern-height-sym) "")
|
||||
(when center `(mapconcat 'identity ',center ""))
|
||||
(when second-pattern
|
||||
`(mapconcat 'identity
|
||||
(cl-subseq ',second-pattern
|
||||
0 ,second-pattern-height-sym) ""))
|
||||
(when footer `(mapconcat 'identity ',footer "")))))))
|
||||
|
||||
(defun centaur-tabs-separator-pattern-defun (name dir width &rest patterns)
|
||||
"Create a powerline function of NAME in DIR with WIDTH for PATTERNS.
|
||||
|
||||
PATTERNS is of the form (PATTERN HEADER FOOTER SECOND-PATTERN CENTER
|
||||
PATTERN-2X HEADER-2X FOOTER-2X SECOND-PATTERN-2X CENTER-2X).
|
||||
PATTERN is required, all other components are optional.
|
||||
The first 5 components are for the standard resolution image.
|
||||
The remaining ones are for the high resolution image where both
|
||||
width and height are doubled. If PATTERN-2X is nil or not given,
|
||||
then the remaining components are ignored and the standard
|
||||
resolution image with magnification and interpolation will be
|
||||
used in high resolution environments
|
||||
|
||||
All generated functions generate the form:
|
||||
HEADER
|
||||
PATTERN ...
|
||||
CENTER
|
||||
SECOND-PATTERN ...
|
||||
FOOTER
|
||||
|
||||
PATTERN and SECOND-PATTERN repeat infinitely to fill the space needed to
|
||||
generate a full height XPM.
|
||||
|
||||
PATTERN, HEADER, FOOTER, SECOND-PATTERN, CENTER are of the form
|
||||
\((COLOR ...) (COLOR ...) ...).
|
||||
|
||||
COLOR can be one of 0, 1, or 2, where 0 is the source color, 1 is the
|
||||
destination color, and 2 is the interpolated color between 0 and 1."
|
||||
(when (eq dir 'right)
|
||||
(setq patterns (mapcar 'centaur-tabs-separator-reverse-pattern patterns)))
|
||||
(let ((bindings-body (centaur-tabs-separator-pattern-bindings-body patterns
|
||||
'height
|
||||
'pattern-height
|
||||
'second-pattern-height))
|
||||
(bindings-body-2x (centaur-tabs-separator-pattern-bindings-body (nthcdr 5 patterns)
|
||||
'(* height 2)
|
||||
'pattern-height-2x
|
||||
'second-pattern-height-2x)))
|
||||
(centaur-tabs-separator-wrap-defun name dir width
|
||||
(append (car bindings-body) (car bindings-body-2x))
|
||||
(cdr bindings-body) (cdr bindings-body-2x))))
|
||||
|
||||
(defun centaur-tabs-separator-background-color (face)
|
||||
"Set the separator background color using FACE."
|
||||
(face-attribute face
|
||||
(if (face-attribute face :inverse-video nil 'default)
|
||||
:foreground
|
||||
:background)
|
||||
nil
|
||||
'default))
|
||||
|
||||
(defun centaur-tabs-separator-wrap-defun (name dir width let-vars body &optional body-2x)
|
||||
"Generate a powerline function of name NAME in dir DIR.
|
||||
This is made with WIDTH using LET-VARS and BODY.
|
||||
BODY-2X is an optional argument."
|
||||
(let* ((src-face (if (eq dir 'left) 'face1 'face2))
|
||||
(dst-face (if (eq dir 'left) 'face2 'face1)))
|
||||
`(defun ,(intern (format "powerline-%s-%s" name (symbol-name dir)))
|
||||
(face1 face2 &optional height)
|
||||
(when window-system
|
||||
(unless height (setq height centaur-tabs-height))
|
||||
(let* ,(append `((color1 (when ,src-face
|
||||
(centaur-tabs-separator-hex-color (centaur-tabs-separator-background-color ,src-face))))
|
||||
(color2 (when ,dst-face
|
||||
(centaur-tabs-separator-hex-color (centaur-tabs-separator-background-color ,dst-face))))
|
||||
(colori (when (and color1 color2) (centaur-tabs-separator-interpolate color1 color2)))
|
||||
(color1 (or color1 "None"))
|
||||
(color2 (or color2 "None"))
|
||||
(colori (or colori "None")))
|
||||
let-vars)
|
||||
(apply #'create-image
|
||||
,(append `(concat (format "/* XPM */ static char * %s_%s[] = { \"%s %s 3 1\", \"0 c %s\", \"1 c %s\", \"2 c %s\","
|
||||
,(replace-regexp-in-string "-" "_" name)
|
||||
(symbol-name ',dir)
|
||||
,width
|
||||
height
|
||||
color1
|
||||
color2
|
||||
colori))
|
||||
body
|
||||
'("};"))
|
||||
'xpm t
|
||||
:ascent 'center
|
||||
:face (when (and face1 face2)
|
||||
,dst-face)
|
||||
,(and body-2x
|
||||
`(and (featurep 'mac)
|
||||
(list :data-2x
|
||||
,(append `(concat (format "/* XPM */ static char * %s_%s_2x[] = { \"%s %s 3 1\", \"0 c %s\", \"1 c %s\", \"2 c %s\","
|
||||
,(replace-regexp-in-string "-" "_" name)
|
||||
(symbol-name ',dir)
|
||||
(* ,width 2)
|
||||
(* height 2)
|
||||
color1
|
||||
color2
|
||||
colori))
|
||||
body-2x
|
||||
'("};")))))))))))
|
||||
|
||||
(defun centaur-tabs-separator-alternate (dir)
|
||||
"Generate an alternating pattern XPM function for DIR."
|
||||
(centaur-tabs-separator-pattern-defun "alternate" dir 4
|
||||
'((2 2 1 1)
|
||||
(0 0 2 2))
|
||||
nil nil nil nil
|
||||
;; 2x
|
||||
'((2 2 2 2 1 1 1 1)
|
||||
(2 2 2 2 1 1 1 1)
|
||||
(0 0 0 0 2 2 2 2)
|
||||
(0 0 0 0 2 2 2 2))))
|
||||
|
||||
(defun centaur-tabs-separator-bar (dir)
|
||||
"Generate a bar XPM function for DIR."
|
||||
(centaur-tabs-separator-pattern-defun "bar" dir 2
|
||||
'((2 2))))
|
||||
|
||||
(defun centaur-tabs-separator-box (dir)
|
||||
"Generate a box XPM function for DIR."
|
||||
(centaur-tabs-separator-pattern-defun "box" dir 2
|
||||
'((0 0)
|
||||
(0 0)
|
||||
(1 1)
|
||||
(1 1))
|
||||
nil nil nil nil
|
||||
;; 2x
|
||||
'((0 0 0 0)
|
||||
(0 0 0 0)
|
||||
(0 0 0 0)
|
||||
(0 0 0 0)
|
||||
(1 1 1 1)
|
||||
(1 1 1 1)
|
||||
(1 1 1 1)
|
||||
(1 1 1 1))))
|
||||
|
||||
(defun centaur-tabs-separator-chamfer (dir)
|
||||
"Generate a chamfer XPM function for DIR."
|
||||
(centaur-tabs-separator-pattern-defun "chamfer" dir 3
|
||||
'((0 0 0))
|
||||
'((1 1 1)
|
||||
(0 1 1)
|
||||
(0 0 1))
|
||||
nil nil nil
|
||||
;; 2x
|
||||
'((0 0 0 0 0 0))
|
||||
'((1 1 1 1 1 1)
|
||||
(0 1 1 1 1 1)
|
||||
(0 0 1 1 1 1)
|
||||
(0 0 0 1 1 1)
|
||||
(0 0 0 0 1 1)
|
||||
(0 0 0 0 0 1))))
|
||||
|
||||
(defun centaur-tabs-separator-rounded (dir)
|
||||
"Generate a rounded XPM function for DIR."
|
||||
(centaur-tabs-separator-pattern-defun "rounded" dir 6
|
||||
'((0 0 0 0 0 0))
|
||||
'((2 1 1 1 1 1)
|
||||
(0 0 2 1 1 1)
|
||||
(0 0 0 0 1 1)
|
||||
(0 0 0 0 2 1)
|
||||
(0 0 0 0 0 1)
|
||||
(0 0 0 0 0 2))
|
||||
nil nil nil
|
||||
;; 2x
|
||||
'((0 0 0 0 0 0 0 0 0 0 0 0))
|
||||
'((1 1 1 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 2 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 2 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 2 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 0 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 0 1))))
|
||||
|
||||
(defun centaur-tabs-separator-slant (dir)
|
||||
"Generate a slant XPM function for DIR."
|
||||
(let* ((row-modifier (if (eq dir 'left) 'identity 'reverse)))
|
||||
(centaur-tabs-separator-wrap-defun "slant" dir 'width
|
||||
'((width (1- (ceiling height 2))))
|
||||
`((cl-loop for i from 0 to (1- height)
|
||||
concat (centaur-tabs-separator-pattern-to-string (,row-modifier (centaur-tabs-separator-row-pattern (/ i 2) width)))))
|
||||
`((cl-loop for i from 0 to (1- (* height 2))
|
||||
concat (centaur-tabs-separator-pattern-to-string (,row-modifier (centaur-tabs-separator-row-pattern (/ i 2) (* width 2)))))))))
|
||||
|
||||
(defun centaur-tabs-separator-wave (dir)
|
||||
"Generate a wave XPM function for DIR."
|
||||
(centaur-tabs-separator-pattern-defun "wave" dir 11
|
||||
'((0 0 0 0 0 0 1 1 1 1 1))
|
||||
'((2 1 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 2 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 2 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 2 1 1 1 1 1))
|
||||
'((0 0 0 0 0 0 2 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 2 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 2 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 2))
|
||||
nil nil
|
||||
;; 2x
|
||||
'((0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1))
|
||||
'((1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1))
|
||||
'((0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0))))
|
||||
|
||||
(defun centaur-tabs-separator-zigzag (dir)
|
||||
"Generate a zigzag pattern XPM function for DIR."
|
||||
(centaur-tabs-separator-pattern-defun "zigzag" dir 3
|
||||
'((1 1 1)
|
||||
(0 1 1)
|
||||
(0 0 1)
|
||||
(0 0 0)
|
||||
(0 0 1)
|
||||
(0 1 1))
|
||||
nil nil nil nil
|
||||
;; 2x
|
||||
'((1 1 1 1 1 1)
|
||||
(0 1 1 1 1 1)
|
||||
(0 0 1 1 1 1)
|
||||
(0 0 0 1 1 1)
|
||||
(0 0 0 0 1 1)
|
||||
(0 0 0 0 0 1)
|
||||
(0 0 0 0 0 0)
|
||||
(0 0 0 0 0 1)
|
||||
(0 0 0 0 1 1)
|
||||
(0 0 0 1 1 1)
|
||||
(0 0 1 1 1 1)
|
||||
(0 1 1 1 1 1))))
|
||||
|
||||
(defun centaur-tabs-separator-memoize (func)
|
||||
"Memoize FUNC.
|
||||
If argument is a symbol then install the memoized function over
|
||||
the original function. Use frame-local memoization."
|
||||
(cl-typecase func
|
||||
(symbol (fset func (centaur-tabs-separator-memoize-wrap-frame-local (symbol-function func))) func)
|
||||
(function (centaur-tabs-separator-memoize-wrap-frame-local func))))
|
||||
|
||||
(defun centaur-tabs-separator-memoize-wrap-frame-local (func)
|
||||
"Return the memoized version of FUNC.
|
||||
The memoization cache is frame-local."
|
||||
(let ((funcid (cl-gensym)))
|
||||
`(lambda (&rest args)
|
||||
,(concat (documentation func) (format "\n(memoized function %s)" funcid))
|
||||
(let* ((cache (centaur-tabs-separator-create-or-get-cache))
|
||||
(key (cons ',funcid args))
|
||||
(val (gethash key cache)))
|
||||
(or val
|
||||
(puthash key (apply ,func args) cache))))))
|
||||
|
||||
(defun centaur-tabs-separator-create-or-get-cache ()
|
||||
"Return a frame-local hash table that acts as a memoization cache.
|
||||
The cache is for the powerline.
|
||||
Create one if the frame doesn't have one yet."
|
||||
(if-let* ((table (frame-parameter nil 'powerline-cache))
|
||||
((hash-table-p table)))
|
||||
table
|
||||
(centaur-tabs-separator-reset-cache)))
|
||||
|
||||
(defun centaur-tabs-separator-reset-cache ()
|
||||
"Reset and return the frame-local hash table used for a memoization cache."
|
||||
(let ((table (make-hash-table :test 'equal)))
|
||||
;; Store it as a frame-local variable
|
||||
(modify-frame-parameters nil `((powerline-cache . ,table)))
|
||||
table))
|
||||
|
||||
(centaur-tabs-separator-memoize (centaur-tabs-separator-alternate 'left))
|
||||
(centaur-tabs-separator-memoize (centaur-tabs-separator-alternate 'right))
|
||||
(centaur-tabs-separator-memoize (centaur-tabs-separator-bar 'left))
|
||||
(centaur-tabs-separator-memoize (centaur-tabs-separator-bar 'right))
|
||||
(centaur-tabs-separator-memoize (centaur-tabs-separator-box 'left))
|
||||
(centaur-tabs-separator-memoize (centaur-tabs-separator-box 'right))
|
||||
(centaur-tabs-separator-memoize (centaur-tabs-separator-chamfer 'left))
|
||||
(centaur-tabs-separator-memoize (centaur-tabs-separator-chamfer 'right))
|
||||
(centaur-tabs-separator-memoize (centaur-tabs-separator-rounded 'left))
|
||||
(centaur-tabs-separator-memoize (centaur-tabs-separator-rounded 'right))
|
||||
(centaur-tabs-separator-memoize (centaur-tabs-separator-slant 'left))
|
||||
(centaur-tabs-separator-memoize (centaur-tabs-separator-slant 'right))
|
||||
(centaur-tabs-separator-memoize (centaur-tabs-separator-wave 'left))
|
||||
(centaur-tabs-separator-memoize (centaur-tabs-separator-wave 'right))
|
||||
(centaur-tabs-separator-memoize (centaur-tabs-separator-zigzag 'left))
|
||||
(centaur-tabs-separator-memoize (centaur-tabs-separator-zigzag 'right))
|
||||
|
||||
(defun centaur-tabs-select-separator-style (tab-style)
|
||||
"Set the separator style to TAB-STYLE."
|
||||
(let* ((theme (or (car custom-enabled-themes) "default"))
|
||||
(name (intern (format "centaur-tabs--%s-%s-face" theme tab-style)))
|
||||
(face (copy-face 'centaur-tabs-default name)))
|
||||
(setq centaur-tabs-style-left
|
||||
(funcall (intern (format "powerline-%s-right" tab-style))
|
||||
face nil centaur-tabs-height))
|
||||
(setq centaur-tabs-style-right
|
||||
(funcall (intern (format "powerline-%s-left" tab-style))
|
||||
nil face centaur-tabs-height))))
|
||||
|
||||
(provide 'centaur-tabs-elements)
|
||||
;;; centaur-tabs-elements.el ends here
|
||||
|
|
@ -1,642 +0,0 @@
|
|||
;;; centaur-tabs-interactive.el --- centaur-tabs interactive functions and plugins support 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 centaur-tabs interactive functions and plugins support
|
||||
;;
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'centaur-tabs-elements)
|
||||
|
||||
;; Compiler pacifier
|
||||
(declare-function ivy-read "ext:ivy.el" t t)
|
||||
(declare-function helm-build-sync-source "ext:helm-source.el" t t)
|
||||
(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 (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) )))
|
||||
|
||||
(defun centaur-tabs-select-end-tab ()
|
||||
"Select end tab of current tabset."
|
||||
(interactive)
|
||||
(centaur-tabs-select-beg-tab t))
|
||||
|
||||
(defun centaur-tabs-select-beg-tab (&optional backward)
|
||||
"Select beginning tab of current tabs.
|
||||
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)
|
||||
(when tabset
|
||||
(setq tabset (centaur-tabs-tabs 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."
|
||||
(interactive)
|
||||
(other-window 1)
|
||||
(if reversed
|
||||
(centaur-tabs-forward-tab)
|
||||
(centaur-tabs-backward-tab))
|
||||
(other-window -1))
|
||||
|
||||
(defun centaur-tabs-forward-tab-other-window ()
|
||||
"Move to right tab in other window."
|
||||
(interactive)
|
||||
(centaur-tabs-backward-tab-other-window t))
|
||||
|
||||
(defun centaur-tabs-move-current-tab-to-right ()
|
||||
"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)
|
||||
(while (and
|
||||
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
|
||||
(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)))
|
||||
(set bufset new-bufs)
|
||||
(centaur-tabs-set-template bufset nil)
|
||||
(centaur-tabs-display-update)))
|
||||
|
||||
(defun centaur-tabs-move-current-tab-to-left ()
|
||||
"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)
|
||||
(if (string= (buffer-name) (format "%s" (car first-buf)))
|
||||
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)))
|
||||
(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"))
|
||||
(set bufset new-bufs)
|
||||
(centaur-tabs-set-template bufset nil)
|
||||
(centaur-tabs-display-update))))
|
||||
|
||||
(defmacro centaur-tabs-kill-buffer-match-rule (match-rule)
|
||||
"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))))
|
||||
|
||||
(defun centaur-tabs-kill-all-buffers-in-current-group ()
|
||||
"Kill all buffers in current group."
|
||||
(interactive)
|
||||
(let* ((current-group-name (cdr (centaur-tabs-selected-tab (centaur-tabs-current-tabset t)))))
|
||||
;; Kill all buffers in current group.
|
||||
(centaur-tabs-kill-buffer-match-rule
|
||||
(lambda (_buffer) t))
|
||||
;; Switch to next 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)))
|
||||
;; Kill all buffers in current group.
|
||||
(centaur-tabs-kill-buffer-match-rule
|
||||
(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)))
|
||||
;; Kill all buffers in current group.
|
||||
(centaur-tabs-kill-buffer-match-rule
|
||||
(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)
|
||||
;; 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)))))
|
||||
;; Switch to next group if last file killed.
|
||||
(when (equal (length extension-names) 1)
|
||||
(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)
|
||||
;; 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))))))
|
||||
;; Switch to next group if last file killed.
|
||||
(when (equal (length extension-names) 1)
|
||||
(centaur-tabs-forward-group))))
|
||||
|
||||
(defun centaur-tabs-select-visible-nth-tab (tab-index)
|
||||
"Select visible tab with TAB-INDEX'.
|
||||
Example, when `tab-index' is 1, this function will select the leftmost label in
|
||||
the visible area, instead of the first label in the current group.
|
||||
If `tab-index' more than length of visible tabs, selet the last tab.
|
||||
|
||||
If `tab-index' is 0, select last tab."
|
||||
(let ((visible-tabs (centaur-tabs-view centaur-tabs-current-tabset)))
|
||||
(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))))))
|
||||
|
||||
(defun centaur-tabs-select-visible-tab ()
|
||||
"Bind this function with number keystroke, such as s-1, s-2, s-3 ... etc.
|
||||
|
||||
This function automatically recognizes the number at the end of the keystroke
|
||||
and switches to the tab of the corresponding index.
|
||||
|
||||
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)))
|
||||
(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
|
||||
"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.")
|
||||
|
||||
(defun centaur-tabs--dim-window ()
|
||||
"Create a dim background overlay for the current window."
|
||||
(when centaur-tabs-ace-jump-dim-buffer
|
||||
(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))))
|
||||
|
||||
(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)))
|
||||
(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 `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: ")))
|
||||
|
||||
(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 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)
|
||||
(setq centaur-tabs-dim-overlay nil))
|
||||
(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."
|
||||
(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))))
|
||||
|
||||
(defun centaur-tabs-group-buffer-groups ()
|
||||
"Use centaur-tabs's own buffer grouping function."
|
||||
(interactive)
|
||||
(setq centaur-tabs-buffer-groups-function 'centaur-tabs-buffer-groups)
|
||||
(centaur-tabs-display-update))
|
||||
|
||||
;; Projectile integration. Taken from tabbar-ruler
|
||||
(defvar centaur-tabs-projectile-buffer-group-calc nil
|
||||
"Set buffer groups for projectile.
|
||||
Should be buffer local and speed up calculation of buffer groups.")
|
||||
|
||||
(defun centaur-tabs-projectile-buffer-groups ()
|
||||
"Return the list of group names BUFFER belongs to."
|
||||
(if centaur-tabs-projectile-buffer-group-calc
|
||||
(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"))))
|
||||
(symbol-value 'centaur-tabs-projectile-buffer-group-calc)))
|
||||
|
||||
(defun centaur-tabs-group-by-projectile-project()
|
||||
"Group by projectile project."
|
||||
(interactive)
|
||||
(setq centaur-tabs-buffer-groups-function 'centaur-tabs-projectile-buffer-groups)
|
||||
(centaur-tabs-display-update))
|
||||
|
||||
;; Show groups instead of tabs
|
||||
(defun centaur-tabs-toggle-groups ()
|
||||
"Show group names on the tabs instead of buffer names."
|
||||
(interactive)
|
||||
(centaur-tabs-buffer-show-groups (not centaur-tabs--buffer-show-groups))
|
||||
(centaur-tabs-display-update))
|
||||
|
||||
;; Helm source for switching group in helm.
|
||||
|
||||
(defun centaur-tabs-build-helm-source ()
|
||||
"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))))))
|
||||
|
||||
;; Ivy source for switching group in ivy.
|
||||
|
||||
;;;###autoload
|
||||
(defun centaur-tabs-counsel-switch-group ()
|
||||
"Display a list of current buffer groups using Counsel."
|
||||
(interactive)
|
||||
(when (featurep 'ivy)
|
||||
(require 'ivy)
|
||||
(ivy-read
|
||||
"Centaur Tabs Groups:"
|
||||
(centaur-tabs-get-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."
|
||||
(interactive)
|
||||
(unless (centaur-tabs--one-window-p)
|
||||
(let ((buffer (current-buffer)))
|
||||
(delete-window)
|
||||
(display-buffer-pop-up-frame buffer nil))))
|
||||
|
||||
(defun centaur-tabs--copy-file-name-to-clipboard ()
|
||||
"Copy the current buffer file name to the clipboard."
|
||||
;;; From https://emacsredux.com/blog/2013/03/27/copy-filename-to-the-clipboard/
|
||||
(interactive)
|
||||
(let* ((filename (if (equal major-mode 'dired-mode)
|
||||
default-directory
|
||||
(buffer-file-name)))
|
||||
(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)
|
||||
(centaur-tabs--open-externally default-directory))
|
||||
|
||||
(defun centaur-tabs-open-in-external-application ()
|
||||
"Open the file of the current buffer according to its mime type."
|
||||
(interactive)
|
||||
(let ((path (or (buffer-file-name) default-directory)))
|
||||
(centaur-tabs--open-externally path)))
|
||||
|
||||
(defun centaur-tabs--open-externally (file-or-path)
|
||||
"Open FILE-OR-PATH according to its mime type in an external application.
|
||||
FILE-OR-PATH is expanded with `expand-file-name`.
|
||||
Modified copy of `treemacs-visit-node-in-external-application`."
|
||||
(let ((path (expand-file-name file-or-path)))
|
||||
(pcase system-type
|
||||
('windows-nt
|
||||
(declare-function w32-shell-execute "w32fns.c")
|
||||
(w32-shell-execute "open" (replace-regexp-in-string "/" "\\" path t t)))
|
||||
('darwin
|
||||
(shell-command (format "open \"%s\"" path)))
|
||||
('gnu/linux
|
||||
(let ((process-connection-type nil))
|
||||
(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)
|
||||
(when default-directory
|
||||
(kill-new default-directory)
|
||||
(message "Copied directory name '%s' to the kill ring." (expand-file-name default-directory))))
|
||||
|
||||
(defun centaur-tabs--tab-submenu-groups-definition ()
|
||||
"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))
|
||||
(buffers (mapcar #'centaur-tabs-tab-value tabs-in-group))
|
||||
(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)
|
||||
(kill-buffer (current-buffer))
|
||||
(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]
|
||||
["Kill other buffers of group" centaur-tabs-kill-other-buffers-in-current-group]
|
||||
["Kill unmodified buffers of group" centaur-tabs-kill-unmodified-buffers-in-current-group]
|
||||
"----"
|
||||
["Split below" split-window-below]
|
||||
["Split right" split-window-right]
|
||||
"----"
|
||||
["Maximize tab" delete-other-windows
|
||||
:active (null (centaur-tabs--one-window-p))]
|
||||
["Extract to new frame" centaur-tabs-extract-window-to-new-frame
|
||||
:active (null (centaur-tabs--one-window-p))]
|
||||
["Duplicate in new frame" make-frame-command]
|
||||
"----"
|
||||
["Copy filepath" centaur-tabs--copy-file-name-to-clipboard
|
||||
:active (buffer-file-name)]
|
||||
["Copy directory path" centaur-tabs--copy-directory-name-to-clipboard
|
||||
:active default-directory]
|
||||
["Open in external application" centaur-tabs-open-in-external-application
|
||||
:active (or (buffer-file-name) default-directory)]
|
||||
["Open directory in dired" dired-jump
|
||||
:active (not (eq major-mode 'dired-mode))]
|
||||
["Open directory externally" centaur-tabs-open-directory-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))))
|
||||
|
||||
(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)))
|
||||
(= 0 child-count)))
|
||||
|
||||
(defun centaur-tabs--get-tab-from-name (tabname)
|
||||
"Get the tab from the current group given de TABNAME."
|
||||
(let ((seq (centaur-tabs-tabs (centaur-tabs-get-tabset centaur-tabs-last-focused-buffer-group))))
|
||||
(cl-find-if
|
||||
(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."
|
||||
(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 (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))))
|
||||
(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))))))
|
||||
|
||||
(provide 'centaur-tabs-interactive)
|
||||
;;; centaur-tabs-interactive.el ends here
|
||||
|
|
@ -1,15 +0,0 @@
|
|||
(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,6 +1,6 @@
|
|||
(define-package "dash" "20240510.1327" "A modern list library for Emacs"
|
||||
(define-package "dash" "20240103.1301" "A modern list library for Emacs"
|
||||
'((emacs "24"))
|
||||
:commit "1de9dcb83eacfb162b6d9a118a4770b1281bcd84" :authors
|
||||
:commit "e32a70ca636bad42232b6c79f1491dc86802a721" :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 the second form, etc."
|
||||
signified by `it' in in second form, etc."
|
||||
(declare (debug (form body)))
|
||||
`(-as-> ,x it ,@forms))
|
||||
|
||||
|
|
@ -3298,8 +3298,6 @@ 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.8 from dash.texi.
|
||||
This is dash.info, produced by makeinfo version 6.7 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 the second form, etc.
|
||||
position signified by ‘it’ in in second form, etc.
|
||||
|
||||
(--> "def" (concat "abc" it "ghi"))
|
||||
⇒ "abcdefghi"
|
||||
|
|
@ -4892,53 +4892,53 @@ Node: Threading macros84441
|
|||
Ref: ->84666
|
||||
Ref: ->>85154
|
||||
Ref: -->85657
|
||||
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
|
||||
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
|
||||
|
||||
End Tag Table
|
||||
|
||||
|
|
@ -1,14 +0,0 @@
|
|||
(define-package "dash" "20240510.1327" "A modern list library for Emacs"
|
||||
'((emacs "24"))
|
||||
:commit "1de9dcb83eacfb162b6d9a118a4770b1281bcd84" :authors
|
||||
'(("Magnar Sveen" . "magnars@gmail.com"))
|
||||
:maintainers
|
||||
'(("Magnar Sveen" . "magnars@gmail.com"))
|
||||
:maintainer
|
||||
'("Magnar Sveen" . "magnars@gmail.com")
|
||||
:keywords
|
||||
'("extensions" "lisp")
|
||||
:url "https://github.com/magnars/dash.el")
|
||||
;; Local Variables:
|
||||
;; no-byte-compile: t
|
||||
;; End:
|
||||
|
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,10 +1,9 @@
|
|||
(define-package "dashboard" "20240529.2058" "A startup screen extracted from Spacemacs"
|
||||
(define-package "dashboard" "20240319.915" "A startup screen extracted from Spacemacs"
|
||||
'((emacs "26.1"))
|
||||
:commit "3852301f9c6f3104d9cc98389612b5ef3452a7de" :authors
|
||||
:commit "e34ce1b4730fb88a33a571b9065114b7a77645f0" :authors
|
||||
'(("Rakan Al-Hneiti" . "rakan.alhneiti@gmail.com"))
|
||||
:maintainers
|
||||
'(("Jesús Martínez" . "jesusmartinez93@gmail.com")
|
||||
("Jen-Chieh" . "jcs090218@gmail.com"))
|
||||
'(("Jesús Martínez" . "jesusmartinez93@gmail.com"))
|
||||
:maintainer
|
||||
'("Jesús Martínez" . "jesusmartinez93@gmail.com")
|
||||
:keywords
|
||||
|
|
@ -70,6 +70,15 @@
|
|||
(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)
|
||||
|
|
@ -124,27 +133,6 @@ 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!"
|
||||
|
|
@ -193,7 +181,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 '(alist :key-type symbol :value-type string)
|
||||
:type '(repeat (alist :key-type symbol :value-type string))
|
||||
:group 'dashboard)
|
||||
|
||||
(defcustom dashboard-heading-icon-height 1.2
|
||||
|
|
@ -257,16 +245,7 @@ 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
|
||||
(choice face
|
||||
(repeat :tag "Anonymous face" sexp))
|
||||
(choice string
|
||||
(const nil))
|
||||
(choice string
|
||||
(const nil)))))
|
||||
:type '(repeat (repeat (list string string string function symbol string string)))
|
||||
:group 'dashboard)
|
||||
|
||||
(defcustom dashboard-init-info
|
||||
|
|
@ -356,10 +335,8 @@ 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.
|
||||
It can be a string or a string list for display random icons."
|
||||
:type '(choice string
|
||||
(repeat string))
|
||||
"Footer's icon."
|
||||
:type 'string
|
||||
:group 'dashboard)
|
||||
|
||||
(defcustom dashboard-heading-shorcut-format " (%s)"
|
||||
|
|
@ -434,9 +411,7 @@ 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 (choice
|
||||
symbol
|
||||
(cons symbol integer)))
|
||||
:type '(repeat (alist :key-type symbol :value-type integer))
|
||||
:group 'dashboard)
|
||||
|
||||
(defcustom dashboard-item-shortcuts
|
||||
|
|
@ -448,8 +423,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 disabled. See `dashboard-items' for possible values of list-type.'"
|
||||
:type '(alist :key-type symbol :value-type string)
|
||||
shortcut is disbaled. See `dashboard-items' for possible values of list-type.'"
|
||||
:type '(repeat (alist :key-type symbol :value-type string))
|
||||
:group 'dashboard)
|
||||
|
||||
(defcustom dashboard-item-names nil
|
||||
|
|
@ -599,8 +574,7 @@ 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))
|
||||
|
|
@ -625,12 +599,9 @@ 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 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)))
|
||||
(defun dashboard-insert-newline (&optional n)
|
||||
"Insert N times of newlines."
|
||||
(dotimes (_ (or n 1))
|
||||
(insert "\n")))
|
||||
|
||||
(defun dashboard-insert-heading (heading &optional shortcut icon)
|
||||
|
|
@ -744,9 +715,7 @@ When called with TIMES return a function that insert TIMES number of newlines."
|
|||
(list :text (dashboard-get-banner-path 1)))))
|
||||
((and
|
||||
(pred listp)
|
||||
(pred (lambda (c)
|
||||
(and (not (proper-list-p c))
|
||||
(not (null c)))))
|
||||
(pred (lambda (c) (not (proper-list-p c))))
|
||||
`(,img . ,txt))
|
||||
(list :image (if (dashboard--image-supported-p img)
|
||||
img
|
||||
|
|
@ -756,16 +725,12 @@ When called with TIMES return a function that insert TIMES number of newlines."
|
|||
txt
|
||||
(message "could not find banner %s, use default instead" txt)
|
||||
(dashboard-get-banner-path 1))))
|
||||
((and
|
||||
(pred proper-list-p)
|
||||
(pred (lambda (l) (not (null l)))))
|
||||
|
||||
((pred proper-list-p)
|
||||
(let* ((max (length banner))
|
||||
(choose (nth (random max) banner)))
|
||||
(dashboard-choose-banner choose)))
|
||||
(_
|
||||
(user-error "Unsupported banner type: `%s'" banner)
|
||||
nil)))
|
||||
(message "unsupported banner config %s" banner))))
|
||||
|
||||
(defun dashboard--image-animated-p (image-path)
|
||||
"Return if image is a gif or webp.
|
||||
|
|
@ -885,8 +850,7 @@ Argument IMAGE-PATH path to the image."
|
|||
(when (and icon title
|
||||
(not (string-equal icon ""))
|
||||
(not (string-equal title "")))
|
||||
(propertize " " 'face `(:inherit (variable-pitch
|
||||
,face))))
|
||||
(propertize " " 'face 'variable-pitch))
|
||||
(when title (propertize title 'face face)))
|
||||
:help-echo help
|
||||
:action action
|
||||
|
|
@ -908,10 +872,7 @@ 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
|
||||
(when (and ,list
|
||||
,shortcut-char
|
||||
dashboard-show-shortcuts)
|
||||
,shortcut-char))
|
||||
(if (and ,list ,shortcut-char dashboard-show-shortcuts) ,shortcut-char))
|
||||
(if ,list
|
||||
(when (and (dashboard-insert-section-list
|
||||
,section-name
|
||||
|
|
@ -967,19 +928,10 @@ 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-footer-icon)))
|
||||
(footer-icon (dashboard-replace-displayable dashboard-footer-icon)))
|
||||
(dashboard-insert-center
|
||||
(if (string-empty-p footer-icon) footer-icon
|
||||
(concat footer-icon " "))
|
||||
|
|
@ -1388,9 +1340,7 @@ 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,15 +143,10 @@ Avalaible functions:
|
|||
`dashboard-insert-items'
|
||||
`dashboard-insert-footer'
|
||||
|
||||
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.
|
||||
You can also add your custom function or a lambda to the list.
|
||||
example:
|
||||
(lambda () (delete-char -1))"
|
||||
:type '(repeat (choice
|
||||
function
|
||||
(cons function sexp)))
|
||||
:type '(repeat function)
|
||||
:group 'dashboard)
|
||||
|
||||
(defcustom dashboard-navigation-cycle nil
|
||||
|
|
@ -159,10 +154,8 @@ example:
|
|||
:type 'boolean
|
||||
:group 'dashboard)
|
||||
|
||||
(defcustom dashboard-buffer-name "*dashboard*"
|
||||
"Dashboard's buffer name."
|
||||
:type 'string
|
||||
:group 'dashboard)
|
||||
(defconst dashboard-buffer-name "*dashboard*"
|
||||
"Dashboard's buffer name.")
|
||||
|
||||
(defvar dashboard-force-refresh nil
|
||||
"If non-nil, force refresh dashboard buffer.")
|
||||
|
|
@ -198,16 +191,16 @@ example:
|
|||
(save-excursion
|
||||
(if-let* ((sep (dashboard--separator))
|
||||
((and (search-backward sep nil t)
|
||||
(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")))
|
||||
(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"))))
|
||||
(user-error "Failed searching dashboard section"))))
|
||||
|
||||
;;
|
||||
|
|
@ -507,11 +500,8 @@ See `dashboard-item-generators' for all items available."
|
|||
(erase-buffer)
|
||||
(setq dashboard--section-starts nil)
|
||||
|
||||
(mapc (lambda (entry)
|
||||
(if (and (listp entry)
|
||||
(not (functionp entry)))
|
||||
(apply (car entry) `(,(cdr entry)))
|
||||
(funcall entry)))
|
||||
(mapc (lambda (fn)
|
||||
(funcall fn))
|
||||
dashboard-startupify-list)
|
||||
|
||||
(when dashboard-vertically-center-content
|
||||
File diff suppressed because it is too large
Load diff
|
|
@ -1,566 +0,0 @@
|
|||
;;; dashboard.el --- A startup screen extracted from Spacemacs -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (c) 2016-2024 emacs-dashboard maintainers
|
||||
;;
|
||||
;; Author : Rakan Al-Hneiti <rakan.alhneiti@gmail.com>
|
||||
;; Maintainer : Jesús Martínez <jesusmartinez93@gmail.com>
|
||||
;; Shen, Jen-Chieh <jcs090218@gmail.com>
|
||||
;; URL : https://github.com/emacs-dashboard/emacs-dashboard
|
||||
;;
|
||||
;; This file is not part of GNU Emacs.
|
||||
;;
|
||||
;;; License: GPLv3
|
||||
;;
|
||||
;; Created: October 05, 2016
|
||||
;; Package-Version: 1.9.0-SNAPSHOT
|
||||
;; Keywords: startup, screen, tools, dashboard
|
||||
;; Package-Requires: ((emacs "26.1"))
|
||||
;;; Commentary:
|
||||
|
||||
;; An extensible Emacs dashboard, with sections for
|
||||
;; bookmarks, projects (projectile or project.el), org-agenda and more.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'ffap)
|
||||
(require 'recentf)
|
||||
|
||||
(require 'dashboard-widgets)
|
||||
|
||||
;;
|
||||
;;; Externals
|
||||
|
||||
(declare-function bookmark-get-filename "ext:bookmark.el")
|
||||
(declare-function bookmark-all-names "ext:bookmark.el")
|
||||
(declare-function dashboard-ls--dirs "ext:dashboard-ls.el")
|
||||
(declare-function dashboard-ls--files "ext:dashboard-ls.el")
|
||||
(declare-function page-break-lines-mode "ext:page-break-lines.el")
|
||||
(declare-function projectile-remove-known-project "ext:projectile.el")
|
||||
(declare-function project-forget-projects-under "ext:project.el")
|
||||
(declare-function linum-mode "linum.el")
|
||||
|
||||
(declare-function dashboard-refresh-buffer "dashboard.el")
|
||||
|
||||
;;
|
||||
;;; Customization
|
||||
|
||||
(defgroup dashboard nil
|
||||
"Extensible startup screen."
|
||||
:group 'applications)
|
||||
|
||||
;; Custom splash screen
|
||||
(defvar dashboard-mode-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map (kbd "C-p") #'dashboard-previous-line)
|
||||
(define-key map (kbd "C-n") #'dashboard-next-line)
|
||||
(define-key map (kbd "<up>") #'dashboard-previous-line)
|
||||
(define-key map (kbd "<down>") #'dashboard-next-line)
|
||||
(define-key map (kbd "k") #'dashboard-previous-line)
|
||||
(define-key map (kbd "j") #'dashboard-next-line)
|
||||
(define-key map [tab] #'widget-forward)
|
||||
(define-key map (kbd "C-i") #'widget-forward)
|
||||
(define-key map [backtab] #'widget-backward)
|
||||
(define-key map (kbd "RET") #'dashboard-return)
|
||||
(define-key map [mouse-1] #'dashboard-mouse-1)
|
||||
(define-key map (kbd "}") #'dashboard-next-section)
|
||||
(define-key map (kbd "{") #'dashboard-previous-section)
|
||||
|
||||
(define-key map (kbd "<backspace>") #'dashboard-remove-item-under)
|
||||
(define-key map (kbd "<delete>") #'dashboard-remove-item-under)
|
||||
(define-key map (kbd "DEL") #'dashboard-remove-item-under)
|
||||
|
||||
(define-key map (kbd "1") #'dashboard-section-1)
|
||||
(define-key map (kbd "2") #'dashboard-section-2)
|
||||
(define-key map (kbd "3") #'dashboard-section-3)
|
||||
(define-key map (kbd "4") #'dashboard-section-4)
|
||||
(define-key map (kbd "5") #'dashboard-section-5)
|
||||
(define-key map (kbd "6") #'dashboard-section-6)
|
||||
(define-key map (kbd "7") #'dashboard-section-7)
|
||||
(define-key map (kbd "8") #'dashboard-section-8)
|
||||
(define-key map (kbd "9") #'dashboard-section-9)
|
||||
map)
|
||||
"Keymap for dashboard mode.")
|
||||
|
||||
(defcustom dashboard-before-initialize-hook nil
|
||||
"Hook that is run before dashboard buffer is initialized."
|
||||
:group 'dashboard
|
||||
:type 'hook)
|
||||
|
||||
(defcustom dashboard-after-initialize-hook nil
|
||||
"Hook that is run after dashboard buffer is initialized."
|
||||
:group 'dashboard
|
||||
:type 'hook)
|
||||
|
||||
(defcustom dashboard-hide-cursor nil
|
||||
"Whether to hide the cursor in the dashboard."
|
||||
:type 'boolean
|
||||
:group 'dashboard)
|
||||
|
||||
(define-derived-mode dashboard-mode special-mode "Dashboard"
|
||||
"Dashboard major mode for startup screen."
|
||||
:group 'dashboard
|
||||
:syntax-table nil
|
||||
:abbrev-table nil
|
||||
(buffer-disable-undo)
|
||||
(when (featurep 'whitespace) (whitespace-mode -1))
|
||||
(when (featurep 'linum) (linum-mode -1))
|
||||
(when (featurep 'display-line-numbers) (display-line-numbers-mode -1))
|
||||
(when (featurep 'page-break-lines) (page-break-lines-mode 1))
|
||||
(setq-local revert-buffer-function #'dashboard-refresh-buffer)
|
||||
(when dashboard-hide-cursor
|
||||
(setq-local cursor-type nil))
|
||||
(setq inhibit-startup-screen t
|
||||
buffer-read-only t
|
||||
truncate-lines t))
|
||||
|
||||
(defcustom dashboard-center-content nil
|
||||
"Whether to center content within the window."
|
||||
:type 'boolean
|
||||
:group 'dashboard)
|
||||
|
||||
(defcustom dashboard-vertically-center-content nil
|
||||
"Whether to vertically center content within the window."
|
||||
:type 'boolean
|
||||
:group 'dashboard)
|
||||
|
||||
(defcustom dashboard-startupify-list
|
||||
'(dashboard-insert-banner
|
||||
dashboard-insert-newline
|
||||
dashboard-insert-banner-title
|
||||
dashboard-insert-newline
|
||||
dashboard-insert-init-info
|
||||
dashboard-insert-items
|
||||
dashboard-insert-newline
|
||||
dashboard-insert-footer)
|
||||
"List of dashboard widgets (in order) to insert in dashboard buffer.
|
||||
Avalaible functions:
|
||||
`dashboard-insert-newline'
|
||||
`dashboard-insert-page-break'
|
||||
`dashboard-insert-banner'
|
||||
`dashboard-insert-banner-title'
|
||||
`dashboard-insert-navigator'
|
||||
`dashboard-insert-init-info'
|
||||
`dashboard-insert-items'
|
||||
`dashboard-insert-footer'
|
||||
|
||||
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 (choice
|
||||
function
|
||||
(cons function sexp)))
|
||||
:group 'dashboard)
|
||||
|
||||
(defcustom dashboard-navigation-cycle nil
|
||||
"Non-nil cycle the section navigation."
|
||||
:type 'boolean
|
||||
:group 'dashboard)
|
||||
|
||||
(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.")
|
||||
|
||||
(defvar dashboard--section-starts nil
|
||||
"List of section starting positions.")
|
||||
|
||||
;;
|
||||
;;; Util
|
||||
|
||||
(defun dashboard--goto-line (line)
|
||||
"Goto LINE."
|
||||
(goto-char (point-min)) (forward-line (1- line)))
|
||||
|
||||
(defmacro dashboard--save-excursion (&rest body)
|
||||
"Execute BODY save window point."
|
||||
(declare (indent 0) (debug t))
|
||||
`(let ((line (line-number-at-pos nil t))
|
||||
(column (current-column)))
|
||||
,@body
|
||||
(dashboard--goto-line line)
|
||||
(move-to-column column)))
|
||||
|
||||
;;
|
||||
;;; Core
|
||||
|
||||
(defun dashboard--separator ()
|
||||
"Return separator used to search."
|
||||
(concat "\n" dashboard-page-separator))
|
||||
|
||||
(defun dashboard--current-section ()
|
||||
"Return section symbol in dashboard."
|
||||
(save-excursion
|
||||
(if-let* ((sep (dashboard--separator))
|
||||
((and (search-backward sep nil t)
|
||||
(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"))))
|
||||
|
||||
;;
|
||||
;;; Navigation
|
||||
|
||||
(defun dashboard-previous-section ()
|
||||
"Navigate forward to next section."
|
||||
(interactive)
|
||||
(let* ((items-len (1- (length dashboard-items)))
|
||||
(first-item (car (nth 0 dashboard-items)))
|
||||
(current (or (ignore-errors (dashboard--current-section))
|
||||
first-item))
|
||||
(items (mapcar #'car dashboard-items))
|
||||
(find (cl-position current items :test #'equal))
|
||||
(prev-index (1- find))
|
||||
(prev (cond (dashboard-navigation-cycle
|
||||
(if (< prev-index 0) (nth items-len items)
|
||||
(nth prev-index items)))
|
||||
(t
|
||||
(if (< prev-index 0) (nth 0 items)
|
||||
(nth prev-index items))))))
|
||||
(dashboard--goto-section prev)))
|
||||
|
||||
(defun dashboard-next-section ()
|
||||
"Navigate forward to next section."
|
||||
(interactive)
|
||||
(let* ((items-len (1- (length dashboard-items)))
|
||||
(last-item (car (nth items-len dashboard-items)))
|
||||
(current (or (ignore-errors (dashboard--current-section))
|
||||
last-item))
|
||||
(items (mapcar #'car dashboard-items))
|
||||
(find (cl-position current items :test #'equal))
|
||||
(next-index (1+ find))
|
||||
(next (cond (dashboard-navigation-cycle
|
||||
(or (nth next-index items)
|
||||
(nth 0 items)))
|
||||
(t
|
||||
(if (< items-len next-index)
|
||||
(nth (min items-len next-index) items)
|
||||
(nth next-index items))))))
|
||||
(dashboard--goto-section next)))
|
||||
|
||||
(defun dashboard--section-lines ()
|
||||
"Return a list of integer represent the starting line number of each section."
|
||||
(let (pb-lst)
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(while (search-forward (dashboard--separator) nil t)
|
||||
(when (ignore-errors (dashboard--current-section))
|
||||
(push (line-number-at-pos) pb-lst))))
|
||||
(setq pb-lst (reverse pb-lst))
|
||||
pb-lst))
|
||||
|
||||
(defun dashboard--goto-section-by-index (index)
|
||||
"Navigate to item section by INDEX."
|
||||
(let* ((pg-lst (dashboard--section-lines))
|
||||
(items-id (1- index))
|
||||
(items-pg (nth items-id pg-lst))
|
||||
(items-len (length pg-lst)))
|
||||
(when (and items-pg (< items-id items-len))
|
||||
(dashboard--goto-line items-pg))))
|
||||
|
||||
(defun dashboard-section-1 ()
|
||||
"Navigate to section 1." (interactive) (dashboard--goto-section-by-index 1))
|
||||
(defun dashboard-section-2 ()
|
||||
"Navigate to section 2." (interactive) (dashboard--goto-section-by-index 2))
|
||||
(defun dashboard-section-3 ()
|
||||
"Navigate to section 3." (interactive) (dashboard--goto-section-by-index 3))
|
||||
(defun dashboard-section-4 ()
|
||||
"Navigate to section 4." (interactive) (dashboard--goto-section-by-index 4))
|
||||
(defun dashboard-section-5 ()
|
||||
"Navigate to section 5." (interactive) (dashboard--goto-section-by-index 5))
|
||||
(defun dashboard-section-6 ()
|
||||
"Navigate to section 6." (interactive) (dashboard--goto-section-by-index 6))
|
||||
(defun dashboard-section-7 ()
|
||||
"Navigate to section 7." (interactive) (dashboard--goto-section-by-index 7))
|
||||
(defun dashboard-section-8 ()
|
||||
"Navigate to section 8." (interactive) (dashboard--goto-section-by-index 8))
|
||||
(defun dashboard-section-9 ()
|
||||
"Navigate to section 9." (interactive) (dashboard--goto-section-by-index 9))
|
||||
|
||||
(defun dashboard-previous-line (arg)
|
||||
"Move point up and position it at that line’s item.
|
||||
Optional prefix ARG says how many lines to move; default is one line."
|
||||
(interactive "^p")
|
||||
(dashboard-next-line (- arg)))
|
||||
|
||||
(defun dashboard-next-line (arg)
|
||||
"Move point down and position it at that line’s item.
|
||||
Optional prefix ARG says how many lines to move; default is one line."
|
||||
;; code heavily inspired by `dired-next-line'
|
||||
(interactive "^p")
|
||||
(let (line-move-visual goal-column)
|
||||
(line-move arg t))
|
||||
;; We never want to move point into an invisible line. Dashboard doesn’t
|
||||
;; use invisible text currently but when it does we’re ready!
|
||||
(while (and (invisible-p (point))
|
||||
(not (if (and arg (< arg 0)) (bobp) (eobp))))
|
||||
(forward-char (if (and arg (< arg 0)) -1 1)))
|
||||
(beginning-of-line-text))
|
||||
|
||||
;;
|
||||
;;; ffap
|
||||
|
||||
(defun dashboard--goto-section (section)
|
||||
"Move to SECTION declares in variable `dashboard-item-shortcuts'."
|
||||
(let ((fnc (intern (format "dashboard-jump-to-%s" section))))
|
||||
(dashboard-funcall-fboundp fnc)))
|
||||
|
||||
(defun dashboard--current-index (section &optional pos)
|
||||
"Return the idex by SECTION from POS."
|
||||
(let (target-ln section-line)
|
||||
(save-excursion
|
||||
(when pos (goto-char pos))
|
||||
(setq target-ln (line-number-at-pos))
|
||||
(dashboard--goto-section section)
|
||||
(setq section-line (line-number-at-pos)))
|
||||
(- target-ln section-line)))
|
||||
|
||||
(defun dashboard--section-list (section)
|
||||
"Return the list from SECTION."
|
||||
(cl-case section
|
||||
(`recents recentf-list)
|
||||
(`bookmarks (bookmark-all-names))
|
||||
(`projects (dashboard-projects-backend-load-projects))
|
||||
(`ls-directories (dashboard-ls--dirs))
|
||||
(`ls-files (dashboard-ls--files))
|
||||
(t (user-error "Unknown section for search: %s" section))))
|
||||
|
||||
(defun dashboard--current-item-in-path ()
|
||||
"Return the path from current dashboard section in path."
|
||||
(let ((section (dashboard--current-section)) path)
|
||||
(cl-case section
|
||||
(`bookmarks (setq path (bookmark-get-filename path)))
|
||||
(t
|
||||
(let ((lst (dashboard--section-list section))
|
||||
(index (dashboard--current-index section)))
|
||||
(setq path (nth index lst)))))
|
||||
path))
|
||||
|
||||
(defun dashboard--on-path-item-p ()
|
||||
"Return non-nil if current point is on the item path from dashboard."
|
||||
(save-excursion
|
||||
(when (= (point) (line-end-position)) (ignore-errors (forward-char -1)))
|
||||
(eq (get-char-property (point) 'face) 'dashboard-items-face)))
|
||||
|
||||
(defun dashboard--ffap-guesser--adv (fnc &rest args)
|
||||
"Advice execution around function `ffap-guesser'.
|
||||
|
||||
Argument FNC is the adviced function.
|
||||
Optional argument ARGS adviced function arguments."
|
||||
(cl-case major-mode
|
||||
(`dashboard-mode
|
||||
(or (and (dashboard--on-path-item-p)
|
||||
(dashboard--current-item-in-path))
|
||||
(apply fnc args))) ; fallback
|
||||
(t (apply fnc args))))
|
||||
(advice-add 'ffap-guesser :around #'dashboard--ffap-guesser--adv)
|
||||
|
||||
;;
|
||||
;;; Removal
|
||||
|
||||
(defun dashboard-remove-item-under ()
|
||||
"Remove a item from the current item section."
|
||||
(interactive)
|
||||
(cl-case (dashboard--current-section)
|
||||
(`recents (dashboard-remove-item-recentf))
|
||||
(`bookmarks (dashboard-remove-item-bookmarks))
|
||||
(`projects (dashboard-remove-item-projects))
|
||||
(`agenda (dashboard-remove-item-agenda))
|
||||
(`registers (dashboard-remove-item-registers)))
|
||||
(dashboard--save-excursion (dashboard-refresh-buffer)))
|
||||
|
||||
(defun dashboard-remove-item-recentf ()
|
||||
"Remove a file from `recentf-list'."
|
||||
(interactive)
|
||||
(let ((path (save-excursion (end-of-line) (ffap-guesser))))
|
||||
(setq recentf-list (delete path recentf-list)))
|
||||
(dashboard-mute-apply (recentf-save-list)))
|
||||
|
||||
(defun dashboard-remove-item-projects ()
|
||||
"Remove a path from `project--list'."
|
||||
(interactive)
|
||||
(let ((path (save-excursion (end-of-line) (ffap-guesser))))
|
||||
(dashboard-mute-apply
|
||||
(cl-case dashboard-projects-backend
|
||||
(`projectile (projectile-remove-known-project path))
|
||||
(`project-el (project-forget-projects-under path))))))
|
||||
|
||||
(defun dashboard-remove-item-bookmarks ()
|
||||
"Remove a bookmarks from `bookmark-alist'."
|
||||
(interactive)) ; TODO: ..
|
||||
|
||||
(defun dashboard-remove-item-agenda ()
|
||||
"Remove an agenda from `org-agenda-files'."
|
||||
(interactive "P")
|
||||
(let ((agenda-file (get-text-property (point) 'dashboard-agenda-file))
|
||||
(agenda-loc (get-text-property (point) 'dashboard-agenda-loc)))
|
||||
(with-current-buffer (find-file-noselect agenda-file)
|
||||
(goto-char agenda-loc)
|
||||
(call-interactively 'org-todo))))
|
||||
|
||||
(defun dashboard-remove-item-registers ()
|
||||
"Remove a registers from `register-alist'."
|
||||
(interactive)) ; TODO: ..
|
||||
|
||||
;;
|
||||
;;; Confirmation
|
||||
|
||||
(defun dashboard-return ()
|
||||
"Hit return key in dashboard buffer."
|
||||
(interactive)
|
||||
(let ((start-ln (line-number-at-pos)) (fd-cnt 0) diff-line entry-pt)
|
||||
(save-excursion
|
||||
(while (and (not diff-line)
|
||||
(not (= (point) (point-min)))
|
||||
(not (get-char-property (point) 'button))
|
||||
(not (= (point) (point-max))))
|
||||
(forward-char 1)
|
||||
(setq fd-cnt (1+ fd-cnt))
|
||||
(unless (= start-ln (line-number-at-pos))
|
||||
(setq diff-line t)))
|
||||
(unless (= (point) (point-max))
|
||||
(setq entry-pt (point))))
|
||||
(when (= fd-cnt 1)
|
||||
(setq entry-pt (1- (point))))
|
||||
(if entry-pt
|
||||
(widget-button-press entry-pt)
|
||||
(call-interactively #'widget-button-press))))
|
||||
|
||||
(defun dashboard-mouse-1 ()
|
||||
"Key for keymap `mouse-1'."
|
||||
(interactive)
|
||||
(let ((old-track-mouse track-mouse))
|
||||
(when (call-interactively #'widget-button-click)
|
||||
(setq track-mouse old-track-mouse))))
|
||||
|
||||
;;
|
||||
;;; Insertion
|
||||
|
||||
(defmacro dashboard--with-buffer (&rest body)
|
||||
"Execute BODY in dashboard buffer."
|
||||
(declare (indent 0))
|
||||
`(with-current-buffer (get-buffer-create dashboard-buffer-name)
|
||||
(let ((inhibit-read-only t)) ,@body)
|
||||
(current-buffer)))
|
||||
|
||||
(defun dashboard-insert-items ()
|
||||
"Function to insert dashboard items.
|
||||
See `dashboard-item-generators' for all items available."
|
||||
(let ((recentf-is-on (recentf-enabled-p))
|
||||
(origial-recentf-list recentf-list))
|
||||
(mapc (lambda (els)
|
||||
(let* ((el (or (car-safe els) els))
|
||||
(list-size
|
||||
(or (cdr-safe els)
|
||||
dashboard-items-default-length))
|
||||
(item-generator
|
||||
(cdr-safe (assoc el dashboard-item-generators))))
|
||||
|
||||
(insert "\n")
|
||||
(push (point) dashboard--section-starts)
|
||||
(funcall item-generator list-size)
|
||||
(goto-char (point-max))
|
||||
|
||||
(when recentf-is-on
|
||||
(setq recentf-list origial-recentf-list))))
|
||||
dashboard-items)
|
||||
|
||||
(when dashboard-center-content
|
||||
(dashboard-center-text
|
||||
(if dashboard--section-starts
|
||||
(car (last dashboard--section-starts))
|
||||
(point))
|
||||
(point-max)))
|
||||
|
||||
(save-excursion
|
||||
(dolist (start dashboard--section-starts)
|
||||
(goto-char start)
|
||||
(insert dashboard-page-separator)))
|
||||
|
||||
(insert "\n")
|
||||
(insert dashboard-page-separator)))
|
||||
|
||||
(defun dashboard-insert-startupify-lists ()
|
||||
"Insert the list of widgets into the buffer."
|
||||
(interactive)
|
||||
(let ((inhibit-redisplay t)
|
||||
(recentf-is-on (recentf-enabled-p))
|
||||
(origial-recentf-list recentf-list)
|
||||
(dashboard-num-recents (or (cdr (assoc 'recents dashboard-items)) 0)))
|
||||
(when recentf-is-on
|
||||
(setq recentf-list (dashboard-subseq recentf-list dashboard-num-recents)))
|
||||
(dashboard--with-buffer
|
||||
(when (or dashboard-force-refresh (not (eq major-mode 'dashboard-mode)))
|
||||
(run-hooks 'dashboard-before-initialize-hook)
|
||||
(erase-buffer)
|
||||
(setq dashboard--section-starts nil)
|
||||
|
||||
(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
|
||||
(goto-char (point-min))
|
||||
(when-let* ((content-height (cdr (window-absolute-pixel-position (point-max))))
|
||||
(vertical-padding (floor (/ (- (window-pixel-height) content-height) 2)))
|
||||
((> vertical-padding 0))
|
||||
(vertical-lines (1- (floor (/ vertical-padding (line-pixel-height)))))
|
||||
((> vertical-lines 0)))
|
||||
(insert (make-string vertical-lines ?\n))))
|
||||
|
||||
(goto-char (point-min))
|
||||
(dashboard-mode)))
|
||||
(when recentf-is-on
|
||||
(setq recentf-list origial-recentf-list))))
|
||||
|
||||
;;;###autoload
|
||||
(defun dashboard-open (&rest _)
|
||||
"Open (or refresh) the *dashboard* buffer."
|
||||
(interactive)
|
||||
(let ((dashboard-force-refresh t)) (dashboard-insert-startupify-lists))
|
||||
(switch-to-buffer dashboard-buffer-name))
|
||||
|
||||
(defalias #'dashboard-refresh-buffer #'dashboard-open)
|
||||
|
||||
(defun dashboard-resize-on-hook (&optional _)
|
||||
"Re-render dashboard on window size change."
|
||||
(let ((space-win (get-buffer-window dashboard-buffer-name))
|
||||
(frame-win (frame-selected-window)))
|
||||
(when (and space-win
|
||||
(not (window-minibuffer-p frame-win)))
|
||||
(with-selected-window space-win
|
||||
(dashboard-insert-startupify-lists)))))
|
||||
|
||||
(defun dashboard-initialize ()
|
||||
"Switch to dashboard and run `dashboard-after-initialize-hook'."
|
||||
(switch-to-buffer dashboard-buffer-name)
|
||||
(goto-char (point-min))
|
||||
(redisplay)
|
||||
(run-hooks 'dashboard-after-initialize-hook))
|
||||
|
||||
;;;###autoload
|
||||
(defun dashboard-setup-startup-hook ()
|
||||
"Setup post initialization hooks unless a command line argument is provided."
|
||||
(when (< (length command-line-args) 2) ;; Assume no file name passed
|
||||
(add-hook 'window-size-change-functions #'dashboard-resize-on-hook 100)
|
||||
(add-hook 'window-setup-hook #'dashboard-resize-on-hook)
|
||||
(add-hook 'after-init-hook #'dashboard-insert-startupify-lists)
|
||||
(add-hook 'emacs-startup-hook #'dashboard-initialize)))
|
||||
|
||||
(provide 'dashboard)
|
||||
;;; dashboard.el ends here
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
(define-package "devdocs" "20240428.711" "Emacs viewer for DevDocs"
|
||||
(define-package "devdocs" "20240301.1838" "Emacs viewer for DevDocs"
|
||||
'((emacs "27.1"))
|
||||
:commit "c14d1306648d3ae09ee3a3b3f45592334943cfeb" :authors
|
||||
:commit "3424436f333955b39a0803ce9781aaffaae003f5" :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-2024 Free Software Foundation, Inc.
|
||||
;; Copyright (C) 2021 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.6.1
|
||||
;; Version: 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
|
||||
|
|
@ -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 5 (invisible t)))
|
||||
#("%s (%s)" 2 7 (invisible t)))
|
||||
string))
|
||||
|
||||
(defcustom devdocs-fontify-code-blocks t
|
||||
|
|
@ -94,9 +94,6 @@ 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.")
|
||||
|
||||
|
|
@ -319,10 +316,7 @@ already installed, reinstall it."
|
|||
"Go to the original position in a DevDocs buffer."
|
||||
(interactive)
|
||||
(goto-char (point-min))
|
||||
(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
|
||||
(when-let ((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))))
|
||||
|
||||
|
|
@ -483,18 +477,15 @@ fragment part of ENTRY.path."
|
|||
(unless (eq major-mode 'devdocs-mode)
|
||||
(devdocs-mode))
|
||||
(let-alist entry
|
||||
(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)))
|
||||
(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)))
|
||||
(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
|
||||
|
|
@ -503,9 +494,7 @@ 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,648 +0,0 @@
|
|||
;;; devdocs.el --- Emacs viewer for DevDocs -*- lexical-binding: t -*-
|
||||
|
||||
;; 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.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
|
||||
;; 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:
|
||||
|
||||
;; devdocs.el is a documentation viewer similar to the built-in Info
|
||||
;; browser, but geared towards documentation obtained from
|
||||
;; https://devdocs.io.
|
||||
|
||||
;; To get started, download some documentation with `devdocs-install`.
|
||||
;; This will show the available documents and save the selected one to
|
||||
;; disk. Once you have the desired documents at hand, use
|
||||
;; `devdocs-lookup` to search for entries.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'seq)
|
||||
(require 'shr)
|
||||
(require 'url-expand)
|
||||
(eval-when-compile
|
||||
(require 'let-alist)
|
||||
(require 'subr-x))
|
||||
|
||||
(unless (libxml-available-p)
|
||||
(display-warning 'devdocs "This package requires Emacs to be compiled with libxml2"))
|
||||
|
||||
(defgroup devdocs nil
|
||||
"Emacs viewer for DevDocs."
|
||||
:group 'help
|
||||
:prefix "devdocs-")
|
||||
|
||||
(defcustom devdocs-current-docs nil
|
||||
"A list of documents relevant to the current buffer.
|
||||
This variable is normally set by the `devdocs-lookup' command,
|
||||
but you may also wish to set it via a hook or as file or
|
||||
directory-local variable."
|
||||
:local t
|
||||
:type '(list string))
|
||||
|
||||
(defcustom devdocs-data-dir (expand-file-name "devdocs" user-emacs-directory)
|
||||
"Directory to save documentation files."
|
||||
:type 'directory)
|
||||
|
||||
(defvar devdocs-site-url "https://devdocs.io"
|
||||
"Location of the DevDocs website.")
|
||||
|
||||
(defvar devdocs-cdn-url "https://documents.devdocs.io"
|
||||
"Location of the DevDocs CDN.")
|
||||
|
||||
(defcustom devdocs-cache-timeout 900
|
||||
"Number of seconds to keep cached information such as document indexes."
|
||||
:type 'number)
|
||||
|
||||
(defcustom devdocs-separator " » "
|
||||
"String used to format a documentation location, e.g. in header line."
|
||||
:type 'string)
|
||||
|
||||
(defcustom devdocs-disambiguated-entry-format #("%s (%s)" 3 7 (face italic))
|
||||
"How to disambiguate entries with identical names in `devdocs-lookup'.
|
||||
This string is passed to `format' with two arguments, the entry
|
||||
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 5 (invisible t)))
|
||||
string))
|
||||
|
||||
(defcustom devdocs-fontify-code-blocks t
|
||||
"Whether to fontify code snippets inside pre tags.
|
||||
Fontification is done using the `org-src' library, which see."
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom devdocs-window-select nil
|
||||
"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.")
|
||||
|
||||
(defvar devdocs-history nil
|
||||
"History of documentation entries.")
|
||||
|
||||
(defconst devdocs--data-format-version 1
|
||||
"Version number of the saved documentation data format.")
|
||||
|
||||
;;; Memoization
|
||||
|
||||
(defvar devdocs--cache (make-hash-table :test 'equal)
|
||||
"Hash table used by `devdocs--with-cache'.")
|
||||
|
||||
(defmacro devdocs--with-cache (&rest body)
|
||||
"Evaluate BODY with memoization.
|
||||
The return value is stored and reused if needed again within the
|
||||
time span specified by `devdocs-cache-timeout'.
|
||||
|
||||
Note that the lexical environment is used to associate BODY to
|
||||
its return value; take the necessary precautions."
|
||||
`(if-let ((fun (lambda () ,@body))
|
||||
(funrep ,(if (< emacs-major-version 28) ;; Cf. bug#32503
|
||||
'(prin1-to-string fun)
|
||||
'fun))
|
||||
(data (gethash funrep devdocs--cache)))
|
||||
(prog1 (cdr data)
|
||||
(timer-set-time (car data) (time-add nil devdocs-cache-timeout)))
|
||||
(let ((val (funcall fun))
|
||||
(timer (run-at-time devdocs-cache-timeout nil
|
||||
#'remhash funrep devdocs--cache)))
|
||||
(prog1 val
|
||||
(puthash funrep (cons timer val) devdocs--cache)))))
|
||||
|
||||
;;; Documentation management
|
||||
|
||||
(defalias 'devdocs--json-parse-buffer
|
||||
(if (json-available-p)
|
||||
(lambda () (json-parse-buffer :object-type 'alist))
|
||||
(require 'json)
|
||||
#'json-read))
|
||||
|
||||
(defun devdocs--doc-metadata (slug)
|
||||
"Return the metadata of an installed document named SLUG."
|
||||
(let ((file (expand-file-name (concat slug "/metadata") devdocs-data-dir)))
|
||||
(unless (file-exists-p file)
|
||||
(user-error "Document `%s' is not installed" slug))
|
||||
(with-temp-buffer
|
||||
(insert-file-contents file)
|
||||
(let ((metadata (read (current-buffer))))
|
||||
(unless (eq (car metadata) devdocs--data-format-version)
|
||||
(user-error "Please run `devdocs-update-all'"))
|
||||
(cdr metadata)))))
|
||||
|
||||
(defun devdocs--installed-docs ()
|
||||
"Return a list of installed documents."
|
||||
(mapcar #'devdocs--doc-metadata
|
||||
(let ((default-directory devdocs-data-dir))
|
||||
(seq-filter #'file-directory-p
|
||||
(when (file-directory-p devdocs-data-dir)
|
||||
(directory-files "." nil "^[^.]"))))))
|
||||
|
||||
(defun devdocs--available-docs ()
|
||||
"Return a list of available documents.
|
||||
If necessary, download data from `devdocs-site-url'."
|
||||
(devdocs--with-cache
|
||||
(with-temp-buffer
|
||||
(url-insert-file-contents
|
||||
(format "%s/docs.json" devdocs-site-url))
|
||||
(devdocs--json-parse-buffer))))
|
||||
|
||||
(defun devdocs--doc-title (doc)
|
||||
"Title of document DOC.
|
||||
DOC is either a metadata alist, or the slug of an installed
|
||||
document."
|
||||
(let-alist (if (stringp doc) (devdocs--doc-metadata doc) doc)
|
||||
(if (seq-empty-p .version) .name (concat .name " " .version))))
|
||||
|
||||
(defun devdocs--read-document (prompt &optional multiple available)
|
||||
"Query interactively for a DevDocs document.
|
||||
|
||||
PROMPT is passed to `completing-read'.
|
||||
Non-nil MULTIPLE allows selecting multiple documents.
|
||||
Non-nil AVAILABLE means to offer a list of all available documents;
|
||||
otherwise, offer only installed documents.
|
||||
|
||||
Return a document metadata alist if MULTIPLE is nil; otherwise, a
|
||||
list of metadata alists."
|
||||
(let ((cands (mapcar (lambda (it) (cons (alist-get 'slug it) it))
|
||||
(if available
|
||||
(devdocs--available-docs)
|
||||
(or (devdocs--installed-docs)
|
||||
(user-error "No documents in `%s'" devdocs-data-dir))))))
|
||||
(if multiple
|
||||
(delq nil (mapcar (lambda (s) (cdr (assoc s cands)))
|
||||
(completing-read-multiple prompt cands)))
|
||||
(cdr (assoc (completing-read prompt cands nil t) cands)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun devdocs-delete (doc)
|
||||
"Delete DevDocs documentation.
|
||||
DOC is a document metadata alist."
|
||||
(interactive (list (devdocs--read-document "Delete documentation: ")))
|
||||
(let ((dest (expand-file-name (alist-get 'slug doc) devdocs-data-dir)))
|
||||
(if (and (file-directory-p dest)
|
||||
(file-in-directory-p dest devdocs-data-dir))
|
||||
(delete-directory dest t)
|
||||
(user-error "Document `%s' is not installed" (alist-get 'slug doc)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun devdocs-install (doc)
|
||||
"Download and install DevDocs documentation.
|
||||
DOC is a document slug or metadata alist. If the document is
|
||||
already installed, reinstall it."
|
||||
(interactive (list (devdocs--read-document "Install documentation: " nil t)))
|
||||
(make-directory devdocs-data-dir t)
|
||||
(unless (listp doc)
|
||||
(setq doc (or (seq-find (lambda (it) (string= doc (alist-get 'slug it)))
|
||||
(devdocs--available-docs))
|
||||
(user-error "No such document: %s" doc))))
|
||||
(let* ((slug (alist-get 'slug doc))
|
||||
(mtime (alist-get 'mtime doc))
|
||||
(temp (make-temp-file "devdocs-" t))
|
||||
pages)
|
||||
(with-temp-buffer
|
||||
(url-insert-file-contents (format "%s/%s/db.json?%s" devdocs-cdn-url slug mtime))
|
||||
(dolist-with-progress-reporter
|
||||
(entry (devdocs--json-parse-buffer))
|
||||
"Installing documentation..."
|
||||
(with-temp-file (expand-file-name
|
||||
(url-hexify-string (format "%s.html" (car entry))) temp)
|
||||
(push (symbol-name (car entry)) pages)
|
||||
(insert (cdr entry)))))
|
||||
(with-temp-buffer
|
||||
(url-insert-file-contents (format "%s/%s/index.json?%s" devdocs-cdn-url slug mtime))
|
||||
(let ((index (devdocs--json-parse-buffer)))
|
||||
(push `(pages . ,(vconcat (nreverse pages))) index)
|
||||
(with-temp-file (expand-file-name "index" temp)
|
||||
(prin1 index (current-buffer)))))
|
||||
(with-temp-file (expand-file-name "metadata" temp)
|
||||
(prin1 (cons devdocs--data-format-version doc) (current-buffer)))
|
||||
(let ((dest (expand-file-name slug devdocs-data-dir)))
|
||||
(when (and (file-directory-p dest)
|
||||
(file-in-directory-p dest devdocs-data-dir))
|
||||
(delete-directory dest t))
|
||||
(rename-file (file-name-as-directory temp) dest))
|
||||
(message "Document `%s' installed" slug)))
|
||||
|
||||
;;;###autoload
|
||||
(defun devdocs-update-all ()
|
||||
"Reinstall all documents with a new version available."
|
||||
(interactive)
|
||||
(when-let ((installed (when (file-directory-p devdocs-data-dir)
|
||||
(directory-files devdocs-data-dir nil "^[^.]")))
|
||||
(newer (seq-filter
|
||||
(lambda (doc)
|
||||
(let-alist doc
|
||||
(and (member .slug installed)
|
||||
(< (alist-get 'mtime
|
||||
(ignore-errors (devdocs--doc-metadata .slug))
|
||||
0) ;; Update docs with an old data format too
|
||||
.mtime))))
|
||||
(devdocs--available-docs)))
|
||||
((y-or-n-p (format "Update %s documents %s?"
|
||||
(length newer)
|
||||
(mapcar (lambda (d) (alist-get 'slug d)) newer)))))
|
||||
(dolist (doc newer)
|
||||
(devdocs-install doc))))
|
||||
|
||||
;;; Document indexes
|
||||
|
||||
(defun devdocs--index (doc kind)
|
||||
"Return an index of document DOC, where KIND is `entries', `pages' or `types'."
|
||||
(if kind
|
||||
(alist-get kind (devdocs--with-cache (devdocs--index doc nil)))
|
||||
(let* ((docmeta (cons 'doc doc))
|
||||
(indexes (with-temp-buffer
|
||||
(insert-file-contents (expand-file-name
|
||||
(concat (alist-get 'slug doc) "/index")
|
||||
devdocs-data-dir))
|
||||
(read (current-buffer))))
|
||||
(entries (alist-get 'entries indexes)))
|
||||
(prog1 indexes
|
||||
(seq-do-indexed (lambda (entry i) (aset entries i (cons docmeta entry)))
|
||||
entries)))))
|
||||
|
||||
;;; Documentation viewer
|
||||
|
||||
(defvar-local devdocs--stack nil
|
||||
"List of viewed entries, set buffer-locally when in `devdocs-mode'.")
|
||||
|
||||
(defvar-local devdocs--forward-stack nil
|
||||
"List of viewed entries for `devdocs-go-forward'.")
|
||||
|
||||
(defvar devdocs-header-line
|
||||
'(:eval (let-alist (car devdocs--stack)
|
||||
(concat (devdocs--doc-title .doc)
|
||||
(and .type devdocs-separator) .type
|
||||
devdocs-separator (or .name .path)))))
|
||||
|
||||
(define-derived-mode devdocs-mode special-mode "DevDocs"
|
||||
"Major mode for viewing DevDocs documents."
|
||||
:interactive nil
|
||||
(if (boundp 'browse-url-handlers) ;; Emacs ≥ 28
|
||||
(setq-local browse-url-handlers
|
||||
`((devdocs--internal-url-p . devdocs--internal-url-handler)
|
||||
,@browse-url-handlers))
|
||||
(setq-local browse-url-browser-function
|
||||
`(("\\`[^:]+\\'" . devdocs--internal-url-handler)
|
||||
,@(if (functionp browse-url-browser-function)
|
||||
`(("" . ,browse-url-browser-function))
|
||||
browse-url-browser-function))))
|
||||
(setq-local
|
||||
buffer-undo-list t
|
||||
header-line-format devdocs-header-line
|
||||
revert-buffer-function #'devdocs--revert-buffer
|
||||
truncate-lines t))
|
||||
|
||||
(defun devdocs-goto-target ()
|
||||
"Go to the original position in a DevDocs buffer."
|
||||
(interactive)
|
||||
(goto-char (point-min))
|
||||
(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))))
|
||||
|
||||
(defun devdocs-go-back ()
|
||||
"Go to the previously displayed entry in this DevDocs buffer."
|
||||
(interactive)
|
||||
(unless (cadr devdocs--stack)
|
||||
(user-error "No previous entry"))
|
||||
(push (pop devdocs--stack) devdocs--forward-stack)
|
||||
(devdocs--render (pop devdocs--stack)))
|
||||
|
||||
(defun devdocs-go-forward ()
|
||||
"Go to the next entry in this DevDocs buffer."
|
||||
(interactive)
|
||||
(unless (car devdocs--forward-stack)
|
||||
(user-error "No next entry"))
|
||||
(devdocs--render (pop devdocs--forward-stack)))
|
||||
|
||||
(defun devdocs-next-entry (count)
|
||||
"Go forward COUNT entries in this document.
|
||||
|
||||
Note that this refers to the index order, which may not coincide
|
||||
with the order of appearance in the text."
|
||||
(interactive "p")
|
||||
(let-alist (car devdocs--stack)
|
||||
(let* ((entries (devdocs--index .doc 'entries))
|
||||
(pred (lambda (entry _) (string= (alist-get 'path entry) .path)))
|
||||
(current (seq-position entries nil pred)))
|
||||
(unless current (user-error "No current entry"))
|
||||
(devdocs--render
|
||||
(or (ignore-error args-out-of-range (elt entries (+ count current)))
|
||||
(user-error "No %s entry" (if (< count 0) "previous" "next")))))))
|
||||
|
||||
(defun devdocs-previous-entry (count)
|
||||
"Go backward COUNT entries in this document."
|
||||
(interactive "p")
|
||||
(devdocs-next-entry (- count)))
|
||||
|
||||
(defun devdocs-goto-page (doc page)
|
||||
"Go to a given PAGE (a number or path) of DOC.
|
||||
Interactively, read a page name with completion."
|
||||
(interactive (let-alist (car devdocs--stack)
|
||||
(list .doc (completing-read "Go to page: "
|
||||
(append (devdocs--index .doc 'pages) nil)
|
||||
nil t nil 'devdocs-history))))
|
||||
(let* ((path (cond ((stringp page) page)
|
||||
((numberp page) (elt (devdocs--index doc 'pages) page))))
|
||||
(entry (or (seq-find (lambda (entry) (string= (alist-get 'path entry) path))
|
||||
(devdocs--index doc 'entries))
|
||||
`((doc . ,doc) (path . ,path)))))
|
||||
(devdocs--render entry)))
|
||||
|
||||
(defun devdocs-first-page (doc)
|
||||
"Go to first page of DOC."
|
||||
(interactive (list (alist-get 'doc (car devdocs--stack))))
|
||||
(devdocs-goto-page doc 0))
|
||||
|
||||
(defun devdocs-last-page (doc)
|
||||
"Go to last page of DOC."
|
||||
(interactive (list (alist-get 'doc (car devdocs--stack))))
|
||||
(devdocs-goto-page doc (1- (length (devdocs--index doc 'pages)))))
|
||||
|
||||
(defun devdocs-next-page (count)
|
||||
"Go forward COUNT pages in this document."
|
||||
(interactive "p")
|
||||
(let-alist (car devdocs--stack)
|
||||
(let* ((pages (devdocs--index .doc 'pages))
|
||||
(dest (+ count (seq-position pages (devdocs--path-file .path)))))
|
||||
(cond ((< dest 0) (user-error "No previous page"))
|
||||
((<= (length pages) dest) (user-error "No next page")))
|
||||
(devdocs-goto-page .doc dest))))
|
||||
|
||||
(defun devdocs-previous-page (count)
|
||||
"Go backward COUNT entries in this document."
|
||||
(interactive "p")
|
||||
(devdocs-next-page (- count)))
|
||||
|
||||
(defun devdocs-copy-url ()
|
||||
"Copy the URL of the current DevDocs page to the kill ring."
|
||||
(interactive)
|
||||
(let-alist (or (car devdocs--stack)
|
||||
(user-error "Not in a DevDocs buffer"))
|
||||
(let ((url (url-encode-url
|
||||
(format "%s/%s/%s"
|
||||
devdocs-site-url
|
||||
.doc.slug
|
||||
(if .fragment
|
||||
(concat (devdocs--path-file .path) "#" .fragment)
|
||||
.path)))))
|
||||
(kill-new url)
|
||||
(message "Copied %s" url))))
|
||||
|
||||
(let ((map devdocs-mode-map))
|
||||
(define-key map [tab] #'forward-button)
|
||||
(define-key map [backtab] #'backward-button)
|
||||
(define-key map "d" #'devdocs-peruse)
|
||||
(define-key map "i" #'devdocs-lookup)
|
||||
(define-key map "p" #'devdocs-previous-entry)
|
||||
(define-key map "n" #'devdocs-next-entry)
|
||||
(define-key map "g" #'devdocs-goto-page)
|
||||
(define-key map "[" #'devdocs-previous-page)
|
||||
(define-key map "]" #'devdocs-next-page)
|
||||
(define-key map "<" #'devdocs-first-page)
|
||||
(define-key map ">" #'devdocs-last-page)
|
||||
(define-key map "l" #'devdocs-go-back)
|
||||
(define-key map "r" #'devdocs-go-forward)
|
||||
(define-key map "w" #'devdocs-copy-url)
|
||||
(define-key map "." #'devdocs-goto-target))
|
||||
|
||||
;;; Rendering
|
||||
|
||||
(defun devdocs--path-file (path)
|
||||
"Return the non-fragment part of PATH."
|
||||
(substring path 0 (string-match "#" path)))
|
||||
|
||||
(defun devdocs--path-fragment (path)
|
||||
"Return the fragment part of PATH, or nil if absent."
|
||||
(when-let ((i (string-match "#" path)))
|
||||
(substring path (1+ i))))
|
||||
|
||||
(defun devdocs--path-expand (path base)
|
||||
"Expand PATH relative to a BASE path."
|
||||
(pcase (string-to-char path)
|
||||
('?/ path)
|
||||
('?# (concat (devdocs--path-file base) path))
|
||||
(_ (string-remove-prefix
|
||||
"/"
|
||||
(url-expander-remove-relative-links ;; undocumented function!
|
||||
(concat (file-name-directory base) path))))))
|
||||
|
||||
(defun devdocs--shr-tag-pre (dom)
|
||||
"Insert and fontify pre-tag represented by DOM."
|
||||
(let ((start (point)))
|
||||
(if-let ((lang (and devdocs-fontify-code-blocks
|
||||
(dom-attr dom 'data-language)))
|
||||
(mode (or (cdr (assoc lang '(("cpp" . c++-mode)
|
||||
("shell" . sh-mode))))
|
||||
(intern (concat lang "-mode"))))
|
||||
(buffer (and (fboundp mode) (current-buffer))))
|
||||
(insert
|
||||
(with-temp-buffer
|
||||
(shr-tag-pre dom)
|
||||
(let ((inhibit-message t)
|
||||
(message-log-max nil))
|
||||
(ignore-errors (delay-mode-hooks (funcall mode)))
|
||||
(font-lock-ensure))
|
||||
(buffer-string)))
|
||||
(shr-tag-pre dom))
|
||||
(add-face-text-property start (point) 'devdocs-code-block t)))
|
||||
|
||||
(defun devdocs--render (entry)
|
||||
"Render a DevDocs documentation entry, returning a buffer.
|
||||
|
||||
ENTRY is an alist like those in the entry index of the document,
|
||||
possibly with an additional ENTRY.fragment which overrides the
|
||||
fragment part of ENTRY.path."
|
||||
(with-current-buffer (get-buffer-create "*devdocs*")
|
||||
(unless (eq major-mode 'devdocs-mode)
|
||||
(devdocs-mode))
|
||||
(let-alist entry
|
||||
(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)
|
||||
;; TODO: cl-progv here for shr settings?
|
||||
(shr-insert-document
|
||||
(with-temp-buffer
|
||||
(insert-file-contents file)
|
||||
(libxml-parse-html-region (point-min) (point-max)))))
|
||||
(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)))
|
||||
(devdocs-goto-target)
|
||||
(current-buffer))))
|
||||
|
||||
(defun devdocs--revert-buffer (&rest _args)
|
||||
"Refresh DevDocs buffer."
|
||||
(devdocs--render (pop devdocs--stack)))
|
||||
|
||||
(defun devdocs--internal-url-p (url)
|
||||
"Return t if URL seems to be an internal DevDocs link."
|
||||
(not (string-match-p "\\`[a-z]+:" url)))
|
||||
|
||||
(defun devdocs--internal-url-handler (url &rest _)
|
||||
"Open URL of an internal link in a DevDocs document."
|
||||
(let-alist (car devdocs--stack)
|
||||
(let* ((dest (devdocs--path-expand url .path))
|
||||
(file (devdocs--path-file dest))
|
||||
(frag (devdocs--path-fragment dest))
|
||||
(entry (seq-find (lambda (it)
|
||||
(let-alist it
|
||||
(or (string= .path dest)
|
||||
(string= .path file))))
|
||||
(devdocs--index .doc 'entries))))
|
||||
(unless entry (error "Can't find `%s'" dest))
|
||||
(when frag (push `(fragment . ,frag) entry))
|
||||
(devdocs--render entry))))
|
||||
|
||||
;;; Lookup commands
|
||||
|
||||
(defun devdocs--entries (documents)
|
||||
"A list of entries in DOCUMENTS, as propertized strings."
|
||||
(let* ((counts (make-hash-table :test 'equal))
|
||||
(mkentry (lambda (it)
|
||||
(let* ((name (alist-get 'name it))
|
||||
(count (1+ (gethash name counts 0))))
|
||||
(puthash name count counts)
|
||||
`(,name ,count . ,it))))
|
||||
(entries (mapcan (lambda (doc)
|
||||
(mapcar mkentry
|
||||
(devdocs--index doc 'entries)))
|
||||
documents)))
|
||||
(mapcar (pcase-lambda (`(,name ,count . ,it))
|
||||
(propertize (if (= 1 (gethash name counts))
|
||||
name
|
||||
(format devdocs-disambiguated-entry-format name count))
|
||||
'devdocs--data it))
|
||||
entries)))
|
||||
|
||||
(defun devdocs--get-data (str)
|
||||
"Get data stored as a string property in STR."
|
||||
(get-text-property 0 'devdocs--data str))
|
||||
|
||||
(defun devdocs--annotate (cand)
|
||||
"Return an annotation for `devdocs--read-entry' candidate CAND."
|
||||
(let-alist (devdocs--get-data cand)
|
||||
(concat " " (propertize " " 'display '(space :align-to 40))
|
||||
(devdocs--doc-title .doc) devdocs-separator .type)))
|
||||
|
||||
(defun devdocs--relevant-docs (ask)
|
||||
"Return a list of relevant documents for the current buffer.
|
||||
May ask interactively for the desired documents, remembering the
|
||||
choice for this buffer. If ASK is non-nil, ask unconditionally."
|
||||
(if ask
|
||||
(let ((docs (devdocs--read-document "Documents for this buffer: " t)))
|
||||
(prog1 docs
|
||||
(setq-local devdocs-current-docs
|
||||
(mapcar (lambda (d) (alist-get 'slug d)) docs))))
|
||||
(or (mapcar #'devdocs--doc-metadata devdocs-current-docs)
|
||||
(devdocs--relevant-docs t)
|
||||
(user-error "No documents"))))
|
||||
|
||||
(defun devdocs--read-entry (prompt documents initial-input)
|
||||
"Read the name of an entry in one of the DOCUMENTS, using PROMPT.
|
||||
|
||||
INITIAL-INPUT is passed to `completing-read'"
|
||||
(let* ((cands (devdocs--with-cache
|
||||
(devdocs--entries documents)))
|
||||
(metadata '(metadata
|
||||
(category . devdocs)
|
||||
(annotation-function . devdocs--annotate)))
|
||||
(coll (lambda (string predicate action)
|
||||
(if (eq action 'metadata)
|
||||
metadata
|
||||
(complete-with-action action cands string predicate))))
|
||||
(cand (completing-read prompt coll nil t initial-input
|
||||
'devdocs-history
|
||||
(thing-at-point 'symbol))))
|
||||
(devdocs--get-data (or (car (member cand cands))
|
||||
(user-error "Not an entry!")))))
|
||||
|
||||
;;;###autoload
|
||||
(defun devdocs-lookup (&optional ask-docs initial-input)
|
||||
"Look up a DevDocs documentation entry.
|
||||
|
||||
Display entries in the documents `devdocs-current-docs' for
|
||||
selection. With a prefix argument (or, from Lisp, if ASK-DOCS is
|
||||
non-nil), first read the name of one or more installed documents
|
||||
and set `devdocs-current-docs' for this buffer.
|
||||
|
||||
If INITIAL-INPUT is not nil, insert it into the minibuffer."
|
||||
(interactive "P")
|
||||
(let* ((entry (devdocs--read-entry "Go to documentation: "
|
||||
(devdocs--relevant-docs ask-docs)
|
||||
initial-input))
|
||||
(buffer (devdocs--render entry))
|
||||
(window (display-buffer buffer)))
|
||||
(when window
|
||||
(with-selected-window window
|
||||
(devdocs-goto-target)
|
||||
(recenter 0))
|
||||
(when devdocs-window-select
|
||||
(select-window window)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun devdocs-peruse (doc)
|
||||
"Read a document from the first page."
|
||||
(interactive (list (devdocs--read-document "Peruse documentation: ")))
|
||||
(pop-to-buffer (devdocs-goto-page doc 0)))
|
||||
|
||||
;; Don't show devdocs-mode specific commands in M-x
|
||||
(dolist (sym '(devdocs-goto-target devdocs-go-back devdocs-go-forward
|
||||
devdocs-next-entry devdocs-previous-entry devdocs-goto-page
|
||||
devdocs-first-page devdocs-last-page devdocs-next-page
|
||||
devdocs-previous-page devdocs-copy-url))
|
||||
(put sym 'completion-predicate (lambda (_ buffer)
|
||||
(provided-mode-derived-p
|
||||
(buffer-local-value 'major-mode buffer)
|
||||
'devdocs-mode))))
|
||||
|
||||
;;; Compatibility with the old devdocs package
|
||||
|
||||
;;;###autoload
|
||||
(defun devdocs-search (query)
|
||||
"Search for QUERY in the DevDocs website."
|
||||
(interactive (list (read-from-minibuffer
|
||||
(format "Search %s: " devdocs-site-url)
|
||||
nil nil nil nil (thing-at-point 'symbol))))
|
||||
(browse-url (format "%s/#q=%s" devdocs-site-url (url-hexify-string query))))
|
||||
|
||||
(provide 'devdocs)
|
||||
;;; devdocs.el ends here
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
(define-package "devdocs-browser" "20240511.306" "Browse devdocs.io documents using EWW"
|
||||
(define-package "devdocs-browser" "20231231.1455" "Browse devdocs.io documents using EWW"
|
||||
'((emacs "27.1"))
|
||||
:commit "0655b89651458777354a3b89c1d486e0fda1928d" :authors
|
||||
:commit "afc460e687bec4eb947ab85d207778fc3b9b3bbc" :authors
|
||||
'(("blahgeek" . "i@blahgeek.com"))
|
||||
:maintainers
|
||||
'(("blahgeek" . "i@blahgeek.com"))
|
||||
|
|
@ -32,7 +32,6 @@
|
|||
(require 'eww)
|
||||
(require 'eldoc)
|
||||
(require 'imenu)
|
||||
(require 'seq)
|
||||
|
||||
|
||||
(defgroup devdocs-browser nil
|
||||
|
|
@ -40,40 +39,12 @@
|
|||
:group 'tools
|
||||
:group 'web)
|
||||
|
||||
|
||||
;; 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
|
||||
(defcustom devdocs-browser-cache-directory
|
||||
(expand-file-name "devdocs-browser" user-emacs-directory)
|
||||
"Directory to store devdocs data files."
|
||||
"Directory to store devdocs cache 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)
|
||||
|
|
@ -189,20 +160,37 @@ See https://prismjs.com/ for list of language names."
|
|||
(insert (devdocs-browser--eww-fontify-pre dom))
|
||||
(shr-ensure-newline)))
|
||||
|
||||
(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-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)))
|
||||
|
||||
;; 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-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))
|
||||
|
||||
(defun devdocs-browser--eww-tag-generic-ensure-paragraph (dom)
|
||||
"Rendering function for generic DOM while ensuring paragraph."
|
||||
|
|
@ -296,7 +284,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))))
|
||||
|
||||
|
|
@ -337,12 +325,13 @@ 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))
|
||||
(mapcar (lambda (level)
|
||||
(cons (intern (concat "h" (number-to-string level)))
|
||||
(apply-partially #'devdocs-browser--eww-tag-header level)))
|
||||
(number-sequence 1 5))))
|
||||
(section . devdocs-browser--eww-tag-generic-ensure-paragraph))))
|
||||
(setq-local imenu-create-index-function
|
||||
#'devdocs-browser--imenu-create-index)
|
||||
(when (boundp 'eww-auto-rename-buffer)
|
||||
|
|
@ -362,12 +351,13 @@ 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 or hashtable of (name . props), where props is a plist with
|
||||
COLLECTION: alist 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.
|
||||
(let* (collection-ht
|
||||
(setq collection (delq nil collection))
|
||||
(let* ((collection-ht (make-hash-table :test 'equal :size (length collection)))
|
||||
(annotation-function
|
||||
(lambda (s)
|
||||
(let ((annotation (plist-get (gethash s collection-ht) :annotation)))
|
||||
|
|
@ -382,13 +372,8 @@ DEF: same meaning;"
|
|||
(replace-match "" t t s)
|
||||
s))
|
||||
(t group))))))
|
||||
(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))
|
||||
(mapc (lambda (elem) (puthash (car elem) (cdr elem) collection-ht))
|
||||
collection)
|
||||
(setq prompt (concat prompt
|
||||
(when def
|
||||
(format " (default %s)" (funcall group-function def t)))
|
||||
|
|
@ -399,7 +384,7 @@ DEF: same meaning;"
|
|||
(if (eq action 'metadata)
|
||||
`(metadata . ((annotation-function . ,annotation-function)
|
||||
(group-function . ,group-function)))
|
||||
(complete-with-action action collection-ht str pred)))
|
||||
(complete-with-action action collection str pred)))
|
||||
nil t ;; require-match
|
||||
nil nil def)))
|
||||
(or (plist-get (gethash res collection-ht) :value)
|
||||
|
|
@ -411,7 +396,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-data-directory)))
|
||||
(let ((filename (expand-file-name file-path devdocs-browser-cache-directory)))
|
||||
(when (file-exists-p filename)
|
||||
(with-temp-buffer
|
||||
(insert-file-contents filename)
|
||||
|
|
@ -420,7 +405,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-data-directory)))
|
||||
(let ((cache-filename (expand-file-name file-path devdocs-browser-cache-directory)))
|
||||
(unless (file-exists-p (file-name-directory cache-filename))
|
||||
(make-directory (file-name-directory cache-filename) t))
|
||||
(with-temp-file cache-filename
|
||||
|
|
@ -462,18 +447,13 @@ To upgrade docs content, see `devdocs-browser-upgrade-doc'."
|
|||
(equal (plist-get doc :name) slug-or-name)))
|
||||
docs-list)))
|
||||
|
||||
(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.")
|
||||
(defvar devdocs-browser--docs-cache '() "Cached doc indexes 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-data-directory))
|
||||
(docs-dir (expand-file-name devdocs-browser--docs-dir devdocs-browser-cache-directory))
|
||||
(doc-dir (expand-file-name slug docs-dir))
|
||||
success)
|
||||
(unless (file-exists-p docs-dir)
|
||||
|
|
@ -498,7 +478,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
|
||||
(plist-put devdocs-browser--docs-cache slug nil #'equal))
|
||||
(lax-plist-put devdocs-browser--docs-cache slug nil))
|
||||
success))
|
||||
|
||||
(defun devdocs-browser--doc-readable-name (doc)
|
||||
|
|
@ -548,12 +528,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-data-directory))
|
||||
(let* ((docs-dir (expand-file-name devdocs-browser--docs-dir devdocs-browser-cache-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
|
||||
(plist-put devdocs-browser--docs-cache slug nil #'equal)))
|
||||
(lax-plist-put devdocs-browser--docs-cache slug nil)))
|
||||
|
||||
(defun devdocs-browser--upgrade-readable-name (old-doc new-doc)
|
||||
"Get human readable name for upgrade from OLD-DOC to NEW-DOC."
|
||||
|
|
@ -622,7 +602,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-data-directory)))
|
||||
(let ((dir (expand-file-name devdocs-browser--docs-dir devdocs-browser-cache-directory)))
|
||||
(when (file-exists-p dir)
|
||||
(directory-files dir nil
|
||||
;; ignore ".", ".." and hidden files
|
||||
|
|
@ -644,9 +624,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) (plist-get devdocs-browser--docs-cache slug #'equal))
|
||||
(or (and (not refresh-cache) (lax-plist-get devdocs-browser--docs-cache slug))
|
||||
(let* ((docs-dir (expand-file-name devdocs-browser--docs-dir
|
||||
devdocs-browser-data-directory))
|
||||
devdocs-browser-cache-directory))
|
||||
(doc-dir (expand-file-name slug docs-dir))
|
||||
(metadata-filename (expand-file-name devdocs-browser--metadata-filename doc-dir))
|
||||
(metadata nil)
|
||||
|
|
@ -658,16 +638,15 @@ Result is a plist metadata, with an extra :index field at the beginning."
|
|||
(insert-file-contents metadata-filename)
|
||||
(setq metadata (read (current-buffer))))
|
||||
(setq res (append `(:index ,index) metadata))
|
||||
(when devdocs-browser-enable-cache
|
||||
(setq devdocs-browser--docs-cache
|
||||
(plist-put devdocs-browser--docs-cache slug res #'equal))))
|
||||
(setq devdocs-browser--docs-cache
|
||||
(lax-plist-put devdocs-browser--docs-cache slug res)))
|
||||
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-data-directory))
|
||||
(docs-dir (expand-file-name devdocs-browser--docs-dir devdocs-browser-cache-directory))
|
||||
(doc-dir (expand-file-name slug docs-dir))
|
||||
(data-dir (expand-file-name devdocs-browser--offline-data-dir-name doc-dir))
|
||||
success)
|
||||
|
|
@ -703,7 +682,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-data-directory))
|
||||
(let* ((docs-dir (expand-file-name devdocs-browser--docs-dir devdocs-browser-cache-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)
|
||||
|
|
@ -799,8 +778,7 @@ 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) "\\>")))
|
||||
(rows (make-hash-table :test 'equal))
|
||||
slugs def)
|
||||
slugs rows 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))
|
||||
|
|
@ -808,22 +786,25 @@ When called interactively, user can choose from the list."
|
|||
(index (plist-get doc :index))
|
||||
(entries (plist-get index :entries)))
|
||||
(setq slugs (push slug slugs))
|
||||
(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 ((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))))
|
||||
(let* ((selected-value
|
||||
(devdocs-browser--completing-read
|
||||
(format "Devdocs browser [%s]" (mapconcat #'identity slugs ","))
|
||||
|
|
@ -831,12 +812,6 @@ 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.
|
||||
|
|
@ -845,12 +820,7 @@ 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)
|
||||
(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)))))
|
||||
(devdocs-browser-open-in (devdocs-browser--default-active-slugs)))
|
||||
|
||||
|
||||
(provide 'devdocs-browser)
|
||||
|
|
@ -1,857 +0,0 @@
|
|||
;;; devdocs-browser.el --- Browse devdocs.io documents using EWW -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2021
|
||||
|
||||
;; Author: blahgeek <i@blahgeek.com>
|
||||
;; URL: https://github.com/blahgeek/emacs-devdocs-browser
|
||||
;; Version: 20210525
|
||||
;; Keywords: docs, help, tools
|
||||
;; Package-Requires: ((emacs "27.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
|
||||
;; 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:
|
||||
|
||||
;; Browse devdocs.io documents inside Emacs using EWW.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'files)
|
||||
(require 'shr)
|
||||
(require 'eww)
|
||||
(require 'eldoc)
|
||||
(require 'imenu)
|
||||
(require 'seq)
|
||||
|
||||
|
||||
(defgroup devdocs-browser nil
|
||||
"Browse devdocs.io."
|
||||
:group 'tools
|
||||
:group 'web)
|
||||
|
||||
|
||||
;; 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 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)
|
||||
|
||||
(defcustom devdocs-browser-doc-base-url "https://documents.devdocs.io/"
|
||||
"Base URL for doc contents."
|
||||
:type 'string)
|
||||
|
||||
(defcustom devdocs-browser-major-mode-docs-alist
|
||||
'((c++-mode . ("cpp"))
|
||||
(c-mode . ("c"))
|
||||
(go-mode . ("go"))
|
||||
(python-mode . ("Python"))
|
||||
(emacs-lisp-mode . ("elisp"))
|
||||
(rust-mode . ("rust"))
|
||||
(cmake-mode . ("CMake")))
|
||||
"Alist of MAJOR-MODE and list of docset names.
|
||||
When calling `devdocs-browser-open', this variable will be used
|
||||
to pick a list of docsets based on the current MAJOR-MODE.
|
||||
Docset name may be SLUG (e.g. 'python~3.8') or NAME (e.g. 'Python'),
|
||||
if it's a NAME and multiple choices are possible,
|
||||
one of the installed docs with the NAME will be used.
|
||||
Also see `devdocs-browser-active-docs'."
|
||||
:type '(alist :key-type function
|
||||
:value-type (list string)))
|
||||
|
||||
(defvar-local devdocs-browser-active-docs
|
||||
nil
|
||||
"List of docset names used by `devdocs-browser-open' to pick docsets.
|
||||
If this var is set to non-nil,
|
||||
it have higher priority than `devdocs-browser-major-mode-docs-alist'.
|
||||
See `devdocs-browser-major-mode-docs-alist' for the meaning of NAME.")
|
||||
|
||||
(defcustom devdocs-browser-highlight-lang-mode-alist '()
|
||||
"Alist of language name and MAJOR-MODE, to highlight HTML pre blocks.
|
||||
If language is not found in this alist,
|
||||
`devdocs-browser-highlight-lang-mode-alist-default' will be used.
|
||||
See https://prismjs.com/ for list of language names."
|
||||
:type '(alist :key-type string
|
||||
:value-type function))
|
||||
|
||||
(defvar devdocs-browser-highlight-lang-mode-alist-default
|
||||
'(("html" . html-mode)
|
||||
("xml" . xml-mode)
|
||||
("css" . css-mode)
|
||||
("clike" . c-mode)
|
||||
("javascript" . js-mode)
|
||||
("js" . js-mode)
|
||||
("jsx" . js-mode)
|
||||
("bash" . sh-mode)
|
||||
("shell" . sh-mode)
|
||||
("c" . c-mode)
|
||||
("cpp" . c++-mode)
|
||||
("cmake" . cmake-mode)
|
||||
("go" . go-mode)
|
||||
("haskell" . haskell-mode)
|
||||
("hs" . haskell-mode)
|
||||
("java" . java-mode)
|
||||
("json" . js-mode)
|
||||
("elisp" . elisp-mode)
|
||||
("emacs" . elisp-mode)
|
||||
("lua" . lua-mode)
|
||||
("makefile" . makefile-mode)
|
||||
("markdown" . markdown-mode)
|
||||
("md" . markdown-mode)
|
||||
("nginx" . conf-mode)
|
||||
("objectivec" . objc-mode)
|
||||
("objc" . objc-mode)
|
||||
("perl" . perl-mode)
|
||||
("protobuf" . protobuf-mode)
|
||||
("python" . python-mode)
|
||||
("py" . python-mode)
|
||||
("ruby" . ruby-mode)
|
||||
("rust" . rust-mode)
|
||||
("rb" . ruby-mode)
|
||||
("sql" . sql-mode)
|
||||
("typescript" . typescript-mode))
|
||||
"Default value for `devdocs-browser-highlight-lang-mode-alist'.")
|
||||
|
||||
|
||||
(defun devdocs-browser--clear-dom-id-attr (dom)
|
||||
"Clear id attribute for DOM and its children."
|
||||
(dom-remove-attribute dom 'id)
|
||||
(mapc #'devdocs-browser--clear-dom-id-attr (dom-non-text-children dom)))
|
||||
|
||||
(defun devdocs-browser--eww-fontify-pre (dom)
|
||||
"Return fontified string for pre DOM."
|
||||
(with-temp-buffer
|
||||
(shr-generic dom)
|
||||
(when (> shr-indentation 0)
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(while (not (eobp))
|
||||
(shr-indent)
|
||||
(forward-line 1))))
|
||||
(let* ((language (dom-attr dom 'data-language))
|
||||
(mode (cdr (or (assoc language devdocs-browser-highlight-lang-mode-alist)
|
||||
(assoc language devdocs-browser-highlight-lang-mode-alist-default)))))
|
||||
(when (fboundp mode)
|
||||
(delay-mode-hooks (funcall mode))
|
||||
(font-lock-default-function mode)
|
||||
(font-lock-default-fontify-region (point-min) (point-max) nil)))
|
||||
(buffer-string)))
|
||||
|
||||
(defun devdocs-browser--eww-tag-pre (dom)
|
||||
"Rendering function for pre DOM."
|
||||
;; must clear all 'id' attributes in dom.
|
||||
;; otherwise, shr would try to add text properties based on it, but since they are rendered in temp-buffer, the marker would be invalid
|
||||
(devdocs-browser--clear-dom-id-attr dom)
|
||||
(let ((shr-folding-mode 'none)
|
||||
(shr-current-font 'default))
|
||||
(shr-ensure-newline)
|
||||
(insert (devdocs-browser--eww-fontify-pre dom))
|
||||
(shr-ensure-newline)))
|
||||
|
||||
(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))
|
||||
|
||||
;; 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."
|
||||
(shr-ensure-paragraph)
|
||||
(shr-generic dom))
|
||||
|
||||
(defvar-local devdocs-browser--eww-data '()
|
||||
"Plist data for current eww page, contain :doc and :path.")
|
||||
|
||||
(defun devdocs-browser--eww-fix-url (url)
|
||||
"Fix links' URL in docs by appending suffix and mtime."
|
||||
;; shr-expand-url may be call in a temp buffer
|
||||
;; we need to temporary bind this buffer to access the buffer-local variable.
|
||||
(with-current-buffer (window-buffer)
|
||||
(let ((url-parsed (url-generic-parse-url url))
|
||||
(root-url-parsed (url-generic-parse-url (plist-get eww-data :url)))
|
||||
(mtime (plist-get (plist-get devdocs-browser--eww-data :doc) :mtime)))
|
||||
(when (and mtime
|
||||
(equal (url-type url-parsed) (url-type root-url-parsed))
|
||||
(equal (url-host url-parsed) (url-host root-url-parsed))
|
||||
(not (string-match-p "\\.html" url)))
|
||||
(setf (url-filename url-parsed)
|
||||
(if (equal (url-type url-parsed) "file")
|
||||
(concat (url-filename url-parsed) ".html")
|
||||
(format "%s.html?%s" (url-filename url-parsed) mtime)))
|
||||
(setq url (url-recreate-url url-parsed)))))
|
||||
url)
|
||||
|
||||
(defun devdocs-browser--eww-parse-url-path (url)
|
||||
"Return URL's doc :path ('hello/world#target')."
|
||||
;; see devdocs-browser--eww-open for url pattern
|
||||
(when-let* ((url-parsed (url-generic-parse-url url))
|
||||
(doc (plist-get devdocs-browser--eww-data :doc))
|
||||
(slug (plist-get doc :slug))
|
||||
(filename-suffix (if (equal (url-type url-parsed) "file")
|
||||
".html"
|
||||
(format ".html?%s" (plist-get doc :mtime))))
|
||||
(filename-prefix (if (equal (url-type url-parsed) "file")
|
||||
(devdocs-browser-offline-data-dir slug)
|
||||
(concat "/" slug "/")))
|
||||
(path (url-filename url-parsed)))
|
||||
(when (and (string-prefix-p filename-prefix path)
|
||||
(string-suffix-p filename-suffix path))
|
||||
(setq path (string-remove-prefix filename-prefix path))
|
||||
(setq path (string-remove-suffix filename-suffix path))
|
||||
(when (url-target url-parsed)
|
||||
(setq path (concat path "#" (url-target url-parsed))))
|
||||
path)))
|
||||
|
||||
(defun devdocs-browser--eww-page-path ()
|
||||
"Return current page's :path ('hello/world#target')."
|
||||
(devdocs-browser--eww-parse-url-path (plist-get eww-data :url)))
|
||||
|
||||
(defun devdocs-browser--eww-link-eldoc (&optional _)
|
||||
"Show URL link or description at current point."
|
||||
(when-let ((url (get-text-property (point) 'shr-url)))
|
||||
(if-let ((path (devdocs-browser--eww-parse-url-path url)))
|
||||
(let* ((doc (plist-get devdocs-browser--eww-data :doc))
|
||||
(index (plist-get doc :index))
|
||||
(entries (plist-get index :entries))
|
||||
(entry (seq-find
|
||||
(lambda (x) (equal (plist-get x :path) path))
|
||||
entries)))
|
||||
(concat
|
||||
(when entry
|
||||
(propertize (plist-get entry :name) 'face 'font-lock-keyword-face))
|
||||
(when entry
|
||||
(format " (%s): " (plist-get entry :type)))
|
||||
(propertize path 'face 'italic)))
|
||||
(format "External link: %s" (propertize url 'face 'italic)))))
|
||||
|
||||
(defun devdocs-browser--position-by-target (target)
|
||||
"Find buffer position for TARGET (url hash)."
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(when-let ((match (text-property-search-forward 'shr-target-id target #'member)))
|
||||
(prop-match-beginning match))))
|
||||
|
||||
(defun devdocs-browser--imenu-create-index ()
|
||||
"Create index alist for current buffer for imenu.
|
||||
Can be used as `imenu-create-index-function'."
|
||||
(when-let* ((doc (plist-get devdocs-browser--eww-data :doc))
|
||||
(entries (plist-get (plist-get doc :index) :entries))
|
||||
(page-path (devdocs-browser--eww-page-path))
|
||||
(page-url (url-generic-parse-url page-path)))
|
||||
(seq-filter
|
||||
#'identity
|
||||
(mapcar
|
||||
(lambda (entry)
|
||||
(when-let* ((name (plist-get entry :name))
|
||||
(path (plist-get entry :path))
|
||||
(url (url-generic-parse-url path))
|
||||
(target (url-target url))
|
||||
((equal (url-filename url) (url-filename page-url))))
|
||||
(cons name (devdocs-browser--position-by-target target))))
|
||||
entries))))
|
||||
|
||||
(define-obsolete-function-alias 'devdocs-browser-eww-goto-target 'imenu "20220917")
|
||||
|
||||
(defun devdocs-browser-eww-open-in-default-browser ()
|
||||
"Open current page in devdocs.io in browser."
|
||||
(interactive)
|
||||
(when-let* ((doc (plist-get devdocs-browser--eww-data :doc))
|
||||
(slug (plist-get doc :slug))
|
||||
(path (devdocs-browser--eww-page-path))
|
||||
(url (concat devdocs-browser-base-url slug "/" path)))
|
||||
(browse-url-default-browser url)))
|
||||
|
||||
(defun devdocs-browser--eww-recenter-advice (res)
|
||||
"Recenter current cursor for devdocs buffer, used for advice :filter-return (return `RES')."
|
||||
(when devdocs-browser--eww-data
|
||||
(recenter))
|
||||
res)
|
||||
|
||||
(defun devdocs-browser--eww-browse-url-new-window-advice (args)
|
||||
"Advice around `eww-browse-url' with ARGS, set NEW-WINDOW if URL is external."
|
||||
(let ((url (car args))
|
||||
(new-window (cadr args)))
|
||||
(when (and devdocs-browser--eww-data
|
||||
(not (devdocs-browser--eww-parse-url-path url)))
|
||||
(setq new-window t))
|
||||
(list url new-window)))
|
||||
|
||||
(define-minor-mode devdocs-browser-eww-mode
|
||||
"Minor mode for browsing devdocs pages with eww."
|
||||
:lighter " Devdocs"
|
||||
:interactive nil
|
||||
:group 'devdocs-browser
|
||||
:keymap (let ((map (make-sparse-keymap)))
|
||||
(define-key map (kbd "C-c C-o") #'devdocs-browser-eww-open-in-default-browser)
|
||||
map)
|
||||
(setq-local shr-external-rendering-functions
|
||||
(append shr-external-rendering-functions
|
||||
'((pre . devdocs-browser--eww-tag-pre)
|
||||
(summary . 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)
|
||||
(setq-local eww-auto-rename-buffer nil))
|
||||
(advice-add 'shr-expand-url :filter-return #'devdocs-browser--eww-fix-url)
|
||||
(advice-add 'eww-display-html :filter-return #'devdocs-browser--eww-recenter-advice)
|
||||
(advice-add 'eww-browse-url :filter-args #'devdocs-browser--eww-browse-url-new-window-advice)
|
||||
(add-hook 'eldoc-documentation-functions #'devdocs-browser--eww-link-eldoc nil t)
|
||||
(eldoc-mode))
|
||||
|
||||
(defvar devdocs-browser--docs-dir "docs")
|
||||
(defvar devdocs-browser--index-json-filename "index.json")
|
||||
(defvar devdocs-browser--metadata-filename "metadata.el")
|
||||
(defvar devdocs-browser--offline-data-json-filename "content.json")
|
||||
(defvar devdocs-browser--offline-data-dir-name "content")
|
||||
|
||||
(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 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.
|
||||
(let* (collection-ht
|
||||
(annotation-function
|
||||
(lambda (s)
|
||||
(let ((annotation (plist-get (gethash s collection-ht) :annotation)))
|
||||
(if annotation
|
||||
(concat " " annotation)
|
||||
nil))))
|
||||
(group-function
|
||||
(lambda (s transform)
|
||||
(let ((group (plist-get (gethash s collection-ht) :group)))
|
||||
(cond
|
||||
(transform (if (and group (string-match (rx bos (literal group) ": ") s))
|
||||
(replace-match "" t t s)
|
||||
s))
|
||||
(t group))))))
|
||||
(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)))
|
||||
": "))
|
||||
(let ((res (completing-read
|
||||
prompt
|
||||
(lambda (str pred action)
|
||||
(if (eq action 'metadata)
|
||||
`(metadata . ((annotation-function . ,annotation-function)
|
||||
(group-function . ,group-function)))
|
||||
(complete-with-action action collection-ht str pred)))
|
||||
nil t ;; require-match
|
||||
nil nil def)))
|
||||
(or (plist-get (gethash res collection-ht) :value)
|
||||
res))))
|
||||
|
||||
(defun devdocs-browser--json-parse-buffer ()
|
||||
"Same as `json-parse-buffer', with custom settings."
|
||||
(json-parse-buffer :object-type 'plist :array-type 'array))
|
||||
|
||||
(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-data-directory)))
|
||||
(when (file-exists-p filename)
|
||||
(with-temp-buffer
|
||||
(insert-file-contents filename)
|
||||
(devdocs-browser--json-parse-buffer)))))
|
||||
|
||||
(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-data-directory)))
|
||||
(unless (file-exists-p (file-name-directory cache-filename))
|
||||
(make-directory (file-name-directory cache-filename) t))
|
||||
(with-temp-file cache-filename
|
||||
(erase-buffer)
|
||||
(url-insert-file-contents (concat (or base-url devdocs-browser-base-url) url-path))
|
||||
(devdocs-browser--json-parse-buffer))))
|
||||
|
||||
|
||||
(defvar devdocs-browser--docs-list-cache nil "Cached docs list.")
|
||||
|
||||
;;;###autoload
|
||||
(defun devdocs-browser-list-docs (&optional refresh-cache)
|
||||
"Get doc metadata lists, reload cache if REFRESH-CACHE."
|
||||
(setq devdocs-browser--docs-list-cache
|
||||
(or (and (not refresh-cache) devdocs-browser--docs-list-cache)
|
||||
(and (not refresh-cache) (devdocs-browser--read-json "docs.json"))
|
||||
(devdocs-browser--fetch-json "docs.json" "docs.json"))))
|
||||
|
||||
;;;###autoload
|
||||
(defun devdocs-browser-update-metadata ()
|
||||
"Update doc metadata list.
|
||||
To upgrade docs content, see `devdocs-browser-upgrade-doc'."
|
||||
(interactive)
|
||||
(let ((count (length (devdocs-browser-list-docs t))))
|
||||
(message (concat "Doc metadata updated, found total %s docs. "
|
||||
"You may want to run `devdocs-browser-install-doc' "
|
||||
"or `devdocs-browser-upgrade-doc'.")
|
||||
count)))
|
||||
|
||||
;;;###autoload
|
||||
(defalias 'devdocs-browser-update-docs 'devdocs-browser-update-metadata)
|
||||
(make-obsolete 'devdocs-browser-update-docs 'devdocs-browser-update-metadata "20231231")
|
||||
|
||||
(defun devdocs-browser-find-doc (slug-or-name)
|
||||
"Find doc from docs list by SLUG-OR-NAME."
|
||||
(let ((docs-list (devdocs-browser-list-docs)))
|
||||
(seq-find (lambda (doc)
|
||||
(or (equal (plist-get doc :slug) slug-or-name)
|
||||
(equal (plist-get doc :name) slug-or-name)))
|
||||
docs-list)))
|
||||
|
||||
(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-data-directory))
|
||||
(doc-dir (expand-file-name slug docs-dir))
|
||||
success)
|
||||
(unless (file-exists-p docs-dir)
|
||||
(make-directory docs-dir t))
|
||||
(when (file-exists-p doc-dir)
|
||||
(delete-directory doc-dir t))
|
||||
|
||||
;; do not leave empty directory
|
||||
(unwind-protect
|
||||
(progn
|
||||
(devdocs-browser--fetch-json
|
||||
(format "docs/%s/index.json?%s" slug mtime)
|
||||
(expand-file-name devdocs-browser--index-json-filename doc-dir))
|
||||
(with-temp-file (expand-file-name devdocs-browser--metadata-filename doc-dir)
|
||||
(print doc (current-buffer)))
|
||||
(setq success t))
|
||||
(unless success
|
||||
(delete-directory doc-dir t)))
|
||||
|
||||
(if success
|
||||
(message "Installed devdocs doc %s version %s" slug mtime)
|
||||
(message "Failed to install devdocs doc %s" slug))
|
||||
;; remove cache
|
||||
(setq devdocs-browser--docs-cache
|
||||
(plist-put devdocs-browser--docs-cache slug nil #'equal))
|
||||
success))
|
||||
|
||||
(defun devdocs-browser--doc-readable-name (doc)
|
||||
"Get human readable name for DOC."
|
||||
(let ((slug (plist-get doc :slug))
|
||||
(name (plist-get doc :name))
|
||||
(version (plist-get doc :version))
|
||||
(release (plist-get doc :release))
|
||||
res)
|
||||
(setq res (concat slug " (" name))
|
||||
(unless (zerop (length version))
|
||||
(setq res (concat res " " version)))
|
||||
(unless (zerop (length release))
|
||||
(setq res (concat res ", " release)))
|
||||
(setq res (concat res ")"))
|
||||
res))
|
||||
|
||||
;;;###autoload
|
||||
(defun devdocs-browser-install-doc (slug-or-name &optional force)
|
||||
"Install doc by SLUG-OR-NAME.
|
||||
When called interactively, user can choose from the list.
|
||||
When called interactively with prefix, or FORCE is t, reinstall existing doc."
|
||||
(interactive
|
||||
(let* ((force current-prefix-arg)
|
||||
(installed-docs
|
||||
(devdocs-browser-list-installed-slugs))
|
||||
(selected-slug
|
||||
(devdocs-browser--completing-read
|
||||
"Install doc"
|
||||
(mapcar (lambda (doc)
|
||||
(let ((slug (plist-get doc :slug)))
|
||||
(unless (and (not force)
|
||||
(member slug installed-docs))
|
||||
(cons (devdocs-browser--doc-readable-name doc)
|
||||
`(:value ,slug)))))
|
||||
(devdocs-browser-list-docs)))))
|
||||
(list selected-slug force)))
|
||||
(let ((doc (devdocs-browser-find-doc slug-or-name)))
|
||||
(unless (and (not force)
|
||||
(member (plist-get doc :slug) (devdocs-browser-list-installed-slugs)))
|
||||
(devdocs-browser--install-doc-internal doc))))
|
||||
|
||||
;;;###autoload
|
||||
(defun devdocs-browser-uninstall-doc (slug)
|
||||
"Uninstall doc by SLUG.
|
||||
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-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
|
||||
(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."
|
||||
(let ((slug (plist-get old-doc :slug))
|
||||
(name (plist-get old-doc :name))
|
||||
(old-version (plist-get old-doc :version))
|
||||
(old-release (plist-get old-doc :release))
|
||||
(old-mtime (plist-get old-doc :mtime))
|
||||
(new-version (plist-get new-doc :version))
|
||||
(new-release (plist-get new-doc :release))
|
||||
(new-mtime (plist-get new-doc :mtime))
|
||||
res)
|
||||
(setq res (format "%s (%s" slug name))
|
||||
(unless (equal old-version new-version)
|
||||
(setq res (concat res (format " %s->%s" old-version new-version))))
|
||||
(unless (equal old-release new-release)
|
||||
(setq res (concat res (format ", %s->%s" old-release new-release))))
|
||||
(setq res (concat res (format ", %s->%s)" old-mtime new-mtime)))
|
||||
res))
|
||||
|
||||
(defun devdocs-browser--upgrade-readable-name-or-nil (slug)
|
||||
"Get human readable name for upgrading SLUG if it needs upgrade."
|
||||
(let ((old-doc (devdocs-browser--load-doc slug))
|
||||
(new-doc (devdocs-browser-find-doc slug)))
|
||||
(when (and new-doc
|
||||
(> (plist-get new-doc :mtime) (plist-get old-doc :mtime)))
|
||||
(devdocs-browser--upgrade-readable-name old-doc new-doc))))
|
||||
|
||||
;;;###autoload
|
||||
(defun devdocs-browser-upgrade-doc (slug)
|
||||
"Upgrade doc by SLUG, return t if upgrade success.
|
||||
Also download new version of offline data if
|
||||
there's offline data for current version.
|
||||
When called interactively, user can choose from list.
|
||||
You may need to call `devdocs-browser-update-docs' first."
|
||||
(interactive
|
||||
(let (rows)
|
||||
(dolist (slug (devdocs-browser-list-installed-slugs))
|
||||
(let ((desc (devdocs-browser--upgrade-readable-name-or-nil slug)))
|
||||
(when desc
|
||||
(push (cons desc slug) rows))))
|
||||
(if (null rows)
|
||||
(progn
|
||||
(message "All docs up to date")
|
||||
(list nil))
|
||||
(list
|
||||
(cdr (assoc (completing-read "Upgrade doc: " rows nil t) rows))))))
|
||||
(when (and slug (devdocs-browser--upgrade-readable-name-or-nil slug))
|
||||
(let* ((has-offline-data (devdocs-browser-offline-data-dir slug))
|
||||
(doc (devdocs-browser-find-doc slug))
|
||||
(install-success (devdocs-browser--install-doc-internal doc)))
|
||||
(when (and has-offline-data install-success)
|
||||
(devdocs-browser--download-offline-data-internal doc))
|
||||
install-success)))
|
||||
|
||||
;;;###autoload
|
||||
(defun devdocs-browser-upgrade-all-docs ()
|
||||
"Upgrade all docs."
|
||||
(interactive)
|
||||
(let ((count 0))
|
||||
(dolist (slug (devdocs-browser-list-installed-slugs))
|
||||
(message "Processing %s..." slug)
|
||||
(when (devdocs-browser-upgrade-doc slug)
|
||||
(setq count (1+ count))))
|
||||
(message "Upgraded %s docs" count)))
|
||||
|
||||
(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-data-directory)))
|
||||
(when (file-exists-p dir)
|
||||
(directory-files dir nil
|
||||
;; ignore ".", ".." and hidden files
|
||||
"^[^.].*"))))
|
||||
|
||||
(defun devdocs-browser-find-installed-doc (slug-or-name)
|
||||
"Find installed doc by SLUG-OR-NAME."
|
||||
(let ((docs-list (mapcar #'devdocs-browser-installed-doc-info
|
||||
(devdocs-browser-list-installed-slugs))))
|
||||
(seq-find (lambda (doc)
|
||||
(or (equal (plist-get doc :slug) slug-or-name)
|
||||
(equal (plist-get doc :name) slug-or-name)))
|
||||
docs-list)))
|
||||
|
||||
(defun devdocs-browser-installed-doc-info (slug)
|
||||
"Get plist info of installed doc identified by SLUG."
|
||||
(cddr (devdocs-browser--load-doc slug)))
|
||||
|
||||
(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) (plist-get devdocs-browser--docs-cache slug #'equal))
|
||||
(let* ((docs-dir (expand-file-name devdocs-browser--docs-dir
|
||||
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)
|
||||
(index-filename (expand-file-name devdocs-browser--index-json-filename doc-dir))
|
||||
(index (devdocs-browser--read-json index-filename))
|
||||
res)
|
||||
(when (file-exists-p metadata-filename)
|
||||
(with-temp-buffer
|
||||
(insert-file-contents metadata-filename)
|
||||
(setq metadata (read (current-buffer))))
|
||||
(setq res (append `(:index ,index) metadata))
|
||||
(when devdocs-browser-enable-cache
|
||||
(setq devdocs-browser--docs-cache
|
||||
(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-data-directory))
|
||||
(doc-dir (expand-file-name slug docs-dir))
|
||||
(data-dir (expand-file-name devdocs-browser--offline-data-dir-name doc-dir))
|
||||
success)
|
||||
(unless (file-exists-p doc-dir)
|
||||
(make-directory doc-dir t))
|
||||
(when (file-exists-p data-dir)
|
||||
(delete-directory data-dir t))
|
||||
|
||||
;; do not leave half-complete data directory
|
||||
(unwind-protect
|
||||
(let ((data (devdocs-browser--fetch-json
|
||||
(format "%s/db.json?%s" slug mtime)
|
||||
(expand-file-name devdocs-browser--offline-data-json-filename doc-dir)
|
||||
devdocs-browser-doc-base-url)))
|
||||
;; write data to files
|
||||
(dolist (kv (seq-partition data 2))
|
||||
(when-let* ((name (substring (symbol-name (car kv)) 1))
|
||||
(value (cadr kv))
|
||||
;; prepent "./" to fix paths starting with literal "~" (e.g. deno)
|
||||
(path (expand-file-name (concat "./" name ".html") data-dir)))
|
||||
(unless (file-exists-p (file-name-directory path))
|
||||
(make-directory (file-name-directory path) t))
|
||||
(write-region value nil path)))
|
||||
(setq success t))
|
||||
(unless success
|
||||
(delete-directory data-dir t)))
|
||||
|
||||
(if success
|
||||
(message "Installed devdocs offline data %s version %s" slug mtime)
|
||||
(message "Failed to install devdocs offline data %s" slug))
|
||||
|
||||
success))
|
||||
|
||||
(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-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)
|
||||
(file-name-as-directory data-dir))))
|
||||
|
||||
(defun devdocs-browser-download-offline-data (slug)
|
||||
"Download offline data for doc SLUG.
|
||||
Offline data contains full content pages,
|
||||
which allows you to view docs without Internet connection.
|
||||
It may take some time to download offline data.
|
||||
When called interactively, user can choose from the list."
|
||||
(interactive (list (completing-read
|
||||
"Install offline data: "
|
||||
(seq-filter
|
||||
(lambda (slug) (null (devdocs-browser-offline-data-dir slug)))
|
||||
(devdocs-browser-list-installed-slugs))
|
||||
nil t)))
|
||||
(when-let* ((doc (devdocs-browser--load-doc slug)))
|
||||
(devdocs-browser--download-offline-data-internal doc)))
|
||||
|
||||
(defun devdocs-browser-remove-offline-data (slug)
|
||||
"Remove offline data for doc SLUG.
|
||||
When called interactively, user can choose from the list."
|
||||
(interactive (list (completing-read
|
||||
"Remove offline data: "
|
||||
(seq-filter
|
||||
#'devdocs-browser-offline-data-dir
|
||||
(devdocs-browser-list-installed-slugs))
|
||||
nil t)))
|
||||
(when-let* ((data-dir (devdocs-browser-offline-data-dir slug)))
|
||||
(delete-directory data-dir t)))
|
||||
|
||||
(defun devdocs-browser--eww-open (doc path)
|
||||
"Open PATH for document DOC using eww."
|
||||
(let* ((slug (plist-get doc :slug))
|
||||
(mtime (plist-get doc :mtime))
|
||||
base-url url)
|
||||
;; cannot use format directly because `path' may contains #query
|
||||
;; path: hello/world#query
|
||||
;; url for offline: file:///home/path/to/devdocs/python~3.8/hello/world.html#query
|
||||
;; url for online: https://documents.devdocs.io/python~3.8/hello/world.html?161818817#query
|
||||
(let ((offline-data-dir (devdocs-browser-offline-data-dir slug)))
|
||||
(if offline-data-dir
|
||||
(progn
|
||||
(setq base-url (concat "file://" offline-data-dir))
|
||||
(setq url (url-generic-parse-url (concat "file://" offline-data-dir path)))
|
||||
(setf (url-filename url) (concat (url-filename url) ".html")))
|
||||
(setq base-url (concat devdocs-browser-doc-base-url slug "/"))
|
||||
(setq url (url-generic-parse-url
|
||||
(concat devdocs-browser-doc-base-url slug "/" path)))
|
||||
(setf (url-filename url)
|
||||
(format "%s.html?%s" (url-filename url) mtime))))
|
||||
|
||||
(pop-to-buffer (format "*devdocs-%s*" slug))
|
||||
(if devdocs-browser-eww-mode
|
||||
(eww-save-history)
|
||||
(eww-mode)
|
||||
(devdocs-browser-eww-mode))
|
||||
(setq-local devdocs-browser--eww-data
|
||||
(list :doc doc
|
||||
:base-url base-url))
|
||||
|
||||
(eww (url-recreate-url url))
|
||||
(recenter)))
|
||||
|
||||
(defun devdocs-browser--default-active-slugs (&optional no-fallback-all)
|
||||
"Default active doc slugs for current buffer, fallback to all slugs if not NO-FALLBACK-ALL."
|
||||
(if devdocs-browser--eww-data
|
||||
(list (plist-get (plist-get devdocs-browser--eww-data :doc) :slug))
|
||||
(let ((names (or devdocs-browser-active-docs
|
||||
(alist-get major-mode devdocs-browser-major-mode-docs-alist)))
|
||||
slugs)
|
||||
(dolist (name names)
|
||||
(when-let* ((doc (devdocs-browser-find-installed-doc name))
|
||||
(slug (plist-get doc :slug)))
|
||||
(setq slugs (push slug slugs))))
|
||||
(or slugs
|
||||
(and (not no-fallback-all) (devdocs-browser-list-installed-slugs))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun devdocs-browser-open-in (slug-or-name-list)
|
||||
"Open entry in specified docs SLUG-OR-NAME-LIST.
|
||||
When called interactively, user can choose from the list."
|
||||
(interactive
|
||||
(let ((def (devdocs-browser--default-active-slugs t)))
|
||||
(list (completing-read-multiple
|
||||
(concat "Select doc"
|
||||
(when def (format " (default %s)" def))
|
||||
": ")
|
||||
(devdocs-browser-list-installed-slugs)
|
||||
nil t nil nil def))))
|
||||
|
||||
(let ((current-word-regex
|
||||
(when-let ((word (thing-at-point 'word t)))
|
||||
(concat "\\<" (regexp-quote word) "\\>")))
|
||||
(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))
|
||||
(doc (devdocs-browser--load-doc slug))
|
||||
(index (plist-get doc :index))
|
||||
(entries (plist-get index :entries)))
|
||||
(setq slugs (push slug slugs))
|
||||
(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 ","))
|
||||
rows def)))
|
||||
(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.
|
||||
Active docs are specified by `devdocs-browser-active-docs',
|
||||
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)
|
||||
(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)
|
||||
;;; devdocs-browser.el ends here
|
||||
|
|
@ -0,0 +1,23 @@
|
|||
;;; 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
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
;;; 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"))
|
||||
275
code/elpa/dired-hacks-utils-20221127.1247/dired-hacks-utils.el
Normal file
275
code/elpa/dired-hacks-utils-20221127.1247/dired-hacks-utils.el
Normal file
|
|
@ -0,0 +1,275 @@
|
|||
;;; 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
|
||||
|
|
@ -0,0 +1,27 @@
|
|||
;;; 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
|
||||
|
|
@ -1,15 +1,13 @@
|
|||
(define-package "dired-hacks-utils" "20240629.1906" "Utilities and helpers for dired-hacks collection"
|
||||
'((dash "2.5.0")
|
||||
(emacs "24.3"))
|
||||
:commit "63b04d17936c98cb4ad7ce6bc3331cda8e30c55a" :authors
|
||||
(define-package "dired-hacks-utils" "20230512.1107" "Utilities and helpers for dired-hacks collection"
|
||||
'((dash "2.5.0"))
|
||||
:commit "523f51b4152a3bf4e60fe57f512732c698b5c96f" :authors
|
||||
'(("Matúš Goljer" . "matus.goljer@gmail.com"))
|
||||
:maintainers
|
||||
'(("Matúš Goljer" . "matus.goljer@gmail.com"))
|
||||
:maintainer
|
||||
'("Matúš Goljer" . "matus.goljer@gmail.com")
|
||||
:keywords
|
||||
'("files")
|
||||
:url "https://github.com/Fuco1/dired-hacks")
|
||||
'("files"))
|
||||
;; Local Variables:
|
||||
;; no-byte-compile: t
|
||||
;; End:
|
||||
|
|
@ -7,8 +7,7 @@
|
|||
;; Keywords: files
|
||||
;; Version: 0.0.1
|
||||
;; Created: 14th February 2014
|
||||
;; Package-Requires: ((dash "2.5.0") (emacs "24.3"))
|
||||
;; URL: https://github.com/Fuco1/dired-hacks
|
||||
;; 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
|
||||
|
|
@ -42,7 +41,6 @@
|
|||
|
||||
(require 'dash)
|
||||
(require 'dired)
|
||||
(require 'dired-aux) ;; for dired-dwim-target-directory
|
||||
|
||||
(defgroup dired-hacks ()
|
||||
"Collection of useful dired additions."
|
||||
|
|
@ -1,28 +0,0 @@
|
|||
;;; 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
|
||||
|
|
@ -0,0 +1,22 @@
|
|||
;;; 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
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
;;; 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"))
|
||||
|
|
@ -5,10 +5,12 @@
|
|||
;; 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") (emacs "24"))
|
||||
;; URL: https://github.com/Fuco1/dired-hacks
|
||||
;; Package-Requires: ((dash "2.5.0") (dired-hacks-utils "0.0.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
|
||||
|
|
@ -1,28 +0,0 @@
|
|||
;;; 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
|
||||
|
|
@ -1,16 +0,0 @@
|
|||
(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:
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
(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:
|
||||
|
|
@ -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"))
|
||||
;; Package-Requires: ((emacs "24") (s "1.2.0"))
|
||||
;; Homepage: https://github.com/spotify/dockerfile-mode
|
||||
;; URL: https://github.com/spotify/dockerfile-mode
|
||||
;; Version: 1.7
|
||||
|
|
@ -29,6 +29,7 @@
|
|||
|
||||
(require 'sh-script)
|
||||
(require 'rx)
|
||||
(require 's)
|
||||
|
||||
|
||||
(declare-function cygwin-convert-file-name-to-windows "cygw32.c" (file &optional absolute-p))
|
||||
|
|
@ -165,7 +166,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=" (replace-regexp-in-string "\\\\=" "=" (shell-quote-argument arg))))
|
||||
(mapconcat (lambda (arg) (concat "--build-arg=" (s-replace "\\=" "=" (shell-quote-argument arg))))
|
||||
dockerfile-build-args " "))
|
||||
|
||||
(defun dockerfile-standard-filename (file)
|
||||
|
|
@ -1,8 +0,0 @@
|
|||
(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,68 +0,0 @@
|
|||
;;; 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
|
||||
|
|
@ -1,13 +0,0 @@
|
|||
(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:
|
||||
|
|
@ -1,329 +0,0 @@
|
|||
;;; 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
|
||||
|
|
@ -1,115 +0,0 @@
|
|||
;;; 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
|
||||
|
|
@ -1,8 +0,0 @@
|
|||
(define-package "go-mode" "20240620.1948" "Major mode for the Go programming language"
|
||||
'((emacs "26.1"))
|
||||
:commit "636d36e37a0d2b6adb2e12d802ff4794ccbba336" :keywords
|
||||
'("languages" "go")
|
||||
:url "https://github.com/dominikh/go-mode.el")
|
||||
;; Local Variables:
|
||||
;; no-byte-compile: t
|
||||
;; End:
|
||||
File diff suppressed because it is too large
Load diff
|
|
@ -156,37 +156,27 @@ fi
|
|||
|
||||
|
||||
cat > $CONF_FILE <<EOF
|
||||
(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\
|
||||
(setq initial-scratch-message (concat initial-scratch-message
|
||||
";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\\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
|
||||
;; \`helm-mode' is enabled which mean that most Emacs commands using completion\\n\
|
||||
;; will use helm.\\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\
|
||||
|
||||
;; 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")
|
||||
;; 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"))
|
||||
|
||||
(setq load-path (quote $LOAD_PATH))
|
||||
|
||||
|
|
@ -243,7 +233,7 @@ cat > $CONF_FILE <<EOF
|
|||
(setq package-load-list
|
||||
(if (equal load-packages '("all"))
|
||||
'(all)
|
||||
(append '((helm-core t) (helm t) (async t) (wfnames t))
|
||||
(append '((helm-core t) (helm t) (async t) (popup t))
|
||||
(mapcar (lambda (p) (list (intern p) t)) load-packages)))))
|
||||
|
||||
(package-initialize))
|
||||
|
|
@ -266,6 +256,9 @@ 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,7 +33,6 @@
|
|||
(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)
|
||||
|
||||
|
|
@ -66,7 +65,7 @@
|
|||
Don't use `setq' to set this."
|
||||
:type 'boolean
|
||||
:set (lambda (var val)
|
||||
(if (require 'all-the-icons nil t)
|
||||
(if (featurep 'all-the-icons)
|
||||
(set var val)
|
||||
(set var nil))))
|
||||
|
||||
|
|
@ -89,10 +88,6 @@ 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."
|
||||
|
|
@ -255,8 +250,7 @@ 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) 'bmkp-jump-gnus)))
|
||||
(eq (bookmark-get-handler bookmark) 'bookmarkp-jump-gnus)))
|
||||
|
||||
(defun helm-bookmark-mu4e-bookmark-p (bookmark)
|
||||
"Return non nil if BOOKMARK is a mu4e bookmark.
|
||||
|
|
@ -269,24 +263,21 @@ 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) 'bmkp-jump-w3m)))
|
||||
(eq (bookmark-get-handler bookmark) 'bookmarkp-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) 'bmkp-jump-woman)))
|
||||
(eq (bookmark-get-handler bookmark) 'bookmarkp-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) 'bmkp-jump-man)))
|
||||
(eq (bookmark-get-handler bookmark) 'bookmarkp-jump-man)))
|
||||
|
||||
(defun helm-bookmark-woman-man-bookmark-p (bookmark)
|
||||
"Return non-nil if BOOKMARK is a Man or Woman bookmark.
|
||||
|
|
@ -311,10 +302,7 @@ 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 (helm-bookmark-org-file-p bookmark))
|
||||
(not (bookmark-get-handler bookmark)))))
|
||||
(and filename (not isnonfile) (not (bookmark-get-handler bookmark)))))
|
||||
|
||||
(defun helm-bookmark-org-file-p (bookmark)
|
||||
(let* ((filename (bookmark-get-filename bookmark)))
|
||||
|
|
@ -400,10 +388,6 @@ 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
|
||||
|
|
@ -635,17 +619,15 @@ 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"))
|
||||
(isfile (all-the-icons-icon-for-file (helm-basename isfile)))))
|
||||
(all-the-icons-octicon "mail-read"))))
|
||||
;; Add a * if bookmark have annotation
|
||||
if (and isannotation (not (string-equal isannotation "")))
|
||||
do (setq trunc (concat helm-bookmark-annotation-sign
|
||||
(if helm-bookmark-show-location trunc i)))
|
||||
do (setq trunc (concat "*" (if helm-bookmark-show-location trunc i)))
|
||||
for sep = (and helm-bookmark-show-location
|
||||
(make-string (- (+ bookmark-bmenu-file-column 2)
|
||||
(string-width trunc))
|
||||
|
|
@ -767,43 +749,32 @@ 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.
|
||||
|
||||
Unused arg _BATCH is kept for backward compatibility.
|
||||
If BATCH is non-nil, then do not rebuild the menu list.
|
||||
|
||||
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))
|
||||
(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)))
|
||||
(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))
|
||||
|
||||
(helm-make-command-from-action helm-bookmark-run-edit
|
||||
"Run `helm-bookmark-edit-bookmark' from keyboard."
|
||||
|
|
@ -837,65 +808,7 @@ 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 ()
|
||||
|
|
@ -905,7 +818,7 @@ Special commands:
|
|||
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,7 +36,6 @@
|
|||
(defvar dired-buffers)
|
||||
(defvar org-directory)
|
||||
(defvar helm-ff-default-directory)
|
||||
(defvar major-mode-remap-alist)
|
||||
|
||||
|
||||
(defgroup helm-buffers nil
|
||||
|
|
@ -101,10 +100,7 @@ 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
|
||||
;; `truncate-string-ellipsis', the function is not available in 27.1
|
||||
;; See issue#2673.
|
||||
(if (char-displayable-p ?…) "…" "...")
|
||||
(defcustom helm-buffers-end-truncated-string "..."
|
||||
"The string to display at end of truncated buffer names."
|
||||
:type 'string)
|
||||
|
||||
|
|
@ -152,7 +148,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 (require 'all-the-icons nil t)
|
||||
(if (featurep 'all-the-icons)
|
||||
(set var val)
|
||||
(set var nil))))
|
||||
|
||||
|
|
@ -339,9 +335,6 @@ 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))
|
||||
|
|
@ -386,7 +379,7 @@ Note that this variable is buffer-local.")
|
|||
|
||||
|
||||
(defun helm-buffers-get-visible-buffers ()
|
||||
"Returns buffers visible on visible frames."
|
||||
"Returns buffers visibles on current frame."
|
||||
(let (result)
|
||||
(walk-windows
|
||||
(lambda (x)
|
||||
|
|
@ -395,7 +388,6 @@ 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)
|
||||
|
|
@ -439,7 +431,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-name))
|
||||
(all-the-icons-icon-for-file buf-fname))
|
||||
(t (all-the-icons-octicon "star" :v-adjust 0.0))))))
|
||||
(buf-name (propertize buf-name 'face face1
|
||||
'help-echo help-echo
|
||||
|
|
@ -460,7 +452,7 @@ The list is reordered with `helm-buffer-list-reorder-fn'."
|
|||
(format "(%s %s in `%s')"
|
||||
(process-name proc)
|
||||
(process-status proc) dir)
|
||||
(format "`%s'" dir))
|
||||
(format "(in `%s')" dir))
|
||||
'face face2)))))
|
||||
|
||||
(defun helm-buffer--format-mode-name (buf)
|
||||
|
|
@ -1010,14 +1002,12 @@ vertically."
|
|||
|
||||
(defun helm-buffers-persistent-kill (_buffer)
|
||||
(let ((marked (helm-marked-candidates))
|
||||
(sel (helm-get-selection))
|
||||
(msg "Buffer `%s' modified, please save it before kill"))
|
||||
(sel (helm-get-selection)))
|
||||
(unwind-protect
|
||||
(cl-loop for b in marked
|
||||
do (if (and (buffer-file-name b) (buffer-modified-p b))
|
||||
(message msg (buffer-name b))
|
||||
do (progn
|
||||
;; We need to preselect each marked because
|
||||
;; helm-buffers-persistent-kill-1 is deleting
|
||||
;; helm-buffers-persistent-kill is deleting
|
||||
;; current selection.
|
||||
(helm-preselect
|
||||
(format "^%s"
|
||||
|
|
@ -1035,7 +1025,7 @@ vertically."
|
|||
(if (or (helm-follow-mode-p)
|
||||
(eql current (get-buffer helm-current-buffer))
|
||||
(not (eql current (get-buffer candidate))))
|
||||
(display-buffer candidate)
|
||||
(switch-to-buffer candidate)
|
||||
(if (and helm-persistent-action-display-window
|
||||
(window-dedicated-p
|
||||
(next-window helm-persistent-action-display-window 1)))
|
||||
|
|
@ -1120,18 +1110,19 @@ 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 (get-buffer (helm-get-selection nil nil source)))
|
||||
(bname (and (bufferp sel) (buffer-name sel))))
|
||||
(when bname
|
||||
(let* ((sel (helm-get-selection nil nil source))
|
||||
(buf (helm-aand (bufferp sel)
|
||||
(get-buffer sel)
|
||||
(buffer-name it))))
|
||||
(when buf
|
||||
(or (buffer-file-name sel)
|
||||
(car (rassoc bname dired-buffers))
|
||||
(and (with-current-buffer bname
|
||||
(car (rassoc buf dired-buffers))
|
||||
(and (with-current-buffer buf
|
||||
(eq major-mode 'org-agenda-mode))
|
||||
org-directory
|
||||
(expand-file-name org-directory))
|
||||
(with-current-buffer bname
|
||||
(with-current-buffer buf
|
||||
(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) 'category)
|
||||
(next-single-char-property-change (point-min) 'face)
|
||||
(point-max))))
|
||||
(kill-buffer "*Faces*")))
|
||||
|
||||
|
|
@ -55,10 +55,6 @@ 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
|
||||
;;
|
||||
|
|
@ -138,59 +134,45 @@ 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 local-map = (helm-M-x-current-mode-map-alist)
|
||||
(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)
|
||||
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 helm-M-x-show-short-doc
|
||||
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)
|
||||
(eq sym 'helm-M-x)))
|
||||
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)))
|
||||
collect
|
||||
(cons (cond ((and (string-match "^M-x" key) local-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)))
|
||||
(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)))
|
||||
'match-part disp)))
|
||||
cand)
|
||||
into ls
|
||||
|
|
@ -262,7 +244,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)
|
||||
(filtered-candidate-transformer :initform 'helm-M-x-transformer-no-sort)
|
||||
(persistent-help :initform "Describe this command")
|
||||
(help-message :initform 'helm-M-x-help-message)
|
||||
(nomark :initform t)
|
||||
|
|
@ -283,19 +265,23 @@ algorithm."
|
|||
(defun helm-M-x-read-extended-command (collection &optional predicate history)
|
||||
"Read or execute action on command name in COLLECTION or HISTORY.
|
||||
|
||||
Helm completion is not provided when executing or defining kbd macros.
|
||||
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.
|
||||
|
||||
Arg COLLECTION should be an `obarray'.
|
||||
Arg PREDICATE is a function that default to `commandp'.
|
||||
Arg HISTORY default to `extended-command-history'."
|
||||
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'."
|
||||
(setq helm--mode-line-display-prefarg t)
|
||||
(let* ((pred (or predicate #'commandp))
|
||||
(helm-fuzzy-sort-fn (lambda (candidates _source)
|
||||
(if helm-M-x-history-transformer-sort
|
||||
;; Sort on real candidate otherwise
|
||||
;; "symbol (<binding>)" is used when sorting.
|
||||
(helm-fuzzy-matching-default-sort-fn-1 candidates t)
|
||||
candidates)))
|
||||
;; Sort on real candidate otherwise
|
||||
;; "symbol (<binding>)" is used when sorting.
|
||||
(helm-fuzzy-matching-default-sort-fn-1 candidates t)))
|
||||
(sources `(,(helm-make-source "Emacs Commands history" 'helm-M-x-class
|
||||
:data (lambda ()
|
||||
(helm-comp-read-get-candidates
|
||||
|
|
@ -307,10 +293,6 @@ Arg HISTORY 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 ()
|
||||
|
|
@ -318,11 +300,16 @@ Arg HISTORY default to `extended-command-history'."
|
|||
;; [1] Same comment as above.
|
||||
collection pred nil nil ""))
|
||||
:fuzzy-match helm-M-x-fuzzy-match)))
|
||||
(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)))
|
||||
(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)))
|
||||
"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 currently determined by comparing `major-mode' of the
|
||||
This is actually 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,8 +31,7 @@
|
|||
["Recent Files" helm-recentf t]
|
||||
["Locate" helm-locate t]
|
||||
["Search Files with find" helm-find t]
|
||||
["Bookmarks" helm-filtered-bookmarks t]
|
||||
["Locate library" helm-locate-library t])
|
||||
["Bookmarks" helm-filtered-bookmarks t])
|
||||
("Buffers"
|
||||
["Find buffers" helm-buffers-list t])
|
||||
("Projects"
|
||||
|
|
@ -48,9 +47,8 @@
|
|||
["Emacs Manual index" helm-info-emacs t]
|
||||
["Gnus Manual index" helm-info-gnus t]
|
||||
["Helm documentation" helm-documentation t])
|
||||
("Packages"
|
||||
["Elisp packages" helm-packages t]
|
||||
["Finder" helm-finder t])
|
||||
("Elpa"
|
||||
["Elisp packages" helm-packages t])
|
||||
("Tools"
|
||||
["Occur" helm-occur t]
|
||||
["Grep current directory with AG" helm-do-grep-ag t]
|
||||
|
|
@ -33,9 +33,6 @@
|
|||
(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
|
||||
|
||||
|
|
@ -160,9 +157,9 @@ display."
|
|||
;; Called each time cursor move in helm-buffer.
|
||||
(defun helm-show-completion ()
|
||||
(with-helm-current-buffer
|
||||
(helm-aif (helm-get-selection)
|
||||
(overlay-put helm-show-completion-overlay
|
||||
'display (substring-no-properties it)))))
|
||||
(overlay-put helm-show-completion-overlay
|
||||
'display (substring-no-properties
|
||||
(helm-get-selection)))))
|
||||
|
||||
(defun helm-show-completion-init-overlay (beg end)
|
||||
(setq helm-show-completion-overlay (make-overlay beg end))
|
||||
|
|
@ -209,9 +206,6 @@ 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)
|
||||
|
|
@ -298,10 +292,13 @@ 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))
|
||||
|
|
@ -314,12 +311,17 @@ 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 candidates
|
||||
:data helm-lisp-completion--cache
|
||||
:persistent-action `(helm-lisp-completion-persistent-action .
|
||||
,(and (eq helm-elisp-help-function
|
||||
'helm-elisp-show-doc-modeline)
|
||||
|
|
@ -358,17 +360,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)
|
||||
(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))))
|
||||
(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)))))
|
||||
|
||||
(defun helm-elisp-show-help (candidate &optional name)
|
||||
"Show full help for the function CANDIDATE.
|
||||
|
|
@ -392,16 +394,17 @@ 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 = (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)))
|
||||
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)))
|
||||
|
||||
;;;###autoload
|
||||
(cl-defun helm-get-first-line-documentation (sym &optional
|
||||
|
|
@ -412,37 +415,31 @@ 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
|
||||
(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)))
|
||||
(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)))
|
||||
(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 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>.
|
||||
;; Some commands specify key bindings in their first line.
|
||||
(truncate-string-to-width
|
||||
(helm-acase (split-string (substitute-command-keys doc) "\n")
|
||||
((guard (and (string= (car it) "") (cdr it)))
|
||||
(cadr guard))
|
||||
(t (car it)))
|
||||
(substitute-command-keys (car (split-string doc "\n")))
|
||||
end-column nil nil t)
|
||||
(if (or (symbol-function sym) (boundp sym) (facep sym) (helm-group-p sym))
|
||||
"Not documented"
|
||||
|
|
@ -460,7 +457,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 t) ""))
|
||||
(let* ((tap (or (thing-at-point 'filename) ""))
|
||||
beg
|
||||
(init (and tap
|
||||
(or force
|
||||
|
|
@ -469,7 +466,8 @@ 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 tap)))
|
||||
(expand-file-name
|
||||
(substring-no-properties tap))))
|
||||
(end (point))
|
||||
(helm-quit-if-no-candidate t)
|
||||
(helm-execute-action-at-once-if-one t)
|
||||
|
|
@ -481,7 +479,6 @@ 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 ()
|
||||
|
|
@ -493,6 +490,20 @@ 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
|
||||
;;
|
||||
|
|
@ -532,17 +543,18 @@ is only used to test DEFAULT."
|
|||
|
||||
(defun helm-apropos-short-doc-transformer (candidates _source)
|
||||
(if helm-apropos-show-short-doc
|
||||
(cl-loop for cand in candidates
|
||||
(cl-loop with max-len = (helm-in-buffer-get-longest-candidate)
|
||||
for cand in candidates
|
||||
for doc = (helm-get-first-line-documentation (intern-soft cand))
|
||||
collect (cons (format "%s%s%s"
|
||||
cand
|
||||
(if doc
|
||||
(helm-make-separator cand)
|
||||
(make-string (+ 1 (if (zerop max-len)
|
||||
max-len
|
||||
(- max-len (string-width cand))))
|
||||
? )
|
||||
"")
|
||||
(if doc
|
||||
(propertize
|
||||
doc 'face 'helm-M-x-short-doc)
|
||||
""))
|
||||
(if doc (propertize doc 'face 'helm-M-x-short-doc) ""))
|
||||
cand))
|
||||
candidates))
|
||||
|
||||
|
|
@ -746,23 +758,23 @@ is only used to test DEFAULT."
|
|||
("Info lookup" . helm-info-lookup-symbol))))
|
||||
|
||||
(defun helm-info-lookup-fallback-source (candidate)
|
||||
(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")))
|
||||
(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")))
|
||||
(helm-build-sync-source src-name
|
||||
:candidates (list candidate)
|
||||
:persistent-action (lambda (candidate)
|
||||
|
|
@ -798,10 +810,7 @@ is only used to test DEFAULT."
|
|||
|
||||
(defun helm-apropos-get-default ()
|
||||
(with-syntax-table emacs-lisp-mode-syntax-table
|
||||
(symbol-name (intern-soft
|
||||
(helm-aand (thing-at-point 'symbol t)
|
||||
(replace-regexp-in-string "\\`[~=]" "" it)
|
||||
(replace-regexp-in-string "[~=]\\'" "" it))))))
|
||||
(symbol-name (intern-soft (thing-at-point 'symbol)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun helm-apropos (default)
|
||||
|
|
@ -844,19 +853,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
|
||||
|
|
@ -893,76 +902,41 @@ 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)
|
||||
nconc (directory-files
|
||||
dir nil (concat (regexp-opt (find-library-suffixes)) "\\'"))))
|
||||
append (directory-files
|
||||
dir t (concat (regexp-opt (get-load-suffixes))
|
||||
"\\'"))))
|
||||
|
||||
;;;###autoload
|
||||
(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*")))
|
||||
|
||||
(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*"))
|
||||
|
||||
;;; Modify variables from Helm
|
||||
;;
|
||||
|
|
@ -86,18 +86,14 @@
|
|||
uid 'face 'font-lock-warning-face))
|
||||
key)))
|
||||
|
||||
(cl-defun helm-epa--select-keys (prompt keys)
|
||||
(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))
|
||||
:action (lambda (_candidate)
|
||||
(helm-marked-candidates)))
|
||||
(helm-epa-get-key-list keys)))
|
||||
:prompt (and prompt (helm-epa--format-prompt prompt))
|
||||
:buffer "*helm epa*")))
|
||||
(if (or (equal result "") (null result))
|
||||
(cl-return-from helm-epa--select-keys
|
||||
(error "No keys selected, aborting"))
|
||||
(unless (equal result "")
|
||||
result)))
|
||||
|
||||
(defun helm-epa--format-prompt (prompt)
|
||||
|
|
@ -108,23 +104,13 @@
|
|||
(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,c,d,h]"
|
||||
'("n" "c" "d")
|
||||
#'helm-epa--read-signature-type-help)))
|
||||
(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"))))
|
||||
(helm-acase answer
|
||||
("n" 'normal)
|
||||
("c" 'clear)
|
||||
|
|
@ -159,7 +145,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-at-point))
|
||||
(helm-lisp-completion-or-file-name-at-point))
|
||||
;; In eshell `pcomplete-parse-arguments' is called
|
||||
;; with `pcomplete-parse-arguments-function'
|
||||
;; locally bound to `eshell-complete-parse-arguments'
|
||||
|
|
@ -23,8 +23,7 @@
|
|||
(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."
|
||||
|
|
@ -84,13 +83,8 @@ 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-make-source "Evaluation Result" 'helm-evaluation-result-class
|
||||
(helm-build-dummy-source "Evaluation Result"
|
||||
:multiline t
|
||||
:mode-line "C-RET: nl-and-indent, M-tab: reindent, C-tab:complete, C-p/n: next/prec-line."
|
||||
:filtered-candidate-transformer
|
||||
|
|
@ -98,11 +92,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,24 +67,25 @@ If this variable is not set by the user, it will be calculated
|
|||
automatically.")
|
||||
|
||||
(defun helm-external-commands-list-1 (&optional sort)
|
||||
"Return a list of all external commands the user can execute.
|
||||
"Returns 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'."
|
||||
(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)))))
|
||||
(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)))))
|
||||
|
||||
(defun helm-run-or-raise (exe &optional files detached)
|
||||
"Run asynchronously EXE or jump to the application window.
|
||||
|
|
@ -132,11 +132,10 @@
|
|||
(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 "Fd" 'helm-fd-class
|
||||
:header-name
|
||||
(lambda (name)
|
||||
(format "%s (%s)"
|
||||
name (abbreviate-file-name default-directory))))
|
||||
(helm :sources (helm-make-source
|
||||
(format "fd (%s)"
|
||||
(abbreviate-file-name default-directory))
|
||||
'helm-fd-class)
|
||||
:buffer "*helm fd*")))
|
||||
|
||||
|
||||
File diff suppressed because it is too large
Load diff
|
|
@ -50,7 +50,6 @@ 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)
|
||||
|
|
@ -85,7 +84,6 @@ 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)
|
||||
(helm-acase (or grep-cmd (helm-grep-command))
|
||||
(pcase (or grep-cmd (helm-grep-command))
|
||||
;; Use grep for GNU regexp based tools.
|
||||
(("grep" "zgrep" "git-grep")
|
||||
((or "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 so compare by matching ack.
|
||||
((guard (string-match-p "ack" it))
|
||||
(format "%s --smart-case --color %s" it pipe-switches))))
|
||||
;; Sometimes ack-grep cmd is ack only.
|
||||
((and (pred (string-match-p "ack")) ack)
|
||||
(format "%s --smart-case --color %s" ack 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 currently used only as an internal flag
|
||||
It is actually 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 currently to specify \\='zgrep' or \\='git'.
|
||||
It is used actually 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,12 +1635,8 @@ returns if available with current AG version."
|
|||
(helm-default-directory)
|
||||
default-directory))
|
||||
(cmd-line (helm-grep-ag-prepare-cmd-line
|
||||
;; 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))
|
||||
helm-pattern (or (file-remote-p directory 'localname)
|
||||
directory)
|
||||
type))
|
||||
(start-time (float-time))
|
||||
(proc-name (helm-grep--ag-command)))
|
||||
|
|
@ -1697,27 +1693,18 @@ 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-ag-map)
|
||||
(keymap :initform 'helm-grep-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)
|
||||
|
|
@ -1741,30 +1728,16 @@ 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 though it works fine) because it will be slower to
|
||||
is not recommended (even thought 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 currently is using Rsync to copy files from or to
|
||||
The best way actually 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
|
||||
currently seems to use Adb, here some hints to set this up, read
|
||||
actually 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,40 +915,6 @@ 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.
|
||||
|
|
@ -1040,9 +1006,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-remote-directory-fn'.
|
||||
for `helm-list-directory-function'.
|
||||
|
||||
See `helm-list-remote-directory-fn' documentation for more infos.
|
||||
See `helm-list-directory-function' documentation for more infos.
|
||||
|
||||
**** Completing host
|
||||
|
||||
|
|
@ -1301,10 +1267,7 @@ 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-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.")
|
||||
|\\[helm-ff-sort-by-ext]|Sort by extensions.")
|
||||
|
||||
;;; Help for file-name-history
|
||||
;;
|
||||
|
|
@ -2288,15 +2251,6 @@ 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 (require 'all-the-icons nil t)
|
||||
(if (featurep 'all-the-icons)
|
||||
(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 (require 'all-the-icons nil t)
|
||||
(if (featurep 'all-the-icons)
|
||||
(set var val)
|
||||
(set var nil))))
|
||||
|
||||
(defcustom helm-imenu-icon-type-alist
|
||||
'(("Array" . (all-the-icons-material "crop" :face font-lock-builtin-face))
|
||||
("Arrays" . (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))
|
||||
("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))
|
||||
("Classes" . (all-the-icons-octicon "package" :face font-lock-type-face))
|
||||
("Class" . (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))
|
||||
("Numerics" . (all-the-icons-material "crop" :face font-lock-builtin-face))
|
||||
("Numeric" . (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))
|
||||
("Snippets" . (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))
|
||||
("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,8 +320,7 @@ 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 "\\_<" (regexp-quote (car cur)) "\\_>")))
|
||||
(helm-force-update (concat "\\_<" (car cur) "\\_>")))
|
||||
t)))
|
||||
|
||||
(defun helm-imenu-quit-and-find-file-fn (source)
|
||||
|
|
@ -407,11 +406,12 @@ 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 (helm-acase (cdr elm) ; Same as [1].
|
||||
((guard (overlayp it))
|
||||
(copy-overlay it))
|
||||
((guard (or (markerp it) (integerp it)))
|
||||
(copy-marker it))))
|
||||
(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))))
|
||||
(list elm))))))
|
||||
|
||||
(defun helm-imenu--get-prop (item)
|
||||
|
|
@ -443,9 +443,10 @@ 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
|
||||
(helm-acase v
|
||||
((guard (overlayp it)) (overlay-buffer it))
|
||||
((guard (markerp it)) (marker-buffer it))))
|
||||
(pcase v
|
||||
((pred overlayp) (overlay-buffer v))
|
||||
((or (pred markerp) (pred integerp))
|
||||
(marker-buffer v))))
|
||||
for types = (or (helm-imenu--get-prop k)
|
||||
(list (if (with-current-buffer bufname
|
||||
(derived-mode-p 'prog-mode))
|
||||
Some files were not shown because too many files have changed in this diff Show more
Reference in a new issue