Compare commits
2 commits
a988eae948
...
e603e2b7ff
| Author | SHA1 | Date | |
|---|---|---|---|
 KemoNine
|
e603e2b7ff | ||
|
KemoNine
|
403d9230e4 |
19
.gitignore
vendored
19
.gitignore
vendored
|
|
@ -1,19 +0,0 @@
|
|||
*.elc
|
||||
**ido.last**
|
||||
**projectile-bookmarks**
|
||||
**/auto-save-list
|
||||
**/backups
|
||||
**/bookmarks
|
||||
**/persp-confs
|
||||
code/projects
|
||||
**/beancount-mode
|
||||
**/transient
|
||||
**/.org-id-locations
|
||||
**/xapian-lite.so
|
||||
**/projectile.cache
|
||||
**/.persistent-scratch*
|
||||
**/url
|
||||
**/eshell
|
||||
**/.lsp-session*
|
||||
**/eln-cache
|
||||
**/org-persist
|
||||
14
README.md
14
README.md
|
|
@ -1,9 +1,15 @@
|
|||
## Important
|
||||
|
||||
I no longer use `org-mode` as a personal knowledge base / 2nd brain. I also no longer use it for any code editing.
|
||||
- I no longer use `org-mode` as a habit / todo tracker
|
||||
- I no longer use `org-mode` as a personal knowledge base / 2nd brain
|
||||
- I no longer use for code editing
|
||||
- *I now use [Obsidian](https://obsidian.md) as a personal knowledge base / 2nd brain*
|
||||
- *I now use [LogSeq](https://logseq.com/) with the `Org` file format as a habit and todo tracker combined with [Orgzly-Revived](https://github.com/orgzly-revived/orgzly-android-revived) on my Android mobile device(s)*
|
||||
|
||||
The main branch of the repo is now my config for *just* todo tracking, habit tracking, pomodoro timer and some basic time tracking.
|
||||
## The 'To Do and Habit` Config
|
||||
|
||||
## The 'Real Config'
|
||||
If you are interested in a config thats focused on just todo and habit tracking, see the `todo-habit-confit` branch.
|
||||
|
||||
If you are interested in a more complex config that shows how I leveraged emacs with multiple profiles and more, see the `pre-kb-removal` branch.
|
||||
## The 'Big Config'
|
||||
|
||||
If you are interested in a more complex config that shows how I leveraged emacs with multiple profiles, todo / habit tracking, personal knowledge base and more, see the `big-config` branch.
|
||||
|
|
|
|||
|
|
@ -1,55 +0,0 @@
|
|||
;;; 0blayout-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 0blayout.el
|
||||
|
||||
(autoload '0blayout-add-keybindings-with-prefix "0blayout" "\
|
||||
Add 0blayout keybindings using the prefix PREFIX.
|
||||
|
||||
(fn PREFIX)")
|
||||
(defvar 0blayout-mode nil "\
|
||||
Non-nil if 0bLayout mode is enabled.
|
||||
See the `0blayout-mode' command
|
||||
for a description of this minor mode.")
|
||||
(custom-autoload '0blayout-mode "0blayout" nil)
|
||||
(autoload '0blayout-mode "0blayout" "\
|
||||
Handle layouts with ease
|
||||
|
||||
This is a global minor mode. If called interactively, toggle the
|
||||
`0bLayout 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 `(default-value \\='0blayout-mode)'.
|
||||
|
||||
The mode's hook is called both when the mode is enabled and when
|
||||
it is disabled.
|
||||
|
||||
(fn &optional ARG)" t)
|
||||
(register-definition-prefixes "0blayout" '("0blayout-"))
|
||||
|
||||
;;; End of scraped data
|
||||
|
||||
(provide '0blayout-autoloads)
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; no-native-compile: t
|
||||
;; coding: utf-8-emacs-unix
|
||||
;; End:
|
||||
|
||||
;;; 0blayout-autoloads.el ends here
|
||||
|
|
@ -1,6 +0,0 @@
|
|||
(define-package "0blayout" "20190703.527" "Layout grouping with ease" 'nil :commit "fd9a8f353dbd45b4628b5f84b8d8c2525ebf571d" :keywords
|
||||
'("convenience" "window-management")
|
||||
:url "https://github.com/etu/0blayout")
|
||||
;; Local Variables:
|
||||
;; no-byte-compile: t
|
||||
;; End:
|
||||
|
|
@ -1,200 +0,0 @@
|
|||
;;; 0blayout.el --- Layout grouping with ease
|
||||
|
||||
;; Copyright (c) 2015-2016 Elis Axelsson
|
||||
|
||||
;; Author: Elis "etu" Axelsson
|
||||
;; URL: https://github.com/etu/0blayout
|
||||
;; Package-Version: 20160918.0
|
||||
;; Version: 1.0.2
|
||||
;; Keywords: convenience, window-management
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This global minor mode provides a simple way to switch between layouts and
|
||||
;; the buffers you left open before you switched (unless you closed it).
|
||||
|
||||
;; It doesn't require any setup at all more than:
|
||||
;; (0blayout-mode)
|
||||
|
||||
;; When you start Emacs with 0blayout loaded, you will have a default layout
|
||||
;; named "default", and then you can create new layouts (<prefix> C-c), switch
|
||||
;; layouts (<prefix> C-b), and kill the current layout (<prefix> C-k).
|
||||
;; The default <prefix> is (C-c C-l), but you can change it using:
|
||||
;; (0blayout-add-keybindings-with-prefix "<your prefix>")
|
||||
|
||||
;; You can also customize-variable to change the name of the default session.
|
||||
|
||||
;; The project is hosted at https://github.com/etu/0blayout
|
||||
;; There you can leave bug-reports and suggestions.
|
||||
|
||||
;; Another comparable mode is eyebrowse which have been developed for longer.
|
||||
|
||||
;;; License:
|
||||
|
||||
;; This file 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 file 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 file; if not, write to the Free Software
|
||||
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
|
||||
;; 02110-1301, USA.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(defgroup 0blayout nil
|
||||
"Configuration settings for 0blayout-mode."
|
||||
:group 'convenience)
|
||||
|
||||
(defvar 0blayout-alist ()
|
||||
"List of the currently defined layouts.")
|
||||
|
||||
(defcustom 0blayout-default "default"
|
||||
"Name of default layout used."
|
||||
:type 'string
|
||||
:group '0blayout)
|
||||
|
||||
(defvar 0blayout-keys-map '(("C-c" . 0blayout-new)
|
||||
("C-k" . 0blayout-kill)
|
||||
("C-b" . 0blayout-switch))
|
||||
"Which keys bounded to which functions map.")
|
||||
|
||||
(defvar 0blayout-mode-map (make-sparse-keymap)
|
||||
"Keymap for 0blayout.")
|
||||
|
||||
|
||||
;; Function to create a new layout
|
||||
(defun 0blayout-new (layout-name)
|
||||
"0blayout creating function.
|
||||
Argument LAYOUT-NAME Name of the layout."
|
||||
(interactive "sEnter name of new layout: ")
|
||||
|
||||
;; Save the currently active layout
|
||||
(0blayout-save)
|
||||
|
||||
;; Then we just delete all other windows and switch to a *scratch* buffer,
|
||||
;; then it's up to the user to set up their layout.
|
||||
(delete-other-windows)
|
||||
(switch-to-buffer "*scratch*")
|
||||
|
||||
;; Save the name of the new current layout
|
||||
(0blayout-set-current-name layout-name))
|
||||
|
||||
|
||||
;; Function to kill current layout
|
||||
(defun 0blayout-kill ()
|
||||
"0blayout removal function."
|
||||
(interactive)
|
||||
|
||||
(message "Killing layout: '%s'" (0blayout-get-current-name))
|
||||
|
||||
;; Remove current layout from known layouts
|
||||
(setq 0blayout-alist
|
||||
(assq-delete-all (intern (0blayout-get-current-name)) 0blayout-alist))
|
||||
|
||||
;; Switch to next layout in the list
|
||||
(let ((new-layout (car (car 0blayout-alist))))
|
||||
(if (eq new-layout nil)
|
||||
;; If there's no other layout, make a new default layout
|
||||
(progn
|
||||
(0blayout-set-current-name 0blayout-default)
|
||||
(0blayout-new 0blayout-default))
|
||||
|
||||
;; Switch to some other saved layout
|
||||
(progn
|
||||
(set-window-configuration (cdr (car 0blayout-alist)))
|
||||
(0blayout-set-current-name (symbol-name new-layout))))))
|
||||
|
||||
|
||||
;; Function to switch layout
|
||||
(defun 0blayout-switch (layout-name)
|
||||
"0blayout switching function.
|
||||
Argument LAYOUT-NAME Name of the layout."
|
||||
(interactive
|
||||
(list
|
||||
(completing-read "Layout to switch to: " 0blayout-alist)))
|
||||
|
||||
;; Save the currently active layout
|
||||
(0blayout-save)
|
||||
|
||||
(let ((layout (assoc (intern layout-name) 0blayout-alist)))
|
||||
(if (eq layout nil)
|
||||
(message "No layout with name: '%s' is defined" layout-name)
|
||||
(progn
|
||||
;; Load window configuration
|
||||
(set-window-configuration (cdr layout))
|
||||
|
||||
;; Save the name of the currently active layout
|
||||
(0blayout-set-current-name layout-name)
|
||||
|
||||
(message "Switch to layout: '%s'" layout-name)))))
|
||||
|
||||
|
||||
;; Function to save layout
|
||||
(defun 0blayout-save ()
|
||||
"This is a helper function to save the current layout."
|
||||
|
||||
;; Remove all saves of current layout before saving
|
||||
(setq 0blayout-alist
|
||||
(assq-delete-all
|
||||
(intern (0blayout-get-current-name)) 0blayout-alist))
|
||||
|
||||
;; Add current layout to list
|
||||
(add-to-list '0blayout-alist
|
||||
(cons (intern (0blayout-get-current-name))
|
||||
(current-window-configuration)))
|
||||
|
||||
(message "Saved the currently active layout: %s" (0blayout-get-current-name)))
|
||||
|
||||
|
||||
;; Save current layout name
|
||||
(defun 0blayout-set-current-name (layout-name)
|
||||
"Helper function to store current LAYOUT-NAME for this frame."
|
||||
|
||||
(set-frame-parameter nil '0blayout-current layout-name))
|
||||
|
||||
|
||||
;; Get current layout name
|
||||
(defun 0blayout-get-current-name ()
|
||||
"Helper function to get current LAYOUT-NAME for this frame."
|
||||
|
||||
;; Get variable from current frame
|
||||
(let ((current-layout (frame-parameter nil '0blayout-current)))
|
||||
;; Check if it's nil
|
||||
(if (eq current-layout nil)
|
||||
;; If so, return default value
|
||||
0blayout-default
|
||||
;; else return current value
|
||||
current-layout)))
|
||||
|
||||
|
||||
;;;###autoload
|
||||
(defun 0blayout-add-keybindings-with-prefix (prefix)
|
||||
"Add 0blayout keybindings using the prefix PREFIX."
|
||||
(setf (cdr 0blayout-mode-map) nil)
|
||||
(dolist (pair 0blayout-keys-map)
|
||||
(define-key 0blayout-mode-map
|
||||
(kbd (format "%s %s" prefix (car pair)))
|
||||
(cdr pair))))
|
||||
|
||||
(0blayout-add-keybindings-with-prefix "C-c C-l")
|
||||
|
||||
|
||||
;;;###autoload
|
||||
(define-minor-mode 0blayout-mode
|
||||
"Handle layouts with ease"
|
||||
:lighter " 0bL"
|
||||
:global t
|
||||
:group '0blayout
|
||||
:keymap 0blayout-mode-map)
|
||||
|
||||
|
||||
(provide '0blayout)
|
||||
|
||||
;;; 0blayout.el ends here
|
||||
|
|
@ -1,102 +0,0 @@
|
|||
;;; alert-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 "alert" "alert.el" (0 0 0 0))
|
||||
;;; Generated autoloads from alert.el
|
||||
|
||||
(autoload 'alert-add-rule "alert" "\
|
||||
Programmatically add an alert configuration rule.
|
||||
|
||||
Normally, users should custoimze `alert-user-configuration'.
|
||||
This facility is for module writers and users that need to do
|
||||
things the Lisp way.
|
||||
|
||||
Here is a rule the author currently uses with ERC, so that the
|
||||
fringe gets colored whenever people chat on BitlBee:
|
||||
|
||||
\(alert-add-rule :status \\='(buried visible idle)
|
||||
:severity \\='(moderate high urgent)
|
||||
:mode \\='erc-mode
|
||||
:predicate
|
||||
#\\='(lambda (info)
|
||||
(string-match (concat \"\\\\`[^&].*@BitlBee\\\\\\='\")
|
||||
(erc-format-target-and/or-network)))
|
||||
:persistent
|
||||
#\\='(lambda (info)
|
||||
;; If the buffer is buried, or the user has been
|
||||
;; idle for `alert-reveal-idle-time' seconds,
|
||||
;; make this alert persistent. Normally, alerts
|
||||
;; become persistent after
|
||||
;; `alert-persist-idle-time' seconds.
|
||||
(memq (plist-get info :status) \\='(buried idle)))
|
||||
:style \\='fringe
|
||||
:continue t)
|
||||
|
||||
\(fn &key SEVERITY STATUS MODE CATEGORY TITLE MESSAGE PREDICATE ICON (STYLE alert-default-style) PERSISTENT CONTINUE NEVER-PERSIST APPEND)" nil nil)
|
||||
|
||||
(autoload 'alert "alert" "\
|
||||
Alert the user that something has happened.
|
||||
MESSAGE is what the user will see. You may also use keyword
|
||||
arguments to specify additional details. Here is a full example:
|
||||
|
||||
\(alert \"This is a message\"
|
||||
:severity \\='high ;; The default severity is `normal'
|
||||
:title \"Title\" ;; An optional title
|
||||
:category \\='example ;; A symbol to identify the message
|
||||
:mode \\='text-mode ;; Normally determined automatically
|
||||
:buffer (current-buffer) ;; This is the default
|
||||
:data nil ;; Unused by alert.el itself
|
||||
:persistent nil ;; Force the alert to be persistent;
|
||||
;; it is best not to use this
|
||||
:never-persist nil ;; Force this alert to never persist
|
||||
:id \\='my-id) ;; Used to replace previous message of
|
||||
;; the same id in styles that support it
|
||||
:style \\='fringe) ;; Force a given style to be used;
|
||||
;; this is only for debugging!
|
||||
:icon \\=\"mail-message-new\" ;; if style supports icon then add icon
|
||||
;; name or path here
|
||||
|
||||
If no :title is given, the buffer-name of :buffer is used. If
|
||||
:buffer is nil, it is the current buffer at the point of call.
|
||||
|
||||
:data is an opaque value which modules can pass through to their
|
||||
own styles if they wish.
|
||||
|
||||
Here are some more typical examples of usage:
|
||||
|
||||
;; This is the most basic form usage
|
||||
(alert \"This is an alert\")
|
||||
|
||||
;; You can adjust the severity for more important messages
|
||||
(alert \"This is an alert\" :severity \\='high)
|
||||
|
||||
;; Or decrease it for purely informative ones
|
||||
(alert \"This is an alert\" :severity \\='trivial)
|
||||
|
||||
;; Alerts can have optional titles. Otherwise, the title is the
|
||||
;; buffer-name of the (current-buffer) where the alert originated.
|
||||
(alert \"This is an alert\" :title \"My Alert\")
|
||||
|
||||
;; Further, alerts can have categories. This allows users to
|
||||
;; selectively filter on them.
|
||||
(alert \"This is an alert\" :title \"My Alert\"
|
||||
:category \\='some-category-or-other)
|
||||
|
||||
\(fn MESSAGE &key (SEVERITY \\='normal) TITLE ICON CATEGORY BUFFER MODE DATA STYLE PERSISTENT NEVER-PERSIST ID)" nil nil)
|
||||
|
||||
(register-definition-prefixes "alert" '("alert-" "x-urgen"))
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; coding: utf-8
|
||||
;; End:
|
||||
;;; alert-autoloads.el ends here
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
;;; Generated package description from alert.el -*- no-byte-compile: t -*-
|
||||
(define-package "alert" "20221213.1619" "Growl-style notification system for Emacs" '((gntp "0.1") (log4e "0.3.0") (cl-lib "0.5")) :commit "c762380ff71c429faf47552a83605b2578656380" :authors '(("John Wiegley" . "jwiegley@gmail.com")) :maintainer '("John Wiegley" . "jwiegley@gmail.com") :keywords '("notification" "emacs" "message") :url "https://github.com/jwiegley/alert")
|
||||
File diff suppressed because it is too large
Load diff
|
|
@ -1,29 +0,0 @@
|
|||
;;; alert-toast-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 "alert-toast" "alert-toast.el" (0 0 0 0))
|
||||
;;; Generated autoloads from alert-toast.el
|
||||
|
||||
(autoload 'alert-toast-notify "alert-toast" "\
|
||||
Send INFO using Windows 10 toast notification.
|
||||
Handles :ICON, :SEVERITY, :PERSISTENT, :NEVER-PERSIST, :TITLE and
|
||||
:MESSAGE keywords from INFO plist.
|
||||
|
||||
\(fn INFO)" nil nil)
|
||||
|
||||
(register-definition-prefixes "alert-toast" '("alert-toast-"))
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; coding: utf-8
|
||||
;; End:
|
||||
;;; alert-toast-autoloads.el ends here
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
;;; Generated package description from alert-toast.el -*- no-byte-compile: t -*-
|
||||
(define-package "alert-toast" "20220312.229" "Windows 10 toast notifications" '((emacs "25.1") (alert "1.2") (f "0.20.0") (s "1.12.0")) :commit "96c88c93c1084de681700f655223142ee0eb944a" :authors '(("Grzegorz Kowzan" . "grzegorz@kowzan.eu")) :maintainer '("Grzegorz Kowzan" . "grzegorz@kowzan.eu") :url "https://github.com/gkowzan/alert-toast")
|
||||
|
|
@ -1,316 +0,0 @@
|
|||
;;; alert-toast.el --- Windows 10 toast notifications -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright 2020, 2022 Grzegorz Kowzan
|
||||
|
||||
;; Author: Grzegorz Kowzan <grzegorz@kowzan.eu>
|
||||
;; Created: 25 Oct 2020
|
||||
;; Updated: 25 Mar 2022
|
||||
;; Version: 1.0.0
|
||||
;; Package-Version: 20220312.229
|
||||
;; Package-Commit: 96c88c93c1084de681700f655223142ee0eb944a
|
||||
;; Package-Requires: ((emacs "25.1") (alert "1.2") (f "0.20.0") (s "1.12.0"))
|
||||
;; Url: https://github.com/gkowzan/alert-toast
|
||||
|
||||
;; 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 GNU Emacs; see the file COPYING. If not, write to the
|
||||
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
||||
;; Boston, MA 02111-1307, USA.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This package defines a new alert style (`toast') for alert.el using Windows
|
||||
;; 10 toast notifications. It works with native Windows 10 Emacs versions and
|
||||
;; with Emacs run under Windows Subsystem for Linux (WSL) or under Cygwin. These
|
||||
;; notifications are limited to a single-line title and four lines of text.
|
||||
;; Longer text can be passed but it will be truncated by Windows 10.
|
||||
;;
|
||||
;; * Icons
|
||||
;; Icons located on network shares are not supported. This includes icons on the
|
||||
;; WSL virtual drive, therefore for Emacs running under WSL the default Emacs
|
||||
;; icon is copied to C:\Users\<user>\AppData\Local\Emacs-Toast\Emacs.png. PNG
|
||||
;; version is used because toast notifications render SVG graphics as tiny and
|
||||
;; put them in top left corner of the notification.
|
||||
|
||||
;; Under WSL or Cygwin, a path to a custom icon should be given as a WSL/Cygwin
|
||||
;; path (/mnt/c/... or /cygdrive/c/...) instead of a Windows path (C:\\...).
|
||||
;;
|
||||
;; * Priorities
|
||||
;; Looking at Windows.UI.Notifications API, toast notifications seem to support
|
||||
;; 2 priority levels: High and Default. Mapping between alert.el priorities and
|
||||
;; these levels is defined by `alert-toast-priorities'.
|
||||
;;
|
||||
;; * Bugs
|
||||
;; There is an issue in WSL where wslhost.exe dies for no discernible reason,
|
||||
;; which prevents accessing Windows partitions and executables
|
||||
;; (https://github.com/microsoft/WSL/issues/6161). If this happens then you
|
||||
;; should see powershell.exe process failing to start. This will obviously
|
||||
;; prevent this package from working. The only known workaround is to call `wsl
|
||||
;; --shutdown' and start WSL again.
|
||||
;;; Code:
|
||||
|
||||
(require 'f)
|
||||
(require 's)
|
||||
(require 'alert)
|
||||
(require 'dom)
|
||||
(require 'shr)
|
||||
|
||||
;; WSL-related functions and constants
|
||||
;; In the words of WSL developers, there is no official way of testing for WSL
|
||||
;; but they said at the same time that either "wsl" or "microsoft" should always
|
||||
;; be present in the kernel release string.
|
||||
(defun alert-toast--check-wsl ()
|
||||
"Check if running under Windows Subsystem for Linux."
|
||||
(and (eq system-type 'gnu/linux)
|
||||
(let ((kernel-release (shell-command-to-string "uname --kernel-release")))
|
||||
(or (s-contains? "wsl" kernel-release t)
|
||||
(s-contains? "microsoft" kernel-release t)))))
|
||||
|
||||
(defconst alert-toast--wsl (alert-toast--check-wsl))
|
||||
(defconst alert-toast--appdir-text "[System.Environment]::GetFolderPath([System.Environment+SpecialFolder]::LocalApplicationData) | Join-Path -ChildPath Emacs-Toast\\Emacs.png")
|
||||
|
||||
(defun alert-toast--appdir ()
|
||||
"Path to Windows user's data directory."
|
||||
(with-temp-buffer
|
||||
(let ((coding-system-for-read 'utf-8-dos))
|
||||
(call-process-region alert-toast--appdir-text nil "powershell.exe" nil t nil "-noprofile" "-NonInteractive" "-WindowStyle" "Hidden" "-Command" "-"))
|
||||
(s-chomp (buffer-string))))
|
||||
|
||||
(defun alert-toast--default-wsl-icon-path ()
|
||||
"Path to Emacs icon in Windows user's data directory."
|
||||
(with-temp-buffer
|
||||
(call-process "wslpath" nil t nil (alert-toast--appdir))
|
||||
(s-chomp (buffer-string))))
|
||||
|
||||
(defun alert-toast--init-wsl-icon ()
|
||||
"Copy Emacs icon to a Windows-side directory."
|
||||
(let ((icon-path (alert-toast--default-wsl-icon-path)))
|
||||
(unless (f-exists? icon-path)
|
||||
(make-directory (f-parent icon-path) t)
|
||||
(f-copy (concat data-directory "images/icons/hicolor/128x128/apps/emacs.png")
|
||||
icon-path))))
|
||||
|
||||
(defun alert-toast--icon-path (path)
|
||||
"Convert icon PATH from WSL/Cygwin to Windows path if needed."
|
||||
(cond
|
||||
(alert-toast--wsl
|
||||
(with-temp-buffer
|
||||
(call-process "wslpath" nil t nil "-m" path)
|
||||
(s-chomp (buffer-string))))
|
||||
((eq system-type 'cygwin)
|
||||
(with-temp-buffer
|
||||
(call-process "cygpath.exe" nil t nil "-w" path)
|
||||
(s-chomp (buffer-string))))
|
||||
(t path)))
|
||||
|
||||
;; Default icon
|
||||
(defvar alert-toast-default-icon
|
||||
(if alert-toast--wsl
|
||||
(alert-toast--default-wsl-icon-path)
|
||||
(concat data-directory "images/icons/hicolor/128x128/apps/emacs.png"))
|
||||
"Path to default icon for toast notifications.")
|
||||
|
||||
;; Common part -- script body, powershell quoting, priorities and main function
|
||||
(defconst alert-toast--psquote-replacements
|
||||
'(("'" . "''")))
|
||||
|
||||
(defcustom alert-toast-priorities
|
||||
'((urgent . "[Windows.UI.Notifications.ToastNotificationPriority]::High")
|
||||
(high . "[Windows.UI.Notifications.ToastNotificationPriority]::High")
|
||||
(moderate . "[Windows.UI.Notifications.ToastNotificationPriority]::Default")
|
||||
(normal . "[Windows.UI.Notifications.ToastNotificationPriority]::Default")
|
||||
(low . "[Windows.UI.Notifications.ToastNotificationPriority]::Default")
|
||||
(trivial . "[Windows.UI.Notifications.ToastNotificationPriority]::Default"))
|
||||
"A mapping of alert severities onto Windows 10 toast priority values."
|
||||
:type '(alist :key-type symbol :value-type string)
|
||||
:group 'alert)
|
||||
|
||||
(defconst alert-toast--sounds
|
||||
'((default . "ms-winsoundevent:Notification.Default")
|
||||
(im . "ms-winsoundevent:Notification.IM")
|
||||
(mail . "ms-winsoundevent:Notification.Mail")
|
||||
(reminder . "ms-winsoundevent:Notification.Reminder")
|
||||
(sms . "ms-winsoundevent:Notification.SMS"))
|
||||
"Alist of available sounds.")
|
||||
|
||||
(defconst alert-toast--looping-sounds
|
||||
(let ((looping-sounds '((call . "ms-winsoundevent:Notification.Looping.Call")
|
||||
(alarm . "ms-winsoundevent:Notification.Looping.Alarm"))))
|
||||
(dolist (i '(2 3 4 5 6 7 8 9 10) looping-sounds)
|
||||
(setq looping-sounds
|
||||
(cons `(,(intern (format "call%d" i)) . ,(format "ms-winsoundevent:Notification.Looping.Call%d" i))
|
||||
looping-sounds))
|
||||
(setq looping-sounds
|
||||
(cons `(,(intern (format "alarm%d" i)) . ,(format "ms-winsoundevent:Notification.Looping.Alarm%d" i))
|
||||
looping-sounds))))
|
||||
"Alist of available looping sounds.")
|
||||
|
||||
(defvar alert-toast--psprocess nil
|
||||
"Persistent powershell process emitting toast notifications.")
|
||||
|
||||
(defun alert-toast--coding-page ()
|
||||
"Get powershell encoding."
|
||||
(with-temp-buffer
|
||||
(let ((coding-system-for-read 'utf-8-dos))
|
||||
(call-process-region "[console]::InputEncoding.BodyName" nil "powershell.exe" nil t nil "-noprofile" "-NonInteractive" "-WindowStyle" "Hidden" "-Command" "-"))
|
||||
(intern-soft (s-chomp (buffer-string)))))
|
||||
|
||||
(defun alert-toast--psprocess-init ()
|
||||
"Initialize powershell process."
|
||||
(setq alert-toast--psprocess
|
||||
(make-process :name "powershell-toast"
|
||||
:buffer "*powershell-toast*"
|
||||
:command '("powershell.exe" "-noprofile" "-NoExit" "-NonInteractive" "-WindowStyle" "Hidden"
|
||||
"-Command" "-")
|
||||
:coding (if alert-toast--wsl 'utf-8 (alert-toast--coding-page))
|
||||
:noquery t
|
||||
:connection-type 'pipe))
|
||||
(process-send-string alert-toast--psprocess "[Windows.UI.Notifications.ToastNotificationManager, Windows.UI.Notifications, ContentType = WindowsRuntime] > $null
|
||||
[Windows.Data.Xml.Dom.XmlDocument, Windows.Data.Xml, ContentType=WindowsRuntime] > $null\n"))
|
||||
|
||||
(defun alert-toast--psprocess-kill ()
|
||||
"Kill powershell process (for debugging)."
|
||||
(delete-process alert-toast--psprocess)
|
||||
(setq alert-toast--psprocess nil))
|
||||
|
||||
(defun alert-toast--fill-template (title message icon-path &optional audio silent long loop)
|
||||
"Create alert toast XML document.
|
||||
|
||||
Set title to TITLE, message body to MESSAGE and icon to the image at ICON-PATH.
|
||||
ICON-PATH has to be a native Windows path, use `alert-toast--icon-path' for
|
||||
Cygwin->native and WSL->native conversion.
|
||||
|
||||
AUDIO can be one of symbols defined in `alert-toast--sounds' or
|
||||
`alert-toast--looping-sounds'. If SILENT is non-nil, the notification is muted.
|
||||
If LONG is non-nil or one of the sounds in `alert-toast--looping-sounds' was
|
||||
provided as AUDIO, then the notification will last for ~20 s; otherwise it lasts
|
||||
for several seconds. Non-nil LOOP will loop the sound."
|
||||
(let ((looping-sound (alist-get audio alert-toast--looping-sounds))
|
||||
(dom
|
||||
(dom-node
|
||||
'toast nil
|
||||
(dom-node
|
||||
'visual nil
|
||||
(dom-node
|
||||
'binding
|
||||
'((template . "ToastImageAndText02"))
|
||||
(dom-node 'text '((id . "1")) title)
|
||||
(dom-node 'text '((id . "2")) message)
|
||||
(dom-node 'image `((id . "1")
|
||||
(src . ,icon-path)
|
||||
(placement . "appLogoOverride"))))))))
|
||||
(when (or audio silent loop)
|
||||
(dom-append-child
|
||||
dom (dom-node 'audio `((src . ,(or looping-sound
|
||||
(alist-get audio alert-toast--sounds)
|
||||
(alist-get 'default alert-toast--sounds)))
|
||||
(silent . ,(if silent "true" "false"))
|
||||
(loop . ,(if (or loop looping-sound) "true" "false"))))))
|
||||
(when (or long looping-sound)
|
||||
(dom-set-attribute dom 'duration "long"))
|
||||
(shr-dom-to-xml dom)))
|
||||
|
||||
(defun alert-toast--fill-shoulder (title message icon-path person payload)
|
||||
"Create shoulder tap XML document.
|
||||
|
||||
PERSON is an email address given as 'mailto:login@domain.com' of a contact
|
||||
previously added to My People. PAYLOAD is either remote http or local path to a
|
||||
GIF or PNG image. Under WSL and Cygwin, local paths need to be converted to
|
||||
native Windows paths with `alert-toast--icon-path'.
|
||||
|
||||
As a fallback, set title to TITLE, message body to MESSAGE and icon to the image
|
||||
at ICON-PATH. ICON-PATH has to be a native Windows path, use
|
||||
`alert-toast--icon-path' for Cygwin->native and WSL->native conversion."
|
||||
(let ((dom
|
||||
(dom-node 'toast
|
||||
`((hint-people . ,person))
|
||||
(dom-node 'visual nil
|
||||
(dom-node 'binding '((template . "ToastGeneric"))
|
||||
(dom-node 'text nil title)
|
||||
(dom-node 'text nil message)
|
||||
(dom-node 'image `((src . ,icon-path)
|
||||
(placement . "appLogoOverride")
|
||||
(hint-crop . "circle"))))
|
||||
(dom-node 'binding '((template . "ToastGeneric")
|
||||
(experienceType . "shoulderTap"))
|
||||
(dom-node 'image `((src . ,payload))))))))
|
||||
(shr-dom-to-xml dom)))
|
||||
|
||||
(defconst alert-toast--psscript-text "$Xml = New-Object Windows.Data.Xml.Dom.XmlDocument
|
||||
$Xml.LoadXml('%s')
|
||||
|
||||
$Toast = [Windows.UI.Notifications.ToastNotification]::new($Xml)
|
||||
$Toast.Tag = \"Emacs\"
|
||||
$Toast.Group = \"Emacs\"
|
||||
$Toast.Priority = %s
|
||||
$Toast.ExpirationTime = [DateTimeOffset]::Now.AddSeconds(%f)
|
||||
|
||||
$Notifier = [Windows.UI.Notifications.ToastNotificationManager]::CreateToastNotifier(\"Emacs\")
|
||||
$Notifier.Show($Toast);\n"
|
||||
"Template of Powershell script emitting regular toast notification.")
|
||||
|
||||
(defconst alert-toast--psscript-shoulder "$Xml = New-Object Windows.Data.Xml.Dom.XmlDocument
|
||||
$Xml.LoadXml('%s')
|
||||
|
||||
$Toast = [Windows.UI.Notifications.ToastNotification]::new($Xml)
|
||||
|
||||
$Notifier = [Windows.UI.Notifications.ToastNotificationManager]::CreateToastNotifier('Microsoft.People_8wekyb3d8bbwe!x4c7a3b7dy2188y46d4ya362y19ac5a5805e5x')
|
||||
$Notifier.Show($Toast);\n"
|
||||
"Template of Powershell script emitting shoulder tap.")
|
||||
|
||||
;;;###autoload
|
||||
(defun alert-toast-notify (info)
|
||||
"Send INFO using Windows 10 toast notification.
|
||||
Handles :ICON, :SEVERITY, :PERSISTENT, :NEVER-PERSIST, :TITLE and
|
||||
:MESSAGE keywords from INFO plist."
|
||||
(let ((data-plist (plist-get info :data))
|
||||
psscript)
|
||||
(if (and (plist-get data-plist :shoulder-person) (plist-get data-plist :shoulder-payload))
|
||||
(setq psscript (format alert-toast--psscript-shoulder
|
||||
(s-replace-all alert-toast--psquote-replacements
|
||||
(alert-toast--fill-shoulder
|
||||
(plist-get info :title)
|
||||
(plist-get info :message)
|
||||
(alert-toast--icon-path
|
||||
(or (plist-get info :icon)
|
||||
alert-toast-default-icon))
|
||||
(plist-get data-plist :shoulder-person)
|
||||
(plist-get data-plist :shoulder-payload)))))
|
||||
(setq psscript
|
||||
(format alert-toast--psscript-text
|
||||
(s-replace-all alert-toast--psquote-replacements
|
||||
(alert-toast--fill-template
|
||||
(plist-get info :title)
|
||||
(plist-get info :message)
|
||||
(alert-toast--icon-path (or (plist-get info :icon) alert-toast-default-icon))
|
||||
(plist-get data-plist :audio)
|
||||
(plist-get data-plist :silent)
|
||||
(plist-get data-plist :long)
|
||||
(plist-get data-plist :loop)))
|
||||
(or (cdr (assq (plist-get info :severity) alert-toast-priorities))
|
||||
(cdr (assq 'normal alert-toast-priorities)))
|
||||
(if (and (plist-get info :persistent)
|
||||
(not (plist-get info :never-persist)))
|
||||
(* 60 60 24 7) ; a week
|
||||
alert-fade-time))))
|
||||
(unless alert-toast--psprocess
|
||||
(alert-toast--psprocess-init))
|
||||
(process-send-string alert-toast--psprocess psscript)))
|
||||
|
||||
(alert-define-style 'toast :title "Windows 10 toast notification"
|
||||
:notifier #'alert-toast-notify)
|
||||
|
||||
(when alert-toast--wsl
|
||||
(alert-toast--init-wsl-icon))
|
||||
|
||||
(provide 'alert-toast)
|
||||
;;; alert-toast.el ends here
|
||||
|
|
@ -1,70 +0,0 @@
|
|||
;;; all-the-icons-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 all-the-icons.el
|
||||
|
||||
(autoload 'all-the-icons-icon-for-dir "all-the-icons" "\
|
||||
Get the formatted icon for DIR.
|
||||
ARG-OVERRIDES should be a plist containining `:height',
|
||||
`:v-adjust' or `:face' properties like in the normal icon
|
||||
inserting functions.
|
||||
|
||||
Note: You want chevron, please use `all-the-icons-icon-for-dir-with-chevron'.
|
||||
|
||||
(fn DIR &rest ARG-OVERRIDES)")
|
||||
(autoload 'all-the-icons-icon-for-file "all-the-icons" "\
|
||||
Get the formatted icon for FILE.
|
||||
ARG-OVERRIDES should be a plist containining `:height',
|
||||
`:v-adjust' or `:face' properties like in the normal icon
|
||||
inserting functions.
|
||||
|
||||
(fn FILE &rest ARG-OVERRIDES)")
|
||||
(autoload 'all-the-icons-icon-for-mode "all-the-icons" "\
|
||||
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.
|
||||
|
||||
(fn MODE &rest ARG-OVERRIDES)")
|
||||
(autoload 'all-the-icons-icon-for-url "all-the-icons" "\
|
||||
Get the formatted icon for URL.
|
||||
If an icon for URL isn't found in `all-the-icons-url-alist', a globe is used.
|
||||
ARG-OVERRIDES should be a plist containining `:height',
|
||||
`:v-adjust' or `:face' properties like in the normal icon
|
||||
inserting functions.
|
||||
|
||||
(fn URL &rest ARG-OVERRIDES)")
|
||||
(autoload 'all-the-icons-install-fonts "all-the-icons" "\
|
||||
Helper function to download and install the latests fonts based on OS.
|
||||
When PFX is non-nil, ignore the prompt and just install
|
||||
|
||||
(fn &optional PFX)" t)
|
||||
(autoload 'all-the-icons-insert "all-the-icons" "\
|
||||
Interactive icon insertion function.
|
||||
When Prefix ARG is non-nil, insert the propertized icon.
|
||||
When FAMILY is non-nil, limit the candidates to the icon set matching it.
|
||||
|
||||
(fn &optional ARG FAMILY)" t)
|
||||
(register-definition-prefixes "all-the-icons" '("all-the-icons-"))
|
||||
|
||||
;;; End of scraped data
|
||||
|
||||
(provide 'all-the-icons-autoloads)
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; no-native-compile: t
|
||||
;; coding: utf-8-emacs-unix
|
||||
;; End:
|
||||
|
||||
;;; all-the-icons-autoloads.el ends here
|
||||
|
|
@ -1,230 +0,0 @@
|
|||
;;; all-the-icons-faces.el --- A module of faces for all-the-icons
|
||||
|
||||
;; Copyright (C) 2016 Dominic Charlesworth <dgc336@gmail.com>
|
||||
|
||||
;; Author: Dominic Charlesworth <dgc336@gmail.com>
|
||||
;; Version: 1.0.0
|
||||
;; Package-Requires: ((emacs "24.3"))
|
||||
;; URL: https://github.com/domtronn/all-the-icons.el
|
||||
;; Keywords: convenient, lisp
|
||||
|
||||
;; 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:
|
||||
|
||||
;; This file contains all of the faces used by the package for
|
||||
;; colouring icons
|
||||
|
||||
;;; Code:
|
||||
|
||||
(defgroup all-the-icons-faces nil
|
||||
"Manage how All The Icons icons are coloured and themed."
|
||||
:prefix "all-the-icons-"
|
||||
:group 'tools
|
||||
:group 'all-the-icons)
|
||||
|
||||
|
||||
;; red
|
||||
(defface all-the-icons-red
|
||||
'((((background dark)) :foreground "#AC4142")
|
||||
(((background light)) :foreground "#AC4142"))
|
||||
"Face for red icons"
|
||||
:group 'all-the-icons-faces)
|
||||
(defface all-the-icons-lred
|
||||
'((((background dark)) :foreground "#EB595A")
|
||||
(((background light)) :foreground "#EB595A"))
|
||||
"Face for lred icons"
|
||||
:group 'all-the-icons-faces)
|
||||
(defface all-the-icons-dred
|
||||
'((((background dark)) :foreground "#843031")
|
||||
(((background light)) :foreground "#843031"))
|
||||
"Face for dred icons"
|
||||
:group 'all-the-icons-faces)
|
||||
(defface all-the-icons-red-alt
|
||||
'((((background dark)) :foreground "#ce5643")
|
||||
(((background light)) :foreground "#843031"))
|
||||
"Face for dred icons"
|
||||
:group 'all-the-icons-faces)
|
||||
|
||||
;; green
|
||||
(defface all-the-icons-green
|
||||
'((((background dark)) :foreground "#90A959")
|
||||
(((background light)) :foreground "#90A959"))
|
||||
"Face for green icons"
|
||||
:group 'all-the-icons-faces)
|
||||
(defface all-the-icons-lgreen
|
||||
'((((background dark)) :foreground "#C6E87A")
|
||||
(((background light)) :foreground "#3D6837"))
|
||||
"Face for lgreen icons"
|
||||
:group 'all-the-icons-faces)
|
||||
(defface all-the-icons-dgreen
|
||||
'((((background dark)) :foreground "#6D8143")
|
||||
(((background light)) :foreground "#6D8143"))
|
||||
"Face for dgreen icons"
|
||||
:group 'all-the-icons-faces)
|
||||
|
||||
;; yellow
|
||||
(defface all-the-icons-yellow
|
||||
'((((background dark)) :foreground "#FFD446")
|
||||
(((background light)) :foreground "#FFCC0E"))
|
||||
"Face for yellow icons"
|
||||
:group 'all-the-icons-faces)
|
||||
(defface all-the-icons-lyellow
|
||||
'((((background dark)) :foreground "#FFC16D")
|
||||
(((background light)) :foreground "#FF9300"))
|
||||
"Face for lyellow icons"
|
||||
:group 'all-the-icons-faces)
|
||||
(defface all-the-icons-dyellow
|
||||
'((((background dark)) :foreground "#B48D56")
|
||||
(((background light)) :foreground "#B48D56"))
|
||||
"Face for dyellow icons"
|
||||
:group 'all-the-icons-faces)
|
||||
|
||||
;; blue
|
||||
(defface all-the-icons-blue
|
||||
'((((background dark)) :foreground "#6A9FB5")
|
||||
(((background light)) :foreground "#6A9FB5"))
|
||||
"Face for blue icons"
|
||||
:group 'all-the-icons-faces)
|
||||
(defface all-the-icons-blue-alt
|
||||
'((((background dark)) :foreground "#2188b6")
|
||||
(((background light)) :foreground "#2188b6"))
|
||||
"Face for blue icons"
|
||||
:group 'all-the-icons-faces)
|
||||
(defface all-the-icons-lblue
|
||||
'((((background dark)) :foreground "#8FD7F4")
|
||||
(((background light)) :foreground "#677174"))
|
||||
"Face for lblue icons"
|
||||
:group 'all-the-icons-faces)
|
||||
(defface all-the-icons-dblue
|
||||
'((((background dark)) :foreground "#446674")
|
||||
(((background light)) :foreground "#446674"))
|
||||
"Face for dblue icons"
|
||||
:group 'all-the-icons-faces)
|
||||
|
||||
;; maroon
|
||||
(defface all-the-icons-maroon
|
||||
'((((background dark)) :foreground "#8F5536")
|
||||
(((background light)) :foreground "#8F5536"))
|
||||
"Face for maroon icons"
|
||||
:group 'all-the-icons-faces)
|
||||
(defface all-the-icons-lmaroon
|
||||
'((((background dark)) :foreground "#CE7A4E")
|
||||
(((background light)) :foreground "#CE7A4E"))
|
||||
"Face for lmaroon icons"
|
||||
:group 'all-the-icons-faces)
|
||||
(defface all-the-icons-dmaroon
|
||||
'((((background dark)) :foreground "#72584B")
|
||||
(((background light)) :foreground "#72584B"))
|
||||
"Face for dmaroon icons"
|
||||
:group 'all-the-icons-faces)
|
||||
|
||||
;; purple
|
||||
(defface all-the-icons-purple
|
||||
'((((background dark)) :foreground "#AA759F")
|
||||
(((background light)) :foreground "#68295B"))
|
||||
"Face for purple icons"
|
||||
:group 'all-the-icons-faces)
|
||||
(defface all-the-icons-purple-alt
|
||||
'((((background dark)) :foreground "#5D54E1")
|
||||
(((background light)) :foreground "#5D54E1"))
|
||||
"Face for purple icons"
|
||||
:group 'all-the-icons-faces)
|
||||
(defface all-the-icons-lpurple
|
||||
'((((background dark)) :foreground "#E69DD6")
|
||||
(((background light)) :foreground "#E69DD6"))
|
||||
"Face for lpurple icons"
|
||||
:group 'all-the-icons-faces)
|
||||
(defface all-the-icons-dpurple
|
||||
'((((background dark)) :foreground "#694863")
|
||||
(((background light)) :foreground "#694863"))
|
||||
"Face for dpurple icons"
|
||||
:group 'all-the-icons-faces)
|
||||
|
||||
;; orange
|
||||
(defface all-the-icons-orange
|
||||
'((((background dark)) :foreground "#D4843E")
|
||||
(((background light)) :foreground "#D4843E"))
|
||||
"Face for orange icons"
|
||||
:group 'all-the-icons-faces)
|
||||
(defface all-the-icons-lorange
|
||||
'((((background dark)) :foreground "#FFA500")
|
||||
(((background light)) :foreground "#FFA500"))
|
||||
"Face for lorange icons"
|
||||
:group 'all-the-icons-faces)
|
||||
(defface all-the-icons-dorange
|
||||
'((((background dark)) :foreground "#915B2D")
|
||||
(((background light)) :foreground "#915B2D"))
|
||||
"Face for dorange icons"
|
||||
:group 'all-the-icons-faces)
|
||||
|
||||
;; cyan
|
||||
(defface all-the-icons-cyan
|
||||
'((((background dark)) :foreground "#75B5AA")
|
||||
(((background light)) :foreground "#75B5AA"))
|
||||
"Face for cyan icons"
|
||||
:group 'all-the-icons-faces)
|
||||
(defface all-the-icons-cyan-alt
|
||||
'((((background dark)) :foreground "#61dafb")
|
||||
(((background light)) :foreground "#0595bd"))
|
||||
"Face for cyan icons"
|
||||
:group 'all-the-icons-faces)
|
||||
(defface all-the-icons-lcyan
|
||||
'((((background dark)) :foreground "#A5FDEC")
|
||||
(((background light)) :foreground "#2C7D6E"))
|
||||
"Face for lcyan icons"
|
||||
:group 'all-the-icons-faces)
|
||||
(defface all-the-icons-dcyan
|
||||
'((((background dark)) :foreground "#48746D")
|
||||
(((background light)) :foreground "#48746D"))
|
||||
"Face for dcyan icons"
|
||||
:group 'all-the-icons-faces)
|
||||
|
||||
;; pink
|
||||
(defface all-the-icons-pink
|
||||
'((((background dark)) :foreground "#F2B4B8")
|
||||
(((background light)) :foreground "#FC505B"))
|
||||
"Face for pink icons"
|
||||
:group 'all-the-icons-faces)
|
||||
(defface all-the-icons-lpink
|
||||
'((((background dark)) :foreground "#FFBDC1")
|
||||
(((background light)) :foreground "#FF505B"))
|
||||
"Face for lpink icons"
|
||||
:group 'all-the-icons-faces)
|
||||
(defface all-the-icons-dpink
|
||||
'((((background dark)) :foreground "#B18286")
|
||||
(((background light)) :foreground "#7E5D5F"))
|
||||
"Face for dpink icons"
|
||||
:group 'all-the-icons-faces)
|
||||
|
||||
;; silver
|
||||
(defface all-the-icons-silver
|
||||
'((((background dark)) :foreground "#716E68")
|
||||
(((background light)) :foreground "#716E68"))
|
||||
"Face for silver icons"
|
||||
:group 'all-the-icons-faces)
|
||||
(defface all-the-icons-lsilver
|
||||
'((((background dark)) :foreground "#B9B6AA")
|
||||
(((background light)) :foreground "#7F7869"))
|
||||
"Face for lsilver icons"
|
||||
:group 'all-the-icons-faces)
|
||||
(defface all-the-icons-dsilver
|
||||
'((((background dark)) :foreground "#838484")
|
||||
(((background light)) :foreground "#838484"))
|
||||
"Face for dsilver icons"
|
||||
:group 'all-the-icons-faces)
|
||||
|
||||
|
||||
(provide 'all-the-icons-faces)
|
||||
;;; all-the-icons-faces.el ends here
|
||||
|
|
@ -1,14 +0,0 @@
|
|||
(define-package "all-the-icons" "20240623.1800" "A library for inserting Developer icons"
|
||||
'((emacs "24.3"))
|
||||
:commit "39ef44f810c34e8900978788467cc675870bcd19" :authors
|
||||
'(("Dominic Charlesworth" . "dgc336@gmail.com"))
|
||||
:maintainers
|
||||
'(("Dominic Charlesworth" . "dgc336@gmail.com"))
|
||||
:maintainer
|
||||
'("Dominic Charlesworth" . "dgc336@gmail.com")
|
||||
:keywords
|
||||
'("convenient" "lisp")
|
||||
:url "https://github.com/domtronn/all-the-icons.el")
|
||||
;; Local Variables:
|
||||
;; no-byte-compile: t
|
||||
;; End:
|
||||
File diff suppressed because it is too large
Load diff
|
|
@ -1,70 +0,0 @@
|
|||
(defvar all-the-icons-data/alltheicons-alist
|
||||
'(
|
||||
|
||||
( "apache" . "\xe909" )
|
||||
( "atom" . "\xe917" )
|
||||
( "aws" . "\xe90c" )
|
||||
( "bower" . "\xe918" )
|
||||
( "c" . "\xe915" )
|
||||
( "c-line" . "\xe90f" )
|
||||
( "clojure" . "\xe919" )
|
||||
( "clojure-line" . "\xe91a" )
|
||||
( "coffeescript" . "\xe914" )
|
||||
( "cplusplus" . "\xe913" )
|
||||
( "cplusplus-line" . "\xe910" )
|
||||
( "csharp" . "\xe911" )
|
||||
( "csharp-line" . "\xe912" )
|
||||
( "css3" . "\xe91b" )
|
||||
( "css3-alt" . "\xe91c" )
|
||||
( "d3" . "\xe90e" )
|
||||
( "dlang" . "\xe935" )
|
||||
( "elixir" . "\xe936" )
|
||||
( "erlang" . "\xe934" )
|
||||
( "git" . "\xe907" )
|
||||
( "go" . "\xe91d" )
|
||||
( "google-drive" . "\xe91e" )
|
||||
( "grunt" . "\xe90d" )
|
||||
( "grunt-line" . "\xe91f" )
|
||||
( "gulp" . "\xe920" )
|
||||
( "haskell" . "\xe921" )
|
||||
( "html5" . "\xe932" )
|
||||
( "jasmine" . "\xe904" )
|
||||
( "java" . "\xe922" )
|
||||
( "javascript" . "\xe906" )
|
||||
( "javascript-badge" . "\xe923" )
|
||||
( "javascript-shield" . "\xe924" )
|
||||
( "less" . "\xe90b" )
|
||||
( "nginx" . "\xe933" )
|
||||
( "nodejs" . "\xe925" )
|
||||
( "perl" . "\xe905" )
|
||||
( "perldocs" . "\xe926" )
|
||||
( "postgresql" . "\xe938" )
|
||||
( "prolog" . "\xe927" )
|
||||
( "python" . "\xe928" )
|
||||
( "react" . "\xe929" )
|
||||
( "ruby" . "\xe92a" )
|
||||
( "ruby-alt" . "\xe92b" )
|
||||
( "rust" . "\xe92c" )
|
||||
( "sass" . "\xe92d" )
|
||||
( "scala" . "\xe908" )
|
||||
( "script" . "\xe90a" )
|
||||
( "spring" . "\xe937" )
|
||||
( "stylus" . "\xe92e" )
|
||||
( "svg" . "\xe903" )
|
||||
( "swift" . "\xe92f" )
|
||||
( "terminal" . "\xe930" )
|
||||
( "terminal-alt" . "\xe931" )
|
||||
( "battery-charging" . "\xe939" )
|
||||
|
||||
( "arrow-left" . "\xe93a" )
|
||||
( "arrow-right" . "\xe93b" )
|
||||
( "cup-left" . "\xe93c" )
|
||||
( "cup-right" . "\xe93d" )
|
||||
( "slant-left" . "\xe93e" )
|
||||
( "slant-right" . "\xe93f" )
|
||||
( "wave-left" . "\xe940" )
|
||||
( "wave-right" . "\xe941" )
|
||||
|
||||
))
|
||||
|
||||
(provide 'data-alltheicons)
|
||||
|
|
@ -1,641 +0,0 @@
|
|||
(defvar all-the-icons-data/fa-icon-alist
|
||||
'(
|
||||
|
||||
("500px" . "\xf26e")
|
||||
("adjust" . "\xf042")
|
||||
("adn" . "\xf170")
|
||||
("align-center" . "\xf037")
|
||||
("align-justify" . "\xf039")
|
||||
("align-left" . "\xf036")
|
||||
("align-right" . "\xf038")
|
||||
("amazon" . "\xf270")
|
||||
("ambulance" . "\xf0f9")
|
||||
("american-sign-language-interpreting" . "\xf2a3")
|
||||
("anchor" . "\xf13d")
|
||||
("android" . "\xf17b")
|
||||
("angellist" . "\xf209")
|
||||
("angle-double-down" . "\xf103")
|
||||
("angle-double-left" . "\xf100")
|
||||
("angle-double-right" . "\xf101")
|
||||
("angle-double-up" . "\xf102")
|
||||
("angle-down" . "\xf107")
|
||||
("angle-left" . "\xf104")
|
||||
("angle-right" . "\xf105")
|
||||
("angle-up" . "\xf106")
|
||||
("apple" . "\xf179")
|
||||
("archive" . "\xf187")
|
||||
("area-chart" . "\xf1fe")
|
||||
("arrow-circle-down" . "\xf0ab")
|
||||
("arrow-circle-left" . "\xf0a8")
|
||||
("arrow-circle-o-down" . "\xf01a")
|
||||
("arrow-circle-o-left" . "\xf190")
|
||||
("arrow-circle-o-right" . "\xf18e")
|
||||
("arrow-circle-o-up" . "\xf01b")
|
||||
("arrow-circle-right" . "\xf0a9")
|
||||
("arrow-circle-up" . "\xf0aa")
|
||||
("arrow-down" . "\xf063")
|
||||
("arrow-left" . "\xf060")
|
||||
("arrow-right" . "\xf061")
|
||||
("arrow-up" . "\xf062")
|
||||
("arrows" . "\xf047")
|
||||
("arrows-alt" . "\xf0b2")
|
||||
("arrows-h" . "\xf07e")
|
||||
("arrows-v" . "\xf07d")
|
||||
("assistive-listening-systems" . "\xf2a2")
|
||||
("asterisk" . "\xf069")
|
||||
("at" . "\xf1fa")
|
||||
("audio-description" . "\xf29e")
|
||||
("backward" . "\xf04a")
|
||||
("balance-scale" . "\xf24e")
|
||||
("ban" . "\xf05e")
|
||||
("bar-chart" . "\xf080")
|
||||
("barcode" . "\xf02a")
|
||||
("bars" . "\xf0c9")
|
||||
("battery-empty" . "\xf244")
|
||||
("battery-full" . "\xf240")
|
||||
("battery-half" . "\xf242")
|
||||
("battery-quarter" . "\xf243")
|
||||
("battery-three-quarters" . "\xf241")
|
||||
("bed" . "\xf236")
|
||||
("beer" . "\xf0fc")
|
||||
("behance" . "\xf1b4")
|
||||
("behance-square" . "\xf1b5")
|
||||
("bell" . "\xf0f3")
|
||||
("bell-o" . "\xf0a2")
|
||||
("bell-slash" . "\xf1f6")
|
||||
("bell-slash-o" . "\xf1f7")
|
||||
("bicycle" . "\xf206")
|
||||
("binoculars" . "\xf1e5")
|
||||
("birthday-cake" . "\xf1fd")
|
||||
("bitbucket" . "\xf171")
|
||||
("bitbucket-square" . "\xf172")
|
||||
("black-tie" . "\xf27e")
|
||||
("blind" . "\xf29d")
|
||||
("bluetooth" . "\xf293")
|
||||
("bluetooth-b" . "\xf294")
|
||||
("bold" . "\xf032")
|
||||
("bolt" . "\xf0e7")
|
||||
("bomb" . "\xf1e2")
|
||||
("book" . "\xf02d")
|
||||
("bookmark" . "\xf02e")
|
||||
("bookmark-o" . "\xf097")
|
||||
("braille" . "\xf2a1")
|
||||
("briefcase" . "\xf0b1")
|
||||
("btc" . "\xf15a")
|
||||
("bug" . "\xf188")
|
||||
("building" . "\xf1ad")
|
||||
("building-o" . "\xf0f7")
|
||||
("bullhorn" . "\xf0a1")
|
||||
("bullseye" . "\xf140")
|
||||
("bus" . "\xf207")
|
||||
("buysellads" . "\xf20d")
|
||||
("calculator" . "\xf1ec")
|
||||
("calendar" . "\xf073")
|
||||
("calendar-check-o" . "\xf274")
|
||||
("calendar-minus-o" . "\xf272")
|
||||
("calendar-o" . "\xf133")
|
||||
("calendar-plus-o" . "\xf271")
|
||||
("calendar-times-o" . "\xf273")
|
||||
("camera" . "\xf030")
|
||||
("camera-retro" . "\xf083")
|
||||
("car" . "\xf1b9")
|
||||
("caret-down" . "\xf0d7")
|
||||
("caret-left" . "\xf0d9")
|
||||
("caret-right" . "\xf0da")
|
||||
("caret-square-o-down" . "\xf150")
|
||||
("caret-square-o-left" . "\xf191")
|
||||
("caret-square-o-right" . "\xf152")
|
||||
("caret-square-o-up" . "\xf151")
|
||||
("caret-up" . "\xf0d8")
|
||||
("cart-arrow-down" . "\xf218")
|
||||
("cart-plus" . "\xf217")
|
||||
("cc" . "\xf20a")
|
||||
("cc-amex" . "\xf1f3")
|
||||
("cc-diners-club" . "\xf24c")
|
||||
("cc-discover" . "\xf1f2")
|
||||
("cc-jcb" . "\xf24b")
|
||||
("cc-mastercard" . "\xf1f1")
|
||||
("cc-paypal" . "\xf1f4")
|
||||
("cc-stripe" . "\xf1f5")
|
||||
("cc-visa" . "\xf1f0")
|
||||
("certificate" . "\xf0a3")
|
||||
("chain-broken" . "\xf127")
|
||||
("check" . "\xf00c")
|
||||
("check-circle" . "\xf058")
|
||||
("check-circle-o" . "\xf05d")
|
||||
("check-square" . "\xf14a")
|
||||
("check-square-o" . "\xf046")
|
||||
("chevron-circle-down" . "\xf13a")
|
||||
("chevron-circle-left" . "\xf137")
|
||||
("chevron-circle-right" . "\xf138")
|
||||
("chevron-circle-up" . "\xf139")
|
||||
("chevron-down" . "\xf078")
|
||||
("chevron-left" . "\xf053")
|
||||
("chevron-right" . "\xf054")
|
||||
("chevron-up" . "\xf077")
|
||||
("child" . "\xf1ae")
|
||||
("chrome" . "\xf268")
|
||||
("circle" . "\xf111")
|
||||
("circle-o" . "\xf10c")
|
||||
("circle-o-notch" . "\xf1ce")
|
||||
("circle-thin" . "\xf1db")
|
||||
("clipboard" . "\xf0ea")
|
||||
("clock-o" . "\xf017")
|
||||
("clone" . "\xf24d")
|
||||
("cloud" . "\xf0c2")
|
||||
("cloud-download" . "\xf0ed")
|
||||
("cloud-upload" . "\xf0ee")
|
||||
("code" . "\xf121")
|
||||
("code-fork" . "\xf126")
|
||||
("codepen" . "\xf1cb")
|
||||
("codiepie" . "\xf284")
|
||||
("coffee" . "\xf0f4")
|
||||
("cog" . "\xf013")
|
||||
("cogs" . "\xf085")
|
||||
("columns" . "\xf0db")
|
||||
("comment" . "\xf075")
|
||||
("comment-o" . "\xf0e5")
|
||||
("commenting" . "\xf27a")
|
||||
("commenting-o" . "\xf27b")
|
||||
("comments" . "\xf086")
|
||||
("comments-o" . "\xf0e6")
|
||||
("compass" . "\xf14e")
|
||||
("compress" . "\xf066")
|
||||
("connectdevelop" . "\xf20e")
|
||||
("contao" . "\xf26d")
|
||||
("copyright" . "\xf1f9")
|
||||
("creative-commons" . "\xf25e")
|
||||
("credit-card" . "\xf09d")
|
||||
("credit-card-alt" . "\xf283")
|
||||
("crop" . "\xf125")
|
||||
("crosshairs" . "\xf05b")
|
||||
("css3" . "\xf13c")
|
||||
("cube" . "\xf1b2")
|
||||
("cubes" . "\xf1b3")
|
||||
("cutlery" . "\xf0f5")
|
||||
("dashcube" . "\xf210")
|
||||
("database" . "\xf1c0")
|
||||
("deaf" . "\xf2a4")
|
||||
("delicious" . "\xf1a5")
|
||||
("desktop" . "\xf108")
|
||||
("deviantart" . "\xf1bd")
|
||||
("diamond" . "\xf219")
|
||||
("digg" . "\xf1a6")
|
||||
("dot-circle-o" . "\xf192")
|
||||
("download" . "\xf019")
|
||||
("dribbble" . "\xf17d")
|
||||
("dropbox" . "\xf16b")
|
||||
("drupal" . "\xf1a9")
|
||||
("edge" . "\xf282")
|
||||
("eject" . "\xf052")
|
||||
("ellipsis-h" . "\xf141")
|
||||
("ellipsis-v" . "\xf142")
|
||||
("empire" . "\xf1d1")
|
||||
("envelope" . "\xf0e0")
|
||||
("envelope-o" . "\xf003")
|
||||
("envelope-square" . "\xf199")
|
||||
("envira" . "\xf299")
|
||||
("eraser" . "\xf12d")
|
||||
("eur" . "\xf153")
|
||||
("exchange" . "\xf0ec")
|
||||
("exclamation" . "\xf12a")
|
||||
("exclamation-circle" . "\xf06a")
|
||||
("exclamation-triangle" . "\xf071")
|
||||
("expand" . "\xf065")
|
||||
("expeditedssl" . "\xf23e")
|
||||
("external-link" . "\xf08e")
|
||||
("external-link-square" . "\xf14c")
|
||||
("eye" . "\xf06e")
|
||||
("eye-slash" . "\xf070")
|
||||
("eyedropper" . "\xf1fb")
|
||||
("facebook" . "\xf09a")
|
||||
("facebook-official" . "\xf230")
|
||||
("facebook-square" . "\xf082")
|
||||
("fast-backward" . "\xf049")
|
||||
("fast-forward" . "\xf050")
|
||||
("fax" . "\xf1ac")
|
||||
("female" . "\xf182")
|
||||
("fighter-jet" . "\xf0fb")
|
||||
("file" . "\xf15b")
|
||||
("file-archive-o" . "\xf1c6")
|
||||
("file-audio-o" . "\xf1c7")
|
||||
("file-code-o" . "\xf1c9")
|
||||
("file-excel-o" . "\xf1c3")
|
||||
("file-image-o" . "\xf1c5")
|
||||
("file-o" . "\xf016")
|
||||
("file-pdf-o" . "\xf1c1")
|
||||
("file-powerpoint-o" . "\xf1c4")
|
||||
("file-text" . "\xf15c")
|
||||
("file-text-o" . "\xf0f6")
|
||||
("file-video-o" . "\xf1c8")
|
||||
("file-word-o" . "\xf1c2")
|
||||
("files-o" . "\xf0c5")
|
||||
("film" . "\xf008")
|
||||
("filter" . "\xf0b0")
|
||||
("fire" . "\xf06d")
|
||||
("fire-extinguisher" . "\xf134")
|
||||
("firefox" . "\xf269")
|
||||
("first-order" . "\xf2b0")
|
||||
("flag" . "\xf024")
|
||||
("flag-checkered" . "\xf11e")
|
||||
("flag-o" . "\xf11d")
|
||||
("flask" . "\xf0c3")
|
||||
("flickr" . "\xf16e")
|
||||
("floppy-o" . "\xf0c7")
|
||||
("folder" . "\xf07b")
|
||||
("folder-o" . "\xf114")
|
||||
("folder-open" . "\xf07c")
|
||||
("folder-open-o" . "\xf115")
|
||||
("font" . "\xf031")
|
||||
("font-awesome" . "\xf2b4")
|
||||
("fonticons" . "\xf280")
|
||||
("fort-awesome" . "\xf286")
|
||||
("forumbee" . "\xf211")
|
||||
("forward" . "\xf04e")
|
||||
("foursquare" . "\xf180")
|
||||
("frown-o" . "\xf119")
|
||||
("futbol-o" . "\xf1e3")
|
||||
("gamepad" . "\xf11b")
|
||||
("gavel" . "\xf0e3")
|
||||
("gbp" . "\xf154")
|
||||
("genderless" . "\xf22d")
|
||||
("get-pocket" . "\xf265")
|
||||
("gg" . "\xf260")
|
||||
("gg-circle" . "\xf261")
|
||||
("gift" . "\xf06b")
|
||||
("git" . "\xf1d3")
|
||||
("git-square" . "\xf1d2")
|
||||
("github" . "\xf09b")
|
||||
("github-alt" . "\xf113")
|
||||
("github-square" . "\xf092")
|
||||
("gitlab" . "\xf296")
|
||||
("glass" . "\xf000")
|
||||
("glide" . "\xf2a5")
|
||||
("glide-g" . "\xf2a6")
|
||||
("globe" . "\xf0ac")
|
||||
("google" . "\xf1a0")
|
||||
("google-plus" . "\xf0d5")
|
||||
("google-plus-official" . "\xf2b3")
|
||||
("google-plus-square" . "\xf0d4")
|
||||
("google-wallet" . "\xf1ee")
|
||||
("graduation-cap" . "\xf19d")
|
||||
("gratipay" . "\xf184")
|
||||
("h-square" . "\xf0fd")
|
||||
("hacker-news" . "\xf1d4")
|
||||
("hand-lizard-o" . "\xf258")
|
||||
("hand-o-down" . "\xf0a7")
|
||||
("hand-o-left" . "\xf0a5")
|
||||
("hand-o-right" . "\xf0a4")
|
||||
("hand-o-up" . "\xf0a6")
|
||||
("hand-paper-o" . "\xf256")
|
||||
("hand-peace-o" . "\xf25b")
|
||||
("hand-pointer-o" . "\xf25a")
|
||||
("hand-rock-o" . "\xf255")
|
||||
("hand-scissors-o" . "\xf257")
|
||||
("hand-spock-o" . "\xf259")
|
||||
("hashtag" . "\xf292")
|
||||
("hdd-o" . "\xf0a0")
|
||||
("header" . "\xf1dc")
|
||||
("headphones" . "\xf025")
|
||||
("heart" . "\xf004")
|
||||
("heart-o" . "\xf08a")
|
||||
("heartbeat" . "\xf21e")
|
||||
("history" . "\xf1da")
|
||||
("home" . "\xf015")
|
||||
("hospital-o" . "\xf0f8")
|
||||
("hourglass" . "\xf254")
|
||||
("hourglass-end" . "\xf253")
|
||||
("hourglass-half" . "\xf252")
|
||||
("hourglass-o" . "\xf250")
|
||||
("hourglass-start" . "\xf251")
|
||||
("houzz" . "\xf27c")
|
||||
("html5" . "\xf13b")
|
||||
("i-cursor" . "\xf246")
|
||||
("ils" . "\xf20b")
|
||||
("inbox" . "\xf01c")
|
||||
("indent" . "\xf03c")
|
||||
("industry" . "\xf275")
|
||||
("info" . "\xf129")
|
||||
("info-circle" . "\xf05a")
|
||||
("inr" . "\xf156")
|
||||
("instagram" . "\xf16d")
|
||||
("internet-explorer" . "\xf26b")
|
||||
("ioxhost" . "\xf208")
|
||||
("italic" . "\xf033")
|
||||
("joomla" . "\xf1aa")
|
||||
("jpy" . "\xf157")
|
||||
("jsfiddle" . "\xf1cc")
|
||||
("key" . "\xf084")
|
||||
("keyboard-o" . "\xf11c")
|
||||
("krw" . "\xf159")
|
||||
("language" . "\xf1ab")
|
||||
("laptop" . "\xf109")
|
||||
("lastfm" . "\xf202")
|
||||
("lastfm-square" . "\xf203")
|
||||
("leaf" . "\xf06c")
|
||||
("leanpub" . "\xf212")
|
||||
("lemon-o" . "\xf094")
|
||||
("level-down" . "\xf149")
|
||||
("level-up" . "\xf148")
|
||||
("life-ring" . "\xf1cd")
|
||||
("lightbulb-o" . "\xf0eb")
|
||||
("line-chart" . "\xf201")
|
||||
("link" . "\xf0c1")
|
||||
("linkedin" . "\xf0e1")
|
||||
("linkedin-square" . "\xf08c")
|
||||
("linux" . "\xf17c")
|
||||
("list" . "\xf03a")
|
||||
("list-alt" . "\xf022")
|
||||
("list-ol" . "\xf0cb")
|
||||
("list-ul" . "\xf0ca")
|
||||
("location-arrow" . "\xf124")
|
||||
("lock" . "\xf023")
|
||||
("long-arrow-down" . "\xf175")
|
||||
("long-arrow-left" . "\xf177")
|
||||
("long-arrow-right" . "\xf178")
|
||||
("long-arrow-up" . "\xf176")
|
||||
("low-vision" . "\xf2a8")
|
||||
("magic" . "\xf0d0")
|
||||
("magnet" . "\xf076")
|
||||
("male" . "\xf183")
|
||||
("map" . "\xf279")
|
||||
("map-marker" . "\xf041")
|
||||
("map-o" . "\xf278")
|
||||
("map-pin" . "\xf276")
|
||||
("map-signs" . "\xf277")
|
||||
("mars" . "\xf222")
|
||||
("mars-double" . "\xf227")
|
||||
("mars-stroke" . "\xf229")
|
||||
("mars-stroke-h" . "\xf22b")
|
||||
("mars-stroke-v" . "\xf22a")
|
||||
("maxcdn" . "\xf136")
|
||||
("meanpath" . "\xf20c")
|
||||
("medium" . "\xf23a")
|
||||
("medkit" . "\xf0fa")
|
||||
("meh-o" . "\xf11a")
|
||||
("mercury" . "\xf223")
|
||||
("microphone" . "\xf130")
|
||||
("microphone-slash" . "\xf131")
|
||||
("minus" . "\xf068")
|
||||
("minus-circle" . "\xf056")
|
||||
("minus-square" . "\xf146")
|
||||
("minus-square-o" . "\xf147")
|
||||
("mixcloud" . "\xf289")
|
||||
("mobile" . "\xf10b")
|
||||
("modx" . "\xf285")
|
||||
("money" . "\xf0d6")
|
||||
("moon-o" . "\xf186")
|
||||
("motorcycle" . "\xf21c")
|
||||
("mouse-pointer" . "\xf245")
|
||||
("music" . "\xf001")
|
||||
("neuter" . "\xf22c")
|
||||
("newspaper-o" . "\xf1ea")
|
||||
("object-group" . "\xf247")
|
||||
("object-ungroup" . "\xf248")
|
||||
("odnoklassniki" . "\xf263")
|
||||
("odnoklassniki-square" . "\xf264")
|
||||
("opencart" . "\xf23d")
|
||||
("openid" . "\xf19b")
|
||||
("opera" . "\xf26a")
|
||||
("optin-monster" . "\xf23c")
|
||||
("outdent" . "\xf03b")
|
||||
("pagelines" . "\xf18c")
|
||||
("paint-brush" . "\xf1fc")
|
||||
("paper-plane" . "\xf1d8")
|
||||
("paper-plane-o" . "\xf1d9")
|
||||
("paperclip" . "\xf0c6")
|
||||
("paragraph" . "\xf1dd")
|
||||
("pause" . "\xf04c")
|
||||
("pause-circle" . "\xf28b")
|
||||
("pause-circle-o" . "\xf28c")
|
||||
("paw" . "\xf1b0")
|
||||
("paypal" . "\xf1ed")
|
||||
("pencil" . "\xf040")
|
||||
("pencil-square" . "\xf14b")
|
||||
("pencil-square-o" . "\xf044")
|
||||
("percent" . "\xf295")
|
||||
("phone" . "\xf095")
|
||||
("phone-square" . "\xf098")
|
||||
("picture-o" . "\xf03e")
|
||||
("pie-chart" . "\xf200")
|
||||
("pied-piper" . "\xf2ae")
|
||||
("pied-piper-alt" . "\xf1a8")
|
||||
("pied-piper-pp" . "\xf1a7")
|
||||
("pinterest" . "\xf0d2")
|
||||
("pinterest-p" . "\xf231")
|
||||
("pinterest-square" . "\xf0d3")
|
||||
("plane" . "\xf072")
|
||||
("play" . "\xf04b")
|
||||
("play-circle" . "\xf144")
|
||||
("play-circle-o" . "\xf01d")
|
||||
("plug" . "\xf1e6")
|
||||
("plus" . "\xf067")
|
||||
("plus-circle" . "\xf055")
|
||||
("plus-square" . "\xf0fe")
|
||||
("plus-square-o" . "\xf196")
|
||||
("power-off" . "\xf011")
|
||||
("print" . "\xf02f")
|
||||
("product-hunt" . "\xf288")
|
||||
("puzzle-piece" . "\xf12e")
|
||||
("qq" . "\xf1d6")
|
||||
("qrcode" . "\xf029")
|
||||
("question" . "\xf128")
|
||||
("question-circle" . "\xf059")
|
||||
("question-circle-o" . "\xf29c")
|
||||
("quote-left" . "\xf10d")
|
||||
("quote-right" . "\xf10e")
|
||||
("random" . "\xf074")
|
||||
("rebel" . "\xf1d0")
|
||||
("recycle" . "\xf1b8")
|
||||
("reddit" . "\xf1a1")
|
||||
("reddit-alien" . "\xf281")
|
||||
("reddit-square" . "\xf1a2")
|
||||
("refresh" . "\xf021")
|
||||
("registered" . "\xf25d")
|
||||
("renren" . "\xf18b")
|
||||
("repeat" . "\xf01e")
|
||||
("reply" . "\xf112")
|
||||
("reply-all" . "\xf122")
|
||||
("retweet" . "\xf079")
|
||||
("road" . "\xf018")
|
||||
("rocket" . "\xf135")
|
||||
("rss" . "\xf09e")
|
||||
("rss-square" . "\xf143")
|
||||
("rub" . "\xf158")
|
||||
("safari" . "\xf267")
|
||||
("scissors" . "\xf0c4")
|
||||
("scribd" . "\xf28a")
|
||||
("search" . "\xf002")
|
||||
("search-minus" . "\xf010")
|
||||
("search-plus" . "\xf00e")
|
||||
("sellsy" . "\xf213")
|
||||
("server" . "\xf233")
|
||||
("share" . "\xf064")
|
||||
("share-alt" . "\xf1e0")
|
||||
("share-alt-square" . "\xf1e1")
|
||||
("share-square" . "\xf14d")
|
||||
("share-square-o" . "\xf045")
|
||||
("shield" . "\xf132")
|
||||
("ship" . "\xf21a")
|
||||
("shirtsinbulk" . "\xf214")
|
||||
("shopping-bag" . "\xf290")
|
||||
("shopping-basket" . "\xf291")
|
||||
("shopping-cart" . "\xf07a")
|
||||
("sign-in" . "\xf090")
|
||||
("sign-language" . "\xf2a7")
|
||||
("sign-out" . "\xf08b")
|
||||
("signal" . "\xf012")
|
||||
("simplybuilt" . "\xf215")
|
||||
("sitemap" . "\xf0e8")
|
||||
("skyatlas" . "\xf216")
|
||||
("skype" . "\xf17e")
|
||||
("slack" . "\xf198")
|
||||
("sliders" . "\xf1de")
|
||||
("slideshare" . "\xf1e7")
|
||||
("smile-o" . "\xf118")
|
||||
("snapchat" . "\xf2ab")
|
||||
("snapchat-ghost" . "\xf2ac")
|
||||
("snapchat-square" . "\xf2ad")
|
||||
("sort" . "\xf0dc")
|
||||
("sort-alpha-asc" . "\xf15d")
|
||||
("sort-alpha-desc" . "\xf15e")
|
||||
("sort-amount-asc" . "\xf160")
|
||||
("sort-amount-desc" . "\xf161")
|
||||
("sort-asc" . "\xf0de")
|
||||
("sort-desc" . "\xf0dd")
|
||||
("sort-numeric-asc" . "\xf162")
|
||||
("sort-numeric-desc" . "\xf163")
|
||||
("soundcloud" . "\xf1be")
|
||||
("space-shuttle" . "\xf197")
|
||||
("spinner" . "\xf110")
|
||||
("spoon" . "\xf1b1")
|
||||
("spotify" . "\xf1bc")
|
||||
("square" . "\xf0c8")
|
||||
("square-o" . "\xf096")
|
||||
("stack-exchange" . "\xf18d")
|
||||
("stack-overflow" . "\xf16c")
|
||||
("star" . "\xf005")
|
||||
("star-half" . "\xf089")
|
||||
("star-half-o" . "\xf123")
|
||||
("star-o" . "\xf006")
|
||||
("steam" . "\xf1b6")
|
||||
("steam-square" . "\xf1b7")
|
||||
("step-backward" . "\xf048")
|
||||
("step-forward" . "\xf051")
|
||||
("stethoscope" . "\xf0f1")
|
||||
("sticky-note" . "\xf249")
|
||||
("sticky-note-o" . "\xf24a")
|
||||
("stop" . "\xf04d")
|
||||
("stop-circle" . "\xf28d")
|
||||
("stop-circle-o" . "\xf28e")
|
||||
("street-view" . "\xf21d")
|
||||
("strikethrough" . "\xf0cc")
|
||||
("stumbleupon" . "\xf1a4")
|
||||
("stumbleupon-circle" . "\xf1a3")
|
||||
("subscript" . "\xf12c")
|
||||
("subway" . "\xf239")
|
||||
("suitcase" . "\xf0f2")
|
||||
("sun-o" . "\xf185")
|
||||
("superscript" . "\xf12b")
|
||||
("table" . "\xf0ce")
|
||||
("tablet" . "\xf10a")
|
||||
("tachometer" . "\xf0e4")
|
||||
("tag" . "\xf02b")
|
||||
("tags" . "\xf02c")
|
||||
("tasks" . "\xf0ae")
|
||||
("taxi" . "\xf1ba")
|
||||
("television" . "\xf26c")
|
||||
("tencent-weibo" . "\xf1d5")
|
||||
("terminal" . "\xf120")
|
||||
("text-height" . "\xf034")
|
||||
("text-width" . "\xf035")
|
||||
("th" . "\xf00a")
|
||||
("th-large" . "\xf009")
|
||||
("th-list" . "\xf00b")
|
||||
("themeisle" . "\xf2b2")
|
||||
("thumb-tack" . "\xf08d")
|
||||
("thumbs-down" . "\xf165")
|
||||
("thumbs-o-down" . "\xf088")
|
||||
("thumbs-o-up" . "\xf087")
|
||||
("thumbs-up" . "\xf164")
|
||||
("ticket" . "\xf145")
|
||||
("times" . "\xf00d")
|
||||
("times-circle" . "\xf057")
|
||||
("times-circle-o" . "\xf05c")
|
||||
("tint" . "\xf043")
|
||||
("toggle-off" . "\xf204")
|
||||
("toggle-on" . "\xf205")
|
||||
("trademark" . "\xf25c")
|
||||
("train" . "\xf238")
|
||||
("transgender" . "\xf224")
|
||||
("transgender-alt" . "\xf225")
|
||||
("trash" . "\xf1f8")
|
||||
("trash-o" . "\xf014")
|
||||
("tree" . "\xf1bb")
|
||||
("trello" . "\xf181")
|
||||
("tripadvisor" . "\xf262")
|
||||
("trophy" . "\xf091")
|
||||
("truck" . "\xf0d1")
|
||||
("try" . "\xf195")
|
||||
("tty" . "\xf1e4")
|
||||
("tumblr" . "\xf173")
|
||||
("tumblr-square" . "\xf174")
|
||||
("twitch" . "\xf1e8")
|
||||
("twitter" . "\xf099")
|
||||
("twitter-square" . "\xf081")
|
||||
("umbrella" . "\xf0e9")
|
||||
("underline" . "\xf0cd")
|
||||
("undo" . "\xf0e2")
|
||||
("universal-access" . "\xf29a")
|
||||
("university" . "\xf19c")
|
||||
("unlock" . "\xf09c")
|
||||
("unlock-alt" . "\xf13e")
|
||||
("upload" . "\xf093")
|
||||
("usb" . "\xf287")
|
||||
("usd" . "\xf155")
|
||||
("user" . "\xf007")
|
||||
("user-md" . "\xf0f0")
|
||||
("user-plus" . "\xf234")
|
||||
("user-secret" . "\xf21b")
|
||||
("user-times" . "\xf235")
|
||||
("users" . "\xf0c0")
|
||||
("venus" . "\xf221")
|
||||
("venus-double" . "\xf226")
|
||||
("venus-mars" . "\xf228")
|
||||
("viacoin" . "\xf237")
|
||||
("viadeo" . "\xf2a9")
|
||||
("viadeo-square" . "\xf2aa")
|
||||
("video-camera" . "\xf03d")
|
||||
("vimeo" . "\xf27d")
|
||||
("vimeo-square" . "\xf194")
|
||||
("vine" . "\xf1ca")
|
||||
("vk" . "\xf189")
|
||||
("volume-control-phone" . "\xf2a0")
|
||||
("volume-down" . "\xf027")
|
||||
("volume-off" . "\xf026")
|
||||
("volume-up" . "\xf028")
|
||||
("weibo" . "\xf18a")
|
||||
("weixin" . "\xf1d7")
|
||||
("whatsapp" . "\xf232")
|
||||
("wheelchair" . "\xf193")
|
||||
("wheelchair-alt" . "\xf29b")
|
||||
("wifi" . "\xf1eb")
|
||||
("wikipedia-w" . "\xf266")
|
||||
("windows" . "\xf17a")
|
||||
("wordpress" . "\xf19a")
|
||||
("wpbeginner" . "\xf297")
|
||||
("wpforms" . "\xf298")
|
||||
("wrench" . "\xf0ad")
|
||||
("xing" . "\xf168")
|
||||
("xing-square" . "\xf169")
|
||||
("y-combinator" . "\xf23b")
|
||||
("yahoo" . "\xf19e")
|
||||
("yelp" . "\xf1e9")
|
||||
("yoast" . "\xf2b1")
|
||||
("youtube" . "\xf167")
|
||||
("youtube-play" . "\xf16a")
|
||||
("youtube-square" . "\xf166")
|
||||
|
||||
))
|
||||
|
||||
(provide 'data-faicons)
|
||||
|
|
@ -1,502 +0,0 @@
|
|||
(defvar all-the-icons-data/file-icon-alist
|
||||
'(
|
||||
|
||||
( "1c" . "\xa5ea" )
|
||||
( "1c-alt" . "\xea28" )
|
||||
( "MJML" . "\xea6f" )
|
||||
( "R" . "\xe905" )
|
||||
( "abap" . "\xe92b" )
|
||||
( "abif" . "\xea4e" )
|
||||
( "access" . "\xe9ea" )
|
||||
( "actionscript" . "\xe92e" )
|
||||
( "ada" . "\xe90b" )
|
||||
( "ae" . "\xe9f3" )
|
||||
( "ai" . "\xe6b4" )
|
||||
( "akka" . "\xea0e" )
|
||||
( "alex" . "\x29cb" )
|
||||
( "alloy" . "\xe935" )
|
||||
( "alpine-linux" . "\xe9ff" )
|
||||
( "ampl" . "\xe94e" )
|
||||
( "amx" . "\xe99b" )
|
||||
( "angelscript" . "\xea5b" )
|
||||
( "ansible" . "\x24b6" )
|
||||
( "ansible-alt" . "\x61" )
|
||||
( "ant" . "\xe93e" )
|
||||
( "antlr" . "\xe92c" )
|
||||
( "antwar" . "\x2591" )
|
||||
( "api-blueprint" . "\xe92d" )
|
||||
( "apl" . "\x234b" )
|
||||
( "apl-old" . "\xe909" )
|
||||
( "apple" . "\xe925" )
|
||||
( "appveyor" . "\xe923" )
|
||||
( "arc" . "\xe92f" )
|
||||
( "arch-linux" . "\x41" )
|
||||
( "arduino" . "\xe930" )
|
||||
( "arttext" . "\x24d0" )
|
||||
( "asciidoc" . "\xe918" )
|
||||
( "assembly" . "\xEB4F" )
|
||||
( "ats" . "\xe934" )
|
||||
( "audacity" . "\xe9f9" )
|
||||
( "augeas" . "\xe931" )
|
||||
( "aurelia" . "\xea48" )
|
||||
( "auto-hotkey" . "\xe932" )
|
||||
( "autoit" . "\xe933" )
|
||||
( "babel" . "\xe91f" )
|
||||
( "bazel" . "\xea5a" )
|
||||
( "bem" . "\xea59" )
|
||||
( "bib" . "\xe601" )
|
||||
( "bintray" . "\xea6e" )
|
||||
( "bithound" . "\xea2a" )
|
||||
( "blender" . "\xe9fa" )
|
||||
( "bluespec" . "\xe93c" )
|
||||
( "boo" . "\xe939" )
|
||||
( "brain" . "\xe93a" )
|
||||
( "brakeman" . "\xe9d6" )
|
||||
( "bro" . "\xe93b" )
|
||||
( "broccoli" . "\xe922" )
|
||||
( "brotli" . "\xea6c" )
|
||||
( "browserslist" . "\xea80" )
|
||||
( "brunch" . "\xea47" )
|
||||
( "buck" . "\xea46" )
|
||||
( "build-boot" . "\xf103" )
|
||||
( "bundler" . "\xea45" )
|
||||
( "byond" . "\xe962" )
|
||||
( "cabal" . "\xe9c2" )
|
||||
( "caddy" . "\xea58" )
|
||||
( "cake" . "\xe9e3" )
|
||||
( "cakefile" . "\xe924" )
|
||||
( "cakephp" . "\xea43" )
|
||||
( "cakephp-old" . "\xe9d3" )
|
||||
( "cc" . "\xe9d5" )
|
||||
( "ceylon" . "\xe94f" )
|
||||
( "chai" . "\x63" )
|
||||
( "chapel" . "\xe950" )
|
||||
( "chartjs" . "\xea0b" )
|
||||
( "chef" . "\xea42" )
|
||||
( "chuck" . "\xe943" )
|
||||
( "circle-ci" . "\xea12" )
|
||||
( "cirru" . "\xe951" )
|
||||
( "ckeditor" . "\xea0c" )
|
||||
( "clarion" . "\xe952" )
|
||||
( "clean" . "\xe95b" )
|
||||
( "click" . "\xe95c" )
|
||||
( "clips" . "\xe940" )
|
||||
( "clj" . "\xf105" )
|
||||
( "cljs" . "\xf104" )
|
||||
( "closure-template" . "\xea82" )
|
||||
( "cmake" . "\xe93f" )
|
||||
( "cobol" . "\xea44" )
|
||||
( "codecov" . "\x2602" )
|
||||
( "codekit" . "\xea41" )
|
||||
( "codemirror" . "\xea0d" )
|
||||
( "codeship" . "\xea6a" )
|
||||
( "cold-fusion" . "\xe929" )
|
||||
( "clisp" . "\xe972" )
|
||||
( "composer" . "\xe683" )
|
||||
( "config" . "\xf07c" )
|
||||
( "config-coffeescript" . "\xeb18" )
|
||||
( "config-go" . "\xeb12" )
|
||||
( "config-haskell" . "\xeb14" )
|
||||
( "config-js" . "\xeb1a" )
|
||||
( "config-perl" . "\xeb19" )
|
||||
( "config-python" . "\xeb15" )
|
||||
( "config-react" . "\xeb16" )
|
||||
( "config-ruby" . "\xeb17" )
|
||||
( "config-rust" . "\xeb13" )
|
||||
( "config-typescript" . "\xeb1b" )
|
||||
( "coq" . "\xe95f" )
|
||||
( "cordova" . "\xea11" )
|
||||
( "cp" . "\xe942" )
|
||||
( "cpan" . "\xea87" )
|
||||
( "creole" . "\xe95e" )
|
||||
( "crystal" . "\xe902" )
|
||||
( "cs-script" . "\xe9e2" )
|
||||
( "csound" . "\xe9f0" )
|
||||
( "cucumber" . "\xf02b" )
|
||||
( "cython" . "\xe963" )
|
||||
( "d3" . "\xea10" )
|
||||
( "darcs" . "\xe964" )
|
||||
( "dart" . "\xe698" )
|
||||
( "dashboard" . "\xf07d" )
|
||||
( "dbase" . "\xe9f1" )
|
||||
( "default" . "\x1f5cc" )
|
||||
( "delphi" . "\xea40" )
|
||||
( "devicetree" . "\xea57" )
|
||||
( "diff" . "\xe960" )
|
||||
( "dockerfile" . "\xf106" )
|
||||
( "doclets" . "\xea3f" )
|
||||
( "doge" . "\xe946" )
|
||||
( "dom" . "\xea71" )
|
||||
( "donejs" . "\x1f3c1" )
|
||||
( "doxygen" . "\xe928" )
|
||||
( "dragula" . "\x1f44c" )
|
||||
( "drone" . "\xea3d" )
|
||||
( "dyalog" . "\xe90c" )
|
||||
( "dylib" . "\xea15" )
|
||||
( "e" . "\x45" )
|
||||
( "eagle" . "\xe965" )
|
||||
( "easybuild" . "\xea85" )
|
||||
( "ec" . "\xe9c9" )
|
||||
( "ecere" . "\xe966" )
|
||||
( "edge" . "\xea78" )
|
||||
( "editorconfig" . "\xea1b" )
|
||||
( "eiffel" . "\xe967" )
|
||||
( "ejs" . "\xea4b" )
|
||||
( "electron" . "\xea27" )
|
||||
( "elm" . "\xf102" )
|
||||
( "emacs" . "\xe926" )
|
||||
( "elisp" . "\xe926" )
|
||||
( "ember" . "\xe61b" )
|
||||
( "emberscript" . "\xe968" )
|
||||
( "eq" . "\xea0a" )
|
||||
( "esdoc" . "\xea5c" )
|
||||
( "eslint" . "\xea0f" )
|
||||
( "eslint-old" . "\xe90e" )
|
||||
( "excel" . "\xe9ee" )
|
||||
( "fabfile" . "\xe94b" )
|
||||
( "factor" . "\xe96a" )
|
||||
( "fancy" . "\xe96b" )
|
||||
( "fantom" . "\xe96f" )
|
||||
( "fbx" . "\xe9fc" )
|
||||
( "ffmpeg" . "\xea22" )
|
||||
( "finder" . "\xe9e9" )
|
||||
( "firebase" . "\xea7f" )
|
||||
( "flow" . "\xe921" )
|
||||
( "flux" . "\xe969" )
|
||||
( "font" . "\xe90f" )
|
||||
( "fontforge" . "\xfb00" )
|
||||
( "fortran" . "\xe90a" )
|
||||
( "franca" . "\xea56" )
|
||||
( "freemarker" . "\xe970" )
|
||||
( "frege" . "\xe96e" )
|
||||
( "fsharp" . "\xe6a7" )
|
||||
( "fuel-ux" . "\xea09" )
|
||||
( "gams" . "\xe973" )
|
||||
( "gap" . "\xe971" )
|
||||
( "gdb" . "\xea08" )
|
||||
( "genshi" . "\xe976" )
|
||||
( "gentoo" . "\xe96d" )
|
||||
( "gf" . "\xe978" )
|
||||
( "gitlab" . "\xea3c" )
|
||||
( "glade" . "\xe938" )
|
||||
( "glyphs" . "\x47" )
|
||||
( "gn" . "\xea25" )
|
||||
( "gnu" . "\xe679" )
|
||||
( "go" . "\xeaae" )
|
||||
( "godot" . "\xe974" )
|
||||
( "golo" . "\xe979" )
|
||||
( "gosu" . "\xe97a" )
|
||||
( "gradle" . "\xe903" )
|
||||
( "graphql" . "\xe97c" )
|
||||
( "graphviz" . "\xe97d" )
|
||||
( "groovy" . "\xe904" )
|
||||
( "grunt" . "\xe611" )
|
||||
( "gulp" . "\xe610" )
|
||||
( "hack" . "\xe9ce" )
|
||||
( "haml" . "\xf15b" )
|
||||
( "harbour" . "\xe97b" )
|
||||
( "hashicorp" . "\xe97e" )
|
||||
( "haxe" . "\xe907" )
|
||||
( "haxedevelop" . "\xea3b" )
|
||||
( "hg" . "\x263f" )
|
||||
( "hoplon" . "\xea4d" )
|
||||
( "hy" . "\xe97f" )
|
||||
( "icu" . "\xea23" )
|
||||
( "id" . "\xe9f4" )
|
||||
( "idl" . "\xe947" )
|
||||
( "idris" . "\xe983" )
|
||||
( "igorpro" . "\xe980" )
|
||||
( "image" . "\xf012" )
|
||||
( "inform7" . "\xe984" )
|
||||
( "inno" . "\xe985" )
|
||||
( "io" . "\xe981" )
|
||||
( "ioke" . "\xe982" )
|
||||
( "ionic-project" . "\xf14b" )
|
||||
( "isabelle" . "\xe945" )
|
||||
( "j" . "\xe937" )
|
||||
( "jade" . "\xe90d" )
|
||||
( "jake" . "\xe948" )
|
||||
( "jasmine" . "\xea3a" )
|
||||
( "jenkins" . "\xe667" )
|
||||
( "jest" . "\xea39" )
|
||||
( "jinja" . "\xe944" )
|
||||
( "jison" . "\xea55" )
|
||||
( "jolie" . "\xea75" )
|
||||
( "jsonld" . "\xe958" )
|
||||
( "jsx" . "\xf100" )
|
||||
( "jsx-2" . "\xf101" )
|
||||
( "jsx2-alt" . "\xe9e6" )
|
||||
( "julia" . "\x26ec" )
|
||||
( "junos" . "\xea81" )
|
||||
( "jupyter" . "\xe987" )
|
||||
( "karma" . "\xe9cd" )
|
||||
( "keynote" . "\xe9e5" )
|
||||
( "khronos" . "\xe9f8" )
|
||||
( "kicad" . "\xea4c" )
|
||||
( "kitchenci" . "\xea38" )
|
||||
( "kivy" . "\xe901" )
|
||||
( "knockout" . "\x4b" )
|
||||
( "kotlin" . "\xe989" )
|
||||
( "krl" . "\xe988" )
|
||||
( "labview" . "\xe98a" )
|
||||
( "lasso" . "\xe98c" )
|
||||
( "leaflet" . "\xea07" )
|
||||
( "lean" . "\x4c" )
|
||||
( "lerna" . "\xea37" )
|
||||
( "lfe" . "\xe94c" )
|
||||
( "libuv" . "\xea21" )
|
||||
( "lightwave" . "\xe9fb" )
|
||||
( "lime" . "\xea36" )
|
||||
( "lisp" . "\xe908" )
|
||||
( "livescript" . "\xe914" )
|
||||
( "llvm" . "\xe91d" )
|
||||
( "logtalk" . "\xe98d" )
|
||||
( "lookml" . "\xe98e" )
|
||||
( "lsl" . "\xe98b" )
|
||||
( "lua" . "\xe91b" )
|
||||
( "mako" . "\xe98f" )
|
||||
( "man-page" . "\xe936" )
|
||||
( "mapbox" . "\xe941" )
|
||||
( "markdownlint" . "\xf0c9" )
|
||||
( "marko" . "\xe920" )
|
||||
( "mathematica" . "\xe990" )
|
||||
( "mathjax" . "\xea06" )
|
||||
( "matlab" . "\xe991" )
|
||||
( "max" . "\xe993" )
|
||||
( "maxscript" . "\xe900" )
|
||||
( "maya" . "\xe9f6" )
|
||||
( "mediawiki" . "\xe954" )
|
||||
( "mercury" . "\xe994" )
|
||||
( "meson" . "\xeafe" )
|
||||
( "metal" . "\x4d" )
|
||||
( "meteor" . "\xe6a5" )
|
||||
( "microsoft-infopath" . "\xea35" )
|
||||
( "minecraft" . "\xe9dc" )
|
||||
( "minizinc" . "\xea53" )
|
||||
( "mirah" . "\xe995" )
|
||||
( "miranda" . "\xea52" )
|
||||
( "mocha" . "\x26fe" )
|
||||
( "modula-2" . "\xe996" )
|
||||
( "moment" . "\x1f558" )
|
||||
( "moment-tz" . "\x1f30d" )
|
||||
( "monkey" . "\xe997" )
|
||||
( "moustache" . "\xe60f" )
|
||||
( "mruby" . "\xea18" )
|
||||
( "mupad" . "\xe9ca" )
|
||||
( "nano" . "\xea76" )
|
||||
( "nanoc" . "\xea51" )
|
||||
( "nant" . "\xe9e1" )
|
||||
( "nasm" . "\xea72" )
|
||||
( "neko" . "\xea05" )
|
||||
( "netlogo" . "\xe99c" )
|
||||
( "new-relic" . "\xe9d7" )
|
||||
( "nginx" . "\xf146b" )
|
||||
( "nib" . "\x2712" )
|
||||
( "nimrod" . "\xe998" )
|
||||
( "nit" . "\xe999" )
|
||||
( "nix" . "\xe99a" )
|
||||
( "nmap" . "\xe94d" )
|
||||
( "nodemon" . "\xea26" )
|
||||
( "normalize" . "\xea04" )
|
||||
( "npm" . "\xe91c" )
|
||||
( "npm-old" . "\xf17b" )
|
||||
( "nsis" . "\xea1e" )
|
||||
( "nsis-old" . "\xe992" )
|
||||
( "nuclide" . "\xea34" )
|
||||
( "nuget" . "\xe9d9" )
|
||||
( "numpy" . "\xe99d" )
|
||||
( "nunjucks" . "\xe953" )
|
||||
( "nvidia" . "\xe95d" )
|
||||
( "nxc" . "\xea6b" )
|
||||
( "obj" . "\xe9e8" )
|
||||
( "objective-j" . "\xe99e" )
|
||||
( "ocaml" . "\xe91a" )
|
||||
( "octave" . "\xea33" )
|
||||
( "odin" . "\xeb36" )
|
||||
( "onenote" . "\xe9eb" )
|
||||
( "ooc" . "\xe9cb" )
|
||||
( "opa" . "\x2601" )
|
||||
( "opencl" . "\xe99f" )
|
||||
( "opengl" . "\xea7a" )
|
||||
( "openoffice" . "\xe9e4" )
|
||||
( "openscad" . "\xe911" )
|
||||
( "org" . "\xe917" )
|
||||
( "owl" . "\xe957" )
|
||||
( "ox" . "\xe9a1" )
|
||||
( "oxygene" . "\xe9bf" )
|
||||
( "oz" . "\xe9be" )
|
||||
( "p4" . "\xea50" )
|
||||
( "pan" . "\xe9bd" )
|
||||
( "papyrus" . "\xe9bc" )
|
||||
( "parrot" . "\xe9bb" )
|
||||
( "pascal" . "\xe92a" )
|
||||
( "patch" . "\xe961" )
|
||||
( "pawn" . "\x265f" )
|
||||
( "pb" . "\xea14" )
|
||||
( "pegjs" . "\xea74" )
|
||||
( "raku" . "\xe96c" )
|
||||
( "phalcon" . "\xe94a" )
|
||||
( "phoenix" . "\xea5f" )
|
||||
( "php" . "\xf147" )
|
||||
( "phpunit" . "\xea32" )
|
||||
( "pickle" . "\xe9c4" )
|
||||
( "pike" . "\xe9b9" )
|
||||
( "platformio" . "\xea2c" )
|
||||
( "pm2" . "\x2630" )
|
||||
( "pod" . "\xea84" )
|
||||
( "pogo" . "\xe9b8" )
|
||||
( "pointwise" . "\xe977" )
|
||||
( "polymer" . "\xea2b" )
|
||||
( "pony" . "\xe9b7" )
|
||||
( "postcss" . "\xe910" )
|
||||
( "postscript" . "\xe955" )
|
||||
( "povray" . "\x50" )
|
||||
( "powerpoint" . "\xe9ec" )
|
||||
( "powershell" . "\xe9da" )
|
||||
( "precision" . "\x2295" )
|
||||
( "premiere" . "\xe9f5" )
|
||||
( "processing" . "\xe9a0" )
|
||||
( "progress" . "\xe9c0" )
|
||||
( "propeller" . "\xe9b5" )
|
||||
( "proselint" . "\xea6d" )
|
||||
( "protractor" . "\xe9de" )
|
||||
( "ps" . "\xe6b8" )
|
||||
( "pug" . "\xea13" )
|
||||
( "pug-alt" . "\xe9d0" )
|
||||
( "puppet" . "\xf0c3" )
|
||||
( "purebasic" . "\x1b5" )
|
||||
( "purescript" . "\xe9b2" )
|
||||
( "racket" . "\xe9b1" )
|
||||
( "raml" . "\xe913" )
|
||||
( "rascal" . "\xea24" )
|
||||
( "rdoc" . "\xe9b0" )
|
||||
( "realbasic" . "\xe9af" )
|
||||
( "reason" . "\xea1d" )
|
||||
( "rebol" . "\xe9ae" )
|
||||
( "red" . "\xe9ad" )
|
||||
( "redux" . "\xea30" )
|
||||
( "regex" . "\x2a" )
|
||||
( "rexx" . "\xea16" )
|
||||
( "rhino" . "\xea4a" )
|
||||
( "ring" . "\x1f48d" )
|
||||
( "riot" . "\xe919" )
|
||||
( "robot" . "\xe9ac" )
|
||||
( "rollup" . "\xea20" )
|
||||
( "rollup-old" . "\xe9fd" )
|
||||
( "rot" . "\x1f764" )
|
||||
( "rspec" . "\xea31" )
|
||||
( "rst" . "\xe9cc" )
|
||||
( "sage" . "\xe9ab" )
|
||||
( "saltstack" . "\xe915" )
|
||||
( "sas" . "\xe95a" )
|
||||
( "sbt" . "\xe9d2" )
|
||||
( "sc" . "\xe9a2" )
|
||||
( "scheme" . "\x3bb" )
|
||||
( "scilab" . "\xe9a9" )
|
||||
( "scrutinizer" . "\xe9d4" )
|
||||
( "self" . "\xe9a8" )
|
||||
( "sequelize" . "\xea2f" )
|
||||
( "sf" . "\xe9db" )
|
||||
( "shen" . "\xe9a7" )
|
||||
( "shipit" . "\x26f5" )
|
||||
( "shippable" . "\xea2d" )
|
||||
( "shopify" . "\xe9cf" )
|
||||
( "shuriken" . "\x272b" )
|
||||
( "silverstripe" . "\xe800" )
|
||||
( "sinatra" . "\xea03" )
|
||||
( "sketch" . "\xe927" )
|
||||
( "sketchup-layout" . "\xea7c" )
|
||||
( "sketchup-make" . "\xea7e" )
|
||||
( "sketchup-stylebuilder" . "\xea7d" )
|
||||
( "slash" . "\xe9a6" )
|
||||
( "snyk" . "\xea1c" )
|
||||
( "solidity" . "\xea86" )
|
||||
( "sparql" . "\xe959" )
|
||||
( "spray" . "\xea02" )
|
||||
( "sqf" . "\xe9a5" )
|
||||
( "sqlite" . "\xe9dd" )
|
||||
( "squarespace" . "\xea5e" )
|
||||
( "stan" . "\xe9a4" )
|
||||
( "stata" . "\xe9a3" )
|
||||
( "storyist" . "\xe9ef" )
|
||||
( "strings" . "\xe9e0" )
|
||||
( "stylelint" . "\xe93d" )
|
||||
( "stylus" . "\x73" )
|
||||
( "stylus-full" . "\xe9f7" )
|
||||
( "stylus-orb" . "\x53" )
|
||||
( "sublime" . "\xe986" )
|
||||
( "sv" . "\xe9c3" )
|
||||
( "svelte" . "\x33dc" )
|
||||
( "svn" . "\xea17" )
|
||||
( "swagger" . "\xea29" )
|
||||
( "tag" . "\xf015" )
|
||||
( "tcl" . "\xe956" )
|
||||
( "telegram" . "\x2708" )
|
||||
( "terminal" . "\xf0c8" )
|
||||
( "tern" . "\x1f54a" )
|
||||
( "terraform" . "\xe916" )
|
||||
( "test-coffeescript" . "\xea62" )
|
||||
( "test-dir" . "\xea60" )
|
||||
( "test-generic" . "\xea63" )
|
||||
( "test-js" . "\xea64" )
|
||||
( "test-perl" . "\xea65" )
|
||||
( "test-python" . "\xea66" )
|
||||
( "test-react" . "\xea67" )
|
||||
( "test-ruby" . "\xea68" )
|
||||
( "test-typescript" . "\xea69" )
|
||||
( "tex" . "\xe600" )
|
||||
( "textile" . "\x74" )
|
||||
( "textmate" . "\x2122" )
|
||||
( "thor" . "\xe9d8" )
|
||||
( "tinymce" . "\xea01" )
|
||||
( "tsx" . "\xe9d1" )
|
||||
( "tsx-alt" . "\xe9e7" )
|
||||
( "tt" . "\x54" )
|
||||
( "turing" . "\xe9b6" )
|
||||
( "twig" . "\x2e19" )
|
||||
( "twine" . "\xea5d" )
|
||||
( "txl" . "\xe9c1" )
|
||||
( "typedoc" . "\xe9fe" )
|
||||
( "typescript" . "\xe912" )
|
||||
( "typescript-alt" . "\x2a6" )
|
||||
( "typings" . "\xe9df" )
|
||||
( "uno" . "\xe9b3" )
|
||||
( "unreal" . "\x75" )
|
||||
( "urweb" . "\xe9ba" )
|
||||
( "v8" . "\xea1f" )
|
||||
( "vagrant" . "\x56" )
|
||||
( "vcl" . "\xe9b4" )
|
||||
( "verilog" . "\xe949" )
|
||||
( "vertex-shader" . "\xea79" )
|
||||
( "vhdl" . "\xe9aa" )
|
||||
( "video" . "\xf057" )
|
||||
( "virtualbox" . "\xea3e" )
|
||||
( "virtualbox-alt" . "\xea2e" )
|
||||
( "visio" . "\xea83" )
|
||||
( "vmware" . "\xea49" )
|
||||
( "vue" . "\xe906" )
|
||||
( "wasm" . "\xea70" )
|
||||
( "watchman" . "\xea4f" )
|
||||
( "webgl" . "\xea7b" )
|
||||
( "webpack" . "\xea61" )
|
||||
( "webpack-old" . "\xe91e" )
|
||||
( "wercker" . "\xea19" )
|
||||
( "word" . "\xe9ed" )
|
||||
( "x10" . "\x2169" )
|
||||
( "xamarin" . "\xea77" )
|
||||
( "xmos" . "\x58" )
|
||||
( "xpages" . "\xe9c5" )
|
||||
( "xtend" . "\xe9c6" )
|
||||
( "yarn" . "\xea1a" )
|
||||
( "yasm" . "\xea73" )
|
||||
( "yin-yang" . "\x262f" )
|
||||
( "yoyo" . "\xe975" )
|
||||
( "yui" . "\xea00" )
|
||||
( "zbrush" . "\xe9f2" )
|
||||
( "zephir" . "\xe9c7" )
|
||||
( "zig" . "\x7A" )
|
||||
( "zimpl" . "\xe9c8" )
|
||||
)
|
||||
)
|
||||
|
||||
(provide 'data-fileicons)
|
||||
|
|
@ -1,935 +0,0 @@
|
|||
(defvar all-the-icons-data/material-icons-alist
|
||||
'(("3d_rotation" . "\xe84d")
|
||||
("ac_unit" . "\xeb3b")
|
||||
("access_alarm" . "\xe190")
|
||||
("access_alarms" . "\xe191")
|
||||
("access_time" . "\xe192")
|
||||
("accessibility" . "\xe84e")
|
||||
("accessible" . "\xe914")
|
||||
("account_balance" . "\xe84f")
|
||||
("account_balance_wallet" . "\xe850")
|
||||
("account_box" . "\xe851")
|
||||
("account_circle" . "\xe853")
|
||||
("adb" . "\xe60e")
|
||||
("add" . "\xe145")
|
||||
("add_a_photo" . "\xe439")
|
||||
("add_alarm" . "\xe193")
|
||||
("add_alert" . "\xe003")
|
||||
("add_box" . "\xe146")
|
||||
("add_circle" . "\xe147")
|
||||
("add_circle_outline" . "\xe148")
|
||||
("add_location" . "\xe567")
|
||||
("add_shopping_cart" . "\xe854")
|
||||
("add_to_photos" . "\xe39d")
|
||||
("add_to_queue" . "\xe05c")
|
||||
("adjust" . "\xe39e")
|
||||
("airline_seat_flat" . "\xe630")
|
||||
("airline_seat_flat_angled" . "\xe631")
|
||||
("airline_seat_individual_suite" . "\xe632")
|
||||
("airline_seat_legroom_extra" . "\xe633")
|
||||
("airline_seat_legroom_normal" . "\xe634")
|
||||
("airline_seat_legroom_reduced" . "\xe635")
|
||||
("airline_seat_recline_extra" . "\xe636")
|
||||
("airline_seat_recline_normal" . "\xe637")
|
||||
("airplanemode_active" . "\xe195")
|
||||
("airplanemode_inactive" . "\xe194")
|
||||
("airplay" . "\xe055")
|
||||
("airport_shuttle" . "\xeb3c")
|
||||
("alarm" . "\xe855")
|
||||
("alarm_add" . "\xe856")
|
||||
("alarm_off" . "\xe857")
|
||||
("alarm_on" . "\xe858")
|
||||
("album" . "\xe019")
|
||||
("all_inclusive" . "\xeb3d")
|
||||
("all_out" . "\xe90b")
|
||||
("android" . "\xe859")
|
||||
("announcement" . "\xe85a")
|
||||
("apps" . "\xe5c3")
|
||||
("archive" . "\xe149")
|
||||
("arrow_back" . "\xe5c4")
|
||||
("arrow_downward" . "\xe5db")
|
||||
("arrow_drop_down" . "\xe5c5")
|
||||
("arrow_drop_down_circle" . "\xe5c6")
|
||||
("arrow_drop_up" . "\xe5c7")
|
||||
("arrow_forward" . "\xe5c8")
|
||||
("arrow_upward" . "\xe5d8")
|
||||
("art_track" . "\xe060")
|
||||
("aspect_ratio" . "\xe85b")
|
||||
("assessment" . "\xe85c")
|
||||
("assignment" . "\xe85d")
|
||||
("assignment_ind" . "\xe85e")
|
||||
("assignment_late" . "\xe85f")
|
||||
("assignment_return" . "\xe860")
|
||||
("assignment_returned" . "\xe861")
|
||||
("assignment_turned_in" . "\xe862")
|
||||
("assistant" . "\xe39f")
|
||||
("assistant_photo" . "\xe3a0")
|
||||
("attach_file" . "\xe226")
|
||||
("attach_money" . "\xe227")
|
||||
("attachment" . "\xe2bc")
|
||||
("audiotrack" . "\xe3a1")
|
||||
("autorenew" . "\xe863")
|
||||
("av_timer" . "\xe01b")
|
||||
("backspace" . "\xe14a")
|
||||
("backup" . "\xe864")
|
||||
("battery_alert" . "\xe19c")
|
||||
("battery_charging_full" . "\xe1a3")
|
||||
("battery_full" . "\xe1a4")
|
||||
("battery_std" . "\xe1a5")
|
||||
("battery_unknown" . "\xe1a6")
|
||||
("beach_access" . "\xeb3e")
|
||||
("beenhere" . "\xe52d")
|
||||
("block" . "\xe14b")
|
||||
("bluetooth" . "\xe1a7")
|
||||
("bluetooth_audio" . "\xe60f")
|
||||
("bluetooth_connected" . "\xe1a8")
|
||||
("bluetooth_disabled" . "\xe1a9")
|
||||
("bluetooth_searching" . "\xe1aa")
|
||||
("blur_circular" . "\xe3a2")
|
||||
("blur_linear" . "\xe3a3")
|
||||
("blur_off" . "\xe3a4")
|
||||
("blur_on" . "\xe3a5")
|
||||
("book" . "\xe865")
|
||||
("bookmark" . "\xe866")
|
||||
("bookmark_border" . "\xe867")
|
||||
("border_all" . "\xe228")
|
||||
("border_bottom" . "\xe229")
|
||||
("border_clear" . "\xe22a")
|
||||
("border_color" . "\xe22b")
|
||||
("border_horizontal" . "\xe22c")
|
||||
("border_inner" . "\xe22d")
|
||||
("border_left" . "\xe22e")
|
||||
("border_outer" . "\xe22f")
|
||||
("border_right" . "\xe230")
|
||||
("border_style" . "\xe231")
|
||||
("border_top" . "\xe232")
|
||||
("border_vertical" . "\xe233")
|
||||
("branding_watermark" . "\xe06b")
|
||||
("brightness_1" . "\xe3a6")
|
||||
("brightness_2" . "\xe3a7")
|
||||
("brightness_3" . "\xe3a8")
|
||||
("brightness_4" . "\xe3a9")
|
||||
("brightness_5" . "\xe3aa")
|
||||
("brightness_6" . "\xe3ab")
|
||||
("brightness_7" . "\xe3ac")
|
||||
("brightness_auto" . "\xe1ab")
|
||||
("brightness_high" . "\xe1ac")
|
||||
("brightness_low" . "\xe1ad")
|
||||
("brightness_medium" . "\xe1ae")
|
||||
("broken_image" . "\xe3ad")
|
||||
("brush" . "\xe3ae")
|
||||
("bubble_chart" . "\xe6dd")
|
||||
("bug_report" . "\xe868")
|
||||
("build" . "\xe869")
|
||||
("burst_mode" . "\xe43c")
|
||||
("business" . "\xe0af")
|
||||
("business_center" . "\xeb3f")
|
||||
("cached" . "\xe86a")
|
||||
("cake" . "\xe7e9")
|
||||
("call" . "\xe0b0")
|
||||
("call_end" . "\xe0b1")
|
||||
("call_made" . "\xe0b2")
|
||||
("call_merge" . "\xe0b3")
|
||||
("call_missed" . "\xe0b4")
|
||||
("call_missed_outgoing" . "\xe0e4")
|
||||
("call_received" . "\xe0b5")
|
||||
("call_split" . "\xe0b6")
|
||||
("call_to_action" . "\xe06c")
|
||||
("camera" . "\xe3af")
|
||||
("camera_alt" . "\xe3b0")
|
||||
("camera_enhance" . "\xe8fc")
|
||||
("camera_front" . "\xe3b1")
|
||||
("camera_rear" . "\xe3b2")
|
||||
("camera_roll" . "\xe3b3")
|
||||
("cancel" . "\xe5c9")
|
||||
("card_giftcard" . "\xe8f6")
|
||||
("card_membership" . "\xe8f7")
|
||||
("card_travel" . "\xe8f8")
|
||||
("casino" . "\xeb40")
|
||||
("cast" . "\xe307")
|
||||
("cast_connected" . "\xe308")
|
||||
("center_focus_strong" . "\xe3b4")
|
||||
("center_focus_weak" . "\xe3b5")
|
||||
("change_history" . "\xe86b")
|
||||
("chat" . "\xe0b7")
|
||||
("chat_bubble" . "\xe0ca")
|
||||
("chat_bubble_outline" . "\xe0cb")
|
||||
("check" . "\xe5ca")
|
||||
("check_box" . "\xe834")
|
||||
("check_box_outline_blank" . "\xe835")
|
||||
("check_circle" . "\xe86c")
|
||||
("chevron_left" . "\xe5cb")
|
||||
("chevron_right" . "\xe5cc")
|
||||
("child_care" . "\xeb41")
|
||||
("child_friendly" . "\xeb42")
|
||||
("chrome_reader_mode" . "\xe86d")
|
||||
("class" . "\xe86e")
|
||||
("clear" . "\xe14c")
|
||||
("clear_all" . "\xe0b8")
|
||||
("close" . "\xe5cd")
|
||||
("closed_caption" . "\xe01c")
|
||||
("cloud" . "\xe2bd")
|
||||
("cloud_circle" . "\xe2be")
|
||||
("cloud_done" . "\xe2bf")
|
||||
("cloud_download" . "\xe2c0")
|
||||
("cloud_off" . "\xe2c1")
|
||||
("cloud_queue" . "\xe2c2")
|
||||
("cloud_upload" . "\xe2c3")
|
||||
("code" . "\xe86f")
|
||||
("collections" . "\xe3b6")
|
||||
("collections_bookmark" . "\xe431")
|
||||
("color_lens" . "\xe3b7")
|
||||
("colorize" . "\xe3b8")
|
||||
("comment" . "\xe0b9")
|
||||
("compare" . "\xe3b9")
|
||||
("compare_arrows" . "\xe915")
|
||||
("computer" . "\xe30a")
|
||||
("confirmation_number" . "\xe638")
|
||||
("contact_mail" . "\xe0d0")
|
||||
("contact_phone" . "\xe0cf")
|
||||
("contacts" . "\xe0ba")
|
||||
("content_copy" . "\xe14d")
|
||||
("content_cut" . "\xe14e")
|
||||
("content_paste" . "\xe14f")
|
||||
("control_point" . "\xe3ba")
|
||||
("control_point_duplicate" . "\xe3bb")
|
||||
("copyright" . "\xe90c")
|
||||
("create" . "\xe150")
|
||||
("create_new_folder" . "\xe2cc")
|
||||
("credit_card" . "\xe870")
|
||||
("crop" . "\xe3be")
|
||||
("crop_16_9" . "\xe3bc")
|
||||
("crop_3_2" . "\xe3bd")
|
||||
("crop_5_4" . "\xe3bf")
|
||||
("crop_7_5" . "\xe3c0")
|
||||
("crop_din" . "\xe3c1")
|
||||
("crop_free" . "\xe3c2")
|
||||
("crop_landscape" . "\xe3c3")
|
||||
("crop_original" . "\xe3c4")
|
||||
("crop_portrait" . "\xe3c5")
|
||||
("crop_rotate" . "\xe437")
|
||||
("crop_square" . "\xe3c6")
|
||||
("dashboard" . "\xe871")
|
||||
("data_usage" . "\xe1af")
|
||||
("date_range" . "\xe916")
|
||||
("dehaze" . "\xe3c7")
|
||||
("delete" . "\xe872")
|
||||
("delete_forever" . "\xe92b")
|
||||
("delete_sweep" . "\xe16c")
|
||||
("description" . "\xe873")
|
||||
("desktop_mac" . "\xe30b")
|
||||
("desktop_windows" . "\xe30c")
|
||||
("details" . "\xe3c8")
|
||||
("developer_board" . "\xe30d")
|
||||
("developer_mode" . "\xe1b0")
|
||||
("device_hub" . "\xe335")
|
||||
("devices" . "\xe1b1")
|
||||
("devices_other" . "\xe337")
|
||||
("dialer_sip" . "\xe0bb")
|
||||
("dialpad" . "\xe0bc")
|
||||
("directions" . "\xe52e")
|
||||
("directions_bike" . "\xe52f")
|
||||
("directions_boat" . "\xe532")
|
||||
("directions_bus" . "\xe530")
|
||||
("directions_car" . "\xe531")
|
||||
("directions_railway" . "\xe534")
|
||||
("directions_run" . "\xe566")
|
||||
("directions_subway" . "\xe533")
|
||||
("directions_transit" . "\xe535")
|
||||
("directions_walk" . "\xe536")
|
||||
("disc_full" . "\xe610")
|
||||
("dns" . "\xe875")
|
||||
("do_not_disturb" . "\xe612")
|
||||
("do_not_disturb_alt" . "\xe611")
|
||||
("do_not_disturb_off" . "\xe643")
|
||||
("do_not_disturb_on" . "\xe644")
|
||||
("dock" . "\xe30e")
|
||||
("domain" . "\xe7ee")
|
||||
("done" . "\xe876")
|
||||
("done_all" . "\xe877")
|
||||
("donut_large" . "\xe917")
|
||||
("donut_small" . "\xe918")
|
||||
("drafts" . "\xe151")
|
||||
("drag_handle" . "\xe25d")
|
||||
("drive_eta" . "\xe613")
|
||||
("dvr" . "\xe1b2")
|
||||
("edit" . "\xe3c9")
|
||||
("edit_location" . "\xe568")
|
||||
("eject" . "\xe8fb")
|
||||
("email" . "\xe0be")
|
||||
("enhanced_encryption" . "\xe63f")
|
||||
("equalizer" . "\xe01d")
|
||||
("error" . "\xe000")
|
||||
("error_outline" . "\xe001")
|
||||
("euro_symbol" . "\xe926")
|
||||
("ev_station" . "\xe56d")
|
||||
("event" . "\xe878")
|
||||
("event_available" . "\xe614")
|
||||
("event_busy" . "\xe615")
|
||||
("event_note" . "\xe616")
|
||||
("event_seat" . "\xe903")
|
||||
("exit_to_app" . "\xe879")
|
||||
("expand_less" . "\xe5ce")
|
||||
("expand_more" . "\xe5cf")
|
||||
("explicit" . "\xe01e")
|
||||
("explore" . "\xe87a")
|
||||
("exposure" . "\xe3ca")
|
||||
("exposure_neg_1" . "\xe3cb")
|
||||
("exposure_neg_2" . "\xe3cc")
|
||||
("exposure_plus_1" . "\xe3cd")
|
||||
("exposure_plus_2" . "\xe3ce")
|
||||
("exposure_zero" . "\xe3cf")
|
||||
("extension" . "\xe87b")
|
||||
("face" . "\xe87c")
|
||||
("fast_forward" . "\xe01f")
|
||||
("fast_rewind" . "\xe020")
|
||||
("favorite" . "\xe87d")
|
||||
("favorite_border" . "\xe87e")
|
||||
("featured_play_list" . "\xe06d")
|
||||
("featured_video" . "\xe06e")
|
||||
("feedback" . "\xe87f")
|
||||
("fiber_dvr" . "\xe05d")
|
||||
("fiber_manual_record" . "\xe061")
|
||||
("fiber_new" . "\xe05e")
|
||||
("fiber_pin" . "\xe06a")
|
||||
("fiber_smart_record" . "\xe062")
|
||||
("file_download" . "\xe2c4")
|
||||
("file_upload" . "\xe2c6")
|
||||
("filter" . "\xe3d3")
|
||||
("filter_1" . "\xe3d0")
|
||||
("filter_2" . "\xe3d1")
|
||||
("filter_3" . "\xe3d2")
|
||||
("filter_4" . "\xe3d4")
|
||||
("filter_5" . "\xe3d5")
|
||||
("filter_6" . "\xe3d6")
|
||||
("filter_7" . "\xe3d7")
|
||||
("filter_8" . "\xe3d8")
|
||||
("filter_9" . "\xe3d9")
|
||||
("filter_9_plus" . "\xe3da")
|
||||
("filter_b_and_w" . "\xe3db")
|
||||
("filter_center_focus" . "\xe3dc")
|
||||
("filter_drama" . "\xe3dd")
|
||||
("filter_frames" . "\xe3de")
|
||||
("filter_hdr" . "\xe3df")
|
||||
("filter_list" . "\xe152")
|
||||
("filter_none" . "\xe3e0")
|
||||
("filter_tilt_shift" . "\xe3e2")
|
||||
("filter_vintage" . "\xe3e3")
|
||||
("find_in_page" . "\xe880")
|
||||
("find_replace" . "\xe881")
|
||||
("fingerprint" . "\xe90d")
|
||||
("first_page" . "\xe5dc")
|
||||
("fitness_center" . "\xeb43")
|
||||
("flag" . "\xe153")
|
||||
("flare" . "\xe3e4")
|
||||
("flash_auto" . "\xe3e5")
|
||||
("flash_off" . "\xe3e6")
|
||||
("flash_on" . "\xe3e7")
|
||||
("flight" . "\xe539")
|
||||
("flight_land" . "\xe904")
|
||||
("flight_takeoff" . "\xe905")
|
||||
("flip" . "\xe3e8")
|
||||
("flip_to_back" . "\xe882")
|
||||
("flip_to_front" . "\xe883")
|
||||
("folder" . "\xe2c7")
|
||||
("folder_open" . "\xe2c8")
|
||||
("folder_shared" . "\xe2c9")
|
||||
("folder_special" . "\xe617")
|
||||
("font_download" . "\xe167")
|
||||
("format_align_center" . "\xe234")
|
||||
("format_align_justify" . "\xe235")
|
||||
("format_align_left" . "\xe236")
|
||||
("format_align_right" . "\xe237")
|
||||
("format_bold" . "\xe238")
|
||||
("format_clear" . "\xe239")
|
||||
("format_color_fill" . "\xe23a")
|
||||
("format_color_reset" . "\xe23b")
|
||||
("format_color_text" . "\xe23c")
|
||||
("format_indent_decrease" . "\xe23d")
|
||||
("format_indent_increase" . "\xe23e")
|
||||
("format_italic" . "\xe23f")
|
||||
("format_line_spacing" . "\xe240")
|
||||
("format_list_bulleted" . "\xe241")
|
||||
("format_list_numbered" . "\xe242")
|
||||
("format_paint" . "\xe243")
|
||||
("format_quote" . "\xe244")
|
||||
("format_shapes" . "\xe25e")
|
||||
("format_size" . "\xe245")
|
||||
("format_strikethrough" . "\xe246")
|
||||
("format_textdirection_l_to_r" . "\xe247")
|
||||
("format_textdirection_r_to_l" . "\xe248")
|
||||
("format_underlined" . "\xe249")
|
||||
("forum" . "\xe0bf")
|
||||
("forward" . "\xe154")
|
||||
("forward_10" . "\xe056")
|
||||
("forward_30" . "\xe057")
|
||||
("forward_5" . "\xe058")
|
||||
("free_breakfast" . "\xeb44")
|
||||
("fullscreen" . "\xe5d0")
|
||||
("fullscreen_exit" . "\xe5d1")
|
||||
("functions" . "\xe24a")
|
||||
("g_translate" . "\xe927")
|
||||
("gamepad" . "\xe30f")
|
||||
("games" . "\xe021")
|
||||
("gavel" . "\xe90e")
|
||||
("gesture" . "\xe155")
|
||||
("get_app" . "\xe884")
|
||||
("gif" . "\xe908")
|
||||
("golf_course" . "\xeb45")
|
||||
("gps_fixed" . "\xe1b3")
|
||||
("gps_not_fixed" . "\xe1b4")
|
||||
("gps_off" . "\xe1b5")
|
||||
("grade" . "\xe885")
|
||||
("gradient" . "\xe3e9")
|
||||
("grain" . "\xe3ea")
|
||||
("graphic_eq" . "\xe1b8")
|
||||
("grid_off" . "\xe3eb")
|
||||
("grid_on" . "\xe3ec")
|
||||
("group" . "\xe7ef")
|
||||
("group_add" . "\xe7f0")
|
||||
("group_work" . "\xe886")
|
||||
("hd" . "\xe052")
|
||||
("hdr_off" . "\xe3ed")
|
||||
("hdr_on" . "\xe3ee")
|
||||
("hdr_strong" . "\xe3f1")
|
||||
("hdr_weak" . "\xe3f2")
|
||||
("headset" . "\xe310")
|
||||
("headset_mic" . "\xe311")
|
||||
("healing" . "\xe3f3")
|
||||
("hearing" . "\xe023")
|
||||
("help" . "\xe887")
|
||||
("help_outline" . "\xe8fd")
|
||||
("high_quality" . "\xe024")
|
||||
("highlight" . "\xe25f")
|
||||
("highlight_off" . "\xe888")
|
||||
("history" . "\xe889")
|
||||
("home" . "\xe88a")
|
||||
("hot_tub" . "\xeb46")
|
||||
("hotel" . "\xe53a")
|
||||
("hourglass_empty" . "\xe88b")
|
||||
("hourglass_full" . "\xe88c")
|
||||
("http" . "\xe902")
|
||||
("https" . "\xe88d")
|
||||
("image" . "\xe3f4")
|
||||
("image_aspect_ratio" . "\xe3f5")
|
||||
("import_contacts" . "\xe0e0")
|
||||
("import_export" . "\xe0c3")
|
||||
("important_devices" . "\xe912")
|
||||
("inbox" . "\xe156")
|
||||
("indeterminate_check_box" . "\xe909")
|
||||
("info" . "\xe88e")
|
||||
("info_outline" . "\xe88f")
|
||||
("input" . "\xe890")
|
||||
("insert_chart" . "\xe24b")
|
||||
("insert_comment" . "\xe24c")
|
||||
("insert_drive_file" . "\xe24d")
|
||||
("insert_emoticon" . "\xe24e")
|
||||
("insert_invitation" . "\xe24f")
|
||||
("insert_link" . "\xe250")
|
||||
("insert_photo" . "\xe251")
|
||||
("invert_colors" . "\xe891")
|
||||
("invert_colors_off" . "\xe0c4")
|
||||
("iso" . "\xe3f6")
|
||||
("keyboard" . "\xe312")
|
||||
("keyboard_arrow_down" . "\xe313")
|
||||
("keyboard_arrow_left" . "\xe314")
|
||||
("keyboard_arrow_right" . "\xe315")
|
||||
("keyboard_arrow_up" . "\xe316")
|
||||
("keyboard_backspace" . "\xe317")
|
||||
("keyboard_capslock" . "\xe318")
|
||||
("keyboard_hide" . "\xe31a")
|
||||
("keyboard_return" . "\xe31b")
|
||||
("keyboard_tab" . "\xe31c")
|
||||
("keyboard_voice" . "\xe31d")
|
||||
("kitchen" . "\xeb47")
|
||||
("label" . "\xe892")
|
||||
("label_outline" . "\xe893")
|
||||
("landscape" . "\xe3f7")
|
||||
("language" . "\xe894")
|
||||
("laptop" . "\xe31e")
|
||||
("laptop_chromebook" . "\xe31f")
|
||||
("laptop_mac" . "\xe320")
|
||||
("laptop_windows" . "\xe321")
|
||||
("last_page" . "\xe5dd")
|
||||
("launch" . "\xe895")
|
||||
("layers" . "\xe53b")
|
||||
("layers_clear" . "\xe53c")
|
||||
("leak_add" . "\xe3f8")
|
||||
("leak_remove" . "\xe3f9")
|
||||
("lens" . "\xe3fa")
|
||||
("library_add" . "\xe02e")
|
||||
("library_books" . "\xe02f")
|
||||
("library_music" . "\xe030")
|
||||
("lightbulb_outline" . "\xe90f")
|
||||
("line_style" . "\xe919")
|
||||
("line_weight" . "\xe91a")
|
||||
("linear_scale" . "\xe260")
|
||||
("link" . "\xe157")
|
||||
("linked_camera" . "\xe438")
|
||||
("list" . "\xe896")
|
||||
("live_help" . "\xe0c6")
|
||||
("live_tv" . "\xe639")
|
||||
("local_activity" . "\xe53f")
|
||||
("local_airport" . "\xe53d")
|
||||
("local_atm" . "\xe53e")
|
||||
("local_bar" . "\xe540")
|
||||
("local_cafe" . "\xe541")
|
||||
("local_car_wash" . "\xe542")
|
||||
("local_convenience_store" . "\xe543")
|
||||
("local_dining" . "\xe556")
|
||||
("local_drink" . "\xe544")
|
||||
("local_florist" . "\xe545")
|
||||
("local_gas_station" . "\xe546")
|
||||
("local_grocery_store" . "\xe547")
|
||||
("local_hospital" . "\xe548")
|
||||
("local_hotel" . "\xe549")
|
||||
("local_laundry_service" . "\xe54a")
|
||||
("local_library" . "\xe54b")
|
||||
("local_mall" . "\xe54c")
|
||||
("local_movies" . "\xe54d")
|
||||
("local_offer" . "\xe54e")
|
||||
("local_parking" . "\xe54f")
|
||||
("local_pharmacy" . "\xe550")
|
||||
("local_phone" . "\xe551")
|
||||
("local_pizza" . "\xe552")
|
||||
("local_play" . "\xe553")
|
||||
("local_post_office" . "\xe554")
|
||||
("local_printshop" . "\xe555")
|
||||
("local_see" . "\xe557")
|
||||
("local_shipping" . "\xe558")
|
||||
("local_taxi" . "\xe559")
|
||||
("location_city" . "\xe7f1")
|
||||
("location_disabled" . "\xe1b6")
|
||||
("location_off" . "\xe0c7")
|
||||
("location_on" . "\xe0c8")
|
||||
("location_searching" . "\xe1b7")
|
||||
("lock" . "\xe897")
|
||||
("lock_open" . "\xe898")
|
||||
("lock_outline" . "\xe899")
|
||||
("looks" . "\xe3fc")
|
||||
("looks_3" . "\xe3fb")
|
||||
("looks_4" . "\xe3fd")
|
||||
("looks_5" . "\xe3fe")
|
||||
("looks_6" . "\xe3ff")
|
||||
("looks_one" . "\xe400")
|
||||
("looks_two" . "\xe401")
|
||||
("loop" . "\xe028")
|
||||
("loupe" . "\xe402")
|
||||
("low_priority" . "\xe16d")
|
||||
("loyalty" . "\xe89a")
|
||||
("mail" . "\xe158")
|
||||
("mail_outline" . "\xe0e1")
|
||||
("map" . "\xe55b")
|
||||
("markunread" . "\xe159")
|
||||
("markunread_mailbox" . "\xe89b")
|
||||
("memory" . "\xe322")
|
||||
("menu" . "\xe5d2")
|
||||
("merge_type" . "\xe252")
|
||||
("message" . "\xe0c9")
|
||||
("mic" . "\xe029")
|
||||
("mic_none" . "\xe02a")
|
||||
("mic_off" . "\xe02b")
|
||||
("mms" . "\xe618")
|
||||
("mode_comment" . "\xe253")
|
||||
("mode_edit" . "\xe254")
|
||||
("monetization_on" . "\xe263")
|
||||
("money_off" . "\xe25c")
|
||||
("monochrome_photos" . "\xe403")
|
||||
("mood" . "\xe7f2")
|
||||
("mood_bad" . "\xe7f3")
|
||||
("more" . "\xe619")
|
||||
("more_horiz" . "\xe5d3")
|
||||
("more_vert" . "\xe5d4")
|
||||
("motorcycle" . "\xe91b")
|
||||
("mouse" . "\xe323")
|
||||
("move_to_inbox" . "\xe168")
|
||||
("movie" . "\xe02c")
|
||||
("movie_creation" . "\xe404")
|
||||
("movie_filter" . "\xe43a")
|
||||
("multiline_chart" . "\xe6df")
|
||||
("music_note" . "\xe405")
|
||||
("music_video" . "\xe063")
|
||||
("my_location" . "\xe55c")
|
||||
("nature" . "\xe406")
|
||||
("nature_people" . "\xe407")
|
||||
("navigate_before" . "\xe408")
|
||||
("navigate_next" . "\xe409")
|
||||
("navigation" . "\xe55d")
|
||||
("near_me" . "\xe569")
|
||||
("network_cell" . "\xe1b9")
|
||||
("network_check" . "\xe640")
|
||||
("network_locked" . "\xe61a")
|
||||
("network_wifi" . "\xe1ba")
|
||||
("new_releases" . "\xe031")
|
||||
("next_week" . "\xe16a")
|
||||
("nfc" . "\xe1bb")
|
||||
("no_encryption" . "\xe641")
|
||||
("no_sim" . "\xe0cc")
|
||||
("not_interested" . "\xe033")
|
||||
("note" . "\xe06f")
|
||||
("note_add" . "\xe89c")
|
||||
("notifications" . "\xe7f4")
|
||||
("notifications_active" . "\xe7f7")
|
||||
("notifications_none" . "\xe7f5")
|
||||
("notifications_off" . "\xe7f6")
|
||||
("notifications_paused" . "\xe7f8")
|
||||
("offline_pin" . "\xe90a")
|
||||
("ondemand_video" . "\xe63a")
|
||||
("opacity" . "\xe91c")
|
||||
("open_in_browser" . "\xe89d")
|
||||
("open_in_new" . "\xe89e")
|
||||
("open_with" . "\xe89f")
|
||||
("pages" . "\xe7f9")
|
||||
("pageview" . "\xe8a0")
|
||||
("palette" . "\xe40a")
|
||||
("pan_tool" . "\xe925")
|
||||
("panorama" . "\xe40b")
|
||||
("panorama_fish_eye" . "\xe40c")
|
||||
("panorama_horizontal" . "\xe40d")
|
||||
("panorama_vertical" . "\xe40e")
|
||||
("panorama_wide_angle" . "\xe40f")
|
||||
("party_mode" . "\xe7fa")
|
||||
("pause" . "\xe034")
|
||||
("pause_circle_filled" . "\xe035")
|
||||
("pause_circle_outline" . "\xe036")
|
||||
("payment" . "\xe8a1")
|
||||
("people" . "\xe7fb")
|
||||
("people_outline" . "\xe7fc")
|
||||
("perm_camera_mic" . "\xe8a2")
|
||||
("perm_contact_calendar" . "\xe8a3")
|
||||
("perm_data_setting" . "\xe8a4")
|
||||
("perm_device_information" . "\xe8a5")
|
||||
("perm_identity" . "\xe8a6")
|
||||
("perm_media" . "\xe8a7")
|
||||
("perm_phone_msg" . "\xe8a8")
|
||||
("perm_scan_wifi" . "\xe8a9")
|
||||
("person" . "\xe7fd")
|
||||
("person_add" . "\xe7fe")
|
||||
("person_outline" . "\xe7ff")
|
||||
("person_pin" . "\xe55a")
|
||||
("person_pin_circle" . "\xe56a")
|
||||
("personal_video" . "\xe63b")
|
||||
("pets" . "\xe91d")
|
||||
("phone" . "\xe0cd")
|
||||
("phone_android" . "\xe324")
|
||||
("phone_bluetooth_speaker" . "\xe61b")
|
||||
("phone_forwarded" . "\xe61c")
|
||||
("phone_in_talk" . "\xe61d")
|
||||
("phone_iphone" . "\xe325")
|
||||
("phone_locked" . "\xe61e")
|
||||
("phone_missed" . "\xe61f")
|
||||
("phone_paused" . "\xe620")
|
||||
("phonelink" . "\xe326")
|
||||
("phonelink_erase" . "\xe0db")
|
||||
("phonelink_lock" . "\xe0dc")
|
||||
("phonelink_off" . "\xe327")
|
||||
("phonelink_ring" . "\xe0dd")
|
||||
("phonelink_setup" . "\xe0de")
|
||||
("photo" . "\xe410")
|
||||
("photo_album" . "\xe411")
|
||||
("photo_camera" . "\xe412")
|
||||
("photo_filter" . "\xe43b")
|
||||
("photo_library" . "\xe413")
|
||||
("photo_size_select_actual" . "\xe432")
|
||||
("photo_size_select_large" . "\xe433")
|
||||
("photo_size_select_small" . "\xe434")
|
||||
("picture_as_pdf" . "\xe415")
|
||||
("picture_in_picture" . "\xe8aa")
|
||||
("picture_in_picture_alt" . "\xe911")
|
||||
("pie_chart" . "\xe6c4")
|
||||
("pie_chart_outlined" . "\xe6c5")
|
||||
("pin_drop" . "\xe55e")
|
||||
("place" . "\xe55f")
|
||||
("play_arrow" . "\xe037")
|
||||
("play_circle_filled" . "\xe038")
|
||||
("play_circle_outline" . "\xe039")
|
||||
("play_for_work" . "\xe906")
|
||||
("playlist_add" . "\xe03b")
|
||||
("playlist_add_check" . "\xe065")
|
||||
("playlist_play" . "\xe05f")
|
||||
("plus_one" . "\xe800")
|
||||
("poll" . "\xe801")
|
||||
("polymer" . "\xe8ab")
|
||||
("pool" . "\xeb48")
|
||||
("portable_wifi_off" . "\xe0ce")
|
||||
("portrait" . "\xe416")
|
||||
("power" . "\xe63c")
|
||||
("power_input" . "\xe336")
|
||||
("power_settings_new" . "\xe8ac")
|
||||
("pregnant_woman" . "\xe91e")
|
||||
("present_to_all" . "\xe0df")
|
||||
("print" . "\xe8ad")
|
||||
("priority_high" . "\xe645")
|
||||
("public" . "\xe80b")
|
||||
("publish" . "\xe255")
|
||||
("query_builder" . "\xe8ae")
|
||||
("question_answer" . "\xe8af")
|
||||
("queue" . "\xe03c")
|
||||
("queue_music" . "\xe03d")
|
||||
("queue_play_next" . "\xe066")
|
||||
("radio" . "\xe03e")
|
||||
("radio_button_checked" . "\xe837")
|
||||
("radio_button_unchecked" . "\xe836")
|
||||
("rate_review" . "\xe560")
|
||||
("receipt" . "\xe8b0")
|
||||
("recent_actors" . "\xe03f")
|
||||
("record_voice_over" . "\xe91f")
|
||||
("redeem" . "\xe8b1")
|
||||
("redo" . "\xe15a")
|
||||
("refresh" . "\xe5d5")
|
||||
("remove" . "\xe15b")
|
||||
("remove_circle" . "\xe15c")
|
||||
("remove_circle_outline" . "\xe15d")
|
||||
("remove_from_queue" . "\xe067")
|
||||
("remove_red_eye" . "\xe417")
|
||||
("remove_shopping_cart" . "\xe928")
|
||||
("reorder" . "\xe8fe")
|
||||
("repeat" . "\xe040")
|
||||
("repeat_one" . "\xe041")
|
||||
("replay" . "\xe042")
|
||||
("replay_10" . "\xe059")
|
||||
("replay_30" . "\xe05a")
|
||||
("replay_5" . "\xe05b")
|
||||
("reply" . "\xe15e")
|
||||
("reply_all" . "\xe15f")
|
||||
("report" . "\xe160")
|
||||
("report_problem" . "\xe8b2")
|
||||
("restaurant" . "\xe56c")
|
||||
("restaurant_menu" . "\xe561")
|
||||
("restore" . "\xe8b3")
|
||||
("restore_page" . "\xe929")
|
||||
("ring_volume" . "\xe0d1")
|
||||
("room" . "\xe8b4")
|
||||
("room_service" . "\xeb49")
|
||||
("rotate_90_degrees_ccw" . "\xe418")
|
||||
("rotate_left" . "\xe419")
|
||||
("rotate_right" . "\xe41a")
|
||||
("rounded_corner" . "\xe920")
|
||||
("router" . "\xe328")
|
||||
("rowing" . "\xe921")
|
||||
("rss_feed" . "\xe0e5")
|
||||
("rv_hookup" . "\xe642")
|
||||
("satellite" . "\xe562")
|
||||
("save" . "\xe161")
|
||||
("scanner" . "\xe329")
|
||||
("schedule" . "\xe8b5")
|
||||
("school" . "\xe80c")
|
||||
("screen_lock_landscape" . "\xe1be")
|
||||
("screen_lock_portrait" . "\xe1bf")
|
||||
("screen_lock_rotation" . "\xe1c0")
|
||||
("screen_rotation" . "\xe1c1")
|
||||
("screen_share" . "\xe0e2")
|
||||
("sd_card" . "\xe623")
|
||||
("sd_storage" . "\xe1c2")
|
||||
("search" . "\xe8b6")
|
||||
("security" . "\xe32a")
|
||||
("select_all" . "\xe162")
|
||||
("send" . "\xe163")
|
||||
("sentiment_dissatisfied" . "\xe811")
|
||||
("sentiment_neutral" . "\xe812")
|
||||
("sentiment_satisfied" . "\xe813")
|
||||
("sentiment_very_dissatisfied" . "\xe814")
|
||||
("sentiment_very_satisfied" . "\xe815")
|
||||
("settings" . "\xe8b8")
|
||||
("settings_applications" . "\xe8b9")
|
||||
("settings_backup_restore" . "\xe8ba")
|
||||
("settings_bluetooth" . "\xe8bb")
|
||||
("settings_brightness" . "\xe8bd")
|
||||
("settings_cell" . "\xe8bc")
|
||||
("settings_ethernet" . "\xe8be")
|
||||
("settings_input_antenna" . "\xe8bf")
|
||||
("settings_input_component" . "\xe8c0")
|
||||
("settings_input_composite" . "\xe8c1")
|
||||
("settings_input_hdmi" . "\xe8c2")
|
||||
("settings_input_svideo" . "\xe8c3")
|
||||
("settings_overscan" . "\xe8c4")
|
||||
("settings_phone" . "\xe8c5")
|
||||
("settings_power" . "\xe8c6")
|
||||
("settings_remote" . "\xe8c7")
|
||||
("settings_system_daydream" . "\xe1c3")
|
||||
("settings_voice" . "\xe8c8")
|
||||
("share" . "\xe80d")
|
||||
("shop" . "\xe8c9")
|
||||
("shop_two" . "\xe8ca")
|
||||
("shopping_basket" . "\xe8cb")
|
||||
("shopping_cart" . "\xe8cc")
|
||||
("short_text" . "\xe261")
|
||||
("show_chart" . "\xe6e1")
|
||||
("shuffle" . "\xe043")
|
||||
("signal_cellular_4_bar" . "\xe1c8")
|
||||
("signal_cellular_connected_no_internet_4_bar" . "\xe1cd")
|
||||
("signal_cellular_no_sim" . "\xe1ce")
|
||||
("signal_cellular_null" . "\xe1cf")
|
||||
("signal_cellular_off" . "\xe1d0")
|
||||
("signal_wifi_4_bar" . "\xe1d8")
|
||||
("signal_wifi_4_bar_lock" . "\xe1d9")
|
||||
("signal_wifi_off" . "\xe1da")
|
||||
("sim_card" . "\xe32b")
|
||||
("sim_card_alert" . "\xe624")
|
||||
("skip_next" . "\xe044")
|
||||
("skip_previous" . "\xe045")
|
||||
("slideshow" . "\xe41b")
|
||||
("slow_motion_video" . "\xe068")
|
||||
("smartphone" . "\xe32c")
|
||||
("smoke_free" . "\xeb4a")
|
||||
("smoking_rooms" . "\xeb4b")
|
||||
("sms" . "\xe625")
|
||||
("sms_failed" . "\xe626")
|
||||
("snooze" . "\xe046")
|
||||
("sort" . "\xe164")
|
||||
("sort_by_alpha" . "\xe053")
|
||||
("spa" . "\xeb4c")
|
||||
("space_bar" . "\xe256")
|
||||
("speaker" . "\xe32d")
|
||||
("speaker_group" . "\xe32e")
|
||||
("speaker_notes" . "\xe8cd")
|
||||
("speaker_notes_off" . "\xe92a")
|
||||
("speaker_phone" . "\xe0d2")
|
||||
("spellcheck" . "\xe8ce")
|
||||
("star" . "\xe838")
|
||||
("star_border" . "\xe83a")
|
||||
("star_half" . "\xe839")
|
||||
("stars" . "\xe8d0")
|
||||
("stay_current_landscape" . "\xe0d3")
|
||||
("stay_current_portrait" . "\xe0d4")
|
||||
("stay_primary_landscape" . "\xe0d5")
|
||||
("stay_primary_portrait" . "\xe0d6")
|
||||
("stop" . "\xe047")
|
||||
("stop_screen_share" . "\xe0e3")
|
||||
("storage" . "\xe1db")
|
||||
("store" . "\xe8d1")
|
||||
("store_mall_directory" . "\xe563")
|
||||
("straighten" . "\xe41c")
|
||||
("streetview" . "\xe56e")
|
||||
("strikethrough_s" . "\xe257")
|
||||
("style" . "\xe41d")
|
||||
("subdirectory_arrow_left" . "\xe5d9")
|
||||
("subdirectory_arrow_right" . "\xe5da")
|
||||
("subject" . "\xe8d2")
|
||||
("subscriptions" . "\xe064")
|
||||
("subtitles" . "\xe048")
|
||||
("subway" . "\xe56f")
|
||||
("supervisor_account" . "\xe8d3")
|
||||
("surround_sound" . "\xe049")
|
||||
("swap_calls" . "\xe0d7")
|
||||
("swap_horiz" . "\xe8d4")
|
||||
("swap_vert" . "\xe8d5")
|
||||
("swap_vertical_circle" . "\xe8d6")
|
||||
("switch_camera" . "\xe41e")
|
||||
("switch_video" . "\xe41f")
|
||||
("sync" . "\xe627")
|
||||
("sync_disabled" . "\xe628")
|
||||
("sync_problem" . "\xe629")
|
||||
("system_update" . "\xe62a")
|
||||
("system_update_alt" . "\xe8d7")
|
||||
("tab" . "\xe8d8")
|
||||
("tab_unselected" . "\xe8d9")
|
||||
("tablet" . "\xe32f")
|
||||
("tablet_android" . "\xe330")
|
||||
("tablet_mac" . "\xe331")
|
||||
("tag_faces" . "\xe420")
|
||||
("tap_and_play" . "\xe62b")
|
||||
("terrain" . "\xe564")
|
||||
("text_fields" . "\xe262")
|
||||
("text_format" . "\xe165")
|
||||
("textsms" . "\xe0d8")
|
||||
("texture" . "\xe421")
|
||||
("theaters" . "\xe8da")
|
||||
("thumb_down" . "\xe8db")
|
||||
("thumb_up" . "\xe8dc")
|
||||
("thumbs_up_down" . "\xe8dd")
|
||||
("time_to_leave" . "\xe62c")
|
||||
("timelapse" . "\xe422")
|
||||
("timeline" . "\xe922")
|
||||
("timer" . "\xe425")
|
||||
("timer_10" . "\xe423")
|
||||
("timer_3" . "\xe424")
|
||||
("timer_off" . "\xe426")
|
||||
("title" . "\xe264")
|
||||
("toc" . "\xe8de")
|
||||
("today" . "\xe8df")
|
||||
("toll" . "\xe8e0")
|
||||
("tonality" . "\xe427")
|
||||
("touch_app" . "\xe913")
|
||||
("toys" . "\xe332")
|
||||
("track_changes" . "\xe8e1")
|
||||
("traffic" . "\xe565")
|
||||
("train" . "\xe570")
|
||||
("tram" . "\xe571")
|
||||
("transfer_within_a_station" . "\xe572")
|
||||
("transform" . "\xe428")
|
||||
("translate" . "\xe8e2")
|
||||
("trending_down" . "\xe8e3")
|
||||
("trending_flat" . "\xe8e4")
|
||||
("trending_up" . "\xe8e5")
|
||||
("tune" . "\xe429")
|
||||
("turned_in" . "\xe8e6")
|
||||
("turned_in_not" . "\xe8e7")
|
||||
("tv" . "\xe333")
|
||||
("unarchive" . "\xe169")
|
||||
("undo" . "\xe166")
|
||||
("unfold_less" . "\xe5d6")
|
||||
("unfold_more" . "\xe5d7")
|
||||
("update" . "\xe923")
|
||||
("usb" . "\xe1e0")
|
||||
("verified_user" . "\xe8e8")
|
||||
("vertical_align_bottom" . "\xe258")
|
||||
("vertical_align_center" . "\xe259")
|
||||
("vertical_align_top" . "\xe25a")
|
||||
("vibration" . "\xe62d")
|
||||
("video_call" . "\xe070")
|
||||
("video_label" . "\xe071")
|
||||
("video_library" . "\xe04a")
|
||||
("videocam" . "\xe04b")
|
||||
("videocam_off" . "\xe04c")
|
||||
("videogame_asset" . "\xe338")
|
||||
("view_agenda" . "\xe8e9")
|
||||
("view_array" . "\xe8ea")
|
||||
("view_carousel" . "\xe8eb")
|
||||
("view_column" . "\xe8ec")
|
||||
("view_comfy" . "\xe42a")
|
||||
("view_compact" . "\xe42b")
|
||||
("view_day" . "\xe8ed")
|
||||
("view_headline" . "\xe8ee")
|
||||
("view_list" . "\xe8ef")
|
||||
("view_module" . "\xe8f0")
|
||||
("view_quilt" . "\xe8f1")
|
||||
("view_stream" . "\xe8f2")
|
||||
("view_week" . "\xe8f3")
|
||||
("vignette" . "\xe435")
|
||||
("visibility" . "\xe8f4")
|
||||
("visibility_off" . "\xe8f5")
|
||||
("voice_chat" . "\xe62e")
|
||||
("voicemail" . "\xe0d9")
|
||||
("volume_down" . "\xe04d")
|
||||
("volume_mute" . "\xe04e")
|
||||
("volume_off" . "\xe04f")
|
||||
("volume_up" . "\xe050")
|
||||
("vpn_key" . "\xe0da")
|
||||
("vpn_lock" . "\xe62f")
|
||||
("wallpaper" . "\xe1bc")
|
||||
("warning" . "\xe002")
|
||||
("watch" . "\xe334")
|
||||
("watch_later" . "\xe924")
|
||||
("wb_auto" . "\xe42c")
|
||||
("wb_cloudy" . "\xe42d")
|
||||
("wb_incandescent" . "\xe42e")
|
||||
("wb_iridescent" . "\xe436")
|
||||
("wb_sunny" . "\xe430")
|
||||
("wc" . "\xe63d")
|
||||
("web" . "\xe051")
|
||||
("web_asset" . "\xe069")
|
||||
("weekend" . "\xe16b")
|
||||
("whatshot" . "\xe80e")
|
||||
("widgets" . "\xe1bd")
|
||||
("wifi" . "\xe63e")
|
||||
("wifi_lock" . "\xe1e1")
|
||||
("wifi_tethering" . "\xe1e2")
|
||||
("work" . "\xe8f9")
|
||||
("wrap_text" . "\xe25b")
|
||||
("youtube_searched_for" . "\xe8fa")
|
||||
("zoom_in" . "\xe8ff")
|
||||
("zoom_out" . "\xe900")
|
||||
("zoom_out_map" . "\xe56b")))
|
||||
|
||||
(provide 'data-material)
|
||||
|
|
@ -1,165 +0,0 @@
|
|||
(defvar all-the-icons-data/octicons-alist
|
||||
'(
|
||||
|
||||
("alert" . "\xf02d")
|
||||
("arrow-down" . "\xf03f")
|
||||
("arrow-left" . "\xf040")
|
||||
("arrow-right" . "\xf03e")
|
||||
("arrow-small-down" . "\xf0a0")
|
||||
("arrow-small-left" . "\xf0a1")
|
||||
("arrow-small-right" . "\xf071")
|
||||
("arrow-small-up" . "\xf09f")
|
||||
("arrow-up" . "\xf03d")
|
||||
("book" . "\xf007")
|
||||
("bookmark" . "\xf07b")
|
||||
("briefcase" . "\xf0d3")
|
||||
("broadcast" . "\xf048")
|
||||
("browser" . "\xf0c5")
|
||||
("bug" . "\xf091")
|
||||
("calendar" . "\xf068")
|
||||
("check" . "\xf03a")
|
||||
("checklist" . "\xf076")
|
||||
("chevron-down" . "\xf0a3")
|
||||
("chevron-left" . "\xf0a4")
|
||||
("chevron-right" . "\xf078")
|
||||
("chevron-up" . "\xf0a2")
|
||||
("circle-slash" . "\xf084")
|
||||
("circuit-board" . "\xf0d6")
|
||||
("clippy" . "\xf035")
|
||||
("clock" . "\xf046")
|
||||
("cloud-download" . "\xf00b")
|
||||
("cloud-upload" . "\xf00c")
|
||||
("code" . "\xf05f")
|
||||
("comment" . "\xf02b")
|
||||
("comment-discussion" . "\xf04f")
|
||||
("credit-card" . "\xf045")
|
||||
("dash" . "\xf0ca")
|
||||
("dashboard" . "\xf07d")
|
||||
("database" . "\xf096")
|
||||
("device-camera" . "\xf056")
|
||||
("device-camera-video" . "\xf057")
|
||||
("device-desktop" . "\xf27c")
|
||||
("device-mobile" . "\xf038")
|
||||
("diff" . "\xf04d")
|
||||
("diff-added" . "\xf06b")
|
||||
("diff-ignored" . "\xf099")
|
||||
("diff-modified" . "\xf06d")
|
||||
("diff-removed" . "\xf06c")
|
||||
("diff-renamed" . "\xf06e")
|
||||
("ellipsis" . "\xf09a")
|
||||
("eye" . "\xf04e")
|
||||
("file-binary" . "\xf094")
|
||||
("file-code" . "\xf010")
|
||||
("file-directory" . "\xf016")
|
||||
("file-media" . "\xf012")
|
||||
("file-pdf" . "\xf014")
|
||||
("file-submodule" . "\xf017")
|
||||
("file-symlink-directory" . "\xf0b1")
|
||||
("file-symlink-file" . "\xf0b0")
|
||||
("file-text" . "\xf011")
|
||||
("file-zip" . "\xf013")
|
||||
("flame" . "\xf0d2")
|
||||
("fold" . "\xf0cc")
|
||||
("gear" . "\xf02f")
|
||||
("gift" . "\xf042")
|
||||
("gist" . "\xf00e")
|
||||
("gist-secret" . "\xf08c")
|
||||
("git-branch" . "\xf020")
|
||||
("git-commit" . "\xf01f")
|
||||
("git-compare" . "\xf0ac")
|
||||
("git-merge" . "\xf023")
|
||||
("git-pull-request" . "\xf009")
|
||||
("globe" . "\xf0b6")
|
||||
("graph" . "\xf043")
|
||||
("beaker" . "\xf0dd")
|
||||
("heart" . "\x2665")
|
||||
("history" . "\xf07e")
|
||||
("home" . "\xf08d")
|
||||
("horizontal-rule" . "\xf070")
|
||||
("hourglass" . "\xf09e")
|
||||
("hubot" . "\xf09d")
|
||||
("inbox" . "\xf0cf")
|
||||
("info" . "\xf059")
|
||||
("issue-closed" . "\xf028")
|
||||
("issue-opened" . "\xf026")
|
||||
("issue-reopened" . "\xf027")
|
||||
("jersey" . "\xf019")
|
||||
("key" . "\xf049")
|
||||
("keyboard" . "\xf00d")
|
||||
("law" . "\xf0d8")
|
||||
("light-bulb" . "\xf000")
|
||||
("link" . "\xf05c")
|
||||
("link-external" . "\xf07f")
|
||||
("list-ordered" . "\xf062")
|
||||
("list-unordered" . "\xf061")
|
||||
("location" . "\xf060")
|
||||
("lock" . "\xf06a")
|
||||
("logo-github" . "\xf092")
|
||||
("mail" . "\xf03b")
|
||||
("mail-read" . "\xf03c")
|
||||
("mail-reply" . "\xf051")
|
||||
("mark-github" . "\xf00a")
|
||||
("markdown" . "\xf0c9")
|
||||
("megaphone" . "\xf077")
|
||||
("mention" . "\xf0be")
|
||||
("milestone" . "\xf075")
|
||||
("mirror" . "\xf024")
|
||||
("mortar-board" . "\xf0d7")
|
||||
("mute" . "\xf080")
|
||||
("no-newline" . "\xf09c")
|
||||
("octoface" . "\xf008")
|
||||
("organization" . "\xf037")
|
||||
("package" . "\xf0c4")
|
||||
("paintcan" . "\xf0d1")
|
||||
("pencil" . "\xf058")
|
||||
("person" . "\xf018")
|
||||
("pin" . "\xf041")
|
||||
("plug" . "\xf0d4")
|
||||
("plus" . "\xf05d")
|
||||
("primitive-dot" . "\xf052")
|
||||
("primitive-square" . "\xf053")
|
||||
("pulse" . "\xf085")
|
||||
("puzzle" . "\xf0c0")
|
||||
("question" . "\xf02c")
|
||||
("quote" . "\xf063")
|
||||
("radio-tower" . "\xf030")
|
||||
("repo" . "\xf001")
|
||||
("repo-clone" . "\xf04c")
|
||||
("repo-force-push" . "\xf04a")
|
||||
("repo-forked" . "\xf002")
|
||||
("repo-pull" . "\xf006")
|
||||
("repo-push" . "\xf005")
|
||||
("rocket" . "\xf033")
|
||||
("rss" . "\xf034")
|
||||
("ruby" . "\xf047")
|
||||
("search" . "\xf02e")
|
||||
("server" . "\xf097")
|
||||
("settings" . "\xf07c")
|
||||
("sign-in" . "\xf036")
|
||||
("sign-out" . "\xf032")
|
||||
("squirrel" . "\xf0b2")
|
||||
("star" . "\xf02a")
|
||||
("steps" . "\xf0c7")
|
||||
("stop" . "\xf08f")
|
||||
("sync" . "\xf087")
|
||||
("tag" . "\xf015")
|
||||
("telescope" . "\xf088")
|
||||
("terminal" . "\xf0c8")
|
||||
("three-bars" . "\xf05e")
|
||||
("thumbsdown" . "\xf0db")
|
||||
("thumbsup" . "\xf0da")
|
||||
("tools" . "\xf031")
|
||||
("trashcan" . "\xf0d0")
|
||||
("triangle-down" . "\xf05b")
|
||||
("triangle-left" . "\xf044")
|
||||
("triangle-right" . "\xf05a")
|
||||
("triangle-up" . "\xf0aa")
|
||||
("unfold" . "\xf039")
|
||||
("unmute" . "\xf0ba")
|
||||
("versions" . "\xf064")
|
||||
("x" . "\xf081")
|
||||
("zap" . "\x26A1")
|
||||
|
||||
))
|
||||
|
||||
(provide 'data-octicons)
|
||||
|
|
@ -1,594 +0,0 @@
|
|||
(defvar all-the-icons-data/weather-icons-alist
|
||||
'(
|
||||
|
||||
("alien" . "\xf075")
|
||||
("barometer" . "\xf079")
|
||||
("celsius" . "\xf03c")
|
||||
("cloud" . "\xf041")
|
||||
("cloud-down" . "\xf03d")
|
||||
("cloud-refresh" . "\xf03e")
|
||||
("cloud-up" . "\xf040")
|
||||
("cloudy" . "\xf013")
|
||||
("cloudy-gusts" . "\xf011")
|
||||
("cloudy-windy" . "\xf012")
|
||||
("day-cloudy" . "\xf002")
|
||||
("day-cloudy-gusts" . "\xf000")
|
||||
("day-cloudy-high" . "\xf07d")
|
||||
("day-cloudy-windy" . "\xf001")
|
||||
("day-fog" . "\xf003")
|
||||
("day-hail" . "\xf004")
|
||||
("day-haze" . "\xf0b6")
|
||||
("day-light-wind" . "\xf0c4")
|
||||
("day-lightning" . "\xf005")
|
||||
("day-rain" . "\xf008")
|
||||
("day-rain-mix" . "\xf006")
|
||||
("day-rain-wind" . "\xf007")
|
||||
("day-showers" . "\xf009")
|
||||
("day-sleet" . "\xf0b2")
|
||||
("day-sleet-storm" . "\xf068")
|
||||
("day-snow" . "\xf00a")
|
||||
("day-snow-thunderstorm" . "\xf06b")
|
||||
("day-snow-wind" . "\xf065")
|
||||
("day-sprinkle" . "\xf00b")
|
||||
("day-storm-showers" . "\xf00e")
|
||||
("day-sunny" . "\xf00d")
|
||||
("day-sunny-overcast" . "\xf00c")
|
||||
("day-thunderstorm" . "\xf010")
|
||||
("day-windy" . "\xf085")
|
||||
("degrees" . "\xf042")
|
||||
("direction-down" . "\xf044")
|
||||
("direction-down-left" . "\xf043")
|
||||
("direction-down-right" . "\xf088")
|
||||
("direction-left" . "\xf048")
|
||||
("direction-right" . "\xf04d")
|
||||
("direction-up" . "\xf058")
|
||||
("direction-up-left" . "\xf087")
|
||||
("direction-up-right" . "\xf057")
|
||||
("dust" . "\xf063")
|
||||
("earthquake" . "\xf0c6")
|
||||
("fahrenheit" . "\xf045")
|
||||
("fire" . "\xf0c7")
|
||||
("flood" . "\xf07c")
|
||||
("fog" . "\xf014")
|
||||
("forecast-io-clear-day" . "\xf00d")
|
||||
("forecast-io-clear-night" . "\xf02e")
|
||||
("forecast-io-cloudy" . "\xf013")
|
||||
("forecast-io-fog" . "\xf014")
|
||||
("forecast-io-hail" . "\xf015")
|
||||
("forecast-io-partly-cloudy-day" . "\xf002")
|
||||
("forecast-io-partly-cloudy-night" . "\xf031")
|
||||
("forecast-io-rain" . "\xf019")
|
||||
("forecast-io-sleet" . "\xf0b5")
|
||||
("forecast-io-snow" . "\xf01b")
|
||||
("forecast-io-thunderstorm" . "\xf01e")
|
||||
("forecast-io-tornado" . "\xf056")
|
||||
("forecast-io-wind" . "\xf050")
|
||||
("gale-warning" . "\xf0cd")
|
||||
("hail" . "\xf015")
|
||||
("horizon" . "\xf047")
|
||||
("horizon-alt" . "\xf046")
|
||||
("hot" . "\xf072")
|
||||
("humidity" . "\xf07a")
|
||||
("hurricane" . "\xf073")
|
||||
("hurricane-warning" . "\xf0cf")
|
||||
("lightning" . "\xf016")
|
||||
("lunar-eclipse" . "\xf070")
|
||||
("meteor" . "\xf071")
|
||||
("moon-0" . "\xf095")
|
||||
("moon-1" . "\xf096")
|
||||
("moon-10" . "\xf09f")
|
||||
("moon-11" . "\xf0a0")
|
||||
("moon-12" . "\xf0a1")
|
||||
("moon-13" . "\xf0a2")
|
||||
("moon-14" . "\xf0a3")
|
||||
("moon-15" . "\xf0a4")
|
||||
("moon-16" . "\xf0a5")
|
||||
("moon-17" . "\xf0a6")
|
||||
("moon-18" . "\xf0a7")
|
||||
("moon-19" . "\xf0a8")
|
||||
("moon-2" . "\xf097")
|
||||
("moon-20" . "\xf0a9")
|
||||
("moon-21" . "\xf0aa")
|
||||
("moon-22" . "\xf0ab")
|
||||
("moon-23" . "\xf0ac")
|
||||
("moon-24" . "\xf0ad")
|
||||
("moon-25" . "\xf0ae")
|
||||
("moon-26" . "\xf0af")
|
||||
("moon-27" . "\xf0b0")
|
||||
("moon-3" . "\xf098")
|
||||
("moon-4" . "\xf099")
|
||||
("moon-5" . "\xf09a")
|
||||
("moon-6" . "\xf09b")
|
||||
("moon-7" . "\xf09c")
|
||||
("moon-8" . "\xf09d")
|
||||
("moon-9" . "\xf09e")
|
||||
("moon-alt-first-quarter" . "\xf0d6")
|
||||
("moon-alt-full" . "\xf0dd")
|
||||
("moon-alt-new" . "\xf0eb")
|
||||
("moon-alt-third-quarter" . "\xf0e4")
|
||||
("moon-alt-waning-crescent-1" . "\xf0e5")
|
||||
("moon-alt-waning-crescent-2" . "\xf0e6")
|
||||
("moon-alt-waning-crescent-3" . "\xf0e7")
|
||||
("moon-alt-waning-crescent-4" . "\xf0e8")
|
||||
("moon-alt-waning-crescent-5" . "\xf0e9")
|
||||
("moon-alt-waning-crescent-6" . "\xf0ea")
|
||||
("moon-alt-waning-gibbous-1" . "\xf0de")
|
||||
("moon-alt-waning-gibbous-2" . "\xf0df")
|
||||
("moon-alt-waning-gibbous-3" . "\xf0e0")
|
||||
("moon-alt-waning-gibbous-4" . "\xf0e1")
|
||||
("moon-alt-waning-gibbous-5" . "\xf0e2")
|
||||
("moon-alt-waning-gibbous-6" . "\xf0e3")
|
||||
("moon-alt-waxing-crescent-1" . "\xf0d0")
|
||||
("moon-alt-waxing-crescent-2" . "\xf0d1")
|
||||
("moon-alt-waxing-crescent-3" . "\xf0d2")
|
||||
("moon-alt-waxing-crescent-4" . "\xf0d3")
|
||||
("moon-alt-waxing-crescent-5" . "\xf0d4")
|
||||
("moon-alt-waxing-crescent-6" . "\xf0d5")
|
||||
("moon-alt-waxing-gibbous-1" . "\xf0d7")
|
||||
("moon-alt-waxing-gibbous-2" . "\xf0d8")
|
||||
("moon-alt-waxing-gibbous-3" . "\xf0d9")
|
||||
("moon-alt-waxing-gibbous-4" . "\xf0da")
|
||||
("moon-alt-waxing-gibbous-5" . "\xf0db")
|
||||
("moon-alt-waxing-gibbous-6" . "\xf0dc")
|
||||
("moon-first-quarter" . "\xf09c")
|
||||
("moon-full" . "\xf0a3")
|
||||
("moon-new" . "\xf095")
|
||||
("moon-third-quarter" . "\xf0aa")
|
||||
("moon-waning-crescent-1" . "\xf0ab")
|
||||
("moon-waning-crescent-2" . "\xf0ac")
|
||||
("moon-waning-crescent-3" . "\xf0ad")
|
||||
("moon-waning-crescent-4" . "\xf0ae")
|
||||
("moon-waning-crescent-5" . "\xf0af")
|
||||
("moon-waning-crescent-6" . "\xf0b0")
|
||||
("moon-waning-gibbous-1" . "\xf0a4")
|
||||
("moon-waning-gibbous-2" . "\xf0a5")
|
||||
("moon-waning-gibbous-3" . "\xf0a6")
|
||||
("moon-waning-gibbous-4" . "\xf0a7")
|
||||
("moon-waning-gibbous-5" . "\xf0a8")
|
||||
("moon-waning-gibbous-6" . "\xf0a9")
|
||||
("moon-waxing-crescent-1" . "\xf096")
|
||||
("moon-waxing-crescent-2" . "\xf097")
|
||||
("moon-waxing-crescent-3" . "\xf098")
|
||||
("moon-waxing-crescent-4" . "\xf099")
|
||||
("moon-waxing-crescent-5" . "\xf09a")
|
||||
("moon-waxing-crescent-6" . "\xf09b")
|
||||
("moon-waxing-gibbous-1" . "\xf09d")
|
||||
("moon-waxing-gibbous-2" . "\xf09e")
|
||||
("moon-waxing-gibbous-3" . "\xf09f")
|
||||
("moon-waxing-gibbous-4" . "\xf0a0")
|
||||
("moon-waxing-gibbous-5" . "\xf0a1")
|
||||
("moon-waxing-gibbous-6" . "\xf0a2")
|
||||
("moonrise" . "\xf0c9")
|
||||
("moonset" . "\xf0ca")
|
||||
("na" . "\xf07b")
|
||||
("night-alt-cloudy" . "\xf086")
|
||||
("night-alt-cloudy-gusts" . "\xf022")
|
||||
("night-alt-cloudy-high" . "\xf07e")
|
||||
("night-alt-cloudy-windy" . "\xf023")
|
||||
("night-alt-hail" . "\xf024")
|
||||
("night-alt-lightning" . "\xf025")
|
||||
("night-alt-partly-cloudy" . "\xf081")
|
||||
("night-alt-rain" . "\xf028")
|
||||
("night-alt-rain-mix" . "\xf026")
|
||||
("night-alt-rain-wind" . "\xf027")
|
||||
("night-alt-showers" . "\xf029")
|
||||
("night-alt-sleet" . "\xf0b4")
|
||||
("night-alt-sleet-storm" . "\xf06a")
|
||||
("night-alt-snow" . "\xf02a")
|
||||
("night-alt-snow-thunderstorm" . "\xf06d")
|
||||
("night-alt-snow-wind" . "\xf067")
|
||||
("night-alt-sprinkle" . "\xf02b")
|
||||
("night-alt-storm-showers" . "\xf02c")
|
||||
("night-alt-thunderstorm" . "\xf02d")
|
||||
("night-clear" . "\xf02e")
|
||||
("night-cloudy" . "\xf031")
|
||||
("night-cloudy-gusts" . "\xf02f")
|
||||
("night-cloudy-high" . "\xf080")
|
||||
("night-cloudy-windy" . "\xf030")
|
||||
("night-fog" . "\xf04a")
|
||||
("night-hail" . "\xf032")
|
||||
("night-lightning" . "\xf033")
|
||||
("night-partly-cloudy" . "\xf083")
|
||||
("night-rain" . "\xf036")
|
||||
("night-rain-mix" . "\xf034")
|
||||
("night-rain-wind" . "\xf035")
|
||||
("night-showers" . "\xf037")
|
||||
("night-sleet" . "\xf0b3")
|
||||
("night-sleet-storm" . "\xf069")
|
||||
("night-snow" . "\xf038")
|
||||
("night-snow-thunderstorm" . "\xf06c")
|
||||
("night-snow-wind" . "\xf066")
|
||||
("night-sprinkle" . "\xf039")
|
||||
("night-storm-showers" . "\xf03a")
|
||||
("night-thunderstorm" . "\xf03b")
|
||||
("owm-200" . "\xf01e")
|
||||
("owm-201" . "\xf01e")
|
||||
("owm-202" . "\xf01e")
|
||||
("owm-210" . "\xf016")
|
||||
("owm-211" . "\xf016")
|
||||
("owm-212" . "\xf016")
|
||||
("owm-221" . "\xf016")
|
||||
("owm-230" . "\xf01e")
|
||||
("owm-231" . "\xf01e")
|
||||
("owm-232" . "\xf01e")
|
||||
("owm-300" . "\xf01c")
|
||||
("owm-301" . "\xf01c")
|
||||
("owm-302" . "\xf019")
|
||||
("owm-310" . "\xf017")
|
||||
("owm-311" . "\xf019")
|
||||
("owm-312" . "\xf019")
|
||||
("owm-313" . "\xf01a")
|
||||
("owm-314" . "\xf019")
|
||||
("owm-321" . "\xf01c")
|
||||
("owm-500" . "\xf01c")
|
||||
("owm-501" . "\xf019")
|
||||
("owm-502" . "\xf019")
|
||||
("owm-503" . "\xf019")
|
||||
("owm-504" . "\xf019")
|
||||
("owm-511" . "\xf017")
|
||||
("owm-520" . "\xf01a")
|
||||
("owm-521" . "\xf01a")
|
||||
("owm-522" . "\xf01a")
|
||||
("owm-531" . "\xf01d")
|
||||
("owm-600" . "\xf01b")
|
||||
("owm-601" . "\xf01b")
|
||||
("owm-602" . "\xf0b5")
|
||||
("owm-611" . "\xf017")
|
||||
("owm-612" . "\xf017")
|
||||
("owm-615" . "\xf017")
|
||||
("owm-616" . "\xf017")
|
||||
("owm-620" . "\xf017")
|
||||
("owm-621" . "\xf01b")
|
||||
("owm-622" . "\xf01b")
|
||||
("owm-701" . "\xf01a")
|
||||
("owm-711" . "\xf062")
|
||||
("owm-721" . "\xf0b6")
|
||||
("owm-731" . "\xf063")
|
||||
("owm-741" . "\xf014")
|
||||
("owm-761" . "\xf063")
|
||||
("owm-762" . "\xf063")
|
||||
("owm-771" . "\xf011")
|
||||
("owm-781" . "\xf056")
|
||||
("owm-800" . "\xf00d")
|
||||
("owm-801" . "\xf011")
|
||||
("owm-802" . "\xf011")
|
||||
("owm-803" . "\xf012")
|
||||
("owm-804" . "\xf013")
|
||||
("owm-900" . "\xf056")
|
||||
("owm-901" . "\xf01d")
|
||||
("owm-902" . "\xf073")
|
||||
("owm-903" . "\xf076")
|
||||
("owm-904" . "\xf072")
|
||||
("owm-905" . "\xf021")
|
||||
("owm-906" . "\xf015")
|
||||
("owm-957" . "\xf050")
|
||||
("owm-day-200" . "\xf010")
|
||||
("owm-day-201" . "\xf010")
|
||||
("owm-day-202" . "\xf010")
|
||||
("owm-day-210" . "\xf005")
|
||||
("owm-day-211" . "\xf005")
|
||||
("owm-day-212" . "\xf005")
|
||||
("owm-day-221" . "\xf005")
|
||||
("owm-day-230" . "\xf010")
|
||||
("owm-day-231" . "\xf010")
|
||||
("owm-day-232" . "\xf010")
|
||||
("owm-day-300" . "\xf00b")
|
||||
("owm-day-301" . "\xf00b")
|
||||
("owm-day-302" . "\xf008")
|
||||
("owm-day-310" . "\xf008")
|
||||
("owm-day-311" . "\xf008")
|
||||
("owm-day-312" . "\xf008")
|
||||
("owm-day-313" . "\xf008")
|
||||
("owm-day-314" . "\xf008")
|
||||
("owm-day-321" . "\xf00b")
|
||||
("owm-day-500" . "\xf00b")
|
||||
("owm-day-501" . "\xf008")
|
||||
("owm-day-502" . "\xf008")
|
||||
("owm-day-503" . "\xf008")
|
||||
("owm-day-504" . "\xf008")
|
||||
("owm-day-511" . "\xf006")
|
||||
("owm-day-520" . "\xf009")
|
||||
("owm-day-521" . "\xf009")
|
||||
("owm-day-522" . "\xf009")
|
||||
("owm-day-531" . "\xf00e")
|
||||
("owm-day-600" . "\xf00a")
|
||||
("owm-day-601" . "\xf0b2")
|
||||
("owm-day-602" . "\xf00a")
|
||||
("owm-day-611" . "\xf006")
|
||||
("owm-day-612" . "\xf006")
|
||||
("owm-day-615" . "\xf006")
|
||||
("owm-day-616" . "\xf006")
|
||||
("owm-day-620" . "\xf006")
|
||||
("owm-day-621" . "\xf00a")
|
||||
("owm-day-622" . "\xf00a")
|
||||
("owm-day-701" . "\xf009")
|
||||
("owm-day-711" . "\xf062")
|
||||
("owm-day-721" . "\xf0b6")
|
||||
("owm-day-731" . "\xf063")
|
||||
("owm-day-741" . "\xf003")
|
||||
("owm-day-761" . "\xf063")
|
||||
("owm-day-762" . "\xf063")
|
||||
("owm-day-781" . "\xf056")
|
||||
("owm-day-800" . "\xf00d")
|
||||
("owm-day-801" . "\xf000")
|
||||
("owm-day-802" . "\xf000")
|
||||
("owm-day-803" . "\xf000")
|
||||
("owm-day-804" . "\xf00c")
|
||||
("owm-day-900" . "\xf056")
|
||||
("owm-day-902" . "\xf073")
|
||||
("owm-day-903" . "\xf076")
|
||||
("owm-day-904" . "\xf072")
|
||||
("owm-day-906" . "\xf004")
|
||||
("owm-day-957" . "\xf050")
|
||||
("owm-night-200" . "\xf02d")
|
||||
("owm-night-201" . "\xf02d")
|
||||
("owm-night-202" . "\xf02d")
|
||||
("owm-night-210" . "\xf025")
|
||||
("owm-night-211" . "\xf025")
|
||||
("owm-night-212" . "\xf025")
|
||||
("owm-night-221" . "\xf025")
|
||||
("owm-night-230" . "\xf02d")
|
||||
("owm-night-231" . "\xf02d")
|
||||
("owm-night-232" . "\xf02d")
|
||||
("owm-night-300" . "\xf02b")
|
||||
("owm-night-301" . "\xf02b")
|
||||
("owm-night-302" . "\xf028")
|
||||
("owm-night-310" . "\xf028")
|
||||
("owm-night-311" . "\xf028")
|
||||
("owm-night-312" . "\xf028")
|
||||
("owm-night-313" . "\xf028")
|
||||
("owm-night-314" . "\xf028")
|
||||
("owm-night-321" . "\xf02b")
|
||||
("owm-night-500" . "\xf02b")
|
||||
("owm-night-501" . "\xf028")
|
||||
("owm-night-502" . "\xf028")
|
||||
("owm-night-503" . "\xf028")
|
||||
("owm-night-504" . "\xf028")
|
||||
("owm-night-511" . "\xf026")
|
||||
("owm-night-520" . "\xf029")
|
||||
("owm-night-521" . "\xf029")
|
||||
("owm-night-522" . "\xf029")
|
||||
("owm-night-531" . "\xf02c")
|
||||
("owm-night-600" . "\xf02a")
|
||||
("owm-night-601" . "\xf0b4")
|
||||
("owm-night-602" . "\xf02a")
|
||||
("owm-night-611" . "\xf026")
|
||||
("owm-night-612" . "\xf026")
|
||||
("owm-night-615" . "\xf026")
|
||||
("owm-night-616" . "\xf026")
|
||||
("owm-night-620" . "\xf026")
|
||||
("owm-night-621" . "\xf02a")
|
||||
("owm-night-622" . "\xf02a")
|
||||
("owm-night-701" . "\xf029")
|
||||
("owm-night-711" . "\xf062")
|
||||
("owm-night-721" . "\xf0b6")
|
||||
("owm-night-731" . "\xf063")
|
||||
("owm-night-741" . "\xf04a")
|
||||
("owm-night-761" . "\xf063")
|
||||
("owm-night-762" . "\xf063")
|
||||
("owm-night-781" . "\xf056")
|
||||
("owm-night-800" . "\xf02e")
|
||||
("owm-night-801" . "\xf022")
|
||||
("owm-night-802" . "\xf022")
|
||||
("owm-night-803" . "\xf022")
|
||||
("owm-night-804" . "\xf086")
|
||||
("owm-night-900" . "\xf056")
|
||||
("owm-night-902" . "\xf073")
|
||||
("owm-night-903" . "\xf076")
|
||||
("owm-night-904" . "\xf072")
|
||||
("owm-night-906" . "\xf024")
|
||||
("owm-night-957" . "\xf050")
|
||||
("rain" . "\xf019")
|
||||
("rain-mix" . "\xf017")
|
||||
("rain-wind" . "\xf018")
|
||||
("raindrop" . "\xf078")
|
||||
("raindrops" . "\xf04e")
|
||||
("refresh" . "\xf04c")
|
||||
("refresh-alt" . "\xf04b")
|
||||
("sandstorm" . "\xf082")
|
||||
("showers" . "\xf01a")
|
||||
("sleet" . "\xf0b5")
|
||||
("small-craft-advisory" . "\xf0cc")
|
||||
("smog" . "\xf074")
|
||||
("smoke" . "\xf062")
|
||||
("snow" . "\xf01b")
|
||||
("snow" . "\xf01b")
|
||||
("snow-wind" . "\xf064")
|
||||
("snowflake-cold" . "\xf076")
|
||||
("solar-eclipse" . "\xf06e")
|
||||
("sprinkle" . "\xf01c")
|
||||
("stars" . "\xf077")
|
||||
("storm-showers" . "\xf01d")
|
||||
("storm-showers" . "\xf01d")
|
||||
("storm-warning" . "\xf0ce")
|
||||
("strong-wind" . "\xf050")
|
||||
("sunrise" . "\xf051")
|
||||
("sunset" . "\xf052")
|
||||
("thermometer" . "\xf055")
|
||||
("thermometer-exterior" . "\xf053")
|
||||
("thermometer-internal" . "\xf054")
|
||||
("thunderstorm" . "\xf01e")
|
||||
("thunderstorm" . "\xf01e")
|
||||
("time-1" . "\xf08a")
|
||||
("time-10" . "\xf093")
|
||||
("time-11" . "\xf094")
|
||||
("time-12" . "\xf089")
|
||||
("time-2" . "\xf08b")
|
||||
("time-3" . "\xf08c")
|
||||
("time-4" . "\xf08d")
|
||||
("time-5" . "\xf08e")
|
||||
("time-6" . "\xf08f")
|
||||
("time-7" . "\xf090")
|
||||
("time-8" . "\xf091")
|
||||
("time-9" . "\xf092")
|
||||
("tornado" . "\xf056")
|
||||
("train" . "\xf0cb")
|
||||
("tsunami" . "\xf0c5")
|
||||
("umbrella" . "\xf084")
|
||||
("volcano" . "\xf0c8")
|
||||
("wind-beaufort-0" . "\xf0b7")
|
||||
("wind-beaufort-1" . "\xf0b8")
|
||||
("wind-beaufort-10" . "\xf0c1")
|
||||
("wind-beaufort-11" . "\xf0c2")
|
||||
("wind-beaufort-12" . "\xf0c3")
|
||||
("wind-beaufort-2" . "\xf0b9")
|
||||
("wind-beaufort-3" . "\xf0ba")
|
||||
("wind-beaufort-4" . "\xf0bb")
|
||||
("wind-beaufort-5" . "\xf0bc")
|
||||
("wind-beaufort-6" . "\xf0bd")
|
||||
("wind-beaufort-7" . "\xf0be")
|
||||
("wind-beaufort-8" . "\xf0bf")
|
||||
("wind-beaufort-9" . "\xf0c0")
|
||||
("wind-direction" . "\xf0b1")
|
||||
("windy" . "\xf021")
|
||||
("wmo4680-00" . "\xf055")
|
||||
("wmo4680-01" . "\xf013")
|
||||
("wmo4680-02" . "\xf055")
|
||||
("wmo4680-03" . "\xf013")
|
||||
("wmo4680-04" . "\xf014")
|
||||
("wmo4680-05" . "\xf014")
|
||||
("wmo4680-10" . "\xf014")
|
||||
("wmo4680-11" . "\xf014")
|
||||
("wmo4680-12" . "\xf016")
|
||||
("wmo4680-18" . "\xf050")
|
||||
("wmo4680-20" . "\xf014")
|
||||
("wmo4680-21" . "\xf017")
|
||||
("wmo4680-22" . "\xf017")
|
||||
("wmo4680-23" . "\xf019")
|
||||
("wmo4680-24" . "\xf01b")
|
||||
("wmo4680-25" . "\xf015")
|
||||
("wmo4680-26" . "\xf01e")
|
||||
("wmo4680-27" . "\xf063")
|
||||
("wmo4680-28" . "\xf063")
|
||||
("wmo4680-29" . "\xf063")
|
||||
("wmo4680-30" . "\xf014")
|
||||
("wmo4680-31" . "\xf014")
|
||||
("wmo4680-32" . "\xf014")
|
||||
("wmo4680-33" . "\xf014")
|
||||
("wmo4680-34" . "\xf014")
|
||||
("wmo4680-35" . "\xf014")
|
||||
("wmo4680-40" . "\xf017")
|
||||
("wmo4680-41" . "\xf01c")
|
||||
("wmo4680-42" . "\xf019")
|
||||
("wmo4680-43" . "\xf01c")
|
||||
("wmo4680-44" . "\xf019")
|
||||
("wmo4680-45" . "\xf015")
|
||||
("wmo4680-46" . "\xf015")
|
||||
("wmo4680-47" . "\xf01b")
|
||||
("wmo4680-48" . "\xf01b")
|
||||
("wmo4680-50" . "\xf01c")
|
||||
("wmo4680-51" . "\xf01c")
|
||||
("wmo4680-52" . "\xf019")
|
||||
("wmo4680-53" . "\xf019")
|
||||
("wmo4680-54" . "\xf076")
|
||||
("wmo4680-55" . "\xf076")
|
||||
("wmo4680-56" . "\xf076")
|
||||
("wmo4680-57" . "\xf01c")
|
||||
("wmo4680-58" . "\xf019")
|
||||
("wmo4680-60" . "\xf01c")
|
||||
("wmo4680-61" . "\xf01c")
|
||||
("wmo4680-62" . "\xf019")
|
||||
("wmo4680-63" . "\xf019")
|
||||
("wmo4680-64" . "\xf015")
|
||||
("wmo4680-65" . "\xf015")
|
||||
("wmo4680-66" . "\xf015")
|
||||
("wmo4680-67" . "\xf017")
|
||||
("wmo4680-68" . "\xf017")
|
||||
("wmo4680-70" . "\xf01b")
|
||||
("wmo4680-71" . "\xf01b")
|
||||
("wmo4680-72" . "\xf01b")
|
||||
("wmo4680-73" . "\xf01b")
|
||||
("wmo4680-74" . "\xf076")
|
||||
("wmo4680-75" . "\xf076")
|
||||
("wmo4680-76" . "\xf076")
|
||||
("wmo4680-77" . "\xf01b")
|
||||
("wmo4680-78" . "\xf076")
|
||||
("wmo4680-80" . "\xf019")
|
||||
("wmo4680-81" . "\xf01c")
|
||||
("wmo4680-82" . "\xf019")
|
||||
("wmo4680-83" . "\xf019")
|
||||
("wmo4680-84" . "\xf01d")
|
||||
("wmo4680-85" . "\xf017")
|
||||
("wmo4680-86" . "\xf017")
|
||||
("wmo4680-87" . "\xf017")
|
||||
("wmo4680-89" . "\xf015")
|
||||
("wmo4680-90" . "\xf016")
|
||||
("wmo4680-91" . "\xf01d")
|
||||
("wmo4680-92" . "\xf01e")
|
||||
("wmo4680-93" . "\xf01e")
|
||||
("wmo4680-94" . "\xf016")
|
||||
("wmo4680-95" . "\xf01e")
|
||||
("wmo4680-96" . "\xf01e")
|
||||
("wmo4680-99" . "\xf056")
|
||||
("wu-chanceflurries" . "\xf064")
|
||||
("wu-chancerain" . "\xf019")
|
||||
("wu-chancesleat" . "\xf0b5")
|
||||
("wu-chancesnow" . "\xf01b")
|
||||
("wu-chancetstorms" . "\xf01e")
|
||||
("wu-clear" . "\xf00d")
|
||||
("wu-cloudy" . "\xf002")
|
||||
("wu-flurries" . "\xf064")
|
||||
("wu-hazy" . "\xf0b6")
|
||||
("wu-mostlycloudy" . "\xf002")
|
||||
("wu-mostlysunny" . "\xf00d")
|
||||
("wu-partlycloudy" . "\xf002")
|
||||
("wu-partlysunny" . "\xf00d")
|
||||
("wu-rain" . "\xf01a")
|
||||
("wu-sleat" . "\xf0b5")
|
||||
("wu-snow" . "\xf01b")
|
||||
("wu-sunny" . "\xf00d")
|
||||
("wu-tstorms" . "\xf01e")
|
||||
("wu-unknown" . "\xf00d")
|
||||
("yahoo-0" . "\xf056")
|
||||
("yahoo-1" . "\xf00e")
|
||||
("yahoo-10" . "\xf015")
|
||||
("yahoo-11" . "\xf01a")
|
||||
("yahoo-12" . "\xf01a")
|
||||
("yahoo-13" . "\xf01b")
|
||||
("yahoo-14" . "\xf00a")
|
||||
("yahoo-15" . "\xf064")
|
||||
("yahoo-16" . "\xf01b")
|
||||
("yahoo-17" . "\xf015")
|
||||
("yahoo-18" . "\xf017")
|
||||
("yahoo-19" . "\xf063")
|
||||
("yahoo-2" . "\xf073")
|
||||
("yahoo-20" . "\xf014")
|
||||
("yahoo-21" . "\xf021")
|
||||
("yahoo-22" . "\xf062")
|
||||
("yahoo-23" . "\xf050")
|
||||
("yahoo-24" . "\xf050")
|
||||
("yahoo-25" . "\xf076")
|
||||
("yahoo-26" . "\xf013")
|
||||
("yahoo-27" . "\xf031")
|
||||
("yahoo-28" . "\xf002")
|
||||
("yahoo-29" . "\xf031")
|
||||
("yahoo-3" . "\xf01e")
|
||||
("yahoo-30" . "\xf002")
|
||||
("yahoo-31" . "\xf02e")
|
||||
("yahoo-32" . "\xf00d")
|
||||
("yahoo-3200" . "\xf077")
|
||||
("yahoo-33" . "\xf083")
|
||||
("yahoo-34" . "\xf00c")
|
||||
("yahoo-35" . "\xf017")
|
||||
("yahoo-36" . "\xf072")
|
||||
("yahoo-37" . "\xf00e")
|
||||
("yahoo-38" . "\xf00e")
|
||||
("yahoo-39" . "\xf00e")
|
||||
("yahoo-4" . "\xf01e")
|
||||
("yahoo-40" . "\xf01a")
|
||||
("yahoo-41" . "\xf064")
|
||||
("yahoo-42" . "\xf01b")
|
||||
("yahoo-43" . "\xf064")
|
||||
("yahoo-44" . "\xf00c")
|
||||
("yahoo-45" . "\xf00e")
|
||||
("yahoo-46" . "\xf01b")
|
||||
("yahoo-47" . "\xf00e")
|
||||
("yahoo-5" . "\xf017")
|
||||
("yahoo-6" . "\xf017")
|
||||
("yahoo-7" . "\xf017")
|
||||
("yahoo-8" . "\xf015")
|
||||
("yahoo-9" . "\xf01a")
|
||||
|
||||
))
|
||||
|
||||
(provide 'data-weathericons)
|
||||
|
|
@ -1,47 +0,0 @@
|
|||
;;; all-the-icons-dired-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 all-the-icons-dired.el
|
||||
|
||||
(autoload 'all-the-icons-dired-mode "all-the-icons-dired" "\
|
||||
Display all-the-icons icon for each file in a Dired buffer.
|
||||
|
||||
This is a minor mode. If called interactively, toggle the
|
||||
`All-The-Icons-Dired 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 `all-the-icons-dired-mode'.
|
||||
|
||||
The mode's hook is called both when the mode is enabled and when
|
||||
it is disabled.
|
||||
|
||||
(fn &optional ARG)" t)
|
||||
(register-definition-prefixes "all-the-icons-dired" '("all-the-icons-dired-"))
|
||||
|
||||
;;; End of scraped data
|
||||
|
||||
(provide 'all-the-icons-dired-autoloads)
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; no-native-compile: t
|
||||
;; coding: utf-8-emacs-unix
|
||||
;; End:
|
||||
|
||||
;;; all-the-icons-dired-autoloads.el ends here
|
||||
|
|
@ -1,15 +0,0 @@
|
|||
(define-package "all-the-icons-dired" "20231207.1324" "Shows icons for each file in dired mode"
|
||||
'((emacs "26.1")
|
||||
(all-the-icons "2.2.0"))
|
||||
:commit "e157f0668f22ed586aebe0a2c0186ab07702986c" :authors
|
||||
'(("jtbm37"))
|
||||
:maintainers
|
||||
'(("Jimmy Yuen Ho Wong" . "wyuenho@gmail.com"))
|
||||
:maintainer
|
||||
'("Jimmy Yuen Ho Wong" . "wyuenho@gmail.com")
|
||||
:keywords
|
||||
'("files" "icons" "dired")
|
||||
:url "https://github.com/wyuenho/all-the-icons-dired")
|
||||
;; Local Variables:
|
||||
;; no-byte-compile: t
|
||||
;; End:
|
||||
|
|
@ -1,142 +0,0 @@
|
|||
;;; all-the-icons-dired.el --- Shows icons for each file in dired mode -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2016-2020 jtbm37
|
||||
;; Copyright (C) 2021 Jimmy Yuen Ho Wong
|
||||
|
||||
;; Author: jtbm37
|
||||
;; Maintainer: Jimmy Yuen Ho Wong <wyuenho@gmail.com>
|
||||
;; Version: 2.0
|
||||
;; Keywords: files icons dired
|
||||
;; Package-Requires: ((emacs "26.1") (all-the-icons "2.2.0"))
|
||||
;; URL: https://github.com/wyuenho/all-the-icons-dired
|
||||
|
||||
;; 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:
|
||||
;; To use this package, simply add this to your init.el:
|
||||
;; (add-hook 'dired-mode-hook 'all-the-icons-dired-mode)
|
||||
|
||||
;; To manually install, add this to your init.el before the hook mentioned above.
|
||||
;; (add-to-load-path (expand-file-name "~/path/to/all-the-icons-dired"))
|
||||
;; (load "all-the-icons-dired.el")
|
||||
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'dired)
|
||||
(require 'all-the-icons)
|
||||
(require 'subr-x)
|
||||
(require 'image)
|
||||
(require 'jit-lock)
|
||||
(require 'font-core)
|
||||
(require 'font-lock)
|
||||
(require 'map)
|
||||
|
||||
(defface all-the-icons-dired-dir-face
|
||||
'((t (:inherit dired-directory)))
|
||||
"Face for the directory icon."
|
||||
:group 'all-the-icons-faces)
|
||||
|
||||
(defcustom all-the-icons-dired-lighter " all-the-icons-dired-mode"
|
||||
"Lighter of all-the-icons-dired-mode"
|
||||
:group 'all-the-icons
|
||||
:type 'string)
|
||||
|
||||
(defcustom all-the-icons-dired-v-adjust 0.01
|
||||
"The default vertical adjustment of the icon in the Dired buffer."
|
||||
:group 'all-the-icons
|
||||
:type 'number)
|
||||
|
||||
(defcustom all-the-icons-dired-monochrome t
|
||||
"Whether to show the icons as the same color as the text on the same line."
|
||||
:group 'all-the-icons
|
||||
:type 'boolean)
|
||||
|
||||
(defvar all-the-icons-dired-mode)
|
||||
|
||||
(defun all-the-icons-dired--icon (file)
|
||||
"Return the icon for FILE."
|
||||
(if (file-directory-p file)
|
||||
(all-the-icons-icon-for-dir file
|
||||
:face 'all-the-icons-dired-dir-face
|
||||
:v-adjust all-the-icons-dired-v-adjust)
|
||||
(apply 'all-the-icons-icon-for-file file
|
||||
(append
|
||||
`(:v-adjust ,all-the-icons-dired-v-adjust)
|
||||
(when all-the-icons-dired-monochrome
|
||||
`(:face ,(face-at-point)))))))
|
||||
|
||||
(defun all-the-icons-dired--put-icon (pos)
|
||||
"Propertize POS with icon."
|
||||
(let* ((file (dired-get-filename 'relative 'noerror))
|
||||
(icon (all-the-icons-dired--icon file))
|
||||
(image (copy-sequence (get-text-property 0 'display icon)))
|
||||
(props (map-delete (copy-sequence (text-properties-at 0 icon)) 'display)))
|
||||
(if (or (not (eq (car image) 'image)) (member file '("." "..")))
|
||||
(put-text-property (1- pos) pos 'display
|
||||
(if (member file '("." ".."))
|
||||
" "
|
||||
(concat " " icon " ")))
|
||||
(setf (image-property image :margin) (cons (/ (window-text-width nil t) (window-text-width)) 0))
|
||||
(add-text-properties (1- pos) pos (append props `(display ,image) )))))
|
||||
|
||||
(defun all-the-icons-dired--fontify-region (start end &optional loudly)
|
||||
"Add icons using text properties from START to END.
|
||||
|
||||
START, END and the optional argument LOUDLY is passed to
|
||||
`font-lock-default-fontify-region'."
|
||||
(let ((extended-region (font-lock-default-fontify-region start end loudly)))
|
||||
(when (and (consp extended-region)
|
||||
(eq (car extended-region) 'jit-lock-bounds))
|
||||
(setq start (cadr extended-region))
|
||||
(setq end (cddr extended-region)))
|
||||
(with-silent-modifications
|
||||
(save-excursion
|
||||
(goto-char start)
|
||||
(while (< (point) end)
|
||||
(when-let ((pos (dired-move-to-filename)))
|
||||
(all-the-icons-dired--put-icon pos))
|
||||
(forward-line 1))))
|
||||
extended-region))
|
||||
|
||||
(defun all-the-icons-dired--setup ()
|
||||
"Set up `all-the-icons-dired'."
|
||||
(add-function :override (local 'font-lock-fontify-region-function) #'all-the-icons-dired--fontify-region)
|
||||
(setq-local font-lock-extra-managed-props (cons 'display font-lock-extra-managed-props))
|
||||
(cond (jit-lock-mode
|
||||
(jit-lock-refontify))
|
||||
(font-lock-mode
|
||||
(font-lock-fontify-region (point-min) (point-max)))))
|
||||
|
||||
(defun all-the-icons-dired--teardown ()
|
||||
"Tear down `all-the-icons-dired'."
|
||||
(font-lock-unfontify-buffer)
|
||||
(remove-function (local 'font-lock-fontify-region-function) #'all-the-icons-dired--fontify-region)
|
||||
(setq-local font-lock-extra-managed-props (remove 'display font-lock-extra-managed-props))
|
||||
(cond (jit-lock-mode
|
||||
(jit-lock-refontify))
|
||||
(font-lock-mode
|
||||
(font-lock-fontify-region (point-min) (point-max)))))
|
||||
|
||||
;;;###autoload
|
||||
(define-minor-mode all-the-icons-dired-mode
|
||||
"Display all-the-icons icon for each file in a Dired buffer."
|
||||
:lighter all-the-icons-dired-lighter
|
||||
(when (derived-mode-p 'dired-mode)
|
||||
(if all-the-icons-dired-mode
|
||||
(all-the-icons-dired--setup)
|
||||
(all-the-icons-dired--teardown))))
|
||||
|
||||
(provide 'all-the-icons-dired)
|
||||
;;; all-the-icons-dired.el ends here
|
||||
File diff suppressed because it is too large
Load diff
|
|
@ -1 +0,0 @@
|
|||
Good signature from 066DAFCB81E42C40 GNU ELPA Signing Agent (2019) <elpasign@elpa.gnu.org> (trust undefined) created at 2022-11-07T17:05:03-0500 using RSA
|
||||
File diff suppressed because it is too large
Load diff
File diff suppressed because it is too large
Load diff
|
|
@ -1 +0,0 @@
|
|||
Good signature from 066DAFCB81E42C40 GNU ELPA Signing Agent (2019) <elpasign@elpa.gnu.org> (trust undefined) created at 2022-11-07T17:05:05-0500 using RSA
|
||||
|
|
@ -1,210 +0,0 @@
|
|||
;;; async-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 async.el
|
||||
|
||||
(autoload 'async-start-process "async" "\
|
||||
Start the executable PROGRAM asynchronously named NAME. See `async-start'.
|
||||
PROGRAM is passed PROGRAM-ARGS, calling FINISH-FUNC with the
|
||||
process object when done. If FINISH-FUNC is nil, the future
|
||||
object will return the process object when the program is
|
||||
finished. Set DEFAULT-DIRECTORY to change PROGRAM's current
|
||||
working directory.
|
||||
|
||||
(fn NAME PROGRAM FINISH-FUNC &rest PROGRAM-ARGS)")
|
||||
(autoload 'async-start "async" "\
|
||||
Execute START-FUNC (often a lambda) in a subordinate Emacs process.
|
||||
When done, the return value is passed to FINISH-FUNC. Example:
|
||||
|
||||
(async-start
|
||||
;; What to do in the child process
|
||||
(lambda ()
|
||||
(message \"This is a test\")
|
||||
(sleep-for 3)
|
||||
222)
|
||||
|
||||
;; What to do when it finishes
|
||||
(lambda (result)
|
||||
(message \"Async process done, result should be 222: %s\"
|
||||
result)))
|
||||
|
||||
If you call `async-send' from a child process, the message will
|
||||
be also passed to the FINISH-FUNC. You can test RESULT to see if
|
||||
it is a message by using `async-message-p'. If nil, it means
|
||||
this is the final result. Example of the FINISH-FUNC:
|
||||
|
||||
(lambda (result)
|
||||
(if (async-message-p result)
|
||||
(message \"Received a message from child process: %s\" result)
|
||||
(message \"Async process done, result: %s\" result)))
|
||||
|
||||
If FINISH-FUNC is nil or missing, a future is returned that can
|
||||
be inspected using `async-get', blocking until the value is
|
||||
ready. Example:
|
||||
|
||||
(let ((proc (async-start
|
||||
;; What to do in the child process
|
||||
(lambda ()
|
||||
(message \"This is a test\")
|
||||
(sleep-for 3)
|
||||
222))))
|
||||
|
||||
(message \"I'm going to do some work here\") ;; ....
|
||||
|
||||
(message \"Waiting on async process, result should be 222: %s\"
|
||||
(async-get proc)))
|
||||
|
||||
If you don't want to use a callback, and you don't care about any
|
||||
return value from the child process, pass the `ignore' symbol as
|
||||
the second argument (if you don't, and never call `async-get', it
|
||||
will leave *emacs* process buffers hanging around):
|
||||
|
||||
(async-start
|
||||
(lambda ()
|
||||
(delete-file \"a remote file on a slow link\" nil))
|
||||
\\='ignore)
|
||||
|
||||
Special case:
|
||||
If the output of START-FUNC is a string with properties
|
||||
e.g. (buffer-string) RESULT will be transformed in a list where the
|
||||
car is the string itself (without props) and the cdr the rest of
|
||||
properties, this allows using in FINISH-FUNC the string without
|
||||
properties and then apply the properties in cdr to this string (if
|
||||
needed).
|
||||
Properties handling special objects like markers are returned as
|
||||
list to allow restoring them later.
|
||||
See <https://github.com/jwiegley/emacs-async/issues/145> for more infos.
|
||||
|
||||
Note: Even when FINISH-FUNC is present, a future is still
|
||||
returned except that it yields no value (since the value is
|
||||
passed to FINISH-FUNC). Call `async-get' on such a future always
|
||||
returns nil. It can still be useful, however, as an argument to
|
||||
`async-ready' or `async-wait'.
|
||||
|
||||
(fn START-FUNC &optional FINISH-FUNC)")
|
||||
(register-definition-prefixes "async" '("async-"))
|
||||
|
||||
|
||||
;;; Generated autoloads from async-bytecomp.el
|
||||
|
||||
(autoload 'async-byte-recompile-directory "async-bytecomp" "\
|
||||
Compile all *.el files in DIRECTORY asynchronously.
|
||||
All *.elc files are systematically deleted before proceeding.
|
||||
|
||||
(fn DIRECTORY &optional QUIET)")
|
||||
(defvar async-bytecomp-package-mode nil "\
|
||||
Non-nil if Async-Bytecomp-Package mode is enabled.
|
||||
See the `async-bytecomp-package-mode' command
|
||||
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 `async-bytecomp-package-mode'.")
|
||||
(custom-autoload 'async-bytecomp-package-mode "async-bytecomp" nil)
|
||||
(autoload 'async-bytecomp-package-mode "async-bytecomp" "\
|
||||
Byte compile asynchronously packages installed with package.el.
|
||||
|
||||
Async compilation of packages can be controlled by
|
||||
`async-bytecomp-allowed-packages'.
|
||||
|
||||
This is a global minor mode. If called interactively, toggle the
|
||||
`Async-Bytecomp-Package 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 `(default-value \\='async-bytecomp-package-mode)'.
|
||||
|
||||
The mode's hook is called both when the mode is enabled and when
|
||||
it is disabled.
|
||||
|
||||
(fn &optional ARG)" t)
|
||||
(autoload 'async-byte-compile-file "async-bytecomp" "\
|
||||
Byte compile Lisp code FILE asynchronously.
|
||||
|
||||
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
|
||||
|
||||
(defvar dired-async-mode nil "\
|
||||
Non-nil if Dired-Async mode is enabled.
|
||||
See the `dired-async-mode' command
|
||||
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 `dired-async-mode'.")
|
||||
(custom-autoload 'dired-async-mode "dired-async" nil)
|
||||
(autoload 'dired-async-mode "dired-async" "\
|
||||
Do dired actions asynchronously.
|
||||
|
||||
This is a global minor mode. If called interactively, toggle the
|
||||
`Dired-Async 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 `(default-value \\='dired-async-mode)'.
|
||||
|
||||
The mode's hook is called both when the mode is enabled and when
|
||||
it is disabled.
|
||||
|
||||
(fn &optional ARG)" t)
|
||||
(autoload 'dired-async-do-copy "dired-async" "\
|
||||
Run ‘dired-do-copy’ asynchronously.
|
||||
|
||||
(fn &optional ARG)" t)
|
||||
(autoload 'dired-async-do-symlink "dired-async" "\
|
||||
Run ‘dired-do-symlink’ asynchronously.
|
||||
|
||||
(fn &optional ARG)" t)
|
||||
(autoload 'dired-async-do-hardlink "dired-async" "\
|
||||
Run ‘dired-do-hardlink’ asynchronously.
|
||||
|
||||
(fn &optional ARG)" t)
|
||||
(autoload 'dired-async-do-rename "dired-async" "\
|
||||
Run ‘dired-do-rename’ asynchronously.
|
||||
|
||||
(fn &optional ARG)" t)
|
||||
(register-definition-prefixes "dired-async" '("dired-async-"))
|
||||
|
||||
|
||||
;;; Generated autoloads from smtpmail-async.el
|
||||
|
||||
(register-definition-prefixes "smtpmail-async" '("async-smtpmail-"))
|
||||
|
||||
;;; End of scraped data
|
||||
|
||||
(provide 'async-autoloads)
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; no-native-compile: t
|
||||
;; coding: utf-8-emacs-unix
|
||||
;; End:
|
||||
|
||||
;;; async-autoloads.el ends here
|
||||
|
|
@ -1,201 +0,0 @@
|
|||
;;; async-bytecomp.el --- Compile elisp files asynchronously -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2014-2022 Free Software Foundation, Inc.
|
||||
|
||||
;; Authors: John Wiegley <jwiegley@gmail.com>
|
||||
;; Thierry Volpiatto <thievol@posteo.net>
|
||||
|
||||
;; Keywords: dired async byte-compile
|
||||
;; 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:
|
||||
;;
|
||||
;; This package provide the `async-byte-recompile-directory' function
|
||||
;; which allows, as the name says to recompile a directory outside of
|
||||
;; your running emacs.
|
||||
;; The benefit is your files will be compiled in a clean environment without
|
||||
;; the old *.el files loaded.
|
||||
;; Among other things, this fix a bug in package.el which recompile
|
||||
;; the new files in the current environment with the old files loaded, creating
|
||||
;; errors in most packages after upgrades.
|
||||
;;
|
||||
;; NB: This package is advising the function `package--compile'.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'async)
|
||||
(require 'bytecomp)
|
||||
|
||||
(declare-function package-desc-name "package.el")
|
||||
(declare-function package-desc-dir "package.el")
|
||||
|
||||
(defcustom async-bytecomp-allowed-packages 'all
|
||||
"Packages in this list will be compiled asynchronously by `package--compile'.
|
||||
All the dependencies of these packages will be compiled async too,
|
||||
so no need to add dependencies to this list.
|
||||
The value of this variable can also be the symbol `all' (default), in this case
|
||||
all packages are always compiled asynchronously."
|
||||
:group 'async
|
||||
:type '(choice
|
||||
(const :tag "All packages" all)
|
||||
(repeat symbol)))
|
||||
|
||||
(defvar async-byte-compile-log-file
|
||||
(concat user-emacs-directory "async-bytecomp.log"))
|
||||
|
||||
(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.
|
||||
All *.elc files are systematically deleted before proceeding."
|
||||
(cl-loop with dir = (directory-files directory t "\\.elc\\'")
|
||||
unless dir return nil
|
||||
for f in dir
|
||||
when (file-exists-p f) do (delete-file f))
|
||||
;; Ensure async is reloaded when async.elc is deleted.
|
||||
;; This happen when recompiling its own directory.
|
||||
(load "async")
|
||||
(let ((call-back
|
||||
(lambda (&optional _ignore)
|
||||
(async-bytecomp--file-to-comp-buffer directory quiet 'directory))))
|
||||
(async-start
|
||||
`(lambda ()
|
||||
(require 'bytecomp)
|
||||
,(async-inject-variables async-bytecomp-load-variable-regexp)
|
||||
(let ((default-directory (file-name-as-directory ,directory))
|
||||
error-data)
|
||||
(add-to-list 'load-path default-directory)
|
||||
(byte-recompile-directory ,directory 0 t)
|
||||
(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))))))
|
||||
call-back)
|
||||
(unless quiet (message "Started compiling asynchronously directory %s" directory))))
|
||||
|
||||
(defvar package-archive-contents)
|
||||
(defvar package-alist)
|
||||
(declare-function package-desc-reqs "package.el" (cl-x))
|
||||
|
||||
(defun async-bytecomp--get-package-deps (pkgs)
|
||||
;; Same as `package--get-deps' but parse instead `package-archive-contents'
|
||||
;; because PKG is not already installed and not present in `package-alist'.
|
||||
;; However fallback to `package-alist' in case PKG no more present
|
||||
;; in `package-archive-contents' due to modification to `package-archives'.
|
||||
;; See issue #58.
|
||||
(let ((seen '()))
|
||||
(while pkgs
|
||||
(let ((pkg (pop pkgs)))
|
||||
(unless (memq pkg seen)
|
||||
(let ((pkg-desc (cadr (or (assq pkg package-archive-contents)
|
||||
(assq pkg package-alist)))))
|
||||
(when pkg-desc
|
||||
(push pkg seen)
|
||||
(setq pkgs (append (mapcar #'car (package-desc-reqs pkg-desc))
|
||||
pkgs)))))))
|
||||
seen))
|
||||
|
||||
(defun async--package-compile (orig-fun pkg-desc &rest args)
|
||||
(let ((cur-package (package-desc-name pkg-desc))
|
||||
(pkg-dir (package-desc-dir pkg-desc)))
|
||||
(if (or (member async-bytecomp-allowed-packages '(t all (all)))
|
||||
(memq cur-package (async-bytecomp--get-package-deps
|
||||
async-bytecomp-allowed-packages)))
|
||||
(progn
|
||||
(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.
|
||||
(cl-pushnew pkg-dir load-path)
|
||||
(load "async-bytecomp"))
|
||||
;; `async-byte-recompile-directory' will add directory
|
||||
;; as needed to `load-path'.
|
||||
(async-byte-recompile-directory (package-desc-dir pkg-desc) t))
|
||||
(apply orig-fun pkg-desc args))))
|
||||
|
||||
;;;###autoload
|
||||
(define-minor-mode async-bytecomp-package-mode
|
||||
"Byte compile asynchronously packages installed with package.el.
|
||||
Async compilation of packages can be controlled by
|
||||
`async-bytecomp-allowed-packages'."
|
||||
:group 'async
|
||||
:global t
|
||||
(if async-bytecomp-package-mode
|
||||
(advice-add 'package--compile :around #'async--package-compile)
|
||||
(advice-remove 'package--compile #'async--package-compile)))
|
||||
|
||||
;;;###autoload
|
||||
(defun async-byte-compile-file (file)
|
||||
"Byte compile Lisp code FILE asynchronously.
|
||||
|
||||
Same as `byte-compile-file' but asynchronous."
|
||||
(interactive "fFile: ")
|
||||
(let ((call-back
|
||||
(lambda (&optional _ignore)
|
||||
(async-bytecomp--file-to-comp-buffer file nil 'file))))
|
||||
(async-start
|
||||
`(lambda ()
|
||||
(require 'bytecomp)
|
||||
,(async-inject-variables async-bytecomp-load-variable-regexp)
|
||||
(let ((default-directory ,(file-name-directory file))
|
||||
error-data)
|
||||
(add-to-list 'load-path default-directory)
|
||||
(byte-compile-file ,file)
|
||||
(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))))))
|
||||
call-back)))
|
||||
|
||||
(provide 'async-bytecomp)
|
||||
|
||||
;;; async-bytecomp.el ends here
|
||||
|
|
@ -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 +0,0 @@
|
|||
(define-package "async" "20240719.640" "Asynchronous processing in Emacs"
|
||||
'((emacs "24.4"))
|
||||
:commit "93957f5b0f2ed22aeef02972de860fb9c45b4422" :authors
|
||||
'(("John Wiegley" . "jwiegley@gmail.com"))
|
||||
:maintainers
|
||||
'(("Thierry Volpiatto" . "thievol@posteo.net"))
|
||||
:maintainer
|
||||
'("Thierry Volpiatto" . "thievol@posteo.net")
|
||||
:keywords
|
||||
'("async")
|
||||
:url "https://github.com/jwiegley/emacs-async")
|
||||
;; Local Variables:
|
||||
;; no-byte-compile: t
|
||||
;; End:
|
||||
|
|
@ -1,609 +0,0 @@
|
|||
;;; async.el --- Asynchronous processing in Emacs -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2012-2022 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: John Wiegley <jwiegley@gmail.com>
|
||||
;; Maintainer: Thierry Volpiatto <thievol@posteo.net>
|
||||
|
||||
;; Created: 18 Jun 2012
|
||||
;; Version: 1.9.8
|
||||
;; Package-Requires: ((emacs "24.4"))
|
||||
|
||||
;; Keywords: async
|
||||
;; 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:
|
||||
|
||||
;; Adds the ability to call asynchronous functions and process with ease. See
|
||||
;; the documentation for `async-start' and `async-start-process'.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile (require 'cl-lib))
|
||||
|
||||
(defvar tramp-password-prompt-regexp)
|
||||
|
||||
(defgroup async nil
|
||||
"Simple asynchronous processing in Emacs"
|
||||
:group 'lisp)
|
||||
|
||||
(defcustom async-variables-noprops-function #'async--purecopy
|
||||
"Default function to remove text properties in variables."
|
||||
:type 'function)
|
||||
|
||||
(defcustom async-prompt-for-password t
|
||||
"Prompt for password in parent Emacs if needed when non nil.
|
||||
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)
|
||||
(defvar async-callback nil)
|
||||
(defvar async-callback-for-process nil
|
||||
"Non-nil if the subprocess is not Emacs executing a lisp form.")
|
||||
(defvar async-callback-value nil)
|
||||
(defvar async-callback-value-set nil)
|
||||
(defvar async-current-process nil)
|
||||
(defvar async--procvar nil)
|
||||
(defvar async-read-marker nil
|
||||
"Position from which we read the last message packet.
|
||||
|
||||
Message packets are delivered from client line-by-line as base64
|
||||
encoded strings.")
|
||||
(defvar async-child-init nil
|
||||
"Initialisation file for async child Emacs.
|
||||
|
||||
If defined this allows for an init file to setup the child Emacs. It
|
||||
should not be your normal init.el as that would likely load more
|
||||
things that you require. It should limit itself to ensuring paths have
|
||||
been setup so any async code can load libraries you expect.")
|
||||
|
||||
;; For emacs<29 (only exists in emacs-29+).
|
||||
(defvar print-symbols-bare)
|
||||
|
||||
(defun async--purecopy (object)
|
||||
"Remove text properties in OBJECT.
|
||||
|
||||
Argument OBJECT may be a list or a string, if anything else it
|
||||
is returned unmodified."
|
||||
(cond ((stringp object)
|
||||
(substring-no-properties object))
|
||||
((consp object)
|
||||
(cl-loop for elm in object
|
||||
;; A string.
|
||||
if (stringp elm)
|
||||
collect (substring-no-properties elm)
|
||||
else
|
||||
;; Proper lists.
|
||||
if (and (consp elm) (null (cdr (last elm))))
|
||||
collect (async--purecopy elm)
|
||||
else
|
||||
;; Dotted lists.
|
||||
;; We handle here only dotted list where car and cdr
|
||||
;; are atoms i.e. (x . y) and not (x . (x . y)) or
|
||||
;; (x . (x y)) which should fit most cases.
|
||||
if (and (consp elm) (cdr (last elm)))
|
||||
collect (let ((key (car elm))
|
||||
(val (cdr elm)))
|
||||
(cons (if (stringp key)
|
||||
(substring-no-properties key)
|
||||
key)
|
||||
(if (stringp val)
|
||||
(substring-no-properties val)
|
||||
val)))
|
||||
else
|
||||
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'.
|
||||
When NOPROPS is non nil it tries to strip out text properties of each
|
||||
variable's value with `async-variables-noprops-function'.
|
||||
|
||||
It is intended to be used as follows:
|
||||
|
||||
(async-start
|
||||
\\=`(lambda ()
|
||||
(require \\='smtpmail)
|
||||
(with-temp-buffer
|
||||
(insert ,(buffer-substring-no-properties (point-min) (point-max)))
|
||||
;; Pass in the variable environment for smtpmail
|
||||
,(async-inject-variables \"\\\\=`\\(smtpmail\\|\\(user-\\)?mail\\)-\")
|
||||
(smtpmail-send-it)))
|
||||
\\='ignore)"
|
||||
`(setq
|
||||
,@(let (bindings)
|
||||
(mapatoms
|
||||
(lambda (sym)
|
||||
(let ((sname (and (boundp sym) (symbol-name sym)))
|
||||
value)
|
||||
(when (and sname
|
||||
(or (null include-regexp)
|
||||
(string-match include-regexp sname))
|
||||
(or (null exclude-regexp)
|
||||
(not (string-match exclude-regexp sname)))
|
||||
(cl-loop for re in async-inject-variables-exclude-regexps
|
||||
never (string-match-p re sname)))
|
||||
(setq value (symbol-value sym))
|
||||
(unless (or (stringp value)
|
||||
(memq value '(nil t))
|
||||
(numberp value)
|
||||
(vectorp value))
|
||||
(setq value `(quote ,value)))
|
||||
(when noprops
|
||||
(setq value (funcall async-variables-noprops-function
|
||||
value)))
|
||||
(when (or (null predicate)
|
||||
(funcall predicate sym))
|
||||
(setq bindings (cons value bindings)
|
||||
bindings (cons sym bindings)))))))
|
||||
bindings)))
|
||||
|
||||
(defalias 'async-inject-environment 'async-inject-variables)
|
||||
|
||||
(defun async-handle-result (func result buf)
|
||||
(if (null func)
|
||||
(progn
|
||||
(set (make-local-variable 'async-callback-value) result)
|
||||
(set (make-local-variable 'async-callback-value-set) t))
|
||||
(unwind-protect
|
||||
(if (and (listp result)
|
||||
(eq 'async-signal (nth 0 result)))
|
||||
(signal (car (nth 1 result))
|
||||
(cdr (nth 1 result)))
|
||||
(funcall func result))
|
||||
(unless async-debug
|
||||
(kill-buffer buf)))))
|
||||
|
||||
(defun async-when-done (proc &optional _change)
|
||||
"Process sentinel used to retrieve the value from the child process."
|
||||
(when (eq 'exit (process-status proc))
|
||||
(with-current-buffer (process-buffer proc)
|
||||
(let ((async-current-process proc))
|
||||
(if (= 0 (process-exit-status proc))
|
||||
(if async-callback-for-process
|
||||
(if async-callback
|
||||
(prog1
|
||||
(funcall async-callback proc)
|
||||
(unless async-debug
|
||||
;; we need to check this because theoretically
|
||||
;; `async-callback' could've killed it already
|
||||
(when (buffer-live-p (process-buffer proc))
|
||||
(kill-buffer (process-buffer proc)))))
|
||||
(set (make-local-variable 'async-callback-value) proc)
|
||||
(set (make-local-variable 'async-callback-value-set) t))
|
||||
;; Maybe strip out unreadable "#"; They are replaced by
|
||||
;; empty string unless they are prefixing a special
|
||||
;; object like a marker. See issue #145.
|
||||
(widen)
|
||||
(goto-char (point-min))
|
||||
(save-excursion
|
||||
;; Transform markers in list like
|
||||
;; (marker (moves after insertion) at 2338 in
|
||||
;; test\.org) so that remap text properties function
|
||||
;; can parse it to restitute marker.
|
||||
(while (re-search-forward "#<\\([^>]*\\)>" nil t)
|
||||
(replace-match (concat "(" (match-string 1) ")") t t)))
|
||||
(while (re-search-forward "#(" nil t)
|
||||
(replace-match "(" t t))
|
||||
(goto-char (point-max))
|
||||
(backward-sexp)
|
||||
(let ((value (read (current-buffer))))
|
||||
(async-handle-result async-callback value (current-buffer))))
|
||||
(set (make-local-variable 'async-callback-value)
|
||||
(list 'error
|
||||
(format "Async process '%s' failed with exit code %d"
|
||||
(process-name proc) (process-exit-status proc))))
|
||||
(set (make-local-variable 'async-callback-value-set) t))))))
|
||||
|
||||
(defun async-read-from-client (proc string &optional prompt-for-pwd)
|
||||
"Process text from client process.
|
||||
|
||||
The string chunks usually arrive in maximum of 4096 bytes, so a
|
||||
long client message might be split into multiple calls of this
|
||||
function.
|
||||
|
||||
We use a marker `async-read-marker' to track the position of the
|
||||
lasts complete line. Every time we get new input, we try to look
|
||||
for newline, and if found, process the entire line and bump the
|
||||
marker position to the end of this next line.
|
||||
|
||||
Argument PROMPT-FOR-PWD allow binding lexically the value of
|
||||
`async-prompt-for-password', if unspecified its global value
|
||||
is used."
|
||||
(with-current-buffer (process-buffer proc)
|
||||
(when (and prompt-for-pwd
|
||||
(boundp 'tramp-password-prompt-regexp)
|
||||
tramp-password-prompt-regexp
|
||||
(string-match tramp-password-prompt-regexp string))
|
||||
(process-send-string
|
||||
proc (concat (read-passwd (match-string 0 string)) "\n")))
|
||||
(goto-char (point-max))
|
||||
(save-excursion
|
||||
(insert string))
|
||||
|
||||
(while (search-forward "\n" nil t)
|
||||
(save-excursion
|
||||
(save-restriction
|
||||
(widen)
|
||||
(narrow-to-region async-read-marker (point))
|
||||
(goto-char (point-min))
|
||||
(let (msg)
|
||||
(condition-case nil
|
||||
;; It is safe to throw errors in the read because we
|
||||
;; send messages always on their own line, and they
|
||||
;; are always a base64 encoded string, so a message
|
||||
;; will always read. We will also ignore the rest
|
||||
;; of this line since there won't be anything
|
||||
;; interesting.
|
||||
(while (setq msg (read (current-buffer)))
|
||||
(let ((msg-decoded (ignore-errors (base64-decode-string msg))))
|
||||
(when msg-decoded
|
||||
(setq msg-decoded (car (read-from-string msg-decoded)))
|
||||
(when (and (listp msg-decoded)
|
||||
(async-message-p msg-decoded)
|
||||
async-callback)
|
||||
(funcall async-callback msg-decoded)))))
|
||||
;; This is OK, we reached the end of the chunk subprocess sent
|
||||
;; at this time.
|
||||
(invalid-read-syntax t)
|
||||
(end-of-file t)))
|
||||
(goto-char (point-max))
|
||||
(move-marker async-read-marker (point)))))))
|
||||
|
||||
(defun async--receive-sexp (&optional stream)
|
||||
;; FIXME: Why use `utf-8-auto' instead of `utf-8-unix'? This is
|
||||
;; a communication channel over which we have complete control,
|
||||
;; so we get to choose exactly which encoding and EOL we use, isn't
|
||||
;; it?
|
||||
;; UPDATE: We use now `utf-8-emacs-unix' instead of `utf-8-auto' as
|
||||
;; recommended in bug#165.
|
||||
(let ((sexp (decode-coding-string (base64-decode-string (read stream))
|
||||
'utf-8-emacs-unix))
|
||||
;; Parent expects UTF-8 encoded text.
|
||||
(coding-system-for-write 'utf-8-emacs-unix))
|
||||
(if async-debug
|
||||
(message "Received sexp {{{%s}}}" (pp-to-string sexp)))
|
||||
(setq sexp (read sexp))
|
||||
(if async-debug
|
||||
(message "Read sexp {{{%s}}}" (pp-to-string sexp)))
|
||||
(eval sexp t)))
|
||||
|
||||
(defun async--insert-sexp (sexp)
|
||||
(let (print-level
|
||||
print-length
|
||||
(print-escape-nonascii t)
|
||||
(print-circle t)
|
||||
;; Fix bug#153 in emacs-29 with symbol's positions.
|
||||
(print-symbols-bare t))
|
||||
(prin1 sexp (current-buffer))
|
||||
;; Just in case the string we're sending might contain EOF
|
||||
(encode-coding-region (point-min) (point-max) 'utf-8-emacs-unix)
|
||||
(base64-encode-region (point-min) (point-max) t)
|
||||
(goto-char (point-min)) (insert ?\")
|
||||
(goto-char (point-max)) (insert ?\" ?\n)))
|
||||
|
||||
(defun async--transmit-sexp (process sexp)
|
||||
(with-temp-buffer
|
||||
(if async-debug
|
||||
(message "Transmitting sexp {{{%s}}}" (pp-to-string sexp)))
|
||||
(async--insert-sexp sexp)
|
||||
(process-send-region process (point-min) (point-max))))
|
||||
|
||||
(defun async-batch-invoke ()
|
||||
"Called from the child Emacs process' command line."
|
||||
;; Make sure 'message' and 'prin1' encode stuff in UTF-8, as parent
|
||||
;; process expects.
|
||||
(let ((coding-system-for-write 'utf-8-emacs-unix)
|
||||
(args-left command-line-args-left))
|
||||
(setq async-in-child-emacs t
|
||||
debug-on-error async-debug
|
||||
command-line-args-left nil)
|
||||
(condition-case-unless-debug err
|
||||
(let ((ret (funcall
|
||||
(async--receive-sexp (unless async-send-over-pipe
|
||||
args-left)))))
|
||||
;; The newlines makes client messages more robust and also
|
||||
;; handle some weird line-buffering issues on windows.
|
||||
;; Sometimes, the last "chunk" was not read by the filter,
|
||||
;; so a newline here should force a buffer flush.
|
||||
(princ "\n")
|
||||
(prin1 ret)
|
||||
(princ "\n"))
|
||||
(error
|
||||
(progn
|
||||
(princ "\n")
|
||||
(prin1 (list 'async-signal err))
|
||||
(princ "\n"))))))
|
||||
|
||||
(defun async-ready (future)
|
||||
"Query a FUTURE to see if it is ready.
|
||||
|
||||
I.e., if no blocking would result from a call to `async-get' on that FUTURE."
|
||||
(and (memq (process-status future) '(exit signal))
|
||||
(let ((buf (process-buffer future)))
|
||||
(if (buffer-live-p buf)
|
||||
(with-current-buffer buf
|
||||
async-callback-value-set)
|
||||
t))))
|
||||
|
||||
(defun async-wait (future)
|
||||
"Wait for FUTURE to become ready."
|
||||
(while (not (async-ready future))
|
||||
(sleep-for 0.05)))
|
||||
|
||||
(defun async-get (future)
|
||||
"Get the value from process FUTURE when it is ready.
|
||||
FUTURE is returned by `async-start' or `async-start-process' when
|
||||
its FINISH-FUNC is nil."
|
||||
(and future (async-wait future))
|
||||
(let ((buf (process-buffer future)))
|
||||
(when (buffer-live-p buf)
|
||||
(with-current-buffer buf
|
||||
(async-handle-result
|
||||
#'identity async-callback-value (current-buffer))))))
|
||||
|
||||
(defun async-message-p (value)
|
||||
"Return non-nil if VALUE is an async.el message packet."
|
||||
(and (listp value)
|
||||
(plist-get value :async-message)))
|
||||
|
||||
(defun async-send (process-or-key &rest args)
|
||||
"Send the given message to the asynchronous child or parent Emacs.
|
||||
|
||||
To send messages from the parent to a child, PROCESS-OR-KEY is
|
||||
the child process object. ARGS is a plist. Example:
|
||||
|
||||
(async-send proc :operation :load-file :file \"this file\")
|
||||
|
||||
To send messages from the child to the parent, PROCESS-OR-KEY is
|
||||
the first key of the plist, ARGS is a value followed by
|
||||
optionally more key-value pairs. Example:
|
||||
|
||||
(async-send :status \"finished\" :file-size 123)"
|
||||
(let ((args (append args '(:async-message t))))
|
||||
(if async-in-child-emacs
|
||||
;; `princ' because async--insert-sexp already quotes everything.
|
||||
(princ
|
||||
(with-temp-buffer
|
||||
(async--insert-sexp (cons process-or-key args))
|
||||
;; always make sure that one message package has its own
|
||||
;; line as there can be any random debug garbage printed
|
||||
;; above it.
|
||||
(concat "\n" (buffer-string))))
|
||||
(async--transmit-sexp process-or-key (list 'quote args)))))
|
||||
|
||||
(defun async-receive ()
|
||||
"Receive message from parent Emacs.
|
||||
|
||||
The child process blocks until a message is received.
|
||||
|
||||
Message is a plist with one key :async-message set to t always
|
||||
automatically added to signify this plist is an async message.
|
||||
|
||||
You can use `async-message-p' to test if the payload was a
|
||||
message.
|
||||
|
||||
Use
|
||||
|
||||
(let ((msg (async-receive))) ...)
|
||||
|
||||
to read and process a message."
|
||||
(async--receive-sexp))
|
||||
|
||||
;;;###autoload
|
||||
(defun async-start-process (name program finish-func &rest program-args)
|
||||
"Start the executable PROGRAM asynchronously named NAME. See `async-start'.
|
||||
PROGRAM is passed PROGRAM-ARGS, calling FINISH-FUNC with the
|
||||
process object when done. If FINISH-FUNC is nil, the future
|
||||
object will return the process object when the program is
|
||||
finished. Set DEFAULT-DIRECTORY to change PROGRAM's current
|
||||
working directory."
|
||||
(let* ((buf (generate-new-buffer (concat "*" name "*")))
|
||||
(buf-err (generate-new-buffer (concat "*" name ":err*")))
|
||||
(prt-for-pwd async-prompt-for-password)
|
||||
(proc (let ((process-connection-type nil))
|
||||
(make-process
|
||||
:name name
|
||||
:buffer buf
|
||||
:stderr buf-err
|
||||
:command (cons program program-args)
|
||||
:noquery async-process-noquery-on-exit))))
|
||||
(set-process-sentinel
|
||||
(get-buffer-process buf-err)
|
||||
(lambda (proc _change)
|
||||
(unless (or async-debug (process-live-p proc))
|
||||
(kill-buffer (process-buffer proc)))))
|
||||
(with-current-buffer buf
|
||||
(set (make-local-variable 'async-callback) finish-func)
|
||||
(set (make-local-variable 'async-read-marker)
|
||||
(set-marker (make-marker) (point-min) buf))
|
||||
(set-marker-insertion-type async-read-marker nil)
|
||||
(set-process-sentinel proc #'async-when-done)
|
||||
;; Pass the value of `async-prompt-for-password' to the process
|
||||
;; filter fn through the lexical local var prt-for-pwd (Issue#182).
|
||||
(set-process-filter proc (lambda (proc string)
|
||||
(async-read-from-client
|
||||
proc string prt-for-pwd)))
|
||||
(unless (string= name "emacs")
|
||||
(set (make-local-variable 'async-callback-for-process) t))
|
||||
proc)))
|
||||
|
||||
(defvar async-quiet-switch "-Q"
|
||||
"The Emacs parameter to use to call emacs without config.
|
||||
Can be one of \"-Q\" or \"-q\".
|
||||
Default is \"-Q\" but it is sometimes useful to use \"-q\" to have a
|
||||
enhanced config or some more variables loaded.")
|
||||
|
||||
(defun async--emacs-program-args (&optional sexp)
|
||||
"Return a list of arguments for invoking the child Emacs."
|
||||
;; Using `locate-library' ensure we use the right file
|
||||
;; when the .elc have been deleted.
|
||||
(let ((args (list async-quiet-switch "-l" (locate-library "async"))))
|
||||
(when async-child-init
|
||||
(setq args (append args (list "-l" async-child-init))))
|
||||
(append args (list "-batch" "-f" "async-batch-invoke"
|
||||
(if sexp
|
||||
(with-temp-buffer
|
||||
(async--insert-sexp (list 'quote sexp))
|
||||
(buffer-string))
|
||||
"<none>")))))
|
||||
|
||||
;;;###autoload
|
||||
(defun async-start (start-func &optional finish-func)
|
||||
"Execute START-FUNC (often a lambda) in a subordinate Emacs process.
|
||||
When done, the return value is passed to FINISH-FUNC. Example:
|
||||
|
||||
(async-start
|
||||
;; What to do in the child process
|
||||
(lambda ()
|
||||
(message \"This is a test\")
|
||||
(sleep-for 3)
|
||||
222)
|
||||
|
||||
;; What to do when it finishes
|
||||
(lambda (result)
|
||||
(message \"Async process done, result should be 222: %s\"
|
||||
result)))
|
||||
|
||||
If you call `async-send' from a child process, the message will
|
||||
be also passed to the FINISH-FUNC. You can test RESULT to see if
|
||||
it is a message by using `async-message-p'. If nil, it means
|
||||
this is the final result. Example of the FINISH-FUNC:
|
||||
|
||||
(lambda (result)
|
||||
(if (async-message-p result)
|
||||
(message \"Received a message from child process: %s\" result)
|
||||
(message \"Async process done, result: %s\" result)))
|
||||
|
||||
If FINISH-FUNC is nil or missing, a future is returned that can
|
||||
be inspected using `async-get', blocking until the value is
|
||||
ready. Example:
|
||||
|
||||
(let ((proc (async-start
|
||||
;; What to do in the child process
|
||||
(lambda ()
|
||||
(message \"This is a test\")
|
||||
(sleep-for 3)
|
||||
222))))
|
||||
|
||||
(message \"I'm going to do some work here\") ;; ....
|
||||
|
||||
(message \"Waiting on async process, result should be 222: %s\"
|
||||
(async-get proc)))
|
||||
|
||||
If you don't want to use a callback, and you don't care about any
|
||||
return value from the child process, pass the `ignore' symbol as
|
||||
the second argument (if you don't, and never call `async-get', it
|
||||
will leave *emacs* process buffers hanging around):
|
||||
|
||||
(async-start
|
||||
(lambda ()
|
||||
(delete-file \"a remote file on a slow link\" nil))
|
||||
\\='ignore)
|
||||
|
||||
Special case:
|
||||
If the output of START-FUNC is a string with properties
|
||||
e.g. (buffer-string) RESULT will be transformed in a list where the
|
||||
car is the string itself (without props) and the cdr the rest of
|
||||
properties, this allows using in FINISH-FUNC the string without
|
||||
properties and then apply the properties in cdr to this string (if
|
||||
needed).
|
||||
Properties handling special objects like markers are returned as
|
||||
list to allow restoring them later.
|
||||
See <https://github.com/jwiegley/emacs-async/issues/145> for more infos.
|
||||
|
||||
Note: Even when FINISH-FUNC is present, a future is still
|
||||
returned except that it yields no value (since the value is
|
||||
passed to FINISH-FUNC). Call `async-get' on such a future always
|
||||
returns nil. It can still be useful, however, as an argument to
|
||||
`async-ready' or `async-wait'."
|
||||
(let ((sexp start-func)
|
||||
;; Subordinate Emacs will send text encoded in UTF-8.
|
||||
(coding-system-for-read 'utf-8-emacs-unix))
|
||||
(setq async--procvar
|
||||
(apply 'async-start-process
|
||||
"emacs" (file-truename
|
||||
(expand-file-name invocation-name
|
||||
invocation-directory))
|
||||
finish-func
|
||||
(async--emacs-program-args (if (not async-send-over-pipe) sexp))))
|
||||
|
||||
(if async-send-over-pipe
|
||||
(async--transmit-sexp async--procvar (list 'quote sexp)))
|
||||
async--procvar))
|
||||
|
||||
(defmacro async-sandbox(func)
|
||||
"Evaluate FUNC in a separate Emacs process, synchronously."
|
||||
`(async-get (async-start ,func)))
|
||||
|
||||
(defun async--fold-left (fn forms bindings)
|
||||
(let ((res forms))
|
||||
(dolist (binding bindings)
|
||||
(setq res (funcall fn res
|
||||
(if (listp binding)
|
||||
binding
|
||||
(list binding)))))
|
||||
res))
|
||||
|
||||
(defmacro async-let (bindings &rest forms)
|
||||
"Implements `let', but each binding is established asynchronously.
|
||||
For example:
|
||||
|
||||
(async-let ((x (foo))
|
||||
(y (bar)))
|
||||
(message \"%s %s\" x y))
|
||||
|
||||
expands to ==>
|
||||
|
||||
(async-start (foo)
|
||||
(lambda (x)
|
||||
(async-start (bar)
|
||||
(lambda (y)
|
||||
(message \"%s %s\" x y)))))"
|
||||
(declare (indent 1))
|
||||
(async--fold-left
|
||||
(lambda (acc binding)
|
||||
(let ((fun (pcase (cadr binding)
|
||||
((and (pred functionp) f) f)
|
||||
(f `(lambda () ,f)))))
|
||||
`(async-start ,fun
|
||||
(lambda (,(car binding))
|
||||
,acc))))
|
||||
`(progn ,@forms)
|
||||
(reverse bindings)))
|
||||
|
||||
(provide 'async)
|
||||
|
||||
;;; async.el ends here
|
||||
|
|
@ -1,490 +0,0 @@
|
|||
;;; dired-async.el --- Asynchronous dired actions -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2012-2019 Free Software Foundation, Inc.
|
||||
|
||||
;; Authors: John Wiegley <jwiegley@gmail.com>
|
||||
;; Thierry Volpiatto <thievol@posteo.net>
|
||||
|
||||
;; Keywords: dired async network
|
||||
;; 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:
|
||||
|
||||
;; This file provide a redefinition of `dired-create-file' function,
|
||||
;; performs copies, moves and all what is handled by `dired-create-file'
|
||||
;; in the background using a slave Emacs process,
|
||||
;; by means of the async.el module.
|
||||
;; To use it, put this in your .emacs:
|
||||
|
||||
;; (dired-async-mode 1)
|
||||
|
||||
;; This will enable async copy/rename etc...
|
||||
;; in dired and helm.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'dired-aux)
|
||||
(require 'async)
|
||||
|
||||
(eval-when-compile
|
||||
(defvar async-callback))
|
||||
|
||||
(defgroup dired-async nil
|
||||
"Copy rename files asynchronously from dired."
|
||||
:group 'dired)
|
||||
|
||||
(defcustom dired-async-env-variables-regexp
|
||||
"\\`\\(tramp-\\(default\\|connection\\|remote\\)\\|ange-ftp\\)-.*"
|
||||
"Variables matching this regexp will be loaded on Child Emacs."
|
||||
:type 'regexp)
|
||||
|
||||
(defcustom dired-async-message-function 'dired-async-mode-line-message
|
||||
"Function to use to notify result when operation finish.
|
||||
Should take same args as `message'."
|
||||
:type 'function)
|
||||
|
||||
(defcustom dired-async-log-file "/tmp/dired-async.log"
|
||||
"File use to communicate errors from Child Emacs to host Emacs."
|
||||
:type 'string)
|
||||
|
||||
(defcustom dired-async-mode-lighter '(:eval
|
||||
(when (eq major-mode 'dired-mode)
|
||||
" Async"))
|
||||
"Mode line lighter used for `dired-async-mode'."
|
||||
:risky t
|
||||
:type 'sexp)
|
||||
|
||||
(defcustom dired-async-skip-fast nil
|
||||
"If non-nil, skip async for fast operations.
|
||||
Same device renames and copying and renaming files smaller than
|
||||
`dired-async-small-file-max' are considered fast."
|
||||
:risky t
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom dired-async-small-file-max 5000000
|
||||
"Files smaller than this in bytes are considered fast to copy
|
||||
or rename for `dired-async-skip-fast'."
|
||||
:risky t
|
||||
:type 'integer)
|
||||
|
||||
(defcustom dired-async-large-file-warning-threshold large-file-warning-threshold
|
||||
"Same as `large-file-warning-threshold' but for dired-async."
|
||||
:type 'integer)
|
||||
|
||||
(defface dired-async-message
|
||||
'((t (:foreground "yellow")))
|
||||
"Face used for mode-line message.")
|
||||
|
||||
(defface dired-async-failures
|
||||
'((t (:foreground "red")))
|
||||
"Face used for mode-line message.")
|
||||
|
||||
(defface dired-async-mode-message
|
||||
'((t (:foreground "Gold")))
|
||||
"Face used for `dired-async--modeline-mode' lighter.")
|
||||
|
||||
(define-minor-mode dired-async--modeline-mode
|
||||
"Notify mode-line that an async process run."
|
||||
:global t
|
||||
:lighter (:eval (propertize (format " [%s Async job(s) running]"
|
||||
(length (dired-async-processes)))
|
||||
'face 'dired-async-mode-message))
|
||||
(unless dired-async--modeline-mode
|
||||
(let ((visible-bell t)) (ding))))
|
||||
|
||||
(defun dired-async-mode-line-message (text face &rest args)
|
||||
"Notify end of operation in `mode-line'."
|
||||
(message nil)
|
||||
(let ((mode-line-format (concat
|
||||
" " (propertize
|
||||
(if args
|
||||
(apply #'format text args)
|
||||
text)
|
||||
'face face))))
|
||||
(force-mode-line-update)
|
||||
(sit-for 3)
|
||||
(force-mode-line-update)))
|
||||
|
||||
(defun dired-async-processes (&optional propname)
|
||||
(cl-loop for p in (process-list)
|
||||
when (process-get p (or propname 'dired-async-process))
|
||||
collect p))
|
||||
|
||||
(defun dired-async-kill-process ()
|
||||
(interactive)
|
||||
(let* ((processes (dired-async-processes))
|
||||
(proc (car (last processes))))
|
||||
(and proc (delete-process proc))
|
||||
(unless (> (length processes) 1)
|
||||
(dired-async--modeline-mode -1))))
|
||||
|
||||
(defun dired-async-after-file-create (total operation failures skipped)
|
||||
"Callback function used for operation handled by `dired-create-file'."
|
||||
(unless (dired-async-processes)
|
||||
;; Turn off mode-line notification
|
||||
;; only when last process end.
|
||||
(dired-async--modeline-mode -1))
|
||||
(when operation
|
||||
(if (file-exists-p dired-async-log-file)
|
||||
(progn
|
||||
(pop-to-buffer (get-buffer-create dired-log-buffer))
|
||||
(goto-char (point-max))
|
||||
(setq inhibit-read-only t)
|
||||
(insert "Error: ")
|
||||
(insert-file-contents dired-async-log-file)
|
||||
(special-mode)
|
||||
(shrink-window-if-larger-than-buffer)
|
||||
(delete-file dired-async-log-file))
|
||||
(run-with-timer
|
||||
0.1 nil
|
||||
(lambda ()
|
||||
;; First send error messages.
|
||||
(cond (failures
|
||||
(funcall dired-async-message-function
|
||||
"%s failed for %d of %d file%s -- See *Dired log* buffer"
|
||||
'dired-async-failures
|
||||
(car operation) (length failures)
|
||||
total (dired-plural-s total)))
|
||||
(skipped
|
||||
(funcall dired-async-message-function
|
||||
"%s: %d of %d file%s skipped -- See *Dired log* buffer"
|
||||
'dired-async-failures
|
||||
(car operation) (length skipped) total
|
||||
(dired-plural-s total))))
|
||||
(when dired-buffers
|
||||
(cl-loop for (_f . b) in dired-buffers
|
||||
when (buffer-live-p b)
|
||||
do (with-current-buffer b
|
||||
(when (and (not (file-remote-p default-directory nil t))
|
||||
(file-exists-p default-directory))
|
||||
(revert-buffer nil t)))))
|
||||
;; Finally send the success message.
|
||||
(funcall dired-async-message-function
|
||||
"Asynchronous %s of %s on %s file%s done"
|
||||
'dired-async-message
|
||||
(car operation) (cadr operation)
|
||||
total (dired-plural-s total)))))))
|
||||
|
||||
(defun dired-async-maybe-kill-ftp ()
|
||||
"Return a form to kill ftp process in child emacs."
|
||||
(quote
|
||||
(progn
|
||||
(require 'cl-lib)
|
||||
(let ((buf (cl-loop for b in (buffer-list)
|
||||
thereis (and (string-match
|
||||
"\\`\\*ftp.*"
|
||||
(buffer-name b)) b))))
|
||||
(when buf (kill-buffer buf))))))
|
||||
|
||||
(defsubst dired-async--directory-p (attributes)
|
||||
"Return non-nil if ATTRIBUTES is for a directory.
|
||||
See `file-attributes'."
|
||||
;; Can also be a string for symlinks, so check for t explicitly.
|
||||
(eq (file-attribute-type attributes) t))
|
||||
|
||||
(defsubst dired-async--same-device-p (f1 f2)
|
||||
"Return non-nil if F1 and F2 have the same device number."
|
||||
;; file-attribute-device-number may be a cons cell, so use equal for
|
||||
;; testing (See Emacs bug/58446).
|
||||
(equal (file-attribute-device-number (file-attributes f1))
|
||||
(file-attribute-device-number (file-attributes f2))))
|
||||
|
||||
(defun dired-async--small-file-p (file)
|
||||
"Return non-nil if FILE is considered small.
|
||||
|
||||
File is considered small if it size is smaller than
|
||||
`dired-async-small-file-max'."
|
||||
(let ((a (file-attributes file)))
|
||||
;; Directories are always large since we can't easily figure out
|
||||
;; their total size.
|
||||
(and (not (dired-async--directory-p a))
|
||||
(< (file-attribute-size a) dired-async-small-file-max))))
|
||||
|
||||
(defun dired-async--skip-async-p (file-creator file name-constructor)
|
||||
"Return non-nil if we should skip async for FILE.
|
||||
See `dired-create-files' for FILE-CREATOR and NAME-CONSTRUCTOR."
|
||||
;; Skip async for small files.
|
||||
(or (dired-async--small-file-p file)
|
||||
;; Also skip async for same device renames.
|
||||
(and (eq file-creator 'dired-rename-file)
|
||||
(let ((new (funcall name-constructor file)))
|
||||
(dired-async--same-device-p file (file-name-directory new))))))
|
||||
|
||||
(defun dired-async--smart-create-files (old-func file-creator
|
||||
operation fn-list name-constructor
|
||||
&optional marker-char)
|
||||
"Around advice for `dired-create-files'.
|
||||
Uses async like `dired-async-create-files' but skips certain fast
|
||||
cases if `dired-async-skip-fast' is non-nil."
|
||||
(let (async-list quick-list)
|
||||
(if (or (eq file-creator 'backup-file)
|
||||
(null dired-async-skip-fast))
|
||||
(setq async-list fn-list)
|
||||
(dolist (old fn-list)
|
||||
(if (dired-async--skip-async-p file-creator old name-constructor)
|
||||
(push old quick-list)
|
||||
(push old async-list))))
|
||||
(when async-list
|
||||
(dired-async-create-files
|
||||
file-creator operation (nreverse async-list)
|
||||
name-constructor marker-char))
|
||||
(when quick-list
|
||||
(funcall old-func file-creator operation
|
||||
(nreverse quick-list) name-constructor marker-char))))
|
||||
|
||||
(defun dired-async--abort-if-file-too-large (size op-type filename)
|
||||
"Warn when FILENAME larger than `dired-async-large-file-warning-threshold'.
|
||||
Same as `abort-if-file-too-large' but without user-error."
|
||||
(when (and dired-async-large-file-warning-threshold size
|
||||
(> size dired-async-large-file-warning-threshold))
|
||||
(files--ask-user-about-large-file
|
||||
size op-type filename nil)))
|
||||
|
||||
(defvar overwrite-query)
|
||||
(defun dired-async-create-files (file-creator operation fn-list name-constructor
|
||||
&optional _marker-char)
|
||||
"Same as `dired-create-files' but asynchronous.
|
||||
|
||||
See `dired-create-files' for the behavior of arguments."
|
||||
(setq overwrite-query nil)
|
||||
(let ((total (length fn-list))
|
||||
failures async-fn-list skipped callback
|
||||
async-quiet-switch create-dir)
|
||||
(let (to)
|
||||
(dolist (from fn-list)
|
||||
(setq to (funcall name-constructor from))
|
||||
(if (and (equal to from)
|
||||
(null (eq file-creator 'backup-file)))
|
||||
(progn
|
||||
(setq to nil)
|
||||
(dired-log "Cannot %s to same file: %s\n"
|
||||
(downcase operation) from)))
|
||||
(if (not to)
|
||||
(setq skipped (cons (dired-make-relative from) skipped))
|
||||
(let* ((overwrite (and (null (eq file-creator 'backup-file))
|
||||
(file-exists-p to)))
|
||||
(dired-overwrite-confirmed ; for dired-handle-overwrite
|
||||
(and overwrite
|
||||
(let ((help-form `(format "\
|
||||
Type SPC or `y' to overwrite file `%s',
|
||||
DEL or `n' to skip to next,
|
||||
ESC or `q' to not overwrite any of the remaining files,
|
||||
`!' to overwrite all remaining files with no more questions." ,to)))
|
||||
(dired-query 'overwrite-query "Overwrite `%s'?" to)))))
|
||||
;; Handle the `dired-copy-file' file-creator specially
|
||||
;; When copying a directory to another directory or
|
||||
;; possibly to itself or one of its subdirectories.
|
||||
;; e.g "~/foo/" => "~/test/"
|
||||
;; or "~/foo/" =>"~/foo/"
|
||||
;; or "~/foo/ => ~/foo/bar/")
|
||||
;; In this case the 'name-constructor' have set the destination
|
||||
;; TO to "~/test/foo" because the old emacs23 behavior
|
||||
;; of `copy-directory' was to not create the subdirectory
|
||||
;; and instead copy the contents.
|
||||
;; With the new behavior of `copy-directory'
|
||||
;; (similar to the `cp' shell command) we don't
|
||||
;; need such a construction of the target directory,
|
||||
;; so modify the destination TO to "~/test/" instead of "~/test/foo/".
|
||||
(let ((destname (file-name-directory to)))
|
||||
(when (and (file-directory-p from)
|
||||
(file-directory-p to)
|
||||
(eq file-creator 'dired-copy-file))
|
||||
(setq to destname))
|
||||
;; If DESTNAME is a subdirectory of FROM, not a symlink,
|
||||
;; and the method in use is copying, signal an error.
|
||||
(and (eq t (car (file-attributes destname)))
|
||||
(eq file-creator 'dired-copy-file)
|
||||
(file-in-directory-p destname from)
|
||||
(error "Cannot copy `%s' into its subdirectory `%s'"
|
||||
from to)))
|
||||
;; Skip file if it is too large.
|
||||
(if (and (member operation '("Copy" "Rename"))
|
||||
(eq (dired-async--abort-if-file-too-large
|
||||
(file-attribute-size
|
||||
(file-attributes (file-truename from)))
|
||||
(downcase operation) from)
|
||||
'abort))
|
||||
(push from skipped)
|
||||
(if overwrite
|
||||
(or (and dired-overwrite-confirmed
|
||||
(push (cons from to) async-fn-list))
|
||||
(progn
|
||||
(push (dired-make-relative from) failures)
|
||||
(dired-log "%s `%s' to `%s' failed\n"
|
||||
operation from to)))
|
||||
(push (cons from to) async-fn-list))))))
|
||||
;; Fix tramp issue #80 with emacs-26, use "-q" only when needed.
|
||||
(setq async-quiet-switch
|
||||
(if (and (boundp 'tramp-cache-read-persistent-data)
|
||||
async-fn-list
|
||||
(cl-loop for (_from . to) in async-fn-list
|
||||
thereis (file-remote-p to)))
|
||||
"-q" "-Q"))
|
||||
;; When failures have been printed to dired log add the date at bob.
|
||||
(when (or failures skipped) (dired-log t))
|
||||
;; When async-fn-list is empty that's mean only one file
|
||||
;; had to be copied and user finally answer NO.
|
||||
;; In this case async process will never start and callback
|
||||
;; will have no chance to run, so notify failures here.
|
||||
(unless async-fn-list
|
||||
(cond (failures
|
||||
(funcall dired-async-message-function
|
||||
"%s failed for %d of %d file%s -- See *Dired log* buffer"
|
||||
'dired-async-failures
|
||||
operation (length failures)
|
||||
total (dired-plural-s total)))
|
||||
(skipped
|
||||
(funcall dired-async-message-function
|
||||
"%s: %d of %d file%s skipped -- See *Dired log* buffer"
|
||||
'dired-async-failures
|
||||
operation (length skipped) total
|
||||
(dired-plural-s total)))))
|
||||
;; Setup callback.
|
||||
(setq callback
|
||||
(lambda (&optional _ignore)
|
||||
(dired-async-after-file-create
|
||||
total (list operation (length async-fn-list)) failures skipped)
|
||||
(when (string= (downcase operation) "rename")
|
||||
(cl-loop for (file . to) in async-fn-list
|
||||
for bf = (get-file-buffer file)
|
||||
for destp = (file-exists-p to)
|
||||
do (and bf destp
|
||||
(with-current-buffer bf
|
||||
(set-visited-file-name to t t)))))))
|
||||
(let ((dirp (file-directory-p to))
|
||||
(dest (file-name-directory to)))
|
||||
(when (boundp 'dired-create-destination-dirs)
|
||||
(setq create-dir
|
||||
(cl-case dired-create-destination-dirs
|
||||
(always 'always)
|
||||
(ask (and (null dirp)
|
||||
(null (file-directory-p dest))
|
||||
(y-or-n-p (format "Create directory `%s'? " dest)))
|
||||
'always))))))
|
||||
;; Start async process.
|
||||
(when async-fn-list
|
||||
(process-put
|
||||
(async-start `(lambda ()
|
||||
(require 'cl-lib) (require 'dired-aux) (require 'dired-x)
|
||||
,(async-inject-variables dired-async-env-variables-regexp)
|
||||
(advice-add #'files--ask-user-about-large-file
|
||||
:override (lambda (&rest args) nil))
|
||||
(let ((dired-recursive-copies (quote always))
|
||||
(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
|
||||
;; available in emacs.
|
||||
(defalias 'backup-file
|
||||
;; Same feature as "cp -f --backup=numbered from to"
|
||||
;; Symlinks are copied as file from source unlike
|
||||
;; `dired-copy-file' which is same as cp -d.
|
||||
;; Directories are omitted.
|
||||
(lambda (from to ok)
|
||||
(cond ((file-directory-p from) (ignore))
|
||||
(t (let ((count 0))
|
||||
(while (let ((attrs (file-attributes to)))
|
||||
(and attrs (null (nth 0 attrs))))
|
||||
(cl-incf count)
|
||||
(setq to (concat (file-name-sans-versions to)
|
||||
(format ".~%s~" count)))))
|
||||
(condition-case err
|
||||
(copy-file from to ok dired-copy-preserve-time)
|
||||
(file-date-error
|
||||
(dired-log "Can't set date on %s:\n%s\n" from err)))))))
|
||||
;; Now run the FILE-CREATOR function on files.
|
||||
(cl-loop with fn = (quote ,file-creator)
|
||||
for (from . dest) in (quote ,async-fn-list)
|
||||
do (condition-case err
|
||||
(funcall fn from dest t)
|
||||
(file-error
|
||||
(dired-log "%s: %s\n" (car err) (cdr err))
|
||||
nil)))
|
||||
(when (get-buffer dired-log-buffer)
|
||||
(dired-log t)
|
||||
(with-current-buffer dired-log-buffer
|
||||
(write-region (point-min) (point-max)
|
||||
,dired-async-log-file))))
|
||||
,(dired-async-maybe-kill-ftp))
|
||||
callback)
|
||||
'dired-async-process t)
|
||||
;; Run mode-line notifications while process running.
|
||||
(dired-async--modeline-mode 1)
|
||||
(message "%s proceeding asynchronously..." operation))))
|
||||
|
||||
(defvar wdired-use-interactive-rename)
|
||||
(defun dired-async-wdired-do-renames (old-fn &rest args)
|
||||
;; Perhaps a better fix would be to ask for renaming BEFORE starting
|
||||
;; OLD-FN when `wdired-use-interactive-rename' is non-nil. For now
|
||||
;; just bind it to nil to ensure no questions will be asked between
|
||||
;; each rename.
|
||||
(let (wdired-use-interactive-rename)
|
||||
(apply old-fn args)))
|
||||
|
||||
;;;###autoload
|
||||
(define-minor-mode dired-async-mode
|
||||
"Do dired actions asynchronously."
|
||||
:lighter dired-async-mode-lighter
|
||||
:global t
|
||||
(if dired-async-mode
|
||||
(progn
|
||||
(advice-add 'dired-create-files :around #'dired-async--smart-create-files)
|
||||
(advice-add 'wdired-do-renames :around #'dired-async-wdired-do-renames))
|
||||
(progn
|
||||
(advice-remove 'dired-create-files #'dired-async--smart-create-files)
|
||||
(advice-remove 'wdired-do-renames #'dired-async-wdired-do-renames))))
|
||||
|
||||
(defmacro dired-async--with-async-create-files (&rest body)
|
||||
"Evaluate BODY with ‘dired-create-files’ set to ‘dired-async-create-files’."
|
||||
(declare (indent 0))
|
||||
`(cl-letf (((symbol-function 'dired-create-files) #'dired-async-create-files))
|
||||
,@body))
|
||||
|
||||
;;;###autoload
|
||||
(defun dired-async-do-copy (&optional arg)
|
||||
"Run ‘dired-do-copy’ asynchronously."
|
||||
(interactive "P")
|
||||
(dired-async--with-async-create-files
|
||||
(dired-do-copy arg)))
|
||||
|
||||
;;;###autoload
|
||||
(defun dired-async-do-symlink (&optional arg)
|
||||
"Run ‘dired-do-symlink’ asynchronously."
|
||||
(interactive "P")
|
||||
(dired-async--with-async-create-files
|
||||
(dired-do-symlink arg)))
|
||||
|
||||
;;;###autoload
|
||||
(defun dired-async-do-hardlink (&optional arg)
|
||||
"Run ‘dired-do-hardlink’ asynchronously."
|
||||
(interactive "P")
|
||||
(dired-async--with-async-create-files
|
||||
(dired-do-hardlink arg)))
|
||||
|
||||
;;;###autoload
|
||||
(defun dired-async-do-rename (&optional arg)
|
||||
"Run ‘dired-do-rename’ asynchronously."
|
||||
(interactive "P")
|
||||
(dired-async--with-async-create-files
|
||||
(dired-do-rename arg)))
|
||||
|
||||
(provide 'dired-async)
|
||||
|
||||
;;; dired-async.el ends here
|
||||
|
|
@ -1,71 +0,0 @@
|
|||
;;; smtpmail-async.el --- Send e-mail with smtpmail.el asynchronously -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2012-2022 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: John Wiegley <jwiegley@gmail.com>
|
||||
;; Created: 18 Jun 2012
|
||||
|
||||
;; Keywords: email async
|
||||
;; 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:
|
||||
|
||||
;; Send e-mail with smtpmail.el asynchronously. To use:
|
||||
;;
|
||||
;; (require 'smtpmail-async)
|
||||
;;
|
||||
;; (setq send-mail-function 'async-smtpmail-send-it
|
||||
;; message-send-mail-function 'async-smtpmail-send-it)
|
||||
;;
|
||||
;; This assumes you already have smtpmail.el working.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(defgroup smtpmail-async nil
|
||||
"Send e-mail with smtpmail.el asynchronously"
|
||||
:group 'smptmail)
|
||||
|
||||
(require 'async)
|
||||
(require 'smtpmail)
|
||||
(require 'message)
|
||||
|
||||
(defvar async-smtpmail-before-send-hook nil
|
||||
"Hook running in the child emacs in `async-smtpmail-send-it'.
|
||||
It is called just before calling `smtpmail-send-it'.")
|
||||
|
||||
(defun async-smtpmail-send-it ()
|
||||
(let ((to (message-field-value "To"))
|
||||
(buf-content (buffer-substring-no-properties
|
||||
(point-min) (point-max))))
|
||||
(message "Delivering message to %s..." to)
|
||||
(async-start
|
||||
`(lambda ()
|
||||
(require 'smtpmail)
|
||||
(with-temp-buffer
|
||||
(insert ,buf-content)
|
||||
(set-buffer-multibyte nil)
|
||||
;; Pass in the variable environment for smtpmail
|
||||
,(async-inject-variables
|
||||
"\\`\\(smtpmail\\|async-smtpmail\\|\\(user-\\)?mail\\)-\\|auth-sources\\|epg\\|nsm"
|
||||
nil "\\`\\(mail-header-format-function\\|smtpmail-address-buffer\\|mail-mode-abbrev-table\\)")
|
||||
(run-hooks 'async-smtpmail-before-send-hook)
|
||||
(smtpmail-send-it)))
|
||||
(lambda (&optional _ignore)
|
||||
(message "Delivering message to %s...done" to)))))
|
||||
|
||||
(provide 'smtpmail-async)
|
||||
|
||||
;;; smtpmail-async.el ends here
|
||||
|
|
@ -1,102 +0,0 @@
|
|||
;;; bind-key-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 "bind-key" "bind-key.el" (0 0 0 0))
|
||||
;;; Generated autoloads from bind-key.el
|
||||
|
||||
(autoload 'bind-key "bind-key" "\
|
||||
Bind KEY-NAME to COMMAND in KEYMAP (`global-map' if not passed).
|
||||
|
||||
KEY-NAME may be a vector, in which case it is passed straight to
|
||||
`define-key'. Or it may be a string to be interpreted as
|
||||
spelled-out keystrokes, e.g., \"C-c C-z\". See the documentation
|
||||
of `edmacro-mode' for details.
|
||||
|
||||
COMMAND must be an interactive function, lambda form, or a cons
|
||||
`(STRING . DEFN)'.
|
||||
|
||||
KEYMAP, if present, should be a keymap variable or symbol.
|
||||
For example:
|
||||
|
||||
(bind-key \"M-h\" #\\='some-interactive-function my-mode-map)
|
||||
|
||||
(bind-key \"M-h\" #\\='some-interactive-function \\='my-mode-map)
|
||||
|
||||
If PREDICATE is non-nil, it is a form evaluated to determine when
|
||||
a key should be bound. It must return non-nil in such cases.
|
||||
Emacs can evaluate this form at any time that it does redisplay
|
||||
or operates on menu data structures, so you should write it so it
|
||||
can safely be called at any time.
|
||||
|
||||
\(fn KEY-NAME COMMAND &optional KEYMAP PREDICATE)" nil t)
|
||||
|
||||
(autoload 'unbind-key "bind-key" "\
|
||||
Unbind the given KEY-NAME, within the KEYMAP (if specified).
|
||||
See `bind-key' for more details.
|
||||
|
||||
\(fn KEY-NAME &optional KEYMAP)" nil t)
|
||||
|
||||
(autoload 'bind-key* "bind-key" "\
|
||||
Similar to `bind-key', but overrides any mode-specific bindings.
|
||||
|
||||
\(fn KEY-NAME COMMAND &optional PREDICATE)" nil t)
|
||||
|
||||
(autoload 'bind-keys "bind-key" "\
|
||||
Bind multiple keys at once.
|
||||
|
||||
Accepts keyword arguments:
|
||||
:map MAP - a keymap into which the keybindings should be
|
||||
added
|
||||
:prefix KEY - prefix key for these bindings
|
||||
:prefix-map MAP - name of the prefix map that should be created
|
||||
for these bindings
|
||||
:prefix-docstring STR - docstring for the prefix-map variable
|
||||
:menu-name NAME - optional menu string for prefix map
|
||||
:repeat-docstring STR - docstring for the repeat-map variable
|
||||
:repeat-map MAP - name of the repeat map that should be created
|
||||
for these bindings. If specified, the
|
||||
`repeat-map' property of each command bound
|
||||
(within the scope of the `:repeat-map' keyword)
|
||||
is set to this map.
|
||||
:exit BINDINGS - Within the scope of `:repeat-map' will bind the
|
||||
key in the repeat map, but will not set the
|
||||
`repeat-map' property of the bound command.
|
||||
:continue BINDINGS - Within the scope of `:repeat-map' forces the
|
||||
same behaviour as if no special keyword had
|
||||
been used (that is, the command is bound, and
|
||||
it's `repeat-map' property set)
|
||||
:filter FORM - optional form to determine when bindings apply
|
||||
|
||||
The rest of the arguments are conses of keybinding string and a
|
||||
function symbol (unquoted).
|
||||
|
||||
\(fn &rest ARGS)" nil t)
|
||||
|
||||
(autoload 'bind-keys* "bind-key" "\
|
||||
Bind multiple keys at once, in `override-global-map'.
|
||||
Accepts the same keyword arguments as `bind-keys' (which see).
|
||||
|
||||
This binds keys in such a way that bindings are not overridden by
|
||||
other modes. See `override-global-mode'.
|
||||
|
||||
\(fn &rest ARGS)" nil t)
|
||||
|
||||
(autoload 'describe-personal-keybindings "bind-key" "\
|
||||
Display all the personal keybindings defined by `bind-key'." t nil)
|
||||
|
||||
(register-definition-prefixes "bind-key" '("bind-key" "compare-keybindings" "get-binding-description" "override-global-m" "personal-keybindings"))
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; coding: utf-8
|
||||
;; End:
|
||||
;;; bind-key-autoloads.el ends here
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
;;; Generated package description from bind-key.el -*- no-byte-compile: t -*-
|
||||
(define-package "bind-key" "20230203.2004" "A simple way to manage personal keybindings" '((emacs "24.3")) :commit "77945e002f11440eae72d8730d3de218163d551e" :authors '(("John Wiegley" . "johnw@newartisans.com")) :maintainer '("John Wiegley" . "johnw@newartisans.com") :keywords '("keys" "keybinding" "config" "dotemacs" "extensions") :url "https://github.com/jwiegley/use-package")
|
||||
|
|
@ -1,567 +0,0 @@
|
|||
;;; bind-key.el --- A simple way to manage personal keybindings -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (c) 2012-2022 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: John Wiegley <johnw@newartisans.com>
|
||||
;; Maintainer: John Wiegley <johnw@newartisans.com>
|
||||
;; Created: 16 Jun 2012
|
||||
;; Version: 2.4.1
|
||||
;; Package-Version: 20230203.2004
|
||||
;; Package-Commit: 77945e002f11440eae72d8730d3de218163d551e
|
||||
;; Package-Requires: ((emacs "24.3"))
|
||||
;; Keywords: keys keybinding config dotemacs extensions
|
||||
;; URL: https://github.com/jwiegley/use-package
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs 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.
|
||||
|
||||
;; GNU Emacs 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 GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; If you have lots of keybindings set in your init file, it can be
|
||||
;; hard to know which ones you haven't set yet, and which may now be
|
||||
;; overriding some new default in a new Emacs version. This module
|
||||
;; aims to solve that problem.
|
||||
;;
|
||||
;; Bind keys as follows in your init file:
|
||||
;;
|
||||
;; (bind-key "C-c x" 'my-ctrl-c-x-command)
|
||||
;;
|
||||
;; If the keybinding argument is a vector, it is passed straight to
|
||||
;; `define-key', so remapping a key with `[remap COMMAND]' works as
|
||||
;; expected:
|
||||
;;
|
||||
;; (bind-key [remap original-ctrl-c-x-command] 'my-ctrl-c-x-command)
|
||||
;;
|
||||
;; If you want the keybinding to override all minor modes that may also bind
|
||||
;; the same key, use the `bind-key*' form:
|
||||
;;
|
||||
;; (bind-key* "<C-return>" 'other-window)
|
||||
;;
|
||||
;; If you want to rebind a key only in a particular keymap, use:
|
||||
;;
|
||||
;; (bind-key "C-c x" 'my-ctrl-c-x-command some-other-mode-map)
|
||||
;;
|
||||
;; To unbind a key within a keymap (for example, to stop your favorite major
|
||||
;; mode from changing a binding that you don't want to override everywhere),
|
||||
;; use `unbind-key':
|
||||
;;
|
||||
;; (unbind-key "C-c x" some-other-mode-map)
|
||||
;;
|
||||
;; To bind multiple keys at once, or set up a prefix map, a `bind-keys' macro
|
||||
;; is provided. It accepts keyword arguments, please see its documentation
|
||||
;; for a detailed description.
|
||||
;;
|
||||
;; To add keys into a specific map, use :map argument
|
||||
;;
|
||||
;; (bind-keys :map dired-mode-map
|
||||
;; ("o" . dired-omit-mode)
|
||||
;; ("a" . some-custom-dired-function))
|
||||
;;
|
||||
;; To set up a prefix map, use `:prefix-map' and `:prefix' arguments (both are
|
||||
;; required)
|
||||
;;
|
||||
;; (bind-keys :prefix-map my-customize-prefix-map
|
||||
;; :prefix "C-c c"
|
||||
;; ("f" . customize-face)
|
||||
;; ("v" . customize-variable))
|
||||
;;
|
||||
;; You can combine all the keywords together. Additionally,
|
||||
;; `:prefix-docstring' can be specified to set documentation of created
|
||||
;; `:prefix-map' variable.
|
||||
;;
|
||||
;; To bind multiple keys in a `bind-key*' way (to be sure that your bindings
|
||||
;; will not be overridden by other modes), you may use `bind-keys*' macro:
|
||||
;;
|
||||
;; (bind-keys*
|
||||
;; ("C-o" . other-window)
|
||||
;; ("C-M-n" . forward-page)
|
||||
;; ("C-M-p" . backward-page))
|
||||
;;
|
||||
;; After Emacs loads, you can see a summary of all your personal keybindings
|
||||
;; currently in effect with this command:
|
||||
;;
|
||||
;; M-x describe-personal-keybindings
|
||||
;;
|
||||
;; This display will tell you if you've overridden a default keybinding, and
|
||||
;; what the default was. Also, it will tell you if the key was rebound after
|
||||
;; your binding it with `bind-key', and what it was rebound it to.
|
||||
;;
|
||||
;; See the `use-package' info manual for more information.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'easy-mmode)
|
||||
|
||||
(defgroup bind-key nil
|
||||
"A simple way to manage personal keybindings."
|
||||
:group 'keyboard
|
||||
:group 'convenience
|
||||
:link '(emacs-commentary-link :tag "Commentary" "bind-key.el")
|
||||
:version "29.1")
|
||||
|
||||
(defcustom bind-key-column-widths '(18 . 40)
|
||||
"Width of columns in `describe-personal-keybindings'."
|
||||
:type '(cons integer integer)
|
||||
:group 'bind-key)
|
||||
|
||||
(defcustom bind-key-segregation-regexp
|
||||
"\\`\\(\\(C-[chx] \\|M-[gso] \\)\\([CM]-\\)?\\|.+-\\)"
|
||||
"Regexp used by \\[describe-personal-keybindings] to divide key sets."
|
||||
:type 'regexp
|
||||
:group 'bind-key)
|
||||
|
||||
(defcustom bind-key-describe-special-forms nil
|
||||
"If non-nil, extract docstrings from lambdas, closures and keymaps if possible."
|
||||
:type 'boolean
|
||||
:group 'bind-key)
|
||||
|
||||
;; Create override-global-mode to force key remappings
|
||||
|
||||
(defvar override-global-map (make-keymap)
|
||||
"Keymap for `override-global-mode'.")
|
||||
|
||||
(define-minor-mode override-global-mode
|
||||
"A minor mode for allowing keybindings to override other modes.
|
||||
The main purpose of this mode is to simplify bindings keys in
|
||||
such a way that they take precedence over other modes.
|
||||
|
||||
To achieve this, the keymap `override-global-map' is added to
|
||||
`emulation-mode-map-alists', which makes it take precedence over
|
||||
keymaps in `minor-mode-map-alist'. Thereby, key bindings get an
|
||||
even higher precedence than global key bindings defined with
|
||||
`keymap-global-set' (or, in Emacs 28 or older, `global-set-key').
|
||||
|
||||
The macro `bind-key*' (which see) provides a convenient way to
|
||||
add keys to that keymap."
|
||||
:init-value t
|
||||
:lighter "")
|
||||
|
||||
;; the keymaps in `emulation-mode-map-alists' take precedence over
|
||||
;; `minor-mode-map-alist'
|
||||
(add-to-list 'emulation-mode-map-alists
|
||||
`((override-global-mode . ,override-global-map)))
|
||||
|
||||
(defvar personal-keybindings nil
|
||||
"List of bindings performed by `bind-key'.
|
||||
|
||||
Elements have the form ((KEY . [MAP]) CMD ORIGINAL-CMD)")
|
||||
|
||||
;;;###autoload
|
||||
(defmacro bind-key (key-name command &optional keymap predicate)
|
||||
"Bind KEY-NAME to COMMAND in KEYMAP (`global-map' if not passed).
|
||||
|
||||
KEY-NAME may be a vector, in which case it is passed straight to
|
||||
`define-key'. Or it may be a string to be interpreted as
|
||||
spelled-out keystrokes, e.g., \"C-c C-z\". See the documentation
|
||||
of `edmacro-mode' for details.
|
||||
|
||||
COMMAND must be an interactive function, lambda form, or a cons
|
||||
`(STRING . DEFN)'.
|
||||
|
||||
KEYMAP, if present, should be a keymap variable or symbol.
|
||||
For example:
|
||||
|
||||
(bind-key \"M-h\" #\\='some-interactive-function my-mode-map)
|
||||
|
||||
(bind-key \"M-h\" #\\='some-interactive-function \\='my-mode-map)
|
||||
|
||||
If PREDICATE is non-nil, it is a form evaluated to determine when
|
||||
a key should be bound. It must return non-nil in such cases.
|
||||
Emacs can evaluate this form at any time that it does redisplay
|
||||
or operates on menu data structures, so you should write it so it
|
||||
can safely be called at any time."
|
||||
(let ((namevar (make-symbol "name"))
|
||||
(keyvar (make-symbol "key"))
|
||||
(kmapvar (make-symbol "kmap"))
|
||||
(kdescvar (make-symbol "kdesc"))
|
||||
(bindingvar (make-symbol "binding")))
|
||||
`(let* ((,namevar ,key-name)
|
||||
(,keyvar ,(if (stringp key-name) (read-kbd-macro key-name)
|
||||
`(if (vectorp ,namevar) ,namevar
|
||||
(read-kbd-macro ,namevar))))
|
||||
(,kmapvar (or (if (and ,keymap (symbolp ,keymap))
|
||||
(symbol-value ,keymap) ,keymap)
|
||||
global-map))
|
||||
(,kdescvar (cons (if (stringp ,namevar) ,namevar
|
||||
(key-description ,namevar))
|
||||
(if (symbolp ,keymap) ,keymap (quote ,keymap))))
|
||||
(,bindingvar (lookup-key ,kmapvar ,keyvar)))
|
||||
(let ((entry (assoc ,kdescvar personal-keybindings))
|
||||
(details (list ,command
|
||||
(unless (numberp ,bindingvar)
|
||||
,bindingvar))))
|
||||
(if entry
|
||||
(setcdr entry details)
|
||||
(add-to-list 'personal-keybindings (cons ,kdescvar details))))
|
||||
,(if predicate
|
||||
`(define-key ,kmapvar ,keyvar
|
||||
'(menu-item "" nil :filter (lambda (&optional _)
|
||||
(when ,predicate
|
||||
,command))))
|
||||
`(define-key ,kmapvar ,keyvar ,command)))))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro unbind-key (key-name &optional keymap)
|
||||
"Unbind the given KEY-NAME, within the KEYMAP (if specified).
|
||||
See `bind-key' for more details."
|
||||
(let ((namevar (make-symbol "name"))
|
||||
(kdescvar (make-symbol "kdesc")))
|
||||
`(let* ((,namevar ,key-name)
|
||||
(,kdescvar (cons (if (stringp ,namevar) ,namevar
|
||||
(key-description ,namevar))
|
||||
(if (symbolp ,keymap) ,keymap (quote ,keymap)))))
|
||||
(bind-key--remove (if (vectorp ,namevar) ,namevar
|
||||
(read-kbd-macro ,namevar))
|
||||
(or (if (and ,keymap (symbolp ,keymap))
|
||||
(symbol-value ,keymap) ,keymap)
|
||||
global-map))
|
||||
(setq personal-keybindings
|
||||
(cl-delete-if (lambda (k) (equal (car k) ,kdescvar))
|
||||
personal-keybindings))
|
||||
nil)))
|
||||
|
||||
(defun bind-key--remove (key keymap)
|
||||
"Remove KEY from KEYMAP.
|
||||
|
||||
In contrast to `define-key', this function removes the binding from the keymap."
|
||||
(define-key keymap key nil)
|
||||
;; Split M-key in ESC key
|
||||
(setq key (cl-mapcan (lambda (k)
|
||||
(if (and (integerp k) (/= (logand k ?\M-\0) 0))
|
||||
(list ?\e (logxor k ?\M-\0))
|
||||
(list k)))
|
||||
key))
|
||||
;; Delete single keys directly
|
||||
(if (= (length key) 1)
|
||||
(delete key keymap)
|
||||
;; Lookup submap and delete key from there
|
||||
(let* ((prefix (vconcat (butlast key)))
|
||||
(submap (lookup-key keymap prefix)))
|
||||
(unless (keymapp submap)
|
||||
(error "Not a keymap for %s" key))
|
||||
(when (symbolp submap)
|
||||
(setq submap (symbol-function submap)))
|
||||
(delete (last key) submap)
|
||||
;; Delete submap if it is empty
|
||||
(when (= 1 (length submap))
|
||||
(bind-key--remove prefix keymap)))))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro bind-key* (key-name command &optional predicate)
|
||||
"Similar to `bind-key', but overrides any mode-specific bindings."
|
||||
`(bind-key ,key-name ,command override-global-map ,predicate))
|
||||
|
||||
(defun bind-keys-form (args keymap)
|
||||
"Bind multiple keys at once.
|
||||
|
||||
Accepts keyword arguments:
|
||||
:map MAP - a keymap into which the keybindings should be
|
||||
added
|
||||
:prefix KEY - prefix key for these bindings
|
||||
:prefix-map MAP - name of the prefix map that should be created
|
||||
for these bindings
|
||||
:prefix-docstring STR - docstring for the prefix-map variable
|
||||
:menu-name NAME - optional menu string for prefix map
|
||||
:repeat-docstring STR - docstring for the repeat-map variable
|
||||
:repeat-map MAP - name of the repeat map that should be created
|
||||
for these bindings. If specified, the
|
||||
`repeat-map' property of each command bound
|
||||
(within the scope of the `:repeat-map' keyword)
|
||||
is set to this map.
|
||||
:exit BINDINGS - Within the scope of `:repeat-map' will bind the
|
||||
key in the repeat map, but will not set the
|
||||
`repeat-map' property of the bound command.
|
||||
:continue BINDINGS - Within the scope of `:repeat-map' forces the
|
||||
same behaviour as if no special keyword had
|
||||
been used (that is, the command is bound, and
|
||||
it's `repeat-map' property set)
|
||||
:filter FORM - optional form to determine when bindings apply
|
||||
|
||||
The rest of the arguments are conses of keybinding string and a
|
||||
function symbol (unquoted)."
|
||||
(let (map
|
||||
prefix-doc
|
||||
prefix-map
|
||||
prefix
|
||||
repeat-map
|
||||
repeat-doc
|
||||
repeat-type ;; Only used internally
|
||||
filter
|
||||
menu-name
|
||||
pkg)
|
||||
|
||||
;; Process any initial keyword arguments
|
||||
(let ((cont t)
|
||||
(arg-change-func 'cddr))
|
||||
(while (and cont args)
|
||||
(if (cond ((and (eq :map (car args))
|
||||
(not prefix-map))
|
||||
(setq map (cadr args)))
|
||||
((eq :prefix-docstring (car args))
|
||||
(setq prefix-doc (cadr args)))
|
||||
((and (eq :prefix-map (car args))
|
||||
(not (memq map '(global-map
|
||||
override-global-map))))
|
||||
(setq prefix-map (cadr args)))
|
||||
((eq :repeat-docstring (car args))
|
||||
(setq repeat-doc (cadr args)))
|
||||
((and (eq :repeat-map (car args))
|
||||
(not (memq map '(global-map
|
||||
override-global-map))))
|
||||
(setq repeat-map (cadr args))
|
||||
(setq map repeat-map))
|
||||
((eq :continue (car args))
|
||||
(setq repeat-type :continue
|
||||
arg-change-func 'cdr))
|
||||
((eq :exit (car args))
|
||||
(setq repeat-type :exit
|
||||
arg-change-func 'cdr))
|
||||
((eq :prefix (car args))
|
||||
(setq prefix (cadr args)))
|
||||
((eq :filter (car args))
|
||||
(setq filter (cadr args)) t)
|
||||
((eq :menu-name (car args))
|
||||
(setq menu-name (cadr args)))
|
||||
((eq :package (car args))
|
||||
(setq pkg (cadr args))))
|
||||
(setq args (funcall arg-change-func args))
|
||||
(setq cont nil))))
|
||||
|
||||
(when (or (and prefix-map (not prefix))
|
||||
(and prefix (not prefix-map)))
|
||||
(error "Both :prefix-map and :prefix must be supplied"))
|
||||
|
||||
(when repeat-type
|
||||
(unless repeat-map
|
||||
(error ":continue and :exit require specifying :repeat-map")))
|
||||
|
||||
(when (and menu-name (not prefix))
|
||||
(error "If :menu-name is supplied, :prefix must be too"))
|
||||
|
||||
(unless map (setq map keymap))
|
||||
|
||||
;; Process key binding arguments
|
||||
(let (first next)
|
||||
(while args
|
||||
(if (keywordp (car args))
|
||||
(progn
|
||||
(setq next args)
|
||||
(setq args nil))
|
||||
(if first
|
||||
(nconc first (list (car args)))
|
||||
(setq first (list (car args))))
|
||||
(setq args (cdr args))))
|
||||
|
||||
(cl-flet
|
||||
((wrap (map bindings)
|
||||
(if (and map pkg (not (memq map '(global-map
|
||||
override-global-map))))
|
||||
`((if (boundp ',map)
|
||||
,(macroexp-progn bindings)
|
||||
(eval-after-load
|
||||
,(if (symbolp pkg) `',pkg pkg)
|
||||
',(macroexp-progn bindings))))
|
||||
bindings)))
|
||||
|
||||
(append
|
||||
(when prefix-map
|
||||
`((defvar ,prefix-map)
|
||||
,@(when prefix-doc `((put ',prefix-map 'variable-documentation ,prefix-doc)))
|
||||
,@(if menu-name
|
||||
`((define-prefix-command ',prefix-map nil ,menu-name))
|
||||
`((define-prefix-command ',prefix-map)))
|
||||
,@(if (and map (not (eq map 'global-map)))
|
||||
(wrap map `((bind-key ,prefix ',prefix-map ,map ,filter)))
|
||||
`((bind-key ,prefix ',prefix-map nil ,filter)))))
|
||||
(when repeat-map
|
||||
`((defvar ,repeat-map (make-sparse-keymap)
|
||||
,@(when repeat-doc `(,repeat-doc)))))
|
||||
(wrap map
|
||||
(cl-mapcan
|
||||
(lambda (form)
|
||||
(let ((fun (and (cdr form) (list 'function (cdr form)))))
|
||||
(if prefix-map
|
||||
`((bind-key ,(car form) ,fun ,prefix-map ,filter))
|
||||
(if (and map (not (eq map 'global-map)))
|
||||
;; Only needed in this branch, since when
|
||||
;; repeat-map is non-nil, map is always
|
||||
;; non-nil
|
||||
`(,@(when (and repeat-map (not (eq repeat-type :exit)))
|
||||
`((put ,fun 'repeat-map ',repeat-map)))
|
||||
(bind-key ,(car form) ,fun ,map ,filter))
|
||||
`((bind-key ,(car form) ,fun nil ,filter))))))
|
||||
first))
|
||||
(when next
|
||||
(bind-keys-form `(,@(when repeat-map `(:repeat-map ,repeat-map))
|
||||
,@(if pkg
|
||||
(cons :package (cons pkg next))
|
||||
next)) map)))))))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro bind-keys (&rest args)
|
||||
"Bind multiple keys at once.
|
||||
|
||||
Accepts keyword arguments:
|
||||
:map MAP - a keymap into which the keybindings should be
|
||||
added
|
||||
:prefix KEY - prefix key for these bindings
|
||||
:prefix-map MAP - name of the prefix map that should be created
|
||||
for these bindings
|
||||
:prefix-docstring STR - docstring for the prefix-map variable
|
||||
:menu-name NAME - optional menu string for prefix map
|
||||
:repeat-docstring STR - docstring for the repeat-map variable
|
||||
:repeat-map MAP - name of the repeat map that should be created
|
||||
for these bindings. If specified, the
|
||||
`repeat-map' property of each command bound
|
||||
(within the scope of the `:repeat-map' keyword)
|
||||
is set to this map.
|
||||
:exit BINDINGS - Within the scope of `:repeat-map' will bind the
|
||||
key in the repeat map, but will not set the
|
||||
`repeat-map' property of the bound command.
|
||||
:continue BINDINGS - Within the scope of `:repeat-map' forces the
|
||||
same behaviour as if no special keyword had
|
||||
been used (that is, the command is bound, and
|
||||
it's `repeat-map' property set)
|
||||
:filter FORM - optional form to determine when bindings apply
|
||||
|
||||
The rest of the arguments are conses of keybinding string and a
|
||||
function symbol (unquoted)."
|
||||
(macroexp-progn (bind-keys-form args nil)))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro bind-keys* (&rest args)
|
||||
"Bind multiple keys at once, in `override-global-map'.
|
||||
Accepts the same keyword arguments as `bind-keys' (which see).
|
||||
|
||||
This binds keys in such a way that bindings are not overridden by
|
||||
other modes. See `override-global-mode'."
|
||||
(macroexp-progn (bind-keys-form args 'override-global-map)))
|
||||
|
||||
(defun get-binding-description (elem)
|
||||
(cond
|
||||
((listp elem)
|
||||
(cond
|
||||
((memq (car elem) '(lambda function))
|
||||
(if (and bind-key-describe-special-forms
|
||||
(stringp (nth 2 elem)))
|
||||
(nth 2 elem)
|
||||
"#<lambda>"))
|
||||
((eq 'closure (car elem))
|
||||
(if (and bind-key-describe-special-forms
|
||||
(stringp (nth 3 elem)))
|
||||
(nth 3 elem)
|
||||
"#<closure>"))
|
||||
((eq 'keymap (car elem))
|
||||
"#<keymap>")
|
||||
(t
|
||||
elem)))
|
||||
;; must be a symbol, non-symbol keymap case covered above
|
||||
((and bind-key-describe-special-forms (keymapp elem))
|
||||
(let ((doc (get elem 'variable-documentation)))
|
||||
(if (stringp doc) doc elem)))
|
||||
((symbolp elem)
|
||||
elem)
|
||||
(t
|
||||
"#<byte-compiled lambda>")))
|
||||
|
||||
(defun compare-keybindings (l r)
|
||||
(let* ((regex bind-key-segregation-regexp)
|
||||
(lgroup (and (string-match regex (caar l))
|
||||
(match-string 0 (caar l))))
|
||||
(rgroup (and (string-match regex (caar r))
|
||||
(match-string 0 (caar r))))
|
||||
(lkeymap (cdar l))
|
||||
(rkeymap (cdar r)))
|
||||
(cond
|
||||
((and (null lkeymap) rkeymap)
|
||||
(cons t t))
|
||||
((and lkeymap (null rkeymap))
|
||||
(cons nil t))
|
||||
((and lkeymap rkeymap
|
||||
(not (string= (symbol-name lkeymap) (symbol-name rkeymap))))
|
||||
(cons (string< (symbol-name lkeymap) (symbol-name rkeymap)) t))
|
||||
((and (null lgroup) rgroup)
|
||||
(cons t t))
|
||||
((and lgroup (null rgroup))
|
||||
(cons nil t))
|
||||
((and lgroup rgroup)
|
||||
(if (string= lgroup rgroup)
|
||||
(cons (string< (caar l) (caar r)) nil)
|
||||
(cons (string< lgroup rgroup) t)))
|
||||
(t
|
||||
(cons (string< (caar l) (caar r)) nil)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun describe-personal-keybindings ()
|
||||
"Display all the personal keybindings defined by `bind-key'."
|
||||
(interactive)
|
||||
(with-output-to-temp-buffer "*Personal Keybindings*"
|
||||
(princ (format (concat "Key name%s Command%s Comments\n%s %s "
|
||||
"---------------------\n")
|
||||
(make-string (- (car bind-key-column-widths) 9) ? )
|
||||
(make-string (- (cdr bind-key-column-widths) 8) ? )
|
||||
(make-string (1- (car bind-key-column-widths)) ?-)
|
||||
(make-string (1- (cdr bind-key-column-widths)) ?-)))
|
||||
(let (last-binding)
|
||||
(dolist (binding
|
||||
(setq personal-keybindings
|
||||
(sort personal-keybindings
|
||||
(lambda (l r)
|
||||
(car (compare-keybindings l r))))))
|
||||
|
||||
(if (not (eq (cdar last-binding) (cdar binding)))
|
||||
(princ (format "\n\n%s: %s\n%s\n\n"
|
||||
(cdar binding) (caar binding)
|
||||
(make-string (+ 21 (car bind-key-column-widths)
|
||||
(cdr bind-key-column-widths)) ?-)))
|
||||
(if (and last-binding
|
||||
(cdr (compare-keybindings last-binding binding)))
|
||||
(princ "\n")))
|
||||
|
||||
(let* ((key-name (caar binding))
|
||||
(at-present (lookup-key (or (symbol-value (cdar binding))
|
||||
(current-global-map))
|
||||
(read-kbd-macro key-name)))
|
||||
(command (nth 1 binding))
|
||||
(was-command (nth 2 binding))
|
||||
(command-desc (get-binding-description command))
|
||||
(was-command-desc (and was-command
|
||||
(get-binding-description was-command)))
|
||||
(at-present-desc (get-binding-description at-present)))
|
||||
(let ((line
|
||||
(format
|
||||
(format "%%-%ds%%-%ds%%s\n" (car bind-key-column-widths)
|
||||
(cdr bind-key-column-widths))
|
||||
key-name (format "`%s\'" command-desc)
|
||||
(if (string= command-desc at-present-desc)
|
||||
(if (or (null was-command)
|
||||
(string= command-desc was-command-desc))
|
||||
""
|
||||
(format "was `%s\'" was-command-desc))
|
||||
(format "[now: `%s\']" at-present)))))
|
||||
(princ (if (string-match "[ \t]+\n" line)
|
||||
(replace-match "\n" t t line)
|
||||
line))))
|
||||
|
||||
(setq last-binding binding)))))
|
||||
|
||||
(provide 'bind-key)
|
||||
|
||||
;; Local Variables:
|
||||
;; outline-regexp: ";;;\\(;* [^\s\t\n]\\|###autoload\\)\\|("
|
||||
;; End:
|
||||
|
||||
;;; bind-key.el ends here
|
||||
|
|
@ -1,128 +0,0 @@
|
|||
;;; burnt-toast-alert.el --- BurntToast integration with alert package -*- lexical-binding: t; coding: utf-8 -*-
|
||||
|
||||
;; Copyright (C) 2020 Sam Cedarbaum
|
||||
|
||||
;; Author: Sam Cedarbaum (scedarbaum@gmail.com)
|
||||
|
||||
;; 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:
|
||||
|
||||
;; BurntToast integration with alert package.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'burnt-toast)
|
||||
(require 'alert)
|
||||
|
||||
(defconst burnt-toast--icon-path-fallback
|
||||
(concat (file-name-directory load-file-name) "icons/emacs.png")
|
||||
"Path to fallback icon if one isn't specified.")
|
||||
|
||||
(defcustom burnt-toast-icon-path nil
|
||||
"Path to icon to use for notifications."
|
||||
:type 'string
|
||||
:group 'burnt-toast)
|
||||
|
||||
(defcustom burnt-toast-alert-enable-remover nil
|
||||
"Non-nil if alert should remove notifications, nil otherwise."
|
||||
:type 'boolean
|
||||
:group 'burnt-toast)
|
||||
|
||||
(defcustom burnt-toast-emacs-app-id nil
|
||||
"The system's AppId for Emacs. Must be an exact match or notifications will fail."
|
||||
:type 'string
|
||||
:group 'burnt-toast)
|
||||
|
||||
(defcustom burnt-toast-audio-source 'default
|
||||
"The audio source to play for non-silent notifications."
|
||||
:type 'symbol
|
||||
;; TODO: This doesn't actually do anything. Should be a radio-button selection.
|
||||
:options '(default im mail reminder sms alarm alarm2 alarm3 alarm4 alarm5
|
||||
alarm6 alarm7 alarm8 alarm9 alarm10 call call2 call3 call4
|
||||
call5 call6 call7 call8 call9 call10)
|
||||
:group 'burnt-toast)
|
||||
|
||||
(defconst burnt-toast--audio-source-map '((default . "ms-winsoundevent:Notification.Default")
|
||||
(im . "ms-winsoundevent:Notification.IM")
|
||||
(mail . "ms-winsoundevent:Notification.Mail")
|
||||
(reminder . "ms-winsoundevent:Notification.Reminder")
|
||||
(sms . "ms-winsoundevent:Notification.SMS")
|
||||
(alarm . "ms-winsoundevent:Notification.Looping.Alarm")
|
||||
(alarm2 . "ms-winsoundevent:Notification.Looping.Alarm2")
|
||||
(alarm3 . "ms-winsoundevent:Notification.Looping.Alarm3")
|
||||
(alarm4 . "ms-winsoundevent:Notification.Looping.Alarm4")
|
||||
(alarm5 . "ms-winsoundevent:Notification.Looping.Alarm5")
|
||||
(alarm6 . "ms-winsoundevent:Notification.Looping.Alarm6")
|
||||
(alarm7 . "ms-winsoundevent:Notification.Looping.Alarm7")
|
||||
(alarm8 . "ms-winsoundevent:Notification.Looping.Alarm8")
|
||||
(alarm9 . "ms-winsoundevent:Notification.Looping.Alarm9")
|
||||
(alarm10 . "ms-winsoundevent:Notification.Looping.Alarm10")
|
||||
(call . "ms-winsoundevent:Notification.Looping.Call")
|
||||
(call2 . "ms-winsoundevent:Notification.Looping.Call2")
|
||||
(call3 . "ms-winsoundevent:Notification.Looping.Call3")
|
||||
(call4 . "ms-winsoundevent:Notification.Looping.Call4")
|
||||
(call5 . "ms-winsoundevent:Notification.Looping.Call5")
|
||||
(call6 . "ms-winsoundevent:Notification.Looping.Call6")
|
||||
(call7 . "ms-winsoundevent:Notification.Looping.Call7")
|
||||
(call8 . "ms-winsoundevent:Notification.Looping.Call8")
|
||||
(call9 . "ms-winsoundevent:Notification.Looping.Call9")
|
||||
(call10 . "ms-winsoundevent:Notification.Looping.Call10"))
|
||||
"Mapping from symbols to full audio source names.")
|
||||
|
||||
(alert-define-style 'burnt-toast :title "Burnt Toast"
|
||||
:notifier
|
||||
(lambda (info)
|
||||
(let*
|
||||
;; The message text is :message
|
||||
((message (plist-get info :message))
|
||||
;; The :title of the alert
|
||||
(title (plist-get info :title))
|
||||
;; The :category of the alert
|
||||
;; (category (plist-get info :category))
|
||||
;; The major-mode this alert relates to
|
||||
;; (mode (plist-get info :mode))
|
||||
;; The buffer the alert relates to
|
||||
;; (buffer (plist-get info :buffer))
|
||||
;; Severity of the alert. It is one of:
|
||||
;; `urgent'
|
||||
;; `high'
|
||||
;; `moderate'
|
||||
;; `normal'
|
||||
;; `low'
|
||||
;; `trivial'
|
||||
;; (severity (plist-get info :severity))
|
||||
;; Data which was passed to `alert'. Can be
|
||||
;; anything.
|
||||
;; (data (plist-get info :data))
|
||||
;; Whether this alert should persist, or fade away
|
||||
;; (persistent (plist-get info :persistent))
|
||||
(id (plist-get info :id)))
|
||||
(let* ((title-obj (burnt-toast-bt-text-object :content title))
|
||||
(message-obj (burnt-toast-bt-text-object :content message))
|
||||
(icon-path (or burnt-toast-icon-path burnt-toast--icon-path-fallback))
|
||||
(image (burnt-toast-bt-image-object :source icon-path :app-logo-override t))
|
||||
(binding (burnt-toast-bt-binding-object :children `(,title-obj ,message-obj) :app-logo-override image))
|
||||
(visual (burnt-toast-bt-visual-object binding))
|
||||
(audio-source (cdr (assoc burnt-toast-audio-source burnt-toast--audio-source-map)))
|
||||
(audio (burnt-toast-bt-audio-object audio-source))
|
||||
(content (burnt-toast-bt-content-object visual :audio audio)))
|
||||
(burnt-toast-submit-notification content :unique-identifier id :app-id burnt-toast-emacs-app-id))
|
||||
:remover
|
||||
(lambda (info)
|
||||
(when-let ((id (plist-get info :id)))
|
||||
(and burnt-toast-alert-enable-remover (burnt-toast-remove-notification :group id)))))))
|
||||
|
||||
(provide 'burnt-toast-alert)
|
||||
;;; burnt-toast-alert.el ends here
|
||||
|
|
@ -1,211 +0,0 @@
|
|||
;;; burnt-toast-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 "burnt-toast" "burnt-toast.el" (0 0 0 0))
|
||||
;;; Generated autoloads from burnt-toast.el
|
||||
|
||||
(autoload 'burnt-toast-submit-notification "burnt-toast" "\
|
||||
Submit a new notification.
|
||||
|
||||
CONTENT is the notification's content.
|
||||
Should be created with (burnt-toast-bt-content-object ...).
|
||||
|
||||
APP-ID is an the application identifier of Emacs on Windows.
|
||||
|
||||
UNIQUE-IDENTIFIER will be assigned to the tag and group of the notification.
|
||||
|
||||
\(fn CONTENT &key APP-ID UNIQUE-IDENTIFIER)" nil nil)
|
||||
|
||||
(autoload 'burnt-toast-bt-header-object "burnt-toast" "\
|
||||
Create a new header for a notification.
|
||||
|
||||
ID is an identifier for the notification. It is used to correlate
|
||||
the notification with others.
|
||||
|
||||
TITLE is the display name for the notification.
|
||||
|
||||
\(fn &key ID TITLE)" nil nil)
|
||||
|
||||
(autoload 'burnt-toast-bt-text-object "burnt-toast" "\
|
||||
Create a new text object.
|
||||
|
||||
CONTENT is the text content.
|
||||
|
||||
MAX-LINES is the maximum number of lines in the text object.
|
||||
|
||||
\(fn &key CONTENT MAX-LINES)" nil nil)
|
||||
|
||||
(autoload 'burnt-toast-bt-image-object "burnt-toast" "\
|
||||
Create a new image object.
|
||||
|
||||
SOURCE is where the image is located.
|
||||
|
||||
APP-LOGO-OVERRIDE is non-nil if image will be used as application icon, nil otherwise.
|
||||
|
||||
\(fn &key SOURCE APP-LOGO-OVERRIDE)" nil nil)
|
||||
|
||||
(autoload 'burnt-toast-bt-binding-object "burnt-toast" "\
|
||||
Create a new binding object.
|
||||
|
||||
CHILDREN is the elements contained in the binding.
|
||||
|
||||
APP-LOGO-OVERRIDE is the image to be used as the app logo.
|
||||
|
||||
\(fn &key CHILDREN APP-LOGO-OVERRIDE)" nil nil)
|
||||
|
||||
(autoload 'burnt-toast-bt-visual-object "burnt-toast" "\
|
||||
Create a new visual object.
|
||||
|
||||
BINDING-GENERIC is the binding associated with the visual.
|
||||
|
||||
\(fn BINDING-GENERIC)" nil nil)
|
||||
|
||||
(autoload 'burnt-toast-bt-content-object "burnt-toast" "\
|
||||
Create a new content object.
|
||||
|
||||
VISUAL is the visual associated with the content.
|
||||
|
||||
AUDIO is an optional audio object to play.
|
||||
|
||||
\(fn VISUAL &key AUDIO)" nil nil)
|
||||
|
||||
(autoload 'burnt-toast-bt-audio-object "burnt-toast" "\
|
||||
Create a new audio object.
|
||||
|
||||
SOURCE is the audio's source.
|
||||
|
||||
\(fn SOURCE)" nil nil)
|
||||
|
||||
(autoload 'burnt-toast-datetime-seconds-from-now "burnt-toast" "\
|
||||
Return the DateTime SECONDS from now.
|
||||
|
||||
\(fn SECONDS)" nil nil)
|
||||
|
||||
(autoload 'burnt-toast-new-notification-with-sound "burnt-toast" "\
|
||||
Create a new notification.
|
||||
|
||||
TEXT is the content of the notification. This can be a list of strings,
|
||||
in which case each entry is a new line.
|
||||
|
||||
APP-LOGO is a path to an icon to be displayed with the notification.
|
||||
|
||||
SOUND is the sound effect to play.
|
||||
|
||||
HEADER is the notification's header.
|
||||
This should be created with (burnt-toast-bt-header-object ID HEADER).
|
||||
|
||||
UNIQUE-IDENTIFIER a unique identifier that can be used to remove/edit the
|
||||
notification.
|
||||
|
||||
EXPIRATION-TIME DateTime for notification to expire.
|
||||
This should be created with (burnt-toast-datetime-seconds-from-now SECONDS).
|
||||
|
||||
\(fn &key TEXT APP-LOGO SOUND HEADER UNIQUE-IDENTIFIER EXPIRATION-TIME)" nil nil)
|
||||
|
||||
(autoload 'burnt-toast-new-notification-silent "burnt-toast" "\
|
||||
Create a new silent notification.
|
||||
|
||||
TEXT is the content of the notification. This can be a list of strings,
|
||||
in which case each entry is a new line.
|
||||
|
||||
APP-LOGO is a path to an icon to be displayed with the notification.
|
||||
|
||||
HEADER is the notification's header.
|
||||
This should be created with (burnt-toast-bt-header-object ID HEADER).
|
||||
|
||||
UNIQUE-IDENTIFIER a unique identifier that can be used to remove/edit the
|
||||
notification.
|
||||
|
||||
EXPIRATION-TIME DateTime for notification to expire.
|
||||
This should be created with (burnt-toast-datetime-seconds-from-now SECONDS).
|
||||
|
||||
\(fn &key TEXT APP-LOGO HEADER UNIQUE-IDENTIFIER EXPIRATION-TIME)" nil nil)
|
||||
|
||||
(autoload 'burnt-toast-new-notification-snooze-and-dismiss-with-sound "burnt-toast" "\
|
||||
Create a new snooze-and-dismiss notification.
|
||||
|
||||
TEXT is the content of the notification. This can be a list of strings,
|
||||
in which case each entry is a new line.
|
||||
|
||||
APP-LOGO is a path to an icon to be displayed with the notification.
|
||||
|
||||
HEADER is the notification's header.
|
||||
This should be created with (burnt-toast-bt-header-object ID HEADER).
|
||||
|
||||
SOUND is the sound effect to play.
|
||||
|
||||
UNIQUE-IDENTIFIER a unique identifier that can be used to remove/edit the
|
||||
notification.
|
||||
|
||||
EXPIRATION-TIME DateTime for notification to expire.
|
||||
This should be created with (burnt-toast-datetime-seconds-from-now SECONDS).
|
||||
|
||||
\(fn &key TEXT APP-LOGO HEADER SOUND UNIQUE-IDENTIFIER EXPIRATION-TIME)" nil nil)
|
||||
|
||||
(autoload 'burnt-toast-new-notification-snooze-and-dismiss-silent "burnt-toast" "\
|
||||
Create a new silent snooze-and-dismiss notification.
|
||||
|
||||
TEXT is the content of the notification. This can be a list of strings,
|
||||
in which case each entry is a new line.
|
||||
|
||||
APP-LOGO is a path to an icon to be displayed with the notification.
|
||||
|
||||
HEADER is the notification's header.
|
||||
This should be created with (burnt-toast-bt-header-object ID HEADER).
|
||||
|
||||
UNIQUE-IDENTIFIER a unique identifier that can be used to remove/edit
|
||||
the notification.
|
||||
|
||||
EXPIRATION-TIME DateTime for notification to expire.
|
||||
This should be created with (burnt-toast-datetime-seconds-from-now SECONDS).
|
||||
|
||||
\(fn &key TEXT APP-LOGO HEADER UNIQUE-IDENTIFIER EXPIRATION-TIME)" nil nil)
|
||||
|
||||
(autoload 'burnt-toast-new-shoulder-tap "burnt-toast" "\
|
||||
Create a new shoulder tap notification.
|
||||
|
||||
IMAGE is the image representing the contact.
|
||||
|
||||
PERSON is the name of the contact.
|
||||
|
||||
TEXT is the content of the fallback notification. This can be a list of
|
||||
strings, in which case each entry is a new line.
|
||||
|
||||
APP-LOGO is a path to an icon to be displayed with the fallback notification.
|
||||
|
||||
HEADER is the fallback notification's header.
|
||||
This should be created with (burnt-toast-bt-header-object ID HEADER).
|
||||
|
||||
EXPIRATION-TIME DateTime for notification to expire.
|
||||
This should be created with (burnt-toast-datetime-seconds-from-now SECONDS).
|
||||
|
||||
\(fn IMAGE PERSON &key TEXT APP-LOGO HEADER EXPIRATION-TIME)" nil nil)
|
||||
|
||||
(register-definition-prefixes "burnt-toast" '("burnt-toast-"))
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil "burnt-toast-alert" "burnt-toast-alert.el"
|
||||
;;;;;; (0 0 0 0))
|
||||
;;; Generated autoloads from burnt-toast-alert.el
|
||||
|
||||
(register-definition-prefixes "burnt-toast-alert" '("burnt-toast-"))
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil nil ("burnt-toast-pkg.el") (0 0 0 0))
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; coding: utf-8
|
||||
;; End:
|
||||
;;; burnt-toast-autoloads.el ends here
|
||||
|
|
@ -1,14 +0,0 @@
|
|||
(define-package "burnt-toast" "20201113.814" "Elisp integration with the BurntToast PowerShell module"
|
||||
'((emacs "25.1")
|
||||
(dash "2.10")
|
||||
(alert "1.2"))
|
||||
:commit "e9cf41928b7b502fdfa43718c35a24e503db32e2" :authors
|
||||
'(("Sam Cedarbaum" . "scedarbaum@gmail.com"))
|
||||
:maintainer
|
||||
'("Sam Cedarbaum" . "scedarbaum@gmail.com")
|
||||
:keywords
|
||||
'("alert" "notifications" "powershell" "comm")
|
||||
:url "https://github.com/cedarbaum/burnt-toast.el")
|
||||
;; Local Variables:
|
||||
;; no-byte-compile: t
|
||||
;; End:
|
||||
|
|
@ -1,389 +0,0 @@
|
|||
;;; burnt-toast.el --- Elisp integration with the BurntToast PowerShell module -*- lexical-binding: t; coding: utf-8 -*-
|
||||
|
||||
;; Copyright (C) 2020 Sam Cedarbaum
|
||||
|
||||
;; Author: Sam Cedarbaum (scedarbaum@gmail.com)
|
||||
;; Keywords: alert notifications powershell comm
|
||||
;; Homepage: https://github.com/cedarbaum/burnt-toast.el
|
||||
;; Version: 0.1
|
||||
;; Package-Requires: ((emacs "25.1") (dash "2.10") (alert "1.2"))
|
||||
|
||||
;; 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:
|
||||
|
||||
;; Elisp integration with BurntToast, a PowerShell module for displaying Windows 10 and Windows Server 2019 Toast Notifications.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'dash)
|
||||
(require 'cl-lib)
|
||||
|
||||
(defcustom burnt-toast-powershell-command "powershell"
|
||||
"Command to invoke PowerShell."
|
||||
:type 'string
|
||||
:group 'burnt-toast)
|
||||
|
||||
(defvar burnt-toast--verbose nil "Enable verbose logging.")
|
||||
(defvar burnt-toast-powershell-test-hook nil "Hook to intercept powershell command for testing.")
|
||||
(defvar burnt-toast--install-checked nil "Cache if installation has already been checked.")
|
||||
|
||||
(defun burnt-toast--check-installation ()
|
||||
"Check if PowerShell and BurntToast module are installed and on PATH."
|
||||
(unless burnt-toast--install-checked
|
||||
(unless (executable-find burnt-toast-powershell-command)
|
||||
(error "PowerShell executable not on PATH"))
|
||||
(unless (eq 0 (burnt-toast--run-powershell-command "Get-Command New-BurntToastNotification" t))
|
||||
(error "BurntToast module cannot be found"))
|
||||
(setq burnt-toast--install-checked t)))
|
||||
|
||||
;; Based on: https://github.com/mplscorwin/erc-burnt-toast-blob/master/erc-burnt-toast.el
|
||||
(defun burnt-toast--sanitize-powershell-input (string)
|
||||
"Return a version of STRING sanitized for use as input to PowerShell.
|
||||
New-lines are removed, trailing spaces are removed, and single-quotes are doubled."
|
||||
(when (stringp string)
|
||||
(replace-regexp-in-string
|
||||
"\s+$" ""
|
||||
(replace-regexp-in-string
|
||||
"[\t\n\r]+" ""
|
||||
(replace-regexp-in-string
|
||||
"\"" "\"\""
|
||||
string)))))
|
||||
|
||||
(defun burnt-toast--quote-and-sanitize-string (string)
|
||||
"Surround STRING with double quotes and sanitize it when it is non-nil."
|
||||
(when string
|
||||
(concat "\"" (burnt-toast--sanitize-powershell-input string) "\"")))
|
||||
|
||||
(defun burnt-toast--param-to-string (obj)
|
||||
"Return OBJ as string when a non-nil string or an empty string otherwise."
|
||||
(cond ((stringp obj) obj)
|
||||
((numberp obj) (number-to-string obj))
|
||||
(t "")))
|
||||
|
||||
(defun burnt-toast--run-powershell-command (command-and-args &optional skip-install-check)
|
||||
"Execute a PowerShell command COMMAND-AND-ARGS.
|
||||
Optionally skip BurntToast installation check with SKIP-INSTALL-CHECK."
|
||||
(when burnt-toast--verbose (message command-and-args))
|
||||
(if burnt-toast-powershell-test-hook
|
||||
(apply burnt-toast-powershell-test-hook `(,command-and-args))
|
||||
(or skip-install-check (burnt-toast--check-installation))
|
||||
(call-process burnt-toast-powershell-command nil nil nil
|
||||
"-NoProfile" "-NoExit" "-NonInteractive" "-WindowStyle" "Hidden" command-and-args)))
|
||||
|
||||
(defun burnt-toast--create-ps-command (command-prefix args)
|
||||
"Create a new PowerShell command with prefix COMMAND-PREFIX using ARGS."
|
||||
(let* ((prefix-string (concat "$(" command-prefix " "))
|
||||
(non-nil-args (-filter (-lambda ((_ value)) value) args))
|
||||
(quoted-args (-map
|
||||
(-lambda ((arg value quote)) `(,arg ,(if quote (burnt-toast--quote-and-sanitize-string value) value)))
|
||||
non-nil-args))
|
||||
(args-string-list (-map
|
||||
(-lambda ((arg value)) (concat "-" arg " " (burnt-toast--param-to-string value)))
|
||||
quoted-args))
|
||||
(args-string (and args-string-list (-reduce (lambda (s1 s2) (concat s1 " " s2)) args-string-list))))
|
||||
(concat prefix-string (or args-string "") ")")))
|
||||
|
||||
(defun burnt-toast--new-ps-object (object args)
|
||||
"Create a new PowerShell OBJECT with ARGS."
|
||||
(let* ((command-prefix (concat "New-" object)))
|
||||
(burnt-toast--create-ps-command command-prefix args)))
|
||||
|
||||
(defun burnt-toast--new-ps-object-list (objects &optional process)
|
||||
"Create a comma separated list of OBJECTS.
|
||||
Optionally process each object with PROCESS function as list is built."
|
||||
(let* ((map-func (or process #'identity)))
|
||||
(if (and objects (listp objects))
|
||||
(-reduce
|
||||
(lambda (s1 s2) (concat s1 "," s2))
|
||||
(-map map-func objects))
|
||||
(apply map-func `(,objects)))))
|
||||
|
||||
(cl-defun burnt-toast--new-notification-core (&key text app-logo sound header silent snooze-and-dismiss
|
||||
unique-identifier expiration-time)
|
||||
"Create new notification with subset of arguments.
|
||||
Arguments are TEXT, APP-LOGO, SOUND, HEADER, SILENT, SNOOZE-AND-DISMISS,
|
||||
UNIQUE-IDENTIFIER, and EXPIRATION-TIME.
|
||||
This function should not be called directly."
|
||||
(let* ((processed-text (burnt-toast--new-ps-object-list text #'burnt-toast--quote-and-sanitize-string))
|
||||
(ps-command (burnt-toast--new-ps-object
|
||||
"BurntToastNotification"
|
||||
`(("Text" ,processed-text)
|
||||
("AppLogo" ,app-logo t)
|
||||
("Sound" ,sound t)
|
||||
("Header" ,header)
|
||||
("Silent" ,silent)
|
||||
("SnoozeAndDismiss" ,snooze-and-dismiss)
|
||||
("UniqueIdentifier" ,unique-identifier)
|
||||
("ExpirationTime" ,expiration-time)))))
|
||||
(burnt-toast--run-powershell-command ps-command)))
|
||||
|
||||
;;;###autoload
|
||||
(cl-defun burnt-toast-submit-notification (content &key app-id
|
||||
unique-identifier)
|
||||
"Submit a new notification.
|
||||
|
||||
CONTENT is the notification's content.
|
||||
Should be created with (burnt-toast-bt-content-object ...).
|
||||
|
||||
APP-ID is an the application identifier of Emacs on Windows.
|
||||
|
||||
UNIQUE-IDENTIFIER will be assigned to the tag and group of the notification."
|
||||
(let* ((ps-command (burnt-toast--create-ps-command
|
||||
"Submit-BTNotification"
|
||||
`(("Content" ,content)
|
||||
("AppId" ,app-id t)
|
||||
("UniqueIdentifier" ,unique-identifier t)))))
|
||||
(burnt-toast--run-powershell-command ps-command)))
|
||||
|
||||
;;;###autoload
|
||||
(cl-defun burnt-toast-bt-header-object (&key id title)
|
||||
"Create a new header for a notification.
|
||||
|
||||
ID is an identifier for the notification. It is used to correlate
|
||||
the notification with others.
|
||||
|
||||
TITLE is the display name for the notification."
|
||||
(burnt-toast--new-ps-object
|
||||
"BTHeader"
|
||||
`(("Id" ,id)
|
||||
("Title" ,title t))))
|
||||
|
||||
;;;###autoload
|
||||
(cl-defun burnt-toast-bt-text-object (&key content max-lines)
|
||||
"Create a new text object.
|
||||
|
||||
CONTENT is the text content.
|
||||
|
||||
MAX-LINES is the maximum number of lines in the text object."
|
||||
(burnt-toast--new-ps-object
|
||||
"BTText"
|
||||
`(("Content" ,content t)
|
||||
("MaxLines" ,max-lines))))
|
||||
|
||||
;;;###autoload
|
||||
(cl-defun burnt-toast-bt-image-object (&key source app-logo-override)
|
||||
"Create a new image object.
|
||||
|
||||
SOURCE is where the image is located.
|
||||
|
||||
APP-LOGO-OVERRIDE is non-nil if image will be used as application icon, nil otherwise."
|
||||
(burnt-toast--new-ps-object
|
||||
"BTImage"
|
||||
`(("Source" ,source t)
|
||||
("AppLogoOverride" ,app-logo-override))))
|
||||
|
||||
;;;###autoload
|
||||
(cl-defun burnt-toast-bt-binding-object (&key children app-logo-override)
|
||||
"Create a new binding object.
|
||||
|
||||
CHILDREN is the elements contained in the binding.
|
||||
|
||||
APP-LOGO-OVERRIDE is the image to be used as the app logo."
|
||||
(burnt-toast--new-ps-object
|
||||
"BTBinding"
|
||||
`(("Children" ,(burnt-toast--new-ps-object-list children))
|
||||
("AppLogoOverride" ,app-logo-override))))
|
||||
|
||||
;;;###autoload
|
||||
(cl-defun burnt-toast-bt-visual-object (binding-generic)
|
||||
"Create a new visual object.
|
||||
|
||||
BINDING-GENERIC is the binding associated with the visual."
|
||||
(burnt-toast--new-ps-object
|
||||
"BTVisual"
|
||||
`(("BindingGeneric" ,binding-generic))))
|
||||
|
||||
;;;###autoload
|
||||
(cl-defun burnt-toast-bt-content-object (visual &key audio)
|
||||
"Create a new content object.
|
||||
|
||||
VISUAL is the visual associated with the content.
|
||||
|
||||
AUDIO is an optional audio object to play."
|
||||
(burnt-toast--new-ps-object
|
||||
"BTContent"
|
||||
`(("Visual" ,visual)
|
||||
("Audio" ,audio))))
|
||||
|
||||
;;;###autoload
|
||||
(cl-defun burnt-toast-bt-audio-object (source)
|
||||
"Create a new audio object.
|
||||
|
||||
SOURCE is the audio's source."
|
||||
(burnt-toast--new-ps-object
|
||||
"BTAudio"
|
||||
`(("Source" ,source))))
|
||||
|
||||
;;;###autoload
|
||||
(cl-defun burnt-toast-datetime-seconds-from-now (seconds)
|
||||
"Return the DateTime SECONDS from now."
|
||||
(format "$([DateTime]::Now.AddSeconds(%f))" seconds))
|
||||
|
||||
;;;###autoload
|
||||
(cl-defun burnt-toast-new-notification-with-sound (&key text app-logo sound header unique-identifier
|
||||
expiration-time)
|
||||
"Create a new notification.
|
||||
|
||||
TEXT is the content of the notification. This can be a list of strings,
|
||||
in which case each entry is a new line.
|
||||
|
||||
APP-LOGO is a path to an icon to be displayed with the notification.
|
||||
|
||||
SOUND is the sound effect to play.
|
||||
|
||||
HEADER is the notification's header.
|
||||
This should be created with (burnt-toast-bt-header-object ID HEADER).
|
||||
|
||||
UNIQUE-IDENTIFIER a unique identifier that can be used to remove/edit the
|
||||
notification.
|
||||
|
||||
EXPIRATION-TIME DateTime for notification to expire.
|
||||
This should be created with (burnt-toast-datetime-seconds-from-now SECONDS)."
|
||||
(burnt-toast--new-notification-core
|
||||
:text text
|
||||
:app-logo app-logo
|
||||
:sound sound
|
||||
:header header
|
||||
:unique-identifier unique-identifier
|
||||
:expiration-time expiration-time))
|
||||
|
||||
;;;###autoload
|
||||
(cl-defun burnt-toast-new-notification-silent (&key text app-logo header unique-identifier
|
||||
expiration-time)
|
||||
"Create a new silent notification.
|
||||
|
||||
TEXT is the content of the notification. This can be a list of strings,
|
||||
in which case each entry is a new line.
|
||||
|
||||
APP-LOGO is a path to an icon to be displayed with the notification.
|
||||
|
||||
HEADER is the notification's header.
|
||||
This should be created with (burnt-toast-bt-header-object ID HEADER).
|
||||
|
||||
UNIQUE-IDENTIFIER a unique identifier that can be used to remove/edit the
|
||||
notification.
|
||||
|
||||
EXPIRATION-TIME DateTime for notification to expire.
|
||||
This should be created with (burnt-toast-datetime-seconds-from-now SECONDS)."
|
||||
(burnt-toast--new-notification-core
|
||||
:text text
|
||||
:app-logo app-logo
|
||||
:silent t
|
||||
:header header
|
||||
:unique-identifier unique-identifier
|
||||
:expiration-time expiration-time))
|
||||
|
||||
;;;###autoload
|
||||
(cl-defun burnt-toast-new-notification-snooze-and-dismiss-with-sound (&key text app-logo header sound unique-identifier
|
||||
expiration-time)
|
||||
"Create a new snooze-and-dismiss notification.
|
||||
|
||||
TEXT is the content of the notification. This can be a list of strings,
|
||||
in which case each entry is a new line.
|
||||
|
||||
APP-LOGO is a path to an icon to be displayed with the notification.
|
||||
|
||||
HEADER is the notification's header.
|
||||
This should be created with (burnt-toast-bt-header-object ID HEADER).
|
||||
|
||||
SOUND is the sound effect to play.
|
||||
|
||||
UNIQUE-IDENTIFIER a unique identifier that can be used to remove/edit the
|
||||
notification.
|
||||
|
||||
EXPIRATION-TIME DateTime for notification to expire.
|
||||
This should be created with (burnt-toast-datetime-seconds-from-now SECONDS)."
|
||||
(burnt-toast--new-notification-core
|
||||
:text text
|
||||
:app-logo app-logo
|
||||
:header header
|
||||
:sound sound
|
||||
:snooze-and-dismiss t
|
||||
:unique-identifier unique-identifier
|
||||
:expiration-time expiration-time))
|
||||
|
||||
;;;###autoload
|
||||
(cl-defun burnt-toast-new-notification-snooze-and-dismiss-silent (&key text app-logo header unique-identifier
|
||||
expiration-time)
|
||||
"Create a new silent snooze-and-dismiss notification.
|
||||
|
||||
TEXT is the content of the notification. This can be a list of strings,
|
||||
in which case each entry is a new line.
|
||||
|
||||
APP-LOGO is a path to an icon to be displayed with the notification.
|
||||
|
||||
HEADER is the notification's header.
|
||||
This should be created with (burnt-toast-bt-header-object ID HEADER).
|
||||
|
||||
UNIQUE-IDENTIFIER a unique identifier that can be used to remove/edit
|
||||
the notification.
|
||||
|
||||
EXPIRATION-TIME DateTime for notification to expire.
|
||||
This should be created with (burnt-toast-datetime-seconds-from-now SECONDS)."
|
||||
(burnt-toast--new-notification-core
|
||||
:text text
|
||||
:app-logo app-logo
|
||||
:silent t
|
||||
:snooze-and-dismiss t
|
||||
:header header
|
||||
:unique-identifier unique-identifier
|
||||
:expiration-time expiration-time))
|
||||
|
||||
;;;###autoload
|
||||
(cl-defun burnt-toast-new-shoulder-tap (image person &key text app-logo header expiration-time)
|
||||
"Create a new shoulder tap notification.
|
||||
|
||||
IMAGE is the image representing the contact.
|
||||
|
||||
PERSON is the name of the contact.
|
||||
|
||||
TEXT is the content of the fallback notification. This can be a list of
|
||||
strings, in which case each entry is a new line.
|
||||
|
||||
APP-LOGO is a path to an icon to be displayed with the fallback notification.
|
||||
|
||||
HEADER is the fallback notification's header.
|
||||
This should be created with (burnt-toast-bt-header-object ID HEADER).
|
||||
|
||||
EXPIRATION-TIME DateTime for notification to expire.
|
||||
This should be created with (burnt-toast-datetime-seconds-from-now SECONDS)."
|
||||
(let* ((processed-text (burnt-toast--new-ps-object-list text #'burnt-toast--quote-and-sanitize-string))
|
||||
(ps-command (burnt-toast--new-ps-object
|
||||
"BurntToastShoulderTap"
|
||||
`(("Image" ,image t)
|
||||
("Person" ,person t)
|
||||
("Text" ,processed-text)
|
||||
("AppLogo" ,app-logo t)
|
||||
("Header" ,header)
|
||||
("ExpirationTime" ,expiration-time)))))
|
||||
(burnt-toast--run-powershell-command ps-command)))
|
||||
|
||||
(cl-defun burnt-toast-remove-notification (&key app-id tag group)
|
||||
"Remove a notification.
|
||||
|
||||
If APP-ID is specified, removes all notifications for that application.
|
||||
|
||||
If TAG is specified, removes all notifications with that tag.
|
||||
|
||||
If GROUP is specified, removes all notifications in that group."
|
||||
(let* ((ps-command (burnt-toast--create-ps-command
|
||||
"Remove-BTNotification"
|
||||
`(("AppId" ,app-id t)
|
||||
("Tag" ,tag t)
|
||||
("Group" ,group)))))
|
||||
(burnt-toast--run-powershell-command ps-command)))
|
||||
|
||||
(provide 'burnt-toast)
|
||||
;;; burnt-toast.el ends here
|
||||
Binary file not shown.
|
Before Width: | Height: | Size: 3.6 KiB |
|
|
@ -1,103 +0,0 @@
|
|||
;;; centaur-tabs-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 "centaur-tabs" "centaur-tabs.el" (0 0 0 0))
|
||||
;;; Generated autoloads from centaur-tabs.el
|
||||
|
||||
(autoload 'centaur-tabs-local-mode "centaur-tabs" "\
|
||||
Toggle local display of the tab bar.
|
||||
With prefix argument ARG, turn on if positive, otherwise off.
|
||||
Returns non-nil if the new state is enabled.
|
||||
When turned on, if a local header line is shown, it is hidden to show
|
||||
the tab bar. The tab bar is locally hidden otherwise. When turned
|
||||
off, if a local header line is hidden or the tab bar is locally
|
||||
hidden, it is shown again. Signal an error if Centaur-Tabs mode is off.
|
||||
|
||||
\(fn &optional ARG)" t nil)
|
||||
|
||||
(defvar centaur-tabs-mode nil "\
|
||||
Non-nil if Centaur-Tabs mode is enabled.
|
||||
See the `centaur-tabs-mode' command
|
||||
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.
|
||||
Returns non-nil if the new state is enabled.
|
||||
|
||||
\\{centaur-tabs-mode-map}
|
||||
|
||||
\(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" '("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 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 nil)
|
||||
|
||||
(autoload 'centaur-tabs-backward-group "centaur-tabs-functions" "\
|
||||
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 nil)
|
||||
|
||||
(autoload 'centaur-tabs-backward-tab "centaur-tabs-functions" "\
|
||||
Select the previous visible tab." t nil)
|
||||
|
||||
(autoload 'centaur-tabs-forward-tab "centaur-tabs-functions" "\
|
||||
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 nil)
|
||||
|
||||
(register-definition-prefixes "centaur-tabs-interactive" '("centaur-tabs-"))
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil nil ("centaur-tabs-pkg.el") (0 0 0 0))
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; coding: utf-8
|
||||
;; End:
|
||||
;;; centaur-tabs-autoloads.el ends here
|
||||
|
|
@ -1,865 +0,0 @@
|
|||
;;; centaur-tabs-elements.el --- centaur-tabs visual components and customizations -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2019-2020 Emmanuel Bustos
|
||||
;; Package-Requires: ((emacs "24.4") (powerline "2.4") (cl-lib "0.5"))
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;;
|
||||
;; This program is free software; you can redistribute it and/or
|
||||
;; modify it under the terms of the GNU General Public License as
|
||||
;; published by the Free Software Foundation; either version 2, or
|
||||
;; (at your option) any later version.
|
||||
;;
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
;; General Public License for more details.
|
||||
;;
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program; see the file COPYING. If not, write to
|
||||
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
|
||||
;; Floor, Boston, MA 02110-1301, USA.
|
||||
;;
|
||||
;;; Commentary:
|
||||
;; This file contains the visual components of centaur-tabs
|
||||
|
||||
;;; Code:
|
||||
;;
|
||||
;;; Requires
|
||||
;;
|
||||
(require 'color)
|
||||
(require 'powerline)
|
||||
;;; Faces
|
||||
;;
|
||||
(defface centaur-tabs-default
|
||||
'((t
|
||||
(:background "black" :foreground "black")))
|
||||
"Default face used in the tab bar."
|
||||
:group 'centaur-tabs)
|
||||
|
||||
(defface centaur-tabs-unselected
|
||||
'((t
|
||||
(:background "#3D3C3D" :foreground "grey50")))
|
||||
"Face used for unselected tabs."
|
||||
:group 'centaur-tabs)
|
||||
|
||||
(defface centaur-tabs-selected
|
||||
'((t (:background "#31343E" :foreground "white")))
|
||||
"Face used for the selected tab."
|
||||
:group 'centaur-tabs)
|
||||
|
||||
(defface centaur-tabs-unselected-modified
|
||||
'((t
|
||||
(:background "#3D3C3D" :foreground "grey50")))
|
||||
"Face used for unselected-modified tabs."
|
||||
:group 'centaur-tabs)
|
||||
|
||||
(defface centaur-tabs-selected-modified
|
||||
'((t (:background "#31343E" :foreground "white")))
|
||||
"Face used for the selected-modified tab."
|
||||
:group 'centaur-tabs)
|
||||
|
||||
(defface centaur-tabs-close-unselected
|
||||
'((t
|
||||
(:inherit centaur-tabs-unselected)))
|
||||
"Face used for unselected close button."
|
||||
:group 'centaur-tabs)
|
||||
|
||||
(defface centaur-tabs-close-selected
|
||||
'((t (:inherit centaur-tabs-selected)))
|
||||
"Face used for selected close button."
|
||||
:group 'centaur-tabs)
|
||||
|
||||
(defface centaur-tabs-name-mouse-face
|
||||
'((t nil))
|
||||
"Face used for tab name when hovered with the mouse."
|
||||
:group 'centaur-tabs)
|
||||
|
||||
(defface centaur-tabs-close-mouse-face
|
||||
'((t (:inherit underline)))
|
||||
"Face used for close button when hovered with the mouse."
|
||||
:group 'centaur-tabs)
|
||||
|
||||
(defface centaur-tabs-modified-marker-selected
|
||||
`((t (:inherit centaur-tabs-selected)))
|
||||
"Face used for selected modified marker."
|
||||
:group 'centaur-tabs)
|
||||
|
||||
(defface centaur-tabs-modified-marker-unselected
|
||||
`((t (:inherit centaur-tabs-unselected)))
|
||||
"Face used for unselected modified marker."
|
||||
:group 'centaur-tabs)
|
||||
|
||||
(defface centaur-tabs-active-bar-face
|
||||
'((t (:background "cyan")))
|
||||
"Face used for selected tab bar."
|
||||
:group 'centaur-tabs)
|
||||
|
||||
(defface centaur-tabs-jump-identifier-selected
|
||||
'((t (:inherit centaur-tabs-modified-marker-selected :weight extra-bold)))
|
||||
"Face used for selected tab identifiers when centaur-tabs-ace-jump is invoked."
|
||||
:group 'centaur-tabs)
|
||||
|
||||
(defface centaur-tabs-jump-identifier-unselected
|
||||
'((t (:inherit centaur-tabs-modified-marker-unselected :weight extra-bold)))
|
||||
"Face used for unselected tab identifiers when centaur-tabs-ace-jump is invoked."
|
||||
:group 'centaur-tabs)
|
||||
|
||||
(defface centaur-tabs-dim-buffer-face
|
||||
'((t (:foreground "gray40")))
|
||||
"Face for the buffer when centaur-tabs-ace-jump is invoked.")
|
||||
|
||||
;;; Tabs' display line
|
||||
;;
|
||||
(defvar centaur-tabs-display-line
|
||||
(if (boundp 'tab-line-format)
|
||||
'tab-line
|
||||
'header-line))
|
||||
|
||||
(defvar centaur-tabs-display-line-format
|
||||
(if (boundp 'tab-line-format)
|
||||
'tab-line-format
|
||||
'header-line-format))
|
||||
|
||||
;;; Tabs' characteristics
|
||||
;;
|
||||
(defcustom centaur-tabs-style "bar"
|
||||
"The style of tab."
|
||||
:group 'centaur-tabs
|
||||
:type 'string)
|
||||
|
||||
(defcustom centaur-tabs-label-fixed-length 0
|
||||
"Fixed length of label. Set to 0 if dynamic."
|
||||
:group 'centaur-tabs
|
||||
:type 'int)
|
||||
|
||||
(defcustom centaur-tabs-background-color
|
||||
(face-background 'centaur-tabs-default nil 'default)
|
||||
"*Background color of the tab bar.
|
||||
By default, use the background color specified for the
|
||||
`centaur-tabs-default' face (or inherited from another face), or the
|
||||
background color of the `default' face otherwise."
|
||||
:group 'centaur-tabs
|
||||
:type 'face)
|
||||
|
||||
(defcustom centaur-tabs-height 22
|
||||
"The height of tab."
|
||||
:group 'centaur-tabs
|
||||
:type 'int)
|
||||
|
||||
(defcustom centaur-tabs-bar-height (+ 8 centaur-tabs-height)
|
||||
"The height of bar."
|
||||
:group 'centaur-tabs
|
||||
:type 'int)
|
||||
|
||||
(defcustom centaur-tabs-mouse-pointer 'hand
|
||||
"Cursor to display when hovering the tabs.
|
||||
Default is 'hand. The following scopes are possible:
|
||||
- arrow
|
||||
- hand
|
||||
- vdrag
|
||||
- hdrag
|
||||
- modeline
|
||||
- hourglass"
|
||||
:group 'centaur-tabs
|
||||
:type 'variable)
|
||||
|
||||
;;; Icons
|
||||
;;
|
||||
(defcustom centaur-tabs-set-icons nil
|
||||
"When non nil, display an icon based on `centaur-tabs-icon-type' alongside the tab name."
|
||||
:group 'centaur-tabs
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom centaur-tabs-icon-type (and centaur-tabs-set-icons
|
||||
(or (require 'all-the-icons nil t)
|
||||
(require 'nerd-icons nil t)))
|
||||
"Icon type. It should be one of `all-the-icons' and `nerd-icons'."
|
||||
:group 'centaur-tabs
|
||||
:type 'symbol
|
||||
:set
|
||||
(lambda (k v)
|
||||
(pcase v
|
||||
('all-the-icons
|
||||
(unless (require 'all-the-icons nil t)
|
||||
(setq v nil)))
|
||||
('nerd-icons
|
||||
(unless (require 'nerd-icons nil t)
|
||||
(setq v nil)))
|
||||
(type
|
||||
(if (require 'all-the-icons nil t)
|
||||
(setq v 'all-the-icons)
|
||||
(setq v nil))))
|
||||
(set k v)))
|
||||
|
||||
(defvar centaur-tabs-icon-scale-factor
|
||||
1.0
|
||||
"The base scale factor for the `height' face property of tab icons.")
|
||||
|
||||
(defvar centaur-tabs-icon-v-adjust
|
||||
0.01
|
||||
"The vertical adjust for tab icons.")
|
||||
|
||||
(defcustom centaur-tabs-gray-out-icons nil
|
||||
"When non nil, enable gray icons for unselected buffer."
|
||||
:group 'centaur-tabs
|
||||
:type '(choice :tag "Gray out icons for unselected..."
|
||||
(const :tag "Buffer" buffer)))
|
||||
|
||||
(defcustom centaur-tabs-plain-icons nil
|
||||
"When non nil, tab icons' color will be the same as tabs' foreground color."
|
||||
:group 'centaur-tabs
|
||||
:type 'boolean)
|
||||
|
||||
(defun centaur-tabs--icon-for-file (file &rest args)
|
||||
"Get the formatted icon for FILE.
|
||||
ARGS should be a plist containing `:height', `:v-adjust', or `:face' properties."
|
||||
(pcase centaur-tabs-icon-type
|
||||
('all-the-icons (apply #'all-the-icons-icon-for-file file args))
|
||||
('nerd-icons (apply #'nerd-icons-icon-for-file file args))))
|
||||
|
||||
(defun centaur-tabs--icon-for-mode (mode &rest args)
|
||||
"Get the formatted icon for MODE.
|
||||
ARG-OVERRIDES should be a plist containining `:height',
|
||||
`:v-adjust' or `:face' properties like in the normal icon
|
||||
inserting functions."
|
||||
(pcase centaur-tabs-icon-type
|
||||
('all-the-icons (apply #'all-the-icons-icon-for-mode mode args))
|
||||
('nerd-icons (apply #'nerd-icons-icon-for-mode mode args))))
|
||||
|
||||
(defun centaur-tabs--auto-mode-match? (&optional file)
|
||||
"Whether or not FILE's `major-mode' match against its `auto-mode-alist'."
|
||||
(pcase centaur-tabs-icon-type
|
||||
('all-the-icons (apply #'all-the-icons-auto-mode-match? file))
|
||||
('nerd-icons (apply #'nerd-icons-auto-mode-match? file))))
|
||||
|
||||
(defun centaur-tabs-icon (tab face selected)
|
||||
"Generate icon for TAB using FACE's background.
|
||||
If icon gray out option enabled, gray out icon if not SELECTED."
|
||||
(if centaur-tabs-icon-type
|
||||
(with-current-buffer (car tab)
|
||||
(let* ((icon
|
||||
(if (and (buffer-file-name)
|
||||
(centaur-tabs--auto-mode-match?))
|
||||
(centaur-tabs--icon-for-file
|
||||
(file-name-nondirectory (buffer-file-name))
|
||||
:v-adjust centaur-tabs-icon-v-adjust
|
||||
:height centaur-tabs-icon-scale-factor)
|
||||
(centaur-tabs--icon-for-mode
|
||||
major-mode
|
||||
:v-adjust centaur-tabs-icon-v-adjust
|
||||
:height centaur-tabs-icon-scale-factor)))
|
||||
(background (face-background face nil 'default))
|
||||
(inactive (cond ((and (not selected)
|
||||
(eq centaur-tabs-gray-out-icons 'buffer))
|
||||
(face-foreground 'mode-line-inactive nil 'default))
|
||||
(centaur-tabs-plain-icons
|
||||
(face-foreground 'centaur-tabs-selected nil 'default))
|
||||
(t 'unspecified)))
|
||||
(underline (and (eq (if (display-graphic-p) centaur-tabs-set-bar) 'under)
|
||||
(face-attribute face :underline)))
|
||||
(overline (and (eq (if (display-graphic-p) centaur-tabs-set-bar) 'over)
|
||||
(face-attribute face :overline))))
|
||||
(if (stringp icon)
|
||||
(progn
|
||||
(propertize icon 'face `(:inherit ,(get-text-property 0 'face icon)
|
||||
:foreground ,inactive
|
||||
:background ,background
|
||||
:underline ,underline
|
||||
:overline ,overline)))
|
||||
"")))
|
||||
""))
|
||||
|
||||
;;; Ace-window style tab switching
|
||||
;;
|
||||
(defcustom centaur-tabs-show-jump-identifier 'prompted
|
||||
"Whether to show the tab identifier for centaur-tabs-ace-jump.
|
||||
It has 3 options:
|
||||
- 'nil, never show the jump identifier.
|
||||
- 'prompted, only show it when using centaur-tabs-ace-jump.
|
||||
- 'always, always show it regardless of the status."
|
||||
:group 'centaur-tabs
|
||||
:type '(choice :tag "show identifier when..."
|
||||
(const :tag "Never" nil)
|
||||
(const :tag "Only when prompted" prompted)
|
||||
(const :tag "Always" always)))
|
||||
|
||||
(defcustom centaur-tabs-ace-jump-dim-buffer t
|
||||
"Whether to dim the current buffer when centaur-ace-jump is activated.")
|
||||
|
||||
(defvar centaur-tabs-ace-jump-keys
|
||||
'(?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)
|
||||
"Buffer jump keys used by centaur-tabs-ace-jump.")
|
||||
|
||||
(defvar centuar-tabs-ace-dispatch-alist
|
||||
'((?q exit "Exit")
|
||||
(?\C-g exit "Exit")
|
||||
(?j jump-to-tab "Jump to tab")
|
||||
(?x close-tab "Close tab")
|
||||
(?s swap-tab "Swap tab")
|
||||
(?\[ backward-group "Previous group")
|
||||
(?\] forward-group "Next group")
|
||||
(?? show-help "Show dispatch help"))
|
||||
"Action keys used by centaur-tabs-ace-jump.
|
||||
The value of each element must be in the form:
|
||||
\(key keyword docstring), where keyword must be one of the follows:
|
||||
\(exit, jump-to-tab, close-tab, swap-tab, backward-group,
|
||||
forward-group, show-help).")
|
||||
|
||||
;;; Close buttons, modified marker and edges' margins
|
||||
;;
|
||||
(defcustom centaur-tabs-set-close-button t
|
||||
"When non nil, display a clickable close button on the right side of the tabs."
|
||||
:group 'centaur-tabs
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom centaur-tabs-set-left-close-button nil
|
||||
"When non nil, display a clickable close button on the left side of the tabs."
|
||||
:group 'centaur-tabs
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom centaur-tabs-close-button (make-string 1 #x00D7)
|
||||
"Display appearance of the close buttons, if enabled."
|
||||
:group 'centaur-tabs
|
||||
:type 'string)
|
||||
|
||||
(defcustom centaur-tabs-set-modified-marker nil
|
||||
"When non nil, display a marker when the buffer is modified."
|
||||
:group 'centaur-tabs
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom centaur-tabs-modified-marker (make-string 1 #x23FA)
|
||||
"Display appearance of the modified marker, if enabled."
|
||||
:group 'centaur-tabs
|
||||
:type 'string)
|
||||
|
||||
(defcustom centaur-tabs-left-edge-margin " "
|
||||
"Text to display at the left edge of the tabs, or nil for no added margin."
|
||||
:group 'centaur-tabs
|
||||
:type 'string)
|
||||
|
||||
(defcustom centaur-tabs-right-edge-margin " "
|
||||
"Text to display at the right edge of the tabs, or nil for no added margin."
|
||||
:group 'centaur-tabs
|
||||
:type 'string)
|
||||
|
||||
;;; Selected tab bar
|
||||
;;
|
||||
(defcustom centaur-tabs-set-bar nil
|
||||
"When non nil, display a bar to show the currently selected tab.
|
||||
There are three options:
|
||||
- 'left: displays the bar at the left of the currently selected tab.
|
||||
- 'under: displays the bar under the currently selected tab.
|
||||
- 'over: displays the bar over the currently selected tab."
|
||||
:group 'centaur-tabs
|
||||
:type '(choice :tag "Display bar at..."
|
||||
(const :tag "Put bar on the left" left)
|
||||
(const :tag "Put bar as an underline" under)
|
||||
(const :tag "Put bar as an overline" over)))
|
||||
|
||||
(defun centaur-tabs--make-xpm (face width height)
|
||||
"Create an XPM bitmap via FACE WIDTH and HEIGHT.
|
||||
Taken from `doom-modeline'."
|
||||
(when (and (display-graphic-p)
|
||||
(image-type-available-p 'xpm))
|
||||
(propertize
|
||||
" " 'display
|
||||
(let ((data (make-list height (make-list width 1)))
|
||||
(color (or (face-background face nil t) "None")))
|
||||
(ignore-errors
|
||||
(create-image
|
||||
(concat
|
||||
(format
|
||||
"/* XPM */\nstatic char * percent[] = {\n\"%i %i 2 1\",\n\". c %s\",\n\" c %s\","
|
||||
(length (car data)) (length data) color color)
|
||||
(apply #'concat
|
||||
(cl-loop with idx = 0
|
||||
with len = (length data)
|
||||
for dl in data
|
||||
do (cl-incf idx)
|
||||
collect
|
||||
(concat
|
||||
"\""
|
||||
(cl-loop for d in dl
|
||||
if (= d 0) collect (string-to-char " ")
|
||||
else collect (string-to-char "."))
|
||||
(if (eq idx len) "\"};" "\",\n")))))
|
||||
'xpm t :ascent 'center))))))
|
||||
|
||||
(defvar centaur-tabs-active-bar
|
||||
(centaur-tabs--make-xpm 'centaur-tabs-active-bar-face
|
||||
2
|
||||
centaur-tabs-bar-height))
|
||||
|
||||
;;; Navigation buttons
|
||||
;;
|
||||
(defcustom centaur-tabs-show-navigation-buttons nil
|
||||
"When non-nil, show the buttons for backward/forward tabs."
|
||||
:group 'centaur-tabs
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom centaur-tabs-down-tab-text " ▾ "
|
||||
"Text icon to show in the down button tab."
|
||||
:group 'centaur-tabs
|
||||
:type 'string)
|
||||
|
||||
(defcustom centaur-tabs-backward-tab-text " ⏴ "
|
||||
"Text icon to show in the backward button tab."
|
||||
:group 'centaur-tabs
|
||||
:type 'string)
|
||||
|
||||
(defcustom centaur-tabs-forward-tab-text " ⏵ "
|
||||
"Text icon to show in the forward button tab."
|
||||
:group 'centaur-tabs
|
||||
:type 'string)
|
||||
|
||||
(defcustom centaur-tabs-show-count nil
|
||||
"When non-nil, show the current index and count of tabs in the current group."
|
||||
:group 'centaur-tabs
|
||||
:type 'boolean)
|
||||
|
||||
;;; New tab button
|
||||
;;
|
||||
(defcustom centaur-tabs-show-new-tab-button t
|
||||
"When non-nil, show the button to create a new tab."
|
||||
:group 'centaur-tabs
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom centaur-tabs-new-tab-text " + "
|
||||
"Text icon to show in the new-tab button."
|
||||
:group 'centaur-tabs
|
||||
:type 'string)
|
||||
|
||||
;;; Separators
|
||||
;;
|
||||
(defvar centaur-tabs-style-left nil)
|
||||
(defvar centaur-tabs-style-right nil)
|
||||
|
||||
(defvar ns-use-srgb-colorspace)
|
||||
|
||||
(defvar centaur-tabs-image-apple-rgb
|
||||
(and (eq (window-system) 'ns)
|
||||
ns-use-srgb-colorspace
|
||||
(< 11
|
||||
(string-to-number
|
||||
(and (string-match "darwin\\([0-9]+\\)" system-configuration)
|
||||
(match-string-no-properties 1 system-configuration)))))
|
||||
"Boolean variable to determine whether to use Apple RGB colorspace.
|
||||
used to render images.
|
||||
|
||||
t on macOS 10.7+ and `ns-use-srgb-colorspace' is t, nil otherwise.
|
||||
|
||||
This variable is automatically set, there's no need to modify it.")
|
||||
|
||||
(defun centaur-tabs-separator-interpolate (color1 color2)
|
||||
"Interpolate between COLOR1 and COLOR2.
|
||||
|
||||
COLOR1 and COLOR2 must be supplied as hex strings with a leading #."
|
||||
(let* ((c1 (color-name-to-rgb color1))
|
||||
(c2 (color-name-to-rgb color2))
|
||||
(red (/ (+ (nth 0 c1) (nth 0 c2)) 2))
|
||||
(green (/ (+ (nth 1 c1) (nth 1 c2)) 2))
|
||||
(blue (/ (+ (nth 2 c1) (nth 2 c2)) 2)))
|
||||
(color-rgb-to-hex red green blue)))
|
||||
|
||||
(defun centaur-tabs-separator-color-xyz-to-apple-rgb (X Y Z)
|
||||
"Convert CIE X Y Z colors to Apple RGB color space."
|
||||
(let ((r (+ (* 3.2404542 X) (* -1.5371385 Y) (* -0.4985314 Z)))
|
||||
(g (+ (* -0.9692660 X) (* 1.8760108 Y) (* 0.0415560 Z)))
|
||||
(b (+ (* 0.0556434 X) (* -0.2040259 Y) (* 1.0572252 Z))))
|
||||
(list (expt r (/ 1.8)) (expt g (/ 1.8)) (expt b (/ 1.8)))))
|
||||
|
||||
(defun centaur-tabs-separator-color-srgb-to-apple-rgb (red green blue)
|
||||
"Convert RED GREEN BLUE colors from sRGB color space to Apple RGB.
|
||||
RED, GREEN and BLUE should be between 0.0 and 1.0, inclusive."
|
||||
(apply #'centaur-tabs-separator-color-xyz-to-apple-rgb (color-srgb-to-xyz red green blue)))
|
||||
|
||||
(defun centaur-tabs-separator-hex-color (color)
|
||||
"Get the hexadecimal value of COLOR."
|
||||
(when color
|
||||
(let ((srgb-color (color-name-to-rgb color)))
|
||||
(if centaur-tabs-image-apple-rgb
|
||||
(apply #'color-rgb-to-hex (apply #'centaur-tabs-separator-color-srgb-to-apple-rgb srgb-color))
|
||||
(apply #'color-rgb-to-hex srgb-color)))))
|
||||
|
||||
(defun centaur-tabs-separator-pattern (lst)
|
||||
"Turn LST into an infinite pattern."
|
||||
(when lst
|
||||
(let ((pattern (cl-copy-list lst)))
|
||||
(setcdr (last pattern) pattern))))
|
||||
|
||||
(defun centaur-tabs-separator-pattern-to-string (pattern)
|
||||
"Convert a PATTERN into a string that can be used in an XPM."
|
||||
(concat "\"" (mapconcat #'number-to-string pattern "") "\","))
|
||||
|
||||
(defun centaur-tabs-separator-reverse-pattern (pattern)
|
||||
"Reverse each line in PATTERN."
|
||||
(cl-mapcar 'reverse pattern))
|
||||
|
||||
(defun centaur-tabs-separator-row-pattern (fill total &optional fade)
|
||||
"Make a list that has FILL 0s out of TOTAL 1s with FADE 2s to the right of the fill."
|
||||
(unless fade
|
||||
(setq fade 0))
|
||||
(let ((fill (min fill total))
|
||||
(fade (min fade (max (- total fill) 0))))
|
||||
(append (make-list fill 0)
|
||||
(make-list fade 2)
|
||||
(make-list (- total fill fade) 1))))
|
||||
|
||||
(defun centaur-tabs-separator-pattern-bindings-body (patterns height-exp pattern-height-sym
|
||||
second-pattern-height-sym)
|
||||
"Create let-var bindings and a function body from PATTERNS.
|
||||
The `car' and `cdr' parts of the result can be passed to the
|
||||
function `centaur-tabs-separator-wrap-defun' as its `let-vars'
|
||||
and `body' arguments,respectively. HEIGHT-EXP is an expression
|
||||
calculating the image height and it should contain a free variable `height'.
|
||||
PATTERN-HEIGHT-SYM and SECOND-PATTERN-HEIGHT-SYM are symbols used
|
||||
for let-var binding variables."
|
||||
(let* ((pattern (centaur-tabs-separator-pattern (cl-mapcar 'centaur-tabs-separator-pattern-to-string (car patterns))))
|
||||
(header (cl-mapcar 'centaur-tabs-separator-pattern-to-string (nth 1 patterns)))
|
||||
(footer (cl-mapcar 'centaur-tabs-separator-pattern-to-string (nth 2 patterns)))
|
||||
(second-pattern (centaur-tabs-separator-pattern (cl-mapcar 'centaur-tabs-separator-pattern-to-string (nth 3 patterns))))
|
||||
(center (cl-mapcar 'centaur-tabs-separator-pattern-to-string (nth 4 patterns)))
|
||||
(reserve (+ (length header) (length footer) (length center))))
|
||||
(when pattern
|
||||
(cons `((,pattern-height-sym (max (- ,height-exp ,reserve) 0))
|
||||
(,second-pattern-height-sym (/ ,pattern-height-sym 2))
|
||||
(,pattern-height-sym ,(if second-pattern `(ceiling ,pattern-height-sym 2) `,pattern-height-sym)))
|
||||
(list (when header `(mapconcat 'identity ',header ""))
|
||||
`(mapconcat 'identity
|
||||
(cl-subseq ',pattern 0 ,pattern-height-sym) "")
|
||||
(when center `(mapconcat 'identity ',center ""))
|
||||
(when second-pattern
|
||||
`(mapconcat 'identity
|
||||
(cl-subseq ',second-pattern
|
||||
0 ,second-pattern-height-sym) ""))
|
||||
(when footer `(mapconcat 'identity ',footer "")))))))
|
||||
|
||||
(defun centaur-tabs-separator-pattern-defun (name dir width &rest patterns)
|
||||
"Create a powerline function of NAME in DIR with WIDTH for PATTERNS.
|
||||
|
||||
PATTERNS is of the form (PATTERN HEADER FOOTER SECOND-PATTERN CENTER
|
||||
PATTERN-2X HEADER-2X FOOTER-2X SECOND-PATTERN-2X CENTER-2X).
|
||||
PATTERN is required, all other components are optional.
|
||||
The first 5 components are for the standard resolution image.
|
||||
The remaining ones are for the high resolution image where both
|
||||
width and height are doubled. If PATTERN-2X is nil or not given,
|
||||
then the remaining components are ignored and the standard
|
||||
resolution image with magnification and interpolation will be
|
||||
used in high resolution environments
|
||||
|
||||
All generated functions generate the form:
|
||||
HEADER
|
||||
PATTERN ...
|
||||
CENTER
|
||||
SECOND-PATTERN ...
|
||||
FOOTER
|
||||
|
||||
PATTERN and SECOND-PATTERN repeat infinitely to fill the space needed to
|
||||
generate a full height XPM.
|
||||
|
||||
PATTERN, HEADER, FOOTER, SECOND-PATTERN, CENTER are of the form
|
||||
\((COLOR ...) (COLOR ...) ...).
|
||||
|
||||
COLOR can be one of 0, 1, or 2, where 0 is the source color, 1 is the
|
||||
destination color, and 2 is the interpolated color between 0 and 1."
|
||||
(when (eq dir 'right)
|
||||
(setq patterns (cl-mapcar 'centaur-tabs-separator-reverse-pattern patterns)))
|
||||
(let ((bindings-body (centaur-tabs-separator-pattern-bindings-body patterns
|
||||
'height
|
||||
'pattern-height
|
||||
'second-pattern-height))
|
||||
(bindings-body-2x (centaur-tabs-separator-pattern-bindings-body (nthcdr 5 patterns)
|
||||
'(* height 2)
|
||||
'pattern-height-2x
|
||||
'second-pattern-height-2x)))
|
||||
(centaur-tabs-separator-wrap-defun name dir width
|
||||
(append (car bindings-body) (car bindings-body-2x))
|
||||
(cdr bindings-body) (cdr bindings-body-2x))))
|
||||
|
||||
(defun centaur-tabs-separator-background-color (face)
|
||||
"Set the separator background color using FACE."
|
||||
(face-attribute face
|
||||
(if (face-attribute face :inverse-video nil 'default)
|
||||
:foreground
|
||||
:background)
|
||||
nil
|
||||
'default))
|
||||
|
||||
(defun centaur-tabs-separator-wrap-defun (name dir width let-vars body &optional body-2x)
|
||||
"Generate a powerline function of name NAME in dir DIR.
|
||||
This is made with WIDTH using LET-VARS and BODY.
|
||||
BODY-2X is an optional argument."
|
||||
(let* ((src-face (if (eq dir 'left) 'face1 'face2))
|
||||
(dst-face (if (eq dir 'left) 'face2 'face1)))
|
||||
`(defun ,(intern (format "powerline-%s-%s" name (symbol-name dir)))
|
||||
(face1 face2 &optional height)
|
||||
(when window-system
|
||||
(unless height (setq height centaur-tabs-height))
|
||||
(let* ,(append `((color1 (when ,src-face
|
||||
(centaur-tabs-separator-hex-color (centaur-tabs-separator-background-color ,src-face))))
|
||||
(color2 (when ,dst-face
|
||||
(centaur-tabs-separator-hex-color (centaur-tabs-separator-background-color ,dst-face))))
|
||||
(colori (when (and color1 color2) (centaur-tabs-separator-interpolate color1 color2)))
|
||||
(color1 (or color1 "None"))
|
||||
(color2 (or color2 "None"))
|
||||
(colori (or colori "None")))
|
||||
let-vars)
|
||||
(apply #'create-image
|
||||
,(append `(concat (format "/* XPM */ static char * %s_%s[] = { \"%s %s 3 1\", \"0 c %s\", \"1 c %s\", \"2 c %s\","
|
||||
,(replace-regexp-in-string "-" "_" name)
|
||||
(symbol-name ',dir)
|
||||
,width
|
||||
height
|
||||
color1
|
||||
color2
|
||||
colori))
|
||||
body
|
||||
'("};"))
|
||||
'xpm t
|
||||
:ascent 'center
|
||||
:face (when (and face1 face2)
|
||||
,dst-face)
|
||||
,(and body-2x
|
||||
`(and (featurep 'mac)
|
||||
(list :data-2x
|
||||
,(append `(concat (format "/* XPM */ static char * %s_%s_2x[] = { \"%s %s 3 1\", \"0 c %s\", \"1 c %s\", \"2 c %s\","
|
||||
,(replace-regexp-in-string "-" "_" name)
|
||||
(symbol-name ',dir)
|
||||
(* ,width 2)
|
||||
(* height 2)
|
||||
color1
|
||||
color2
|
||||
colori))
|
||||
body-2x
|
||||
'("};")))))))))))
|
||||
|
||||
(defun centaur-tabs-separator-alternate (dir)
|
||||
"Generate an alternating pattern XPM function for DIR."
|
||||
(centaur-tabs-separator-pattern-defun "alternate" dir 4
|
||||
'((2 2 1 1)
|
||||
(0 0 2 2))
|
||||
nil nil nil nil
|
||||
;; 2x
|
||||
'((2 2 2 2 1 1 1 1)
|
||||
(2 2 2 2 1 1 1 1)
|
||||
(0 0 0 0 2 2 2 2)
|
||||
(0 0 0 0 2 2 2 2))))
|
||||
|
||||
(defun centaur-tabs-separator-bar (dir)
|
||||
"Generate a bar XPM function for DIR."
|
||||
(centaur-tabs-separator-pattern-defun "bar" dir 2
|
||||
'((2 2))))
|
||||
|
||||
(defun centaur-tabs-separator-box (dir)
|
||||
"Generate a box XPM function for DIR."
|
||||
(centaur-tabs-separator-pattern-defun "box" dir 2
|
||||
'((0 0)
|
||||
(0 0)
|
||||
(1 1)
|
||||
(1 1))
|
||||
nil nil nil nil
|
||||
;; 2x
|
||||
'((0 0 0 0)
|
||||
(0 0 0 0)
|
||||
(0 0 0 0)
|
||||
(0 0 0 0)
|
||||
(1 1 1 1)
|
||||
(1 1 1 1)
|
||||
(1 1 1 1)
|
||||
(1 1 1 1))))
|
||||
|
||||
(defun centaur-tabs-separator-chamfer (dir)
|
||||
"Generate a chamfer XPM function for DIR."
|
||||
(centaur-tabs-separator-pattern-defun "chamfer" dir 3
|
||||
'((0 0 0))
|
||||
'((1 1 1)
|
||||
(0 1 1)
|
||||
(0 0 1))
|
||||
nil nil nil
|
||||
;; 2x
|
||||
'((0 0 0 0 0 0))
|
||||
'((1 1 1 1 1 1)
|
||||
(0 1 1 1 1 1)
|
||||
(0 0 1 1 1 1)
|
||||
(0 0 0 1 1 1)
|
||||
(0 0 0 0 1 1)
|
||||
(0 0 0 0 0 1))))
|
||||
|
||||
(defun centaur-tabs-separator-rounded (dir)
|
||||
"Generate a rounded XPM function for DIR."
|
||||
(centaur-tabs-separator-pattern-defun "rounded" dir 6
|
||||
'((0 0 0 0 0 0))
|
||||
'((2 1 1 1 1 1)
|
||||
(0 0 2 1 1 1)
|
||||
(0 0 0 0 1 1)
|
||||
(0 0 0 0 2 1)
|
||||
(0 0 0 0 0 1)
|
||||
(0 0 0 0 0 2))
|
||||
nil nil nil
|
||||
;; 2x
|
||||
'((0 0 0 0 0 0 0 0 0 0 0 0))
|
||||
'((1 1 1 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 2 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 2 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 2 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 0 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 0 1))))
|
||||
|
||||
(defun centaur-tabs-separator-slant (dir)
|
||||
"Generate a slant XPM function for DIR."
|
||||
(let* ((row-modifier (if (eq dir 'left) 'identity 'reverse)))
|
||||
(centaur-tabs-separator-wrap-defun "slant" dir 'width
|
||||
'((width (1- (ceiling height 2))))
|
||||
`((cl-loop for i from 0 to (1- height)
|
||||
concat (centaur-tabs-separator-pattern-to-string (,row-modifier (centaur-tabs-separator-row-pattern (/ i 2) width)))))
|
||||
`((cl-loop for i from 0 to (1- (* height 2))
|
||||
concat (centaur-tabs-separator-pattern-to-string (,row-modifier (centaur-tabs-separator-row-pattern (/ i 2) (* width 2)))))))))
|
||||
|
||||
(defun centaur-tabs-separator-wave (dir)
|
||||
"Generate a wave XPM function for DIR."
|
||||
(centaur-tabs-separator-pattern-defun "wave" dir 11
|
||||
'((0 0 0 0 0 0 1 1 1 1 1))
|
||||
'((2 1 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 2 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 2 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 2 1 1 1 1 1))
|
||||
'((0 0 0 0 0 0 2 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 2 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 2 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 2))
|
||||
nil nil
|
||||
;; 2x
|
||||
'((0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1))
|
||||
'((1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1))
|
||||
'((0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2 1 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 2 1 1 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1)
|
||||
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0))))
|
||||
|
||||
(defun centaur-tabs-separator-zigzag (dir)
|
||||
"Generate a zigzag pattern XPM function for DIR."
|
||||
(centaur-tabs-separator-pattern-defun "zigzag" dir 3
|
||||
'((1 1 1)
|
||||
(0 1 1)
|
||||
(0 0 1)
|
||||
(0 0 0)
|
||||
(0 0 1)
|
||||
(0 1 1))
|
||||
nil nil nil nil
|
||||
;; 2x
|
||||
'((1 1 1 1 1 1)
|
||||
(0 1 1 1 1 1)
|
||||
(0 0 1 1 1 1)
|
||||
(0 0 0 1 1 1)
|
||||
(0 0 0 0 1 1)
|
||||
(0 0 0 0 0 1)
|
||||
(0 0 0 0 0 0)
|
||||
(0 0 0 0 0 1)
|
||||
(0 0 0 0 1 1)
|
||||
(0 0 0 1 1 1)
|
||||
(0 0 1 1 1 1)
|
||||
(0 1 1 1 1 1))))
|
||||
|
||||
(defun centaur-tabs-separator-memoize (func)
|
||||
"Memoize FUNC.
|
||||
If argument is a symbol then install the memoized function over
|
||||
the original function. Use frame-local memoization."
|
||||
(cl-typecase func
|
||||
(symbol (fset func (centaur-tabs-separator-memoize-wrap-frame-local (symbol-function func))) func)
|
||||
(function (centaur-tabs-separator-memoize-wrap-frame-local func))))
|
||||
|
||||
(defun centaur-tabs-separator-memoize-wrap-frame-local (func)
|
||||
"Return the memoized version of FUNC.
|
||||
The memoization cache is frame-local."
|
||||
(let ((funcid (cl-gensym)))
|
||||
`(lambda (&rest args)
|
||||
,(concat (documentation func) (format "\n(memoized function %s)" funcid))
|
||||
(let* ((cache (centaur-tabs-separator-create-or-get-cache))
|
||||
(key (cons ',funcid args))
|
||||
(val (gethash key cache)))
|
||||
(if val
|
||||
val
|
||||
(puthash key (apply ,func args) cache))))))
|
||||
|
||||
(defun centaur-tabs-separator-create-or-get-cache ()
|
||||
"Return a frame-local hash table that acts as a memoization cache.
|
||||
The cache is for the powerline.
|
||||
Create one if the frame doesn't have one yet."
|
||||
(let ((table (frame-parameter nil 'powerline-cache)))
|
||||
(if (hash-table-p table) table (centaur-tabs-separator-reset-cache))))
|
||||
|
||||
(defun centaur-tabs-separator-reset-cache ()
|
||||
"Reset and return the frame-local hash table used for a memoization cache."
|
||||
(let ((table (make-hash-table :test 'equal)))
|
||||
;; Store it as a frame-local variable
|
||||
(modify-frame-parameters nil `((powerline-cache . ,table)))
|
||||
table))
|
||||
|
||||
(centaur-tabs-separator-memoize (centaur-tabs-separator-alternate 'left))
|
||||
(centaur-tabs-separator-memoize (centaur-tabs-separator-alternate 'right))
|
||||
(centaur-tabs-separator-memoize (centaur-tabs-separator-bar 'left))
|
||||
(centaur-tabs-separator-memoize (centaur-tabs-separator-bar 'right))
|
||||
(centaur-tabs-separator-memoize (centaur-tabs-separator-box 'left))
|
||||
(centaur-tabs-separator-memoize (centaur-tabs-separator-box 'right))
|
||||
(centaur-tabs-separator-memoize (centaur-tabs-separator-chamfer 'left))
|
||||
(centaur-tabs-separator-memoize (centaur-tabs-separator-chamfer 'right))
|
||||
(centaur-tabs-separator-memoize (centaur-tabs-separator-rounded 'left))
|
||||
(centaur-tabs-separator-memoize (centaur-tabs-separator-rounded 'right))
|
||||
(centaur-tabs-separator-memoize (centaur-tabs-separator-slant 'left))
|
||||
(centaur-tabs-separator-memoize (centaur-tabs-separator-slant 'right))
|
||||
(centaur-tabs-separator-memoize (centaur-tabs-separator-wave 'left))
|
||||
(centaur-tabs-separator-memoize (centaur-tabs-separator-wave 'right))
|
||||
(centaur-tabs-separator-memoize (centaur-tabs-separator-zigzag 'left))
|
||||
(centaur-tabs-separator-memoize (centaur-tabs-separator-zigzag 'right))
|
||||
|
||||
(defun centaur-tabs-select-separator-style (tab-style)
|
||||
"Set the separator style to TAB-STYLE."
|
||||
(setq centaur-tabs-style-left (funcall (intern (format "powerline-%s-right" tab-style)) 'centaur-tabs-default nil centaur-tabs-height))
|
||||
(setq centaur-tabs-style-right (funcall (intern (format "powerline-%s-left" tab-style)) nil 'centaur-tabs-default centaur-tabs-height)))
|
||||
|
||||
(provide 'centaur-tabs-elements)
|
||||
|
||||
;;; centaur-tabs-elements.el ends here
|
||||
File diff suppressed because it is too large
Load diff
|
|
@ -1,627 +0,0 @@
|
|||
;;; centaur-tabs-interactive.el --- centaur-tabs interactive functions and plugins support lexical-binding: t; -*-
|
||||
|
||||
;; 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
|
||||
;; (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:
|
||||
;;; Requires
|
||||
(require 'centaur-tabs-elements)
|
||||
(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 (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) )))
|
||||
|
||||
(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
|
||||
"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 `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: ")))
|
||||
|
||||
(let ((centaur-tabs-ace-jump-active t))
|
||||
(catch 'done
|
||||
(while t
|
||||
(centaur-tabs-set-template (centaur-tabs-current-tabset t) nil)
|
||||
(centaur-tabs-display-update)
|
||||
(let ((char (read-key)) (action-cache))
|
||||
(cond
|
||||
;; tab keys
|
||||
((memq char centaur-tabs-ace-jump-keys)
|
||||
(let ((sel (nth (cl-position char centaur-tabs-ace-jump-keys) (centaur-tabs-view (centaur-tabs-current-tabset t)))))
|
||||
(cond ((eq sel nil)
|
||||
(message "Tab %s does not exist" (key-description (vector char))))
|
||||
((eq action 'jump-to-tab)
|
||||
(centaur-tabs-buffer-select-tab sel))
|
||||
((eq action 'close-tab)
|
||||
(centaur-tabs-buffer-close-tab sel))
|
||||
((eq action 'swap-tab)
|
||||
(centaur-tabs-swap-tab sel))))
|
||||
(throw 'done nil))
|
||||
;; actions
|
||||
((setq action-cache (assoc char centuar-tabs-ace-dispatch-alist))
|
||||
(setq action-cache (cadr action-cache))
|
||||
(cond ((eq action-cache 'exit) ; exit
|
||||
(message "Quit")
|
||||
(throw 'done nil))
|
||||
((eq action-cache 'forward-group) ; forward group
|
||||
(message "Forward group")
|
||||
(centaur-tabs-forward-group)
|
||||
(centaur-tabs--dim-window))
|
||||
((eq action-cache 'backward-group) ; backward group
|
||||
(message "Backward group")
|
||||
(centaur-tabs-backward-group)
|
||||
(centaur-tabs--dim-window))
|
||||
((eq action-cache 'show-help) ; help menu
|
||||
(message "%s" (mapconcat
|
||||
(lambda (elem) (format "%s: %s"
|
||||
(key-description (vector (car elem)))
|
||||
(caddr elem)))
|
||||
centuar-tabs-ace-dispatch-alist
|
||||
"\n")))
|
||||
(t (setq action action-cache) ; other actions
|
||||
(cond ((eq action-cache 'jump-to-tab)
|
||||
(message "Jump to tab: "))
|
||||
((eq action-cache 'close-tab)
|
||||
(message "Close tab: "))
|
||||
((eq action-cache 'swap-tab)
|
||||
(message "Swap current tab with: "))))))
|
||||
;; no match, repeat
|
||||
(t
|
||||
(message "No such candidate: %s, hit ? for help." (key-description (vector char)))))))))
|
||||
(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 (if (buffer-file-name) (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 (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,14 +0,0 @@
|
|||
(define-package "centaur-tabs" "20230607.1501" "Aesthetic, modern looking customizable tabs plugin"
|
||||
'((emacs "24.4")
|
||||
(powerline "2.4")
|
||||
(cl-lib "0.5"))
|
||||
:commit "0bb1aa18d475319df85f192dce3327802866c3c3" :authors
|
||||
'(("Emmanuel Bustos" . "ema2159@gmail.com"))
|
||||
:maintainers
|
||||
'(("Emmanuel Bustos" . "ema2159@gmail.com"))
|
||||
:maintainer
|
||||
'("Emmanuel Bustos" . "ema2159@gmail.com")
|
||||
:url "https://github.com/ema2159/centaur-tabs")
|
||||
;; Local Variables:
|
||||
;; no-byte-compile: t
|
||||
;; End:
|
||||
|
|
@ -1,218 +0,0 @@
|
|||
;;; centaur-tabs.el --- Aesthetic, modern looking customizable tabs plugin -*- lexical-binding: t; -*-
|
||||
|
||||
;; 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: Emmanuel Bustos <ema2159@gmail.com>
|
||||
;; Created: 2019-21-19 22:14:34
|
||||
;; Version: 5
|
||||
;; Known Compatibility: GNU Emacs 26.2
|
||||
;; Package-Requires: ((emacs "24.4") (powerline "2.4") (cl-lib "0.5"))
|
||||
;;
|
||||
;;
|
||||
|
||||
;;; This file is NOT part of GNU Emacs
|
||||
|
||||
;;; License
|
||||
;;
|
||||
;; 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, 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:
|
||||
;;
|
||||
;; Emacs plugin aiming to become an aesthetic, modern looking tabs plugin.
|
||||
;;
|
||||
;; This package offers tabs with a wide range of customization options, both
|
||||
;; aesthetical and functional, implementing them trying to follow the Emacs
|
||||
;; philosophy packing them with useful keybindings and a nice integration
|
||||
;; with the Emacs environment, without sacrificing customizability.
|
||||
;; Some of the features Centaur tabs offers are:
|
||||
;; - Tab styles
|
||||
;; - Tab icons
|
||||
;; - Graying out icons
|
||||
;; - Selected tab bar (over, under and left bar)
|
||||
;; - Close button
|
||||
;; - Modified marker
|
||||
;; - Buffer grouping
|
||||
;; - Projectile integration
|
||||
;; - Ivy and Helm integration for group switching
|
||||
;;
|
||||
|
||||
;;; Code:
|
||||
;;; Requires
|
||||
(require 'centaur-tabs-elements)
|
||||
(require 'centaur-tabs-functions)
|
||||
(require 'centaur-tabs-interactive)
|
||||
;;;;;;;;;;;;;;;;;;;;;;; Centaur-Tabs source code ;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgroup centaur-tabs nil
|
||||
"Display a tab bar in the header line."
|
||||
:group 'convenience)
|
||||
|
||||
(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
|
||||
(define-minor-mode centaur-tabs-local-mode
|
||||
"Toggle local display of the tab bar.
|
||||
With prefix argument ARG, turn on if positive, otherwise off.
|
||||
Returns non-nil if the new state is enabled.
|
||||
When turned on, if a local header line is shown, it is hidden to show
|
||||
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."
|
||||
:group 'centaur-tabs
|
||||
:global nil
|
||||
(unless (centaur-tabs-mode-on-p)
|
||||
(error "Centaur-Tabs mode must be enabled"))
|
||||
;;; 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))
|
||||
;;; 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))
|
||||
;; The tab bar is locally hidden, show it again.
|
||||
(kill-local-variable centaur-tabs-display-line-format))))
|
||||
|
||||
;;; Centaur-Tabs mode
|
||||
;;
|
||||
(defvar centaur-tabs--global-hlf nil)
|
||||
|
||||
;;;###autoload
|
||||
(define-minor-mode centaur-tabs-mode
|
||||
"Toggle display of a tab bar in the header line.
|
||||
With prefix argument ARG, turn on if positive, otherwise off.
|
||||
Returns non-nil if the new state is enabled.
|
||||
|
||||
\\{centaur-tabs-mode-map}"
|
||||
:group 'centaur-tabs
|
||||
:require 'centaur-tabs
|
||||
:global t
|
||||
:keymap centaur-tabs-mode-map
|
||||
(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))
|
||||
;;; 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))
|
||||
;; Restore previous `centaur-tabs-display-line-format'.
|
||||
(set-default centaur-tabs-display-line-format centaur-tabs--global-hlf)
|
||||
(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
|
||||
)
|
||||
;; 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)
|
||||
(set-face-attribute 'centaur-tabs-selected-modified nil
|
||||
:underline (face-background 'centaur-tabs-active-bar-face nil 'default)
|
||||
:overline nil)
|
||||
(set-face-attribute 'centaur-tabs-unselected nil
|
||||
:underline nil
|
||||
:overline nil)
|
||||
(set-face-attribute 'centaur-tabs-unselected-modified 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)
|
||||
(set-face-attribute 'centaur-tabs-selected-modified nil
|
||||
:overline (face-background 'centaur-tabs-active-bar-face nil 'default)
|
||||
:underline nil)
|
||||
(set-face-attribute 'centaur-tabs-unselected nil
|
||||
:overline nil
|
||||
:underline nil)
|
||||
(set-face-attribute 'centaur-tabs-unselected-modified nil
|
||||
: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-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-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-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,85 +0,0 @@
|
|||
;;; centaur-tabs-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*-
|
||||
;; Generated by the `loaddefs-generate' function.
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path)))
|
||||
|
||||
|
||||
|
||||
;;; Generated autoloads from centaur-tabs.el
|
||||
|
||||
(autoload 'centaur-tabs-local-mode "centaur-tabs" "\
|
||||
Toggle local display of the tab bar.
|
||||
With prefix argument ARG, turn on if positive, otherwise off.
|
||||
Returns non-nil if the new state is enabled.
|
||||
When turned on, if a local header line is shown, it is hidden to show
|
||||
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)
|
||||
(defvar centaur-tabs-mode nil "\
|
||||
Non-nil if Centaur-Tabs mode is enabled.
|
||||
See the `centaur-tabs-mode' command
|
||||
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.
|
||||
Returns non-nil if the new state is enabled.
|
||||
|
||||
\\{centaur-tabs-mode-map}
|
||||
|
||||
(fn &optional ARG)" t)
|
||||
(register-definition-prefixes "centaur-tabs" '("centaur-tabs-"))
|
||||
|
||||
|
||||
;;; Generated autoloads from centaur-tabs-elements.el
|
||||
|
||||
(register-definition-prefixes "centaur-tabs-elements" '("centaur-tabs-"))
|
||||
|
||||
|
||||
;;; 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)
|
||||
(autoload 'centaur-tabs-forward "centaur-tabs-functions" "\
|
||||
Select the next available tab.
|
||||
Depend on the setting of the option `centaur-tabs-cycle-scope'." t)
|
||||
(autoload 'centaur-tabs-backward-group "centaur-tabs-functions" "\
|
||||
Go to selected tab in the previous available group." t)
|
||||
(autoload 'centaur-tabs-forward-group "centaur-tabs-functions" "\
|
||||
Go to selected tab in the next available group." t)
|
||||
(autoload 'centaur-tabs-backward-tab "centaur-tabs-functions" "\
|
||||
Select the previous visible tab." t)
|
||||
(autoload 'centaur-tabs-forward-tab "centaur-tabs-functions" "\
|
||||
Select the next visible tab." t)
|
||||
(register-definition-prefixes "centaur-tabs-functions" '("centaur-tabs-"))
|
||||
|
||||
|
||||
;;; 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)
|
||||
(register-definition-prefixes "centaur-tabs-interactive" '("centaur-tabs-"))
|
||||
|
||||
;;; End of scraped data
|
||||
|
||||
(provide 'centaur-tabs-autoloads)
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; no-native-compile: t
|
||||
;; coding: utf-8-emacs-unix
|
||||
;; End:
|
||||
|
||||
;;; centaur-tabs-autoloads.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
|
||||
File diff suppressed because it is too large
Load diff
|
|
@ -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,230 +0,0 @@
|
|||
;;; centaur-tabs.el --- Aesthetic, modern looking customizable tabs plugin -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2019-2024 Emmanuel Bustos
|
||||
;; Copyright (C) 2024 Jen-Chieh Shen
|
||||
|
||||
;; Filename: centaur-tabs.el
|
||||
;; Description: Provide an out of box configuration to use highly customizable tabs.
|
||||
;; URL: https://github.com/ema2159/centaur-tabs
|
||||
;; Author: Emmanuel Bustos <ema2159@gmail.com>
|
||||
;; Maintainer: Jen-Chieh Shen <jcs090218@gmail.com>
|
||||
;; Created: 2019-21-19 22:14:34
|
||||
;; Version: 3.3
|
||||
;; Known Compatibility: GNU Emacs 26.2
|
||||
;; Package-Requires: ((emacs "27.1") (powerline "2.4"))
|
||||
;; Keywords: frames
|
||||
|
||||
;;; This file is NOT part of GNU Emacs
|
||||
|
||||
;;; License
|
||||
;;
|
||||
;; 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, 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:
|
||||
;;
|
||||
;; Emacs plugin aiming to become an aesthetic, modern looking tabs plugin.
|
||||
;;
|
||||
;; This package offers tabs with a wide range of customization options, both
|
||||
;; aesthetical and functional, implementing them trying to follow the Emacs
|
||||
;; philosophy packing them with useful keybindings and a nice integration
|
||||
;; with the Emacs environment, without sacrificing customizability.
|
||||
;; Some of the features Centaur tabs offers are:
|
||||
;; - Tab styles
|
||||
;; - Tab icons
|
||||
;; - Graying out icons
|
||||
;; - Selected tab bar (over, under and left bar)
|
||||
;; - Close button
|
||||
;; - Modified marker
|
||||
;; - Buffer grouping
|
||||
;; - Projectile integration
|
||||
;; - Ivy and Helm integration for group switching
|
||||
;;
|
||||
|
||||
;;; Code:
|
||||
|
||||
(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
|
||||
"Display a tab bar in the header line."
|
||||
:group 'convenience)
|
||||
|
||||
(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
|
||||
(define-minor-mode centaur-tabs-local-mode
|
||||
"Toggle local display of the tab bar.
|
||||
With prefix argument ARG, turn on if positive, otherwise off.
|
||||
Returns non-nil if the new state is enabled.
|
||||
When turned on, if a local header line is shown, it is hidden to show
|
||||
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."
|
||||
:group 'centaur-tabs
|
||||
:global nil
|
||||
(unless (centaur-tabs-mode-on-p)
|
||||
(error "Centaur-Tabs mode must be enabled"))
|
||||
;;; 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))
|
||||
;;; 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))
|
||||
;; The tab bar is locally hidden, show it again.
|
||||
(kill-local-variable centaur-tabs-display-line-format))))
|
||||
|
||||
;;; Centaur-Tabs mode
|
||||
;;
|
||||
(defvar centaur-tabs--global-hlf nil)
|
||||
|
||||
;;;###autoload
|
||||
(define-minor-mode centaur-tabs-mode
|
||||
"Toggle display of a tab bar in the header line.
|
||||
With prefix argument ARG, turn on if positive, otherwise off.
|
||||
Returns non-nil if the new state is enabled.
|
||||
|
||||
\\{centaur-tabs-mode-map}"
|
||||
:group 'centaur-tabs
|
||||
:require 'centaur-tabs
|
||||
:global t
|
||||
:keymap centaur-tabs-mode-map
|
||||
(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))
|
||||
;;; 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))
|
||||
;; 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))
|
||||
|
||||
;;
|
||||
;;; 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)
|
||||
;; 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)
|
||||
(set-face-attribute 'centaur-tabs-selected-modified nil
|
||||
:underline (face-background 'centaur-tabs-active-bar-face nil 'default)
|
||||
:overline nil)
|
||||
(set-face-attribute 'centaur-tabs-unselected nil
|
||||
:underline nil
|
||||
:overline nil)
|
||||
(set-face-attribute 'centaur-tabs-unselected-modified 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)
|
||||
(set-face-attribute 'centaur-tabs-selected-modified nil
|
||||
:overline (face-background 'centaur-tabs-active-bar-face nil 'default)
|
||||
:underline nil)
|
||||
(set-face-attribute 'centaur-tabs-unselected 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)
|
||||
(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))
|
||||
|
||||
(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)
|
||||
(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))
|
||||
|
||||
(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 +0,0 @@
|
|||
Good signature from 066DAFCB81E42C40 GNU ELPA Signing Agent (2019) <elpasign@elpa.gnu.org> (trust undefined) created at 2022-08-25T17:05:04-0400 using RSA
|
||||
|
|
@ -1,7 +0,0 @@
|
|||
;;; Directory Local Variables
|
||||
;;; For more information see (info "(emacs) Directory Variables")
|
||||
|
||||
((emacs-lisp-mode
|
||||
(byte-compile-docstring-max-column . 100)
|
||||
(show-trailing-whitespace . t)
|
||||
(indent-tabs-mode . nil)))
|
||||
|
|
@ -1,108 +0,0 @@
|
|||
#+options: toc:nil num:nil
|
||||
#+link: compat https://todo.sr.ht/~pkal/compat/
|
||||
|
||||
* Release of "Compat" Version 28.1.2.2
|
||||
|
||||
This is a minor release that hopes to address [[compat:7]].
|
||||
|
||||
(Release <2022-08-25 Thu>)
|
||||
|
||||
* Release of "Compat" Version 28.1.2.1
|
||||
|
||||
This is a minor release adding the following changes:
|
||||
|
||||
- Add =derived-mode-p= defined in Emacs 27
|
||||
- Add =provided-mode-derived-p= defined in Emacs 27
|
||||
- Add =read-multiple-choice= defined in Emacs 26
|
||||
- Add =file-name-absolute-p= defined in Emacs 28
|
||||
|
||||
The only other notable change is that the manual has been rewritten to
|
||||
include much more documentation that had been the case previously.
|
||||
|
||||
(Release <2022-08-24 Wed>)
|
||||
|
||||
* Release of "Compat" Version 28.1.2.0
|
||||
|
||||
The main change of this release has been the major simplification of
|
||||
Compat's initialisation system, improving the situation around issues
|
||||
people had been reporting ([[compat:4]], once again) with unconventional
|
||||
or unpopular packaging systems.
|
||||
|
||||
In addition to this, the following functional changes have been made:
|
||||
|
||||
- Fix =format-prompt= of an empty string as "default" argument
|
||||
- Add =decoded-time-period= defined in Emacs 28
|
||||
- Add =subr-primitive-p= defined in Emacs 28
|
||||
|
||||
Minor improvements to manual are also part of this release.
|
||||
|
||||
(Release <2022-07-18 Mon>)
|
||||
|
||||
* Release of "Compat" Version 28.1.1.3
|
||||
|
||||
This release just contains a hot-fix for an issue introduced in the
|
||||
last version, where compat.el raises an error during byte compilation.
|
||||
See [[compat:4]].
|
||||
|
||||
(Release <2022-06-19 Sun>)
|
||||
|
||||
* Release of "Compat" Version 28.1.1.2
|
||||
|
||||
Two main changes have necessitated a new patch release:
|
||||
|
||||
1. Fix issues related to the loading of compat when uncompiled. See
|
||||
[[https://lists.sr.ht/~pkal/compat-devel/%3C20220530191000.2183047-1-jonas%40bernoul.li%3E][this thread]] for more details on the problem.
|
||||
2. Fix issues related to the loading of compat on old pre-releases
|
||||
(think of 28.0.50). See [[https://lists.sr.ht/~pkal/compat-devel/%3Cf8635d7d-e233-448f-b325-9e850363241c%40www.fastmail.com%3E][this thread]] for more details on the
|
||||
problem.
|
||||
|
||||
(Released <2022-06-22 Wed>)
|
||||
|
||||
* Release of "Compat" Version 28.1.1.1
|
||||
|
||||
This is a minor release fixing a bug in =json-serialize=, that could
|
||||
cause unintended side-effects, not related to packages using Compat
|
||||
directly (see [[compat:2]]).
|
||||
|
||||
(Released <2022-05-05 Thu>)
|
||||
|
||||
* Release of "Compat" Version 28.1.1.0
|
||||
|
||||
This release mostly fixes a number of smaller bugs that were not
|
||||
identified as of 28.1.0.0. Nevertheless these warrent a version bump,
|
||||
as some of these changes a functional. These include:
|
||||
|
||||
- The addition of the =file-attribute-*= accessor functions.
|
||||
- The addition of =file-attribute-collect=.
|
||||
- Improvements to the Texinfo manual (via Jonas Bernoulli's recent
|
||||
work on =ox-texinfo=). For the time being, the Texinfo file is
|
||||
maintained in the repository itself, next to the =MANUAL= file.
|
||||
This might change in the future.
|
||||
- Adding a prefix to =string-trim=, =string-trim-left= and
|
||||
=string-trim-right= (i.e. now =compat-string-trim=,
|
||||
=compat-string-trim-left= and =compat-string-trim-right=)
|
||||
- Improving the version inference used in the =compat-*= macros.
|
||||
This improves the compile-time optimisation that strips away
|
||||
functions that are known to be defined for a specific version.
|
||||
- The addition of generalised variable (=setf=) support for
|
||||
=compat-alist-get=.
|
||||
- The addition of =image-property= and generalised variable support
|
||||
for =image-property=.
|
||||
- The addition of the function =compat-executable-find=.
|
||||
- The addition of the function =compat-dired-get-marked-files=.
|
||||
- The addition of the function =exec-path=.
|
||||
- The addition of the function =make-lock-file-name=.
|
||||
- The addition of the function =null-device=.
|
||||
- The addition of the function =time-equal-p=.
|
||||
- The addition of the function =date-days-in-month=.
|
||||
- Handling out-of-directory byte compilation better.
|
||||
- Fixing the usage and edge-cases of =and-let*=.
|
||||
|
||||
Furthermore a bug tracker was added: https://todo.sr.ht/~pkal/compat,
|
||||
which is the preferred way to report issues or feature requests.
|
||||
General problems, questions, etc. are still better discussed on the
|
||||
development mailing list: https://lists.sr.ht/~pkal/compat-devel.
|
||||
|
||||
(Released <2022-04-22 Fri>)
|
||||
|
||||
|
||||
|
|
@ -1,495 +0,0 @@
|
|||
;;; compat-24.el --- Compatibility Layer for Emacs 24.4 -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2021, 2022 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Philip Kaludercic <philipk@posteo.net>
|
||||
;; Maintainer: Compat Development <~pkal/compat-devel@lists.sr.ht>
|
||||
;; URL: https://git.sr.ht/~pkal/compat/
|
||||
;; Keywords: lisp
|
||||
|
||||
;; 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:
|
||||
|
||||
;; Find here the functionality added in Emacs 24.4, needed by older
|
||||
;; versions.
|
||||
;;
|
||||
;; Only load this library if you need to use one of the following
|
||||
;; functions:
|
||||
;;
|
||||
;; - `compat-='
|
||||
;; - `compat-<'
|
||||
;; - `compat->'
|
||||
;; - `compat-<='
|
||||
;; - `compat->='
|
||||
;; - `split-string'.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'compat-macs "compat-macs.el")
|
||||
|
||||
(compat-declare-version "24.4")
|
||||
|
||||
;;;; Defined in data.c
|
||||
|
||||
(compat-defun = (number-or-marker &rest numbers-or-markers)
|
||||
"Handle multiple arguments."
|
||||
:prefix t
|
||||
(catch 'fail
|
||||
(while numbers-or-markers
|
||||
(unless (= number-or-marker (car numbers-or-markers))
|
||||
(throw 'fail nil))
|
||||
(setq number-or-marker (pop numbers-or-markers)))
|
||||
t))
|
||||
|
||||
(compat-defun < (number-or-marker &rest numbers-or-markers)
|
||||
"Handle multiple arguments."
|
||||
:prefix t
|
||||
(catch 'fail
|
||||
(while numbers-or-markers
|
||||
(unless (< number-or-marker (car numbers-or-markers))
|
||||
(throw 'fail nil))
|
||||
(setq number-or-marker (pop numbers-or-markers)))
|
||||
t))
|
||||
|
||||
(compat-defun > (number-or-marker &rest numbers-or-markers)
|
||||
"Handle multiple arguments."
|
||||
:prefix t
|
||||
(catch 'fail
|
||||
(while numbers-or-markers
|
||||
(unless (> number-or-marker (car numbers-or-markers))
|
||||
(throw 'fail nil))
|
||||
(setq number-or-marker (pop numbers-or-markers)))
|
||||
t))
|
||||
|
||||
(compat-defun <= (number-or-marker &rest numbers-or-markers)
|
||||
"Handle multiple arguments."
|
||||
:prefix t
|
||||
(catch 'fail
|
||||
(while numbers-or-markers
|
||||
(unless (<= number-or-marker (car numbers-or-markers))
|
||||
(throw 'fail nil))
|
||||
(setq number-or-marker (pop numbers-or-markers)))
|
||||
t))
|
||||
|
||||
(compat-defun >= (number-or-marker &rest numbers-or-markers)
|
||||
"Handle multiple arguments."
|
||||
:prefix t
|
||||
(catch 'fail
|
||||
(while numbers-or-markers
|
||||
(unless (>= number-or-marker (pop numbers-or-markers))
|
||||
(throw 'fail nil)))
|
||||
t))
|
||||
|
||||
(compat-defun bool-vector-exclusive-or (a b &optional c)
|
||||
"Return A ^ B, bitwise exclusive or.
|
||||
If optional third argument C is given, store result into C.
|
||||
A, B, and C must be bool vectors of the same length.
|
||||
Return the destination vector if it changed or nil otherwise."
|
||||
(unless (bool-vector-p a)
|
||||
(signal 'wrong-type-argument (list 'bool-vector-p a)))
|
||||
(unless (bool-vector-p b)
|
||||
(signal 'wrong-type-argument (list 'bool-vector-p b)))
|
||||
(unless (or (null c) (bool-vector-p c))
|
||||
(signal 'wrong-type-argument (list 'bool-vector-p c)))
|
||||
(when (/= (length a) (length b))
|
||||
(signal 'wrong-length-argument (list (length a) (length b))))
|
||||
(let ((dest (or c (make-bool-vector (length a) nil))) changed)
|
||||
(when (/= (length a) (length dest))
|
||||
(signal 'wrong-length-argument (list (length a) (length dest))))
|
||||
(dotimes (i (length dest))
|
||||
(let ((val (not (eq (aref a i) (aref b i)))))
|
||||
(unless (eq val (aref dest i))
|
||||
(setq changed t))
|
||||
(aset dest i val)))
|
||||
(if c (and changed c) dest)))
|
||||
|
||||
(compat-defun bool-vector-union (a b &optional c)
|
||||
"Return A | B, bitwise or.
|
||||
If optional third argument C is given, store result into C.
|
||||
A, B, and C must be bool vectors of the same length.
|
||||
Return the destination vector if it changed or nil otherwise."
|
||||
(unless (bool-vector-p a)
|
||||
(signal 'wrong-type-argument (list 'bool-vector-p a)))
|
||||
(unless (bool-vector-p b)
|
||||
(signal 'wrong-type-argument (list 'bool-vector-p b)))
|
||||
(unless (or (null c) (bool-vector-p c))
|
||||
(signal 'wrong-type-argument (list 'bool-vector-p c)))
|
||||
(when (/= (length a) (length b))
|
||||
(signal 'wrong-length-argument (list (length a) (length b))))
|
||||
(let ((dest (or c (make-bool-vector (length a) nil))) changed)
|
||||
(when (/= (length a) (length dest))
|
||||
(signal 'wrong-length-argument (list (length a) (length dest))))
|
||||
(dotimes (i (length dest))
|
||||
(let ((val (or (aref a i) (aref b i))))
|
||||
(unless (eq val (aref dest i))
|
||||
(setq changed t))
|
||||
(aset dest i val)))
|
||||
(if c (and changed c) dest)))
|
||||
|
||||
(compat-defun bool-vector-intersection (a b &optional c)
|
||||
"Return A & B, bitwise and.
|
||||
If optional third argument C is given, store result into C.
|
||||
A, B, and C must be bool vectors of the same length.
|
||||
Return the destination vector if it changed or nil otherwise."
|
||||
(unless (bool-vector-p a)
|
||||
(signal 'wrong-type-argument (list 'bool-vector-p a)))
|
||||
(unless (bool-vector-p b)
|
||||
(signal 'wrong-type-argument (list 'bool-vector-p b)))
|
||||
(unless (or (null c) (bool-vector-p c))
|
||||
(signal 'wrong-type-argument (list 'bool-vector-p c)))
|
||||
(when (/= (length a) (length b))
|
||||
(signal 'wrong-length-argument (list (length a) (length b))))
|
||||
(let ((dest (or c (make-bool-vector (length a) nil))) changed)
|
||||
(when (/= (length a) (length dest))
|
||||
(signal 'wrong-length-argument (list (length a) (length dest))))
|
||||
(dotimes (i (length dest))
|
||||
(let ((val (and (aref a i) (aref b i))))
|
||||
(unless (eq val (aref dest i))
|
||||
(setq changed t))
|
||||
(aset dest i val)))
|
||||
(if c (and changed c) dest)))
|
||||
|
||||
(compat-defun bool-vector-set-difference (a b &optional c)
|
||||
"Return A &~ B, set difference.
|
||||
If optional third argument C is given, store result into C.
|
||||
A, B, and C must be bool vectors of the same length.
|
||||
Return the destination vector if it changed or nil otherwise."
|
||||
(unless (bool-vector-p a)
|
||||
(signal 'wrong-type-argument (list 'bool-vector-p a)))
|
||||
(unless (bool-vector-p b)
|
||||
(signal 'wrong-type-argument (list 'bool-vector-p b)))
|
||||
(unless (or (null c) (bool-vector-p c))
|
||||
(signal 'wrong-type-argument (list 'bool-vector-p c)))
|
||||
(when (/= (length a) (length b))
|
||||
(signal 'wrong-length-argument (list (length a) (length b))))
|
||||
(let ((dest (or c (make-bool-vector (length a) nil))) changed)
|
||||
(when (/= (length a) (length dest))
|
||||
(signal 'wrong-length-argument (list (length a) (length dest))))
|
||||
(dotimes (i (length dest))
|
||||
(let ((val (and (aref a i) (not (aref b i)))))
|
||||
(unless (eq val (aref dest i))
|
||||
(setq changed t))
|
||||
(aset dest i val)))
|
||||
(if c (and changed c) dest)))
|
||||
|
||||
(compat-defun bool-vector-not (a &optional b)
|
||||
"Compute ~A, set complement.
|
||||
If optional second argument B is given, store result into B.
|
||||
A and B must be bool vectors of the same length.
|
||||
Return the destination vector."
|
||||
(unless (bool-vector-p a)
|
||||
(signal 'wrong-type-argument (list 'bool-vector-p a)))
|
||||
(unless (or (null b) (bool-vector-p b))
|
||||
(signal 'wrong-type-argument (list 'bool-vector-p b)))
|
||||
(let ((dest (or b (make-bool-vector (length a) nil))))
|
||||
(when (/= (length a) (length dest))
|
||||
(signal 'wrong-length-argument (list (length a) (length dest))))
|
||||
(dotimes (i (length dest))
|
||||
(aset dest i (not (aref a i))))
|
||||
dest))
|
||||
|
||||
(compat-defun bool-vector-subsetp (a b)
|
||||
"Return t if every t value in A is also t in B, nil otherwise.
|
||||
A and B must be bool vectors of the same length."
|
||||
(unless (bool-vector-p a)
|
||||
(signal 'wrong-type-argument (list 'bool-vector-p a)))
|
||||
(unless (bool-vector-p b)
|
||||
(signal 'wrong-type-argument (list 'bool-vector-p b)))
|
||||
(when (/= (length a) (length b))
|
||||
(signal 'wrong-length-argument (list (length a) (length b))))
|
||||
(catch 'not-subset
|
||||
(dotimes (i (length a))
|
||||
(when (if (aref a i) (not (aref b i)) nil)
|
||||
(throw 'not-subset nil)))
|
||||
t))
|
||||
|
||||
(compat-defun bool-vector-count-consecutive (a b i)
|
||||
"Count how many consecutive elements in A equal B starting at I.
|
||||
A is a bool vector, B is t or nil, and I is an index into A."
|
||||
(unless (bool-vector-p a)
|
||||
(signal 'wrong-type-argument (list 'bool-vector-p a)))
|
||||
(setq b (and b t)) ;normalise to nil or t
|
||||
(unless (< i (length a))
|
||||
(signal 'args-out-of-range (list a i)))
|
||||
(let ((len (length a)) (n i))
|
||||
(while (and (< i len) (eq (aref a i) b))
|
||||
(setq i (1+ i)))
|
||||
(- i n)))
|
||||
|
||||
(compat-defun bool-vector-count-population (a)
|
||||
"Count how many elements in A are t.
|
||||
A is a bool vector. To count A's nil elements, subtract the
|
||||
return value from A's length."
|
||||
(unless (bool-vector-p a)
|
||||
(signal 'wrong-type-argument (list 'bool-vector-p a)))
|
||||
(let ((n 0))
|
||||
(dotimes (i (length a))
|
||||
(when (aref a i)
|
||||
(setq n (1+ n))))
|
||||
n))
|
||||
|
||||
;;;; Defined in subr.el
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defmacro with-eval-after-load (file &rest body)
|
||||
"Execute BODY after FILE is loaded.
|
||||
FILE is normally a feature name, but it can also be a file name,
|
||||
in case that file does not provide any feature. See `eval-after-load'
|
||||
for more details about the different forms of FILE and their semantics."
|
||||
(declare (indent 1) (debug (form def-body)))
|
||||
;; See https://nullprogram.com/blog/2018/02/22/ on how
|
||||
;; `eval-after-load' is used to preserve compatibility with 24.3.
|
||||
`(eval-after-load ,file `(funcall ',,`(lambda () ,@body))))
|
||||
|
||||
(compat-defun special-form-p (object)
|
||||
"Non-nil if and only if OBJECT is a special form."
|
||||
(if (and (symbolp object) (fboundp object))
|
||||
(setq object (condition-case nil
|
||||
(indirect-function object)
|
||||
(void-function nil))))
|
||||
(and (subrp object) (eq (cdr (subr-arity object)) 'unevalled)))
|
||||
|
||||
(compat-defun macrop (object)
|
||||
"Non-nil if and only if OBJECT is a macro."
|
||||
(let ((def (condition-case nil
|
||||
(indirect-function object)
|
||||
(void-function nil))))
|
||||
(when (consp def)
|
||||
(or (eq 'macro (car def))
|
||||
(and (autoloadp def) (memq (nth 4 def) '(macro t)))))))
|
||||
|
||||
(compat-defun string-suffix-p (suffix string &optional ignore-case)
|
||||
"Return non-nil if SUFFIX is a suffix of STRING.
|
||||
If IGNORE-CASE is non-nil, the comparison is done without paying
|
||||
attention to case differences."
|
||||
(let ((start-pos (- (length string) (length suffix))))
|
||||
(and (>= start-pos 0)
|
||||
(eq t (compare-strings suffix nil nil
|
||||
string start-pos nil ignore-case)))))
|
||||
|
||||
(compat-defun split-string (string &optional separators omit-nulls trim)
|
||||
"Extend `split-string' by a TRIM argument.
|
||||
The remaining arguments STRING, SEPARATORS and OMIT-NULLS are
|
||||
handled just as with `split-string'."
|
||||
:prefix t
|
||||
(let* ((token (split-string string separators omit-nulls))
|
||||
(trimmed (if trim
|
||||
(mapcar
|
||||
(lambda (token)
|
||||
(when (string-match (concat "\\`" trim) token)
|
||||
(setq token (substring token (match-end 0))))
|
||||
(when (string-match (concat trim "\\'") token)
|
||||
(setq token (substring token 0 (match-beginning 0))))
|
||||
token)
|
||||
token)
|
||||
token)))
|
||||
(if omit-nulls (delete "" trimmed) trimmed)))
|
||||
|
||||
(compat-defun delete-consecutive-dups (list &optional circular)
|
||||
"Destructively remove `equal' consecutive duplicates from LIST.
|
||||
First and last elements are considered consecutive if CIRCULAR is
|
||||
non-nil."
|
||||
(let ((tail list) last)
|
||||
(while (cdr tail)
|
||||
(if (equal (car tail) (cadr tail))
|
||||
(setcdr tail (cddr tail))
|
||||
(setq last tail
|
||||
tail (cdr tail))))
|
||||
(if (and circular
|
||||
last
|
||||
(equal (car tail) (car list)))
|
||||
(setcdr last nil)))
|
||||
list)
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defun define-error (name message &optional parent)
|
||||
"Define NAME as a new error signal.
|
||||
MESSAGE is a string that will be output to the echo area if such an error
|
||||
is signaled without being caught by a `condition-case'.
|
||||
PARENT is either a signal or a list of signals from which it inherits.
|
||||
Defaults to `error'."
|
||||
(unless parent (setq parent 'error))
|
||||
(let ((conditions
|
||||
(if (consp parent)
|
||||
(apply #'append
|
||||
(mapcar (lambda (parent)
|
||||
(cons parent
|
||||
(or (get parent 'error-conditions)
|
||||
(error "Unknown signal `%s'" parent))))
|
||||
parent))
|
||||
(cons parent (get parent 'error-conditions)))))
|
||||
(put name 'error-conditions
|
||||
(delete-dups (copy-sequence (cons name conditions))))
|
||||
(when message (put name 'error-message message))))
|
||||
|
||||
;;;; Defined in minibuffer.el
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defun completion-table-with-cache (fun &optional ignore-case)
|
||||
"Create dynamic completion table from function FUN, with cache.
|
||||
This is a wrapper for `completion-table-dynamic' that saves the last
|
||||
argument-result pair from FUN, so that several lookups with the
|
||||
same argument (or with an argument that starts with the first one)
|
||||
only need to call FUN once. This can be useful when FUN performs a
|
||||
relatively slow operation, such as calling an external process.
|
||||
|
||||
When IGNORE-CASE is non-nil, FUN is expected to be case-insensitive."
|
||||
(let* (last-arg last-result
|
||||
(new-fun
|
||||
(lambda (arg)
|
||||
(if (and last-arg (string-prefix-p last-arg arg ignore-case))
|
||||
last-result
|
||||
(prog1
|
||||
(setq last-result (funcall fun arg))
|
||||
(setq last-arg arg))))))
|
||||
(completion-table-dynamic new-fun)))
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defun completion-table-merge (&rest tables)
|
||||
"Create a completion table that collects completions from all TABLES."
|
||||
(lambda (string pred action)
|
||||
(cond
|
||||
((null action)
|
||||
(let ((retvals (mapcar (lambda (table)
|
||||
(try-completion string table pred))
|
||||
tables)))
|
||||
(if (member string retvals)
|
||||
string
|
||||
(try-completion string
|
||||
(mapcar (lambda (value)
|
||||
(if (eq value t) string value))
|
||||
(delq nil retvals))
|
||||
pred))))
|
||||
((eq action t)
|
||||
(apply #'append (mapcar (lambda (table)
|
||||
(all-completions string table pred))
|
||||
tables)))
|
||||
(t
|
||||
(completion--some (lambda (table)
|
||||
(complete-with-action action table string pred))
|
||||
tables)))))
|
||||
|
||||
;;;; Defined in subr-x.el
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-advise require (feature &rest args)
|
||||
"Allow for Emacs 24.x to require the inexistent FEATURE subr-x."
|
||||
;; As the compatibility advise around `require` is more a hack than
|
||||
;; of of actual value, the highlighting is suppressed.
|
||||
:no-highlight t
|
||||
(if (eq feature 'subr-x)
|
||||
(let ((entry (assq feature after-load-alist)))
|
||||
(let ((load-file-name nil))
|
||||
(dolist (form (cdr entry))
|
||||
(funcall (eval form t)))))
|
||||
(apply oldfun feature args)))
|
||||
|
||||
(compat-defun hash-table-keys (hash-table)
|
||||
"Return a list of keys in HASH-TABLE."
|
||||
(let (values)
|
||||
(maphash
|
||||
(lambda (k _v) (push k values))
|
||||
hash-table)
|
||||
values))
|
||||
|
||||
(compat-defun hash-table-values (hash-table)
|
||||
"Return a list of values in HASH-TABLE."
|
||||
(let (values)
|
||||
(maphash
|
||||
(lambda (_k v) (push v values))
|
||||
hash-table)
|
||||
values))
|
||||
|
||||
(compat-defun string-empty-p (string)
|
||||
"Check whether STRING is empty."
|
||||
(string= string ""))
|
||||
|
||||
(compat-defun string-join (strings &optional separator)
|
||||
"Join all STRINGS using SEPARATOR.
|
||||
Optional argument SEPARATOR must be a string, a vector, or a list of
|
||||
characters; nil stands for the empty string."
|
||||
(mapconcat #'identity strings separator))
|
||||
|
||||
(compat-defun string-blank-p (string)
|
||||
"Check whether STRING is either empty or only whitespace.
|
||||
The following characters count as whitespace here: space, tab, newline and
|
||||
carriage return."
|
||||
(string-match-p "\\`[ \t\n\r]*\\'" string))
|
||||
|
||||
(compat-defun string-remove-prefix (prefix string)
|
||||
"Remove PREFIX from STRING if present."
|
||||
(if (string-prefix-p prefix string)
|
||||
(substring string (length prefix))
|
||||
string))
|
||||
|
||||
(compat-defun string-remove-suffix (suffix string)
|
||||
"Remove SUFFIX from STRING if present."
|
||||
(if (string-suffix-p suffix string)
|
||||
(substring string 0 (- (length string) (length suffix)))
|
||||
string))
|
||||
|
||||
;;;; Defined in faces.el
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defun face-spec-set (face spec &optional spec-type)
|
||||
"Set the FACE's spec SPEC, define FACE, and recalculate its attributes.
|
||||
See `defface' for the format of SPEC.
|
||||
|
||||
The appearance of each face is controlled by its specs (set via
|
||||
this function), and by the internal frame-specific face
|
||||
attributes (set via `set-face-attribute').
|
||||
|
||||
This function also defines FACE as a valid face name if it is not
|
||||
already one, and (re)calculates its attributes on existing
|
||||
frames.
|
||||
|
||||
The optional argument SPEC-TYPE determines which spec to set:
|
||||
nil, omitted or `face-override-spec' means the override spec,
|
||||
which overrides all the other types of spec mentioned below
|
||||
(this is usually what you want if calling this function
|
||||
outside of Custom code);
|
||||
`customized-face' or `saved-face' means the customized spec or
|
||||
the saved custom spec;
|
||||
`face-defface-spec' means the default spec
|
||||
(usually set only via `defface');
|
||||
`reset' means to ignore SPEC, but clear the `customized-face'
|
||||
and `face-override-spec' specs;
|
||||
Any other value means not to set any spec, but to run the
|
||||
function for defining FACE and recalculating its attributes."
|
||||
(if (get face 'face-alias)
|
||||
(setq face (get face 'face-alias)))
|
||||
;; Save SPEC to the relevant symbol property.
|
||||
(unless spec-type
|
||||
(setq spec-type 'face-override-spec))
|
||||
(if (memq spec-type '(face-defface-spec face-override-spec
|
||||
customized-face saved-face))
|
||||
(put face spec-type spec))
|
||||
(if (memq spec-type '(reset saved-face))
|
||||
(put face 'customized-face nil))
|
||||
;; Setting the face spec via Custom empties out any override spec,
|
||||
;; similar to how setting a variable via Custom changes its values.
|
||||
(if (memq spec-type '(customized-face saved-face reset))
|
||||
(put face 'face-override-spec nil))
|
||||
;; If we reset the face based on its custom spec, it is unmodified
|
||||
;; as far as Custom is concerned.
|
||||
(unless (eq face 'face-override-spec)
|
||||
(put face 'face-modified nil))
|
||||
;; Initialize the face if it does not exist, then recalculate.
|
||||
(make-empty-face face)
|
||||
(dolist (frame (frame-list))
|
||||
(face-spec-recalc face frame)))
|
||||
|
||||
(compat--inhibit-prefixed (provide 'compat-24))
|
||||
;;; compat-24.el ends here
|
||||
|
|
@ -1,322 +0,0 @@
|
|||
;;; compat-25.el --- Compatibility Layer for Emacs 25.1 -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2021, 2022 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Philip Kaludercic <philipk@posteo.net>
|
||||
;; Maintainer: Compat Development <~pkal/compat-devel@lists.sr.ht>
|
||||
;; URL: https://git.sr.ht/~pkal/compat/
|
||||
;; Keywords: lisp
|
||||
|
||||
;; 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:
|
||||
|
||||
;; Find here the functionality added in Emacs 25.1, needed by older
|
||||
;; versions.
|
||||
;;
|
||||
;; Only load this library if you need to use one of the following
|
||||
;; functions:
|
||||
;;
|
||||
;; - `compat-sort'
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'compat-macs "compat-macs.el")
|
||||
|
||||
(compat-declare-version "25.1")
|
||||
|
||||
;;;; Defined in alloc.c
|
||||
|
||||
(compat-defun bool-vector (&rest objects)
|
||||
"Return a new bool-vector with specified arguments as elements.
|
||||
Allows any number of arguments, including zero.
|
||||
usage: (bool-vector &rest OBJECTS)"
|
||||
(let ((vec (make-bool-vector (length objects) nil))
|
||||
(i 0))
|
||||
(while objects
|
||||
(when (car objects)
|
||||
(aset vec i t))
|
||||
(setq objects (cdr objects)
|
||||
i (1+ i)))
|
||||
vec))
|
||||
|
||||
;;;; Defined in fns.c
|
||||
|
||||
(compat-defun sort (seq predicate)
|
||||
"Extend `sort' to sort SEQ as a vector."
|
||||
:prefix t
|
||||
(cond
|
||||
((listp seq)
|
||||
(sort seq predicate))
|
||||
((vectorp seq)
|
||||
(let ((cseq (sort (append seq nil) predicate)))
|
||||
(dotimes (i (length cseq))
|
||||
(setf (aref seq i) (nth i cseq)))
|
||||
(apply #'vector cseq)))
|
||||
((signal 'wrong-type-argument 'list-or-vector-p))))
|
||||
|
||||
;;;; Defined in editfns.c
|
||||
|
||||
(compat-defun format-message (string &rest objects)
|
||||
"Format a string out of a format-string and arguments.
|
||||
The first argument is a format control string.
|
||||
The other arguments are substituted into it to make the result, a string.
|
||||
|
||||
This implementation is equivalent to `format'."
|
||||
(apply #'format string objects))
|
||||
|
||||
;;;; Defined in minibuf.c
|
||||
|
||||
;; TODO advise read-buffer to handle 4th argument
|
||||
|
||||
;;;; Defined in fileio.c
|
||||
|
||||
(compat-defun directory-name-p (name)
|
||||
"Return non-nil if NAME ends with a directory separator character."
|
||||
:realname compat--directory-name-p
|
||||
(eq (eval-when-compile
|
||||
(if (memq system-type '(cygwin windows-nt ms-dos))
|
||||
?\\ ?/))
|
||||
(aref name (1- (length name)))))
|
||||
|
||||
;;;; Defined in subr.el
|
||||
|
||||
(compat-defun string-greaterp (string1 string2)
|
||||
"Return non-nil if STRING1 is greater than STRING2 in lexicographic order.
|
||||
Case is significant.
|
||||
Symbols are also allowed; their print names are used instead."
|
||||
(string-lessp string2 string1))
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defmacro with-file-modes (modes &rest body)
|
||||
"Execute BODY with default file permissions temporarily set to MODES.
|
||||
MODES is as for `set-default-file-modes'."
|
||||
(declare (indent 1) (debug t))
|
||||
(let ((umask (make-symbol "umask")))
|
||||
`(let ((,umask (default-file-modes)))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(set-default-file-modes ,modes)
|
||||
,@body)
|
||||
(set-default-file-modes ,umask)))))
|
||||
|
||||
(compat-defun alist-get (key alist &optional default remove testfn)
|
||||
"Find the first element of ALIST whose `car' equals KEY and return its `cdr'.
|
||||
If KEY is not found in ALIST, return DEFAULT.
|
||||
Equality with KEY is tested by TESTFN, defaulting to `eq'."
|
||||
:realname compat--alist-get-full-elisp
|
||||
(ignore remove)
|
||||
(let (entry)
|
||||
(cond
|
||||
((or (null testfn) (eq testfn 'eq))
|
||||
(setq entry (assq key alist)))
|
||||
((eq testfn 'equal)
|
||||
(setq entry (assoc key alist)))
|
||||
((catch 'found
|
||||
(dolist (ent alist)
|
||||
(when (and (consp ent) (funcall testfn (car ent) key))
|
||||
(throw 'found (setq entry ent))))
|
||||
default)))
|
||||
(if entry (cdr entry) default)))
|
||||
|
||||
;;;; Defined in subr-x.el
|
||||
|
||||
(compat-defmacro if-let (spec then &rest else)
|
||||
"Bind variables according to SPEC and evaluate THEN or ELSE.
|
||||
Evaluate each binding in turn, as in `let*', stopping if a
|
||||
binding value is nil. If all are non-nil return the value of
|
||||
THEN, otherwise the last form in ELSE.
|
||||
|
||||
Each element of SPEC is a list (SYMBOL VALUEFORM) that binds
|
||||
SYMBOL to the value of VALUEFORM. An element can additionally be
|
||||
of the form (VALUEFORM), which is evaluated and checked for nil;
|
||||
i.e. SYMBOL can be omitted if only the test result is of
|
||||
interest. It can also be of the form SYMBOL, then the binding of
|
||||
SYMBOL is checked for nil.
|
||||
|
||||
As a special case, interprets a SPEC of the form \(SYMBOL SOMETHING)
|
||||
like \((SYMBOL SOMETHING)). This exists for backward compatibility
|
||||
with an old syntax that accepted only one binding."
|
||||
:realname compat--if-let
|
||||
:feature 'subr-x
|
||||
(declare (indent 2)
|
||||
(debug ([&or (symbolp form)
|
||||
(&rest [&or symbolp (symbolp form) (form)])]
|
||||
body)))
|
||||
(when (and (<= (length spec) 2)
|
||||
(not (listp (car spec))))
|
||||
;; Adjust the single binding case
|
||||
(setq spec (list spec)))
|
||||
`(compat--if-let* ,spec ,then ,(macroexp-progn else)))
|
||||
|
||||
(compat-defmacro when-let (spec &rest body)
|
||||
"Bind variables according to SPEC and conditionally evaluate BODY.
|
||||
Evaluate each binding in turn, stopping if a binding value is nil.
|
||||
If all are non-nil, return the value of the last form in BODY.
|
||||
|
||||
The variable list SPEC is the same as in `if-let'."
|
||||
:feature 'subr-x
|
||||
(declare (indent 1) (debug if-let))
|
||||
`(compat--if-let ,spec ,(macroexp-progn body)))
|
||||
|
||||
(compat-defmacro thread-first (&rest forms)
|
||||
"Thread FORMS elements as the first argument of their successor.
|
||||
Example:
|
||||
(thread-first
|
||||
5
|
||||
(+ 20)
|
||||
(/ 25)
|
||||
-
|
||||
(+ 40))
|
||||
Is equivalent to:
|
||||
(+ (- (/ (+ 5 20) 25)) 40)
|
||||
Note how the single `-' got converted into a list before
|
||||
threading."
|
||||
:feature 'subr-x
|
||||
(declare (indent 1)
|
||||
(debug (form &rest [&or symbolp (sexp &rest form)])))
|
||||
(let ((body (car forms)))
|
||||
(dolist (form (cdr forms))
|
||||
(when (symbolp form)
|
||||
(setq form (list form)))
|
||||
(setq body (append (list (car form))
|
||||
(list body)
|
||||
(cdr form))))
|
||||
body))
|
||||
|
||||
(compat-defmacro thread-last (&rest forms)
|
||||
"Thread FORMS elements as the last argument of their successor.
|
||||
Example:
|
||||
(thread-last
|
||||
5
|
||||
(+ 20)
|
||||
(/ 25)
|
||||
-
|
||||
(+ 40))
|
||||
Is equivalent to:
|
||||
(+ 40 (- (/ 25 (+ 20 5))))
|
||||
Note how the single `-' got converted into a list before
|
||||
threading."
|
||||
:feature 'subr-x
|
||||
(declare (indent 1) (debug thread-first))
|
||||
(let ((body (car forms)))
|
||||
(dolist (form (cdr forms))
|
||||
(when (symbolp form)
|
||||
(setq form (list form)))
|
||||
(setq body (append form (list body))))
|
||||
body))
|
||||
|
||||
;;;; Defined in macroexp.el
|
||||
|
||||
(declare-function macrop nil (object))
|
||||
(compat-defun macroexpand-1 (form &optional environment)
|
||||
"Perform (at most) one step of macro expansion."
|
||||
:feature 'macroexp
|
||||
(cond
|
||||
((consp form)
|
||||
(let* ((head (car form))
|
||||
(env-expander (assq head environment)))
|
||||
(if env-expander
|
||||
(if (cdr env-expander)
|
||||
(apply (cdr env-expander) (cdr form))
|
||||
form)
|
||||
(if (not (and (symbolp head) (fboundp head)))
|
||||
form
|
||||
(let ((def (autoload-do-load (symbol-function head) head 'macro)))
|
||||
(cond
|
||||
;; Follow alias, but only for macros, otherwise we may end up
|
||||
;; skipping an important compiler-macro (e.g. cl--block-wrapper).
|
||||
((and (symbolp def) (macrop def)) (cons def (cdr form)))
|
||||
((not (consp def)) form)
|
||||
(t
|
||||
(if (eq 'macro (car def))
|
||||
(apply (cdr def) (cdr form))
|
||||
form))))))))
|
||||
(t form)))
|
||||
|
||||
;;;; Defined in byte-run.el
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defun function-put (func prop value)
|
||||
"Set FUNCTION's property PROP to VALUE.
|
||||
The namespace for PROP is shared with symbols.
|
||||
So far, FUNCTION can only be a symbol, not a lambda expression."
|
||||
:version "24.4"
|
||||
(put func prop value))
|
||||
|
||||
;;;; Defined in files.el
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defun directory-files-recursively
|
||||
(dir regexp &optional include-directories predicate follow-symlinks)
|
||||
"Return list of all files under directory DIR whose names match REGEXP.
|
||||
This function works recursively. Files are returned in \"depth
|
||||
first\" order, and files from each directory are sorted in
|
||||
alphabetical order. Each file name appears in the returned list
|
||||
in its absolute form.
|
||||
|
||||
By default, the returned list excludes directories, but if
|
||||
optional argument INCLUDE-DIRECTORIES is non-nil, they are
|
||||
included.
|
||||
|
||||
PREDICATE can be either nil (which means that all subdirectories
|
||||
of DIR are descended into), t (which means that subdirectories that
|
||||
can't be read are ignored), or a function (which is called with
|
||||
the name of each subdirectory, and should return non-nil if the
|
||||
subdirectory is to be descended into).
|
||||
|
||||
If FOLLOW-SYMLINKS is non-nil, symbolic links that point to
|
||||
directories are followed. Note that this can lead to infinite
|
||||
recursion."
|
||||
:realname compat--directory-files-recursively
|
||||
(let* ((result nil)
|
||||
(files nil)
|
||||
(dir (directory-file-name dir))
|
||||
;; When DIR is "/", remote file names like "/method:" could
|
||||
;; also be offered. We shall suppress them.
|
||||
(tramp-mode (and tramp-mode (file-remote-p (expand-file-name dir)))))
|
||||
(dolist (file (sort (file-name-all-completions "" dir)
|
||||
'string<))
|
||||
(unless (member file '("./" "../"))
|
||||
(if (directory-name-p file)
|
||||
(let* ((leaf (substring file 0 (1- (length file))))
|
||||
(full-file (concat dir "/" leaf)))
|
||||
;; Don't follow symlinks to other directories.
|
||||
(when (and (or (not (file-symlink-p full-file))
|
||||
(and (file-symlink-p full-file)
|
||||
follow-symlinks))
|
||||
;; Allow filtering subdirectories.
|
||||
(or (eq predicate nil)
|
||||
(eq predicate t)
|
||||
(funcall predicate full-file)))
|
||||
(let ((sub-files
|
||||
(if (eq predicate t)
|
||||
(condition-case nil
|
||||
(compat--directory-files-recursively
|
||||
full-file regexp include-directories
|
||||
predicate follow-symlinks)
|
||||
(file-error nil))
|
||||
(compat--directory-files-recursively
|
||||
full-file regexp include-directories
|
||||
predicate follow-symlinks))))
|
||||
(setq result (nconc result sub-files))))
|
||||
(when (and include-directories
|
||||
(string-match regexp leaf))
|
||||
(setq result (nconc result (list full-file)))))
|
||||
(when (string-match regexp file)
|
||||
(push (concat dir "/" file) files)))))
|
||||
(nconc result (nreverse files))))
|
||||
|
||||
(compat--inhibit-prefixed (provide 'compat-25))
|
||||
;;; compat-25.el ends here
|
||||
|
|
@ -1,675 +0,0 @@
|
|||
;;; compat-26.el --- Compatibility Layer for Emacs 26.1 -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2021, 2022 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Philip Kaludercic <philipk@posteo.net>
|
||||
;; Maintainer: Compat Development <~pkal/compat-devel@lists.sr.ht>
|
||||
;; URL: https://git.sr.ht/~pkal/compat/
|
||||
;; Keywords: lisp
|
||||
|
||||
;; 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:
|
||||
|
||||
;; Find here the functionality added in Emacs 26.1, needed by older
|
||||
;; versions.
|
||||
;;
|
||||
;; Only load this library if you need to use one of the following
|
||||
;; functions:
|
||||
;;
|
||||
;; - `compat-sort'
|
||||
;; - `line-number-at-pos'
|
||||
;; - `compat-alist-get'
|
||||
;; - `string-trim-left'
|
||||
;; - `string-trim-right'
|
||||
;; - `string-trim'
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'compat-macs "compat-macs.el")
|
||||
|
||||
(compat-declare-version "26.1")
|
||||
|
||||
;;;; Defined in eval.c
|
||||
|
||||
(compat-defun func-arity (func)
|
||||
"Return minimum and maximum number of args allowed for FUNC.
|
||||
FUNC must be a function of some kind.
|
||||
The returned value is a cons cell (MIN . MAX). MIN is the minimum number
|
||||
of args. MAX is the maximum number, or the symbol `many', for a
|
||||
function with `&rest' args, or `unevalled' for a special form."
|
||||
:realname compat--func-arity
|
||||
(cond
|
||||
((or (null func) (and (symbolp func) (not (fboundp func))))
|
||||
(signal 'void-function func))
|
||||
((and (symbolp func) (not (null func)))
|
||||
(compat--func-arity (symbol-function func)))
|
||||
((eq (car-safe func) 'macro)
|
||||
(compat--func-arity (cdr func)))
|
||||
((subrp func)
|
||||
(subr-arity func))
|
||||
((memq (car-safe func) '(closure lambda))
|
||||
;; See lambda_arity from eval.c
|
||||
(when (eq (car func) 'closure)
|
||||
(setq func (cdr func)))
|
||||
(let ((syms-left (if (consp func)
|
||||
(car func)
|
||||
(signal 'invalid-function func)))
|
||||
(min-args 0) (max-args 0) optional)
|
||||
(catch 'many
|
||||
(dolist (next syms-left)
|
||||
(cond
|
||||
((not (symbolp next))
|
||||
(signal 'invalid-function func))
|
||||
((eq next '&rest)
|
||||
(throw 'many (cons min-args 'many)))
|
||||
((eq next '&optional)
|
||||
(setq optional t))
|
||||
(t (unless optional
|
||||
(setq min-args (1+ min-args)))
|
||||
(setq max-args (1+ max-args)))))
|
||||
(cons min-args max-args))))
|
||||
((and (byte-code-function-p func) (numberp (aref func 0)))
|
||||
;; See get_byte_code_arity from bytecode.c
|
||||
(let ((at (aref func 0)))
|
||||
(cons (logand at 127)
|
||||
(if (= (logand at 128) 0)
|
||||
(ash at -8)
|
||||
'many))))
|
||||
((and (byte-code-function-p func) (numberp (aref func 0)))
|
||||
;; See get_byte_code_arity from bytecode.c
|
||||
(let ((at (aref func 0)))
|
||||
(cons (logand at 127)
|
||||
(if (= (logand at 128) 0)
|
||||
(ash at -8)
|
||||
'many))))
|
||||
((and (byte-code-function-p func) (listp (aref func 0)))
|
||||
;; Based on `byte-compile-make-args-desc', this is required for
|
||||
;; old versions of Emacs that don't use a integer for the argument
|
||||
;; list description, per e2abe5a13dffb08d6371b6a611bc39c3a9ac2bc6.
|
||||
(let ((arglist (aref func 0)) (mandatory 0) nonrest)
|
||||
(while (and arglist (not (memq (car arglist) '(&optional &rest))))
|
||||
(setq mandatory (1+ mandatory))
|
||||
(setq arglist (cdr arglist)))
|
||||
(setq nonrest mandatory)
|
||||
(when (eq (car arglist) '&optional)
|
||||
(setq arglist (cdr arglist))
|
||||
(while (and arglist (not (eq (car arglist) '&rest)))
|
||||
(setq nonrest (1+ nonrest))
|
||||
(setq arglist (cdr arglist))))
|
||||
(cons mandatory (if arglist 'many nonrest))))
|
||||
((autoloadp func)
|
||||
(autoload-do-load func)
|
||||
(compat--func-arity func))
|
||||
((signal 'invalid-function func))))
|
||||
|
||||
;;;; Defined in fns.c
|
||||
|
||||
(compat-defun assoc (key alist &optional testfn)
|
||||
"Handle the optional argument TESTFN.
|
||||
Equality is defined by the function TESTFN, defaulting to
|
||||
`equal'. TESTFN is called with 2 arguments: a car of an alist
|
||||
element and KEY. With no optional argument, the function behaves
|
||||
just like `assoc'."
|
||||
:prefix t
|
||||
(if testfn
|
||||
(catch 'found
|
||||
(dolist (ent alist)
|
||||
(when (funcall testfn (car ent) key)
|
||||
(throw 'found ent))))
|
||||
(assoc key alist)))
|
||||
|
||||
(compat-defun mapcan (func sequence)
|
||||
"Apply FUNC to each element of SEQUENCE.
|
||||
Concatenate the results by altering them (using `nconc').
|
||||
SEQUENCE may be a list, a vector, a boolean vector, or a string."
|
||||
(apply #'nconc (mapcar func sequence)))
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defun line-number-at-pos (&optional position absolute)
|
||||
"Handle optional argument ABSOLUTE:
|
||||
|
||||
If the buffer is narrowed, the return value by default counts the lines
|
||||
from the beginning of the accessible portion of the buffer. But if the
|
||||
second optional argument ABSOLUTE is non-nil, the value counts the lines
|
||||
from the absolute start of the buffer, disregarding the narrowing."
|
||||
:prefix t
|
||||
(if absolute
|
||||
(save-restriction
|
||||
(widen)
|
||||
(line-number-at-pos position))
|
||||
(line-number-at-pos position)))
|
||||
|
||||
;;;; Defined in subr.el
|
||||
|
||||
(declare-function compat--alist-get-full-elisp "compat-25"
|
||||
(key alist &optional default remove testfn))
|
||||
(compat-defun alist-get (key alist &optional default remove testfn)
|
||||
"Handle TESTFN manually."
|
||||
:realname compat--alist-get-handle-testfn
|
||||
:prefix t
|
||||
(if testfn
|
||||
(compat--alist-get-full-elisp key alist default remove testfn)
|
||||
(alist-get key alist default remove)))
|
||||
|
||||
(gv-define-expander compat-alist-get
|
||||
(lambda (do key alist &optional default remove testfn)
|
||||
(macroexp-let2 macroexp-copyable-p k key
|
||||
(gv-letplace (getter setter) alist
|
||||
(macroexp-let2 nil p `(if (and ,testfn (not (eq ,testfn 'eq)))
|
||||
(compat-assoc ,k ,getter ,testfn)
|
||||
(assq ,k ,getter))
|
||||
(funcall do (if (null default) `(cdr ,p)
|
||||
`(if ,p (cdr ,p) ,default))
|
||||
(lambda (v)
|
||||
(macroexp-let2 nil v v
|
||||
(let ((set-exp
|
||||
`(if ,p (setcdr ,p ,v)
|
||||
,(funcall setter
|
||||
`(cons (setq ,p (cons ,k ,v))
|
||||
,getter)))))
|
||||
`(progn
|
||||
,(cond
|
||||
((null remove) set-exp)
|
||||
((or (eql v default)
|
||||
(and (eq (car-safe v) 'quote)
|
||||
(eq (car-safe default) 'quote)
|
||||
(eql (cadr v) (cadr default))))
|
||||
`(if ,p ,(funcall setter `(delq ,p ,getter))))
|
||||
(t
|
||||
`(cond
|
||||
((not (eql ,default ,v)) ,set-exp)
|
||||
(,p ,(funcall setter
|
||||
`(delq ,p ,getter))))))
|
||||
,v))))))))))
|
||||
|
||||
(compat-defun string-trim-left (string &optional regexp)
|
||||
"Trim STRING of leading string matching REGEXP.
|
||||
|
||||
REGEXP defaults to \"[ \\t\\n\\r]+\"."
|
||||
:realname compat--string-trim-left
|
||||
:prefix t
|
||||
(if (string-match (concat "\\`\\(?:" (or regexp "[ \t\n\r]+") "\\)") string)
|
||||
(substring string (match-end 0))
|
||||
string))
|
||||
|
||||
(compat-defun string-trim-right (string &optional regexp)
|
||||
"Trim STRING of trailing string matching REGEXP.
|
||||
|
||||
REGEXP defaults to \"[ \\t\\n\\r]+\"."
|
||||
:realname compat--string-trim-right
|
||||
:prefix t
|
||||
(let ((i (string-match-p
|
||||
(concat "\\(?:" (or regexp "[ \t\n\r]+") "\\)\\'")
|
||||
string)))
|
||||
(if i (substring string 0 i) string)))
|
||||
|
||||
(compat-defun string-trim (string &optional trim-left trim-right)
|
||||
"Trim STRING of leading with and trailing matching TRIM-LEFT and TRIM-RIGHT.
|
||||
|
||||
TRIM-LEFT and TRIM-RIGHT default to \"[ \\t\\n\\r]+\"."
|
||||
:prefix t
|
||||
;; `string-trim-left' and `string-trim-right' were moved from subr-x
|
||||
;; to subr in Emacs 27, so to avoid loading subr-x we use the
|
||||
;; compatibility function here:
|
||||
(compat--string-trim-left
|
||||
(compat--string-trim-right
|
||||
string
|
||||
trim-right)
|
||||
trim-left))
|
||||
|
||||
(compat-defun caaar (x)
|
||||
"Return the `car' of the `car' of the `car' of X."
|
||||
(declare (pure t))
|
||||
(car (car (car x))))
|
||||
|
||||
(compat-defun caadr (x)
|
||||
"Return the `car' of the `car' of the `cdr' of X."
|
||||
(declare (pure t))
|
||||
(car (car (cdr x))))
|
||||
|
||||
(compat-defun cadar (x)
|
||||
"Return the `car' of the `cdr' of the `car' of X."
|
||||
(declare (pure t))
|
||||
(car (cdr (car x))))
|
||||
|
||||
(compat-defun caddr (x)
|
||||
"Return the `car' of the `cdr' of the `cdr' of X."
|
||||
(declare (pure t))
|
||||
(car (cdr (cdr x))))
|
||||
|
||||
(compat-defun cdaar (x)
|
||||
"Return the `cdr' of the `car' of the `car' of X."
|
||||
(declare (pure t))
|
||||
(cdr (car (car x))))
|
||||
|
||||
(compat-defun cdadr (x)
|
||||
"Return the `cdr' of the `car' of the `cdr' of X."
|
||||
(declare (pure t))
|
||||
(cdr (car (cdr x))))
|
||||
|
||||
(compat-defun cddar (x)
|
||||
"Return the `cdr' of the `cdr' of the `car' of X."
|
||||
(declare (pure t))
|
||||
(cdr (cdr (car x))))
|
||||
|
||||
(compat-defun cdddr (x)
|
||||
"Return the `cdr' of the `cdr' of the `cdr' of X."
|
||||
(declare (pure t))
|
||||
(cdr (cdr (cdr x))))
|
||||
|
||||
(compat-defun caaaar (x)
|
||||
"Return the `car' of the `car' of the `car' of the `car' of X."
|
||||
(declare (pure t))
|
||||
(car (car (car (car x)))))
|
||||
|
||||
(compat-defun caaadr (x)
|
||||
"Return the `car' of the `car' of the `car' of the `cdr' of X."
|
||||
(declare (pure t))
|
||||
(car (car (car (cdr x)))))
|
||||
|
||||
(compat-defun caadar (x)
|
||||
"Return the `car' of the `car' of the `cdr' of the `car' of X."
|
||||
(declare (pure t))
|
||||
(car (car (cdr (car x)))))
|
||||
|
||||
(compat-defun caaddr (x)
|
||||
"Return the `car' of the `car' of the `cdr' of the `cdr' of X."
|
||||
(declare (pure t))
|
||||
(car (car (cdr (cdr x)))))
|
||||
|
||||
(compat-defun cadaar (x)
|
||||
"Return the `car' of the `cdr' of the `car' of the `car' of X."
|
||||
(declare (pure t))
|
||||
(car (cdr (car (car x)))))
|
||||
|
||||
(compat-defun cadadr (x)
|
||||
"Return the `car' of the `cdr' of the `car' of the `cdr' of X."
|
||||
(declare (pure t))
|
||||
(car (cdr (car (cdr x)))))
|
||||
|
||||
(compat-defun caddar (x)
|
||||
"Return the `car' of the `cdr' of the `cdr' of the `car' of X."
|
||||
(declare (pure t))
|
||||
(car (cdr (cdr (car x)))))
|
||||
|
||||
(compat-defun cadddr (x)
|
||||
"Return the `car' of the `cdr' of the `cdr' of the `cdr' of X."
|
||||
(declare (pure t))
|
||||
(car (cdr (cdr (cdr x)))))
|
||||
|
||||
(compat-defun cdaaar (x)
|
||||
"Return the `cdr' of the `car' of the `car' of the `car' of X."
|
||||
(declare (pure t))
|
||||
(cdr (car (car (car x)))))
|
||||
|
||||
(compat-defun cdaadr (x)
|
||||
"Return the `cdr' of the `car' of the `car' of the `cdr' of X."
|
||||
(declare (pure t))
|
||||
(cdr (car (car (cdr x)))))
|
||||
|
||||
(compat-defun cdadar (x)
|
||||
"Return the `cdr' of the `car' of the `cdr' of the `car' of X."
|
||||
(declare (pure t))
|
||||
(cdr (car (cdr (car x)))))
|
||||
|
||||
(compat-defun cdaddr (x)
|
||||
"Return the `cdr' of the `car' of the `cdr' of the `cdr' of X."
|
||||
(declare (pure t))
|
||||
(cdr (car (cdr (cdr x)))))
|
||||
|
||||
(compat-defun cddaar (x)
|
||||
"Return the `cdr' of the `cdr' of the `car' of the `car' of X."
|
||||
(declare (pure t))
|
||||
(cdr (cdr (car (car x)))))
|
||||
|
||||
(compat-defun cddadr (x)
|
||||
"Return the `cdr' of the `cdr' of the `car' of the `cdr' of X."
|
||||
(declare (pure t))
|
||||
(cdr (cdr (car (cdr x)))))
|
||||
|
||||
(compat-defun cdddar (x)
|
||||
"Return the `cdr' of the `cdr' of the `cdr' of the `car' of X."
|
||||
(declare (pure t))
|
||||
(cdr (cdr (cdr (car x)))))
|
||||
|
||||
(compat-defun cddddr (x)
|
||||
"Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X."
|
||||
(declare (pure t))
|
||||
(cdr (cdr (cdr (cdr x)))))
|
||||
|
||||
(compat-defvar gensym-counter 0
|
||||
"Number used to construct the name of the next symbol created by `gensym'.")
|
||||
|
||||
(compat-defun gensym (&optional prefix)
|
||||
"Return a new uninterned symbol.
|
||||
The name is made by appending `gensym-counter' to PREFIX.
|
||||
PREFIX is a string, and defaults to \"g\"."
|
||||
(let ((num (prog1 gensym-counter
|
||||
(setq gensym-counter
|
||||
(1+ gensym-counter)))))
|
||||
(make-symbol (format "%s%d" (or prefix "g") num))))
|
||||
|
||||
;;;; Defined in files.el
|
||||
|
||||
(declare-function temporary-file-directory nil)
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defun make-nearby-temp-file (prefix &optional dir-flag suffix)
|
||||
"Create a temporary file as close as possible to `default-directory'.
|
||||
If PREFIX is a relative file name, and `default-directory' is a
|
||||
remote file name or located on a mounted file systems, the
|
||||
temporary file is created in the directory returned by the
|
||||
function `temporary-file-directory'. Otherwise, the function
|
||||
`make-temp-file' is used. PREFIX, DIR-FLAG and SUFFIX have the
|
||||
same meaning as in `make-temp-file'."
|
||||
(let ((handler (find-file-name-handler
|
||||
default-directory 'make-nearby-temp-file)))
|
||||
(if (and handler (not (file-name-absolute-p default-directory)))
|
||||
(funcall handler 'make-nearby-temp-file prefix dir-flag suffix)
|
||||
(let ((temporary-file-directory (temporary-file-directory)))
|
||||
(make-temp-file prefix dir-flag suffix)))))
|
||||
|
||||
(compat-defvar mounted-file-systems
|
||||
(eval-when-compile
|
||||
(if (memq system-type '(windows-nt cygwin))
|
||||
"^//[^/]+/"
|
||||
(concat
|
||||
"^" (regexp-opt '("/afs/" "/media/" "/mnt" "/net/" "/tmp_mnt/")))))
|
||||
"File systems that ought to be mounted.")
|
||||
|
||||
(compat-defun file-local-name (file)
|
||||
"Return the local name component of FILE.
|
||||
This function removes from FILE the specification of the remote host
|
||||
and the method of accessing the host, leaving only the part that
|
||||
identifies FILE locally on the remote system.
|
||||
The returned file name can be used directly as argument of
|
||||
`process-file', `start-file-process', or `shell-command'."
|
||||
:realname compat--file-local-name
|
||||
(or (file-remote-p file 'localname) file))
|
||||
|
||||
(compat-defun file-name-quoted-p (name &optional top)
|
||||
"Whether NAME is quoted with prefix \"/:\".
|
||||
If NAME is a remote file name and TOP is nil, check the local part of NAME."
|
||||
:realname compat--file-name-quoted-p
|
||||
(let ((file-name-handler-alist (unless top file-name-handler-alist)))
|
||||
(string-prefix-p "/:" (compat--file-local-name name))))
|
||||
|
||||
(compat-defun file-name-quote (name &optional top)
|
||||
"Add the quotation prefix \"/:\" to file NAME.
|
||||
If NAME is a remote file name and TOP is nil, the local part of
|
||||
NAME is quoted. If NAME is already a quoted file name, NAME is
|
||||
returned unchanged."
|
||||
(let ((file-name-handler-alist (unless top file-name-handler-alist)))
|
||||
(if (compat--file-name-quoted-p name top)
|
||||
name
|
||||
(concat (file-remote-p name) "/:" (compat--file-local-name name)))))
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defun temporary-file-directory ()
|
||||
"The directory for writing temporary files.
|
||||
In case of a remote `default-directory', this is a directory for
|
||||
temporary files on that remote host. If such a directory does
|
||||
not exist, or `default-directory' ought to be located on a
|
||||
mounted file system (see `mounted-file-systems'), the function
|
||||
returns `default-directory'.
|
||||
For a non-remote and non-mounted `default-directory', the value of
|
||||
the variable `temporary-file-directory' is returned."
|
||||
(let ((handler (find-file-name-handler
|
||||
default-directory 'temporary-file-directory)))
|
||||
(if handler
|
||||
(funcall handler 'temporary-file-directory)
|
||||
(if (string-match mounted-file-systems default-directory)
|
||||
default-directory
|
||||
temporary-file-directory))))
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defun file-attribute-type (attributes)
|
||||
"The type field in ATTRIBUTES returned by `file-attributes'.
|
||||
The value is either t for directory, string (name linked to) for
|
||||
symbolic link, or nil."
|
||||
(nth 0 attributes))
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defun file-attribute-link-number (attributes)
|
||||
"Return the number of links in ATTRIBUTES returned by `file-attributes'."
|
||||
(nth 1 attributes))
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defun file-attribute-user-id (attributes)
|
||||
"The UID field in ATTRIBUTES returned by `file-attributes'.
|
||||
This is either a string or a number. If a string value cannot be
|
||||
looked up, a numeric value, either an integer or a float, is
|
||||
returned."
|
||||
(nth 2 attributes))
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defun file-attribute-group-id (attributes)
|
||||
"The GID field in ATTRIBUTES returned by `file-attributes'.
|
||||
This is either a string or a number. If a string value cannot be
|
||||
looked up, a numeric value, either an integer or a float, is
|
||||
returned."
|
||||
(nth 3 attributes))
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defun file-attribute-access-time (attributes)
|
||||
"The last access time in ATTRIBUTES returned by `file-attributes'.
|
||||
This a Lisp timestamp in the style of `current-time'."
|
||||
(nth 4 attributes))
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defun file-attribute-modification-time (attributes)
|
||||
"The modification time in ATTRIBUTES returned by `file-attributes'.
|
||||
This is the time of the last change to the file's contents, and
|
||||
is a Lisp timestamp in the style of `current-time'."
|
||||
(nth 5 attributes))
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defun file-attribute-status-change-time (attributes)
|
||||
"The status modification time in ATTRIBUTES returned by `file-attributes'.
|
||||
This is the time of last change to the file's attributes: owner
|
||||
and group, access mode bits, etc., and is a Lisp timestamp in the
|
||||
style of `current-time'."
|
||||
(nth 6 attributes))
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defun file-attribute-size (attributes)
|
||||
"The integer size (in bytes) in ATTRIBUTES returned by `file-attributes'."
|
||||
(nth 7 attributes))
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defun file-attribute-modes (attributes)
|
||||
"The file modes in ATTRIBUTES returned by `file-attributes'.
|
||||
This is a string of ten letters or dashes as in ls -l."
|
||||
(nth 8 attributes))
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defun file-attribute-inode-number (attributes)
|
||||
"The inode number in ATTRIBUTES returned by `file-attributes'.
|
||||
It is a nonnegative integer."
|
||||
(nth 10 attributes))
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defun file-attribute-device-number (attributes)
|
||||
"The file system device number in ATTRIBUTES returned by `file-attributes'.
|
||||
It is an integer."
|
||||
(nth 11 attributes))
|
||||
|
||||
(compat-defun file-attribute-collect (attributes &rest attr-names)
|
||||
"Return a sublist of ATTRIBUTES returned by `file-attributes'.
|
||||
ATTR-NAMES are symbols with the selected attribute names.
|
||||
|
||||
Valid attribute names are: type, link-number, user-id, group-id,
|
||||
access-time, modification-time, status-change-time, size, modes,
|
||||
inode-number and device-number."
|
||||
(let ((idx '((type . 0)
|
||||
(link-number . 1)
|
||||
(user-id . 2)
|
||||
(group-id . 3)
|
||||
(access-time . 4)
|
||||
(modification-time . 5)
|
||||
(status-change-time . 6)
|
||||
(size . 7)
|
||||
(modes . 8)
|
||||
(inode-number . 10)
|
||||
(device-number . 11)))
|
||||
result)
|
||||
(while attr-names
|
||||
(let ((attr (pop attr-names)))
|
||||
(if (assq attr idx)
|
||||
(push (nth (cdr (assq attr idx))
|
||||
attributes)
|
||||
result)
|
||||
(error "Wrong attribute name '%S'" attr))))
|
||||
(nreverse result)))
|
||||
|
||||
;;;; Defined in subr-x.el
|
||||
|
||||
(compat-defmacro if-let* (varlist then &rest else)
|
||||
"Bind variables according to VARLIST and evaluate THEN or ELSE.
|
||||
This is like `if-let' but doesn't handle a VARLIST of the form
|
||||
\(SYMBOL SOMETHING) specially."
|
||||
:realname compat--if-let*
|
||||
:feature 'subr-x
|
||||
(declare (indent 2)
|
||||
(debug ((&rest [&or symbolp (symbolp form) (form)])
|
||||
body)))
|
||||
(let ((empty (make-symbol "s"))
|
||||
(last t) list)
|
||||
(dolist (var varlist)
|
||||
(push `(,(if (cdr var) (car var) empty)
|
||||
(and ,last ,(or (cadr var) (car var))))
|
||||
list)
|
||||
(when (or (cdr var) (consp (car var)))
|
||||
(setq last (caar list))))
|
||||
`(let* ,(nreverse list)
|
||||
(if ,(caar list) ,then ,@else))))
|
||||
|
||||
(compat-defmacro when-let* (varlist &rest body)
|
||||
"Bind variables according to VARLIST and conditionally evaluate BODY.
|
||||
This is like `when-let' but doesn't handle a VARLIST of the form
|
||||
\(SYMBOL SOMETHING) specially."
|
||||
;; :feature 'subr-x
|
||||
(declare (indent 1) (debug if-let*))
|
||||
(let ((empty (make-symbol "s"))
|
||||
(last t) list)
|
||||
(dolist (var varlist)
|
||||
(push `(,(if (cdr var) (car var) empty)
|
||||
(and ,last ,(or (cadr var) (car var))))
|
||||
list)
|
||||
(when (or (cdr var) (consp (car var)))
|
||||
(setq last (caar list))))
|
||||
`(let* ,(nreverse list)
|
||||
(when ,(caar list) ,@body))))
|
||||
|
||||
(compat-defmacro and-let* (varlist &rest body)
|
||||
"Bind variables according to VARLIST and conditionally evaluate BODY.
|
||||
Like `when-let*', except if BODY is empty and all the bindings
|
||||
are non-nil, then the result is non-nil."
|
||||
:feature 'subr-x
|
||||
(declare (indent 1) (debug if-let*))
|
||||
(let ((empty (make-symbol "s"))
|
||||
(last t) list)
|
||||
(dolist (var varlist)
|
||||
(push `(,(if (cdr var) (car var) empty)
|
||||
(and ,last ,(or (cadr var) (car var))))
|
||||
list)
|
||||
(when (or (cdr var) (consp (car var)))
|
||||
(setq last (caar list))))
|
||||
`(let* ,(nreverse list)
|
||||
(if ,(caar list) ,(macroexp-progn (or body '(t)))))))
|
||||
|
||||
;;;; Defined in image.el
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defun image-property (image property)
|
||||
"Return the value of PROPERTY in IMAGE.
|
||||
Properties can be set with
|
||||
|
||||
(setf (image-property IMAGE PROPERTY) VALUE)
|
||||
|
||||
If VALUE is nil, PROPERTY is removed from IMAGE."
|
||||
(plist-get (cdr image) property))
|
||||
|
||||
;;* UNTESTED
|
||||
(unless (get 'image-property 'gv-expander)
|
||||
(gv-define-setter image-property (image property value)
|
||||
(let ((image* (make-symbol "image"))
|
||||
(property* (make-symbol "property"))
|
||||
(value* (make-symbol "value")))
|
||||
`(let ((,image* ,image)
|
||||
(,property* ,property)
|
||||
(,value* ,value))
|
||||
(if
|
||||
(null ,value*)
|
||||
(while
|
||||
(cdr ,image*)
|
||||
(if
|
||||
(eq
|
||||
(cadr ,image*)
|
||||
,property*)
|
||||
(setcdr ,image*
|
||||
(cdddr ,image*))
|
||||
(setq ,image*
|
||||
(cddr ,image*))))
|
||||
(setcdr ,image*
|
||||
(plist-put
|
||||
(cdr ,image*)
|
||||
,property* ,value*)))))))
|
||||
|
||||
;;;; Defined in rmc.el
|
||||
|
||||
;;*UNTESTED
|
||||
(compat-defun read-multiple-choice
|
||||
(prompt choices &optional _help-string _show-help long-form)
|
||||
"Ask user to select an entry from CHOICES, promting with PROMPT.
|
||||
This function allows to ask the user a multiple-choice question.
|
||||
|
||||
CHOICES should be a list of the form (KEY NAME [DESCRIPTION]).
|
||||
KEY is a character the user should type to select the entry.
|
||||
NAME is a short name for the entry to be displayed while prompting
|
||||
\(if there's no room, it might be shortened).
|
||||
|
||||
If LONG-FORM, do a `completing-read' over the NAME elements in
|
||||
CHOICES instead."
|
||||
:note "This is a partial implementation of `read-multiple-choice', that
|
||||
among other things doesn't offer any help and ignores the
|
||||
optional DESCRIPTION field."
|
||||
(if long-form
|
||||
(let ((options (mapconcat #'cadr choices "/"))
|
||||
choice)
|
||||
(setq prompt (concat prompt " (" options "): "))
|
||||
(setq choice (completing-read prompt (mapcar #'cadr choices) nil t))
|
||||
(catch 'found
|
||||
(dolist (option choices)
|
||||
(when (string= choice (cadr option))
|
||||
(throw 'found option)))
|
||||
(error "Invalid choice")))
|
||||
(let ((options
|
||||
(mapconcat
|
||||
(lambda (opt)
|
||||
(format
|
||||
"[%s] %s"
|
||||
(key-description (string (car opt)))
|
||||
(cadr opt)))
|
||||
choices " "))
|
||||
choice)
|
||||
(setq prompt (concat prompt " (" options "): "))
|
||||
(while (not (setq choice (assq (read-char prompt) choices)))
|
||||
(message "Invalid choice")
|
||||
(sit-for 1))
|
||||
choice)))
|
||||
|
||||
(compat--inhibit-prefixed (provide 'compat-26))
|
||||
;;; compat-26.el ends here
|
||||
|
|
@ -1,764 +0,0 @@
|
|||
;;; compat-27.el --- Compatibility Layer for Emacs 27.1 -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2021, 2022 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Philip Kaludercic <philipk@posteo.net>
|
||||
;; Maintainer: Compat Development <~pkal/compat-devel@lists.sr.ht>
|
||||
;; URL: https://git.sr.ht/~pkal/compat/
|
||||
;; Keywords: lisp
|
||||
|
||||
;; 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:
|
||||
|
||||
;; Find here the functionality added in Emacs 27.1, needed by older
|
||||
;; versions.
|
||||
;;
|
||||
;; Only load this library if you need to use one of the following
|
||||
;; functions or macros:
|
||||
;;
|
||||
;; - `compat-recenter'
|
||||
;; - `compat-lookup-key'
|
||||
;; - `compat-setq-local'
|
||||
;; - `compat-assoc-delete-all'
|
||||
;; - `compat-file-size-human-readable'
|
||||
;; - `compat-executable-find'
|
||||
;; - `compat-regexp-opt'
|
||||
;; - `compat-dired-get-marked-files'
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'compat-macs "compat-macs.el")
|
||||
|
||||
(compat-declare-version "27.1")
|
||||
|
||||
;;;; Defined in fns.c
|
||||
|
||||
(compat-defun proper-list-p (object)
|
||||
"Return OBJECT's length if it is a proper list, nil otherwise.
|
||||
A proper list is neither circular nor dotted (i.e., its last cdr
|
||||
is nil)."
|
||||
:min-version "26.1"
|
||||
:max-version "26.3"
|
||||
:realname compat--proper-list-p-length-signal
|
||||
(condition-case nil
|
||||
(and (listp object) (length object))
|
||||
(wrong-type-argument nil)
|
||||
(circular-list nil)))
|
||||
|
||||
(compat-defun proper-list-p (object)
|
||||
"Return OBJECT's length if it is a proper list, nil otherwise.
|
||||
A proper list is neither circular nor dotted (i.e., its last cdr
|
||||
is nil)."
|
||||
:max-version "25.3"
|
||||
:realname compat--proper-list-p-tortoise-hare
|
||||
(when (listp object)
|
||||
(catch 'cycle
|
||||
(let ((hare object) (tortoise object)
|
||||
(max 2) (q 2))
|
||||
(while (consp hare)
|
||||
(setq hare (cdr hare))
|
||||
(when (and (or (/= 0 (setq q (1- q)))
|
||||
(ignore
|
||||
(setq max (ash max 1)
|
||||
q max
|
||||
tortoise hare)))
|
||||
(eq hare tortoise))
|
||||
(throw 'cycle nil)))
|
||||
(and (null hare) (length object))))))
|
||||
|
||||
(compat-defun string-distance (string1 string2 &optional bytecompare)
|
||||
"Return Levenshtein distance between STRING1 and STRING2.
|
||||
The distance is the number of deletions, insertions, and substitutions
|
||||
required to transform STRING1 into STRING2.
|
||||
If BYTECOMPARE is nil or omitted, compute distance in terms of characters.
|
||||
If BYTECOMPARE is non-nil, compute distance in terms of bytes.
|
||||
Letter-case is significant, but text properties are ignored."
|
||||
;; https://en.wikipedia.org/wiki/Levenshtein_distance
|
||||
(let ((s1 (if bytecompare
|
||||
(encode-coding-string string1 'raw-text)
|
||||
(concat string1 "")))
|
||||
(s2 (if bytecompare
|
||||
(encode-coding-string string2 'raw-text)
|
||||
string2)))
|
||||
(let* ((len1 (length s1))
|
||||
(len2 (length s2))
|
||||
(column (make-vector (1+ len1) 0)))
|
||||
(dotimes (y len1)
|
||||
(setf (aref column (1+ y)) y))
|
||||
(dotimes (x len2)
|
||||
(setf (aref column 0) (1+ x))
|
||||
(let ((lastdiag x) olddiag)
|
||||
(dotimes (y len1)
|
||||
(setf olddiag (aref column (1+ y))
|
||||
(aref column (1+ y))
|
||||
(min (+ (if (= (aref s1 y) (aref s2 x)) 0 1)
|
||||
lastdiag)
|
||||
(1+ (aref column (1+ y)))
|
||||
(1+ (aref column y)))
|
||||
lastdiag olddiag))))
|
||||
(aref column len1))))
|
||||
|
||||
;;;; Defined in window.c
|
||||
|
||||
(compat-defun recenter (&optional arg redisplay)
|
||||
"Handle optional argument REDISPLAY."
|
||||
:prefix t
|
||||
(recenter arg)
|
||||
(when (and redisplay recenter-redisplay)
|
||||
(redisplay)))
|
||||
|
||||
;;;; Defined in keymap.c
|
||||
|
||||
(compat-defun lookup-key (keymap key &optional accept-default)
|
||||
"Allow for KEYMAP to be a list of keymaps."
|
||||
:prefix t
|
||||
(cond
|
||||
((keymapp keymap)
|
||||
(lookup-key keymap key accept-default))
|
||||
((listp keymap)
|
||||
(catch 'found
|
||||
(dolist (map keymap)
|
||||
(let ((fn (lookup-key map key accept-default)))
|
||||
(when fn (throw 'found fn))))))
|
||||
((signal 'wrong-type-argument (list 'keymapp keymap)))))
|
||||
|
||||
;;;; Defined in json.c
|
||||
|
||||
(declare-function json-parse-string nil (string &rest args))
|
||||
(declare-function json-encode "json" (object))
|
||||
(declare-function json-read-from-string "json" (string))
|
||||
(declare-function json-read "json" ())
|
||||
(defvar json-encoding-pretty-print)
|
||||
(defvar json-object-type)
|
||||
(defvar json-array-type)
|
||||
(defvar json-false)
|
||||
(defvar json-null)
|
||||
|
||||
;; The function is declared to satisfy the byte compiler while testing
|
||||
;; if native JSON parsing is available.;
|
||||
(declare-function json-serialize nil (object &rest args))
|
||||
(compat-defun json-serialize (object &rest args)
|
||||
"Return the JSON representation of OBJECT as a string.
|
||||
|
||||
OBJECT must be t, a number, string, vector, hashtable, alist, plist,
|
||||
or the Lisp equivalents to the JSON null and false values, and its
|
||||
elements must recursively consist of the same kinds of values. t will
|
||||
be converted to the JSON true value. Vectors will be converted to
|
||||
JSON arrays, whereas hashtables, alists and plists are converted to
|
||||
JSON objects. Hashtable keys must be strings without embedded null
|
||||
characters and must be unique within each object. Alist and plist
|
||||
keys must be symbols; if a key is duplicate, the first instance is
|
||||
used.
|
||||
|
||||
The Lisp equivalents to the JSON null and false values are
|
||||
configurable in the arguments ARGS, a list of keyword/argument pairs:
|
||||
|
||||
The keyword argument `:null-object' specifies which object to use
|
||||
to represent a JSON null value. It defaults to `:null'.
|
||||
|
||||
The keyword argument `:false-object' specifies which object to use to
|
||||
represent a JSON false value. It defaults to `:false'.
|
||||
|
||||
In you specify the same value for `:null-object' and `:false-object',
|
||||
a potentially ambiguous situation, the JSON output will not contain
|
||||
any JSON false values."
|
||||
:cond (not (condition-case nil
|
||||
(equal (json-serialize '()) "{}")
|
||||
(:success t)
|
||||
(void-function nil)
|
||||
(json-unavailable nil)))
|
||||
:realname compat--json-serialize
|
||||
(require 'json)
|
||||
(letrec ((fix (lambda (obj)
|
||||
(cond
|
||||
((hash-table-p obj)
|
||||
(let ((ht (copy-hash-table obj)))
|
||||
(maphash
|
||||
(lambda (key val)
|
||||
(unless (stringp key)
|
||||
(signal
|
||||
'wrong-type-argument
|
||||
(list 'stringp key)))
|
||||
(puthash key (funcall fix val) ht))
|
||||
obj)
|
||||
ht))
|
||||
((and (listp obj) (consp (car obj))) ;alist
|
||||
(mapcar
|
||||
(lambda (ent)
|
||||
(cons (symbol-name (car ent))
|
||||
(funcall fix (cdr ent))))
|
||||
obj))
|
||||
((listp obj) ;plist
|
||||
(let (alist)
|
||||
(while obj
|
||||
(push (cons (cond
|
||||
((keywordp (car obj))
|
||||
(substring
|
||||
(symbol-name (car obj))
|
||||
1))
|
||||
((symbolp (car obj))
|
||||
(symbol-name (car obj)))
|
||||
((signal
|
||||
'wrong-type-argument
|
||||
(list 'symbolp (car obj)))))
|
||||
(funcall fix (cadr obj)))
|
||||
alist)
|
||||
(unless (consp (cdr obj))
|
||||
(signal 'wrong-type-argument '(consp nil)))
|
||||
(setq obj (cddr obj)))
|
||||
(nreverse alist)))
|
||||
((vectorp obj)
|
||||
(let ((vec (make-vector (length obj) nil)))
|
||||
(dotimes (i (length obj))
|
||||
(aset vec i (funcall fix (aref obj i))))
|
||||
vec))
|
||||
(obj))))
|
||||
(json-encoding-pretty-print nil)
|
||||
(json-false (or (plist-get args :false-object) :false))
|
||||
(json-null (or (plist-get args :null-object) :null)))
|
||||
(json-encode (funcall fix object))))
|
||||
|
||||
(compat-defun json-insert (object &rest args)
|
||||
"Insert the JSON representation of OBJECT before point.
|
||||
This is the same as (insert (json-serialize OBJECT)), but potentially
|
||||
faster. See the function `json-serialize' for allowed values of
|
||||
OBJECT."
|
||||
:cond (not (condition-case nil
|
||||
(equal (json-serialize '()) "{}")
|
||||
(:success t)
|
||||
(void-function nil)
|
||||
(json-unavailable nil)))
|
||||
(insert (apply #'compat--json-serialize object args)))
|
||||
|
||||
(compat-defun json-parse-string (string &rest args)
|
||||
"Parse the JSON STRING into a Lisp object.
|
||||
This is essentially the reverse operation of `json-serialize', which
|
||||
see. The returned object will be the JSON null value, the JSON false
|
||||
value, t, a number, a string, a vector, a list, a hashtable, an alist,
|
||||
or a plist. Its elements will be further objects of these types. If
|
||||
there are duplicate keys in an object, all but the last one are
|
||||
ignored. If STRING doesn't contain a valid JSON object, this function
|
||||
signals an error of type `json-parse-error'.
|
||||
|
||||
The arguments ARGS are a list of keyword/argument pairs:
|
||||
|
||||
The keyword argument `:object-type' specifies which Lisp type is used
|
||||
to represent objects; it can be `hash-table', `alist' or `plist'. It
|
||||
defaults to `hash-table'.
|
||||
|
||||
The keyword argument `:array-type' specifies which Lisp type is used
|
||||
to represent arrays; it can be `array' (the default) or `list'.
|
||||
|
||||
The keyword argument `:null-object' specifies which object to use
|
||||
to represent a JSON null value. It defaults to `:null'.
|
||||
|
||||
The keyword argument `:false-object' specifies which object to use to
|
||||
represent a JSON false value. It defaults to `:false'."
|
||||
:cond (not (condition-case nil
|
||||
(equal (json-serialize '()) "{}")
|
||||
(:success t)
|
||||
(void-function nil)
|
||||
(json-unavailable nil)))
|
||||
(require 'json)
|
||||
(condition-case err
|
||||
(let ((json-object-type (or (plist-get args :object-type) 'hash-table))
|
||||
(json-array-type (or (plist-get args :array-type) 'vector))
|
||||
(json-false (or (plist-get args :false-object) :false))
|
||||
(json-null (or (plist-get args :null-object) :null)))
|
||||
(when (eq json-array-type 'array)
|
||||
(setq json-array-type 'vector))
|
||||
(json-read-from-string string))
|
||||
(json-error (signal 'json-parse-error err))))
|
||||
|
||||
(compat-defun json-parse-buffer (&rest args)
|
||||
"Read JSON object from current buffer starting at point.
|
||||
Move point after the end of the object if parsing was successful.
|
||||
On error, don't move point.
|
||||
|
||||
The returned object will be a vector, list, hashtable, alist, or
|
||||
plist. Its elements will be the JSON null value, the JSON false
|
||||
value, t, numbers, strings, or further vectors, lists, hashtables,
|
||||
alists, or plists. If there are duplicate keys in an object, all
|
||||
but the last one are ignored.
|
||||
|
||||
If the current buffer doesn't contain a valid JSON object, the
|
||||
function signals an error of type `json-parse-error'.
|
||||
|
||||
The arguments ARGS are a list of keyword/argument pairs:
|
||||
|
||||
The keyword argument `:object-type' specifies which Lisp type is used
|
||||
to represent objects; it can be `hash-table', `alist' or `plist'. It
|
||||
defaults to `hash-table'.
|
||||
|
||||
The keyword argument `:array-type' specifies which Lisp type is used
|
||||
to represent arrays; it can be `array' (the default) or `list'.
|
||||
|
||||
The keyword argument `:null-object' specifies which object to use
|
||||
to represent a JSON null value. It defaults to `:null'.
|
||||
|
||||
The keyword argument `:false-object' specifies which object to use to
|
||||
represent a JSON false value. It defaults to `:false'."
|
||||
:cond (not (condition-case nil
|
||||
(equal (json-serialize '()) "{}")
|
||||
(:success t)
|
||||
(void-function nil)
|
||||
(json-unavailable nil)))
|
||||
(require 'json)
|
||||
(condition-case err
|
||||
(let ((json-object-type (or (plist-get args :object-type) 'hash-table))
|
||||
(json-array-type (or (plist-get args :array-type) 'vector))
|
||||
(json-false (or (plist-get args :false-object) :false))
|
||||
(json-null (or (plist-get args :null-object) :null)))
|
||||
(when (eq json-array-type 'array)
|
||||
(setq json-array-type 'vector))
|
||||
(json-read))
|
||||
(json-error (signal 'json-parse-buffer err))))
|
||||
|
||||
;;;; Defined in timefns.c
|
||||
|
||||
(compat-defun time-equal-p (t1 t2)
|
||||
"Return non-nil if time value T1 is equal to time value T2.
|
||||
A nil value for either argument stands for the current time."
|
||||
:note "This function is not as accurate as the actual `time-equal-p'."
|
||||
(cond
|
||||
((eq t1 t2))
|
||||
((and (consp t1) (consp t2))
|
||||
(equal t1 t2))
|
||||
((let ((now (current-time)))
|
||||
;; Due to inaccuracies and the relatively slow evaluating of
|
||||
;; Emacs Lisp compared to C, we allow for slight inaccuracies
|
||||
;; (less than a millisecond) when comparing time values.
|
||||
(< (abs (- (float-time (or t1 now))
|
||||
(float-time (or t2 now))))
|
||||
1e-5)))))
|
||||
|
||||
;;;; Defined in fileio.c
|
||||
|
||||
(compat-defun file-name-absolute-p (filename)
|
||||
"Return t if FILENAME is an absolute file name.
|
||||
On Unix, absolute file names start with `/'. In Emacs, an absolute
|
||||
file name can also start with an initial `~' or `~USER' component,
|
||||
where USER is a valid login name."
|
||||
;; See definitions in filename.h
|
||||
(let ((seperator
|
||||
(eval-when-compile
|
||||
(if (memq system-type '(cygwin windows-nt ms-dos))
|
||||
"[\\/]" "/")))
|
||||
(drive
|
||||
(eval-when-compile
|
||||
(cond
|
||||
((memq system-type '(windows-nt ms-dos))
|
||||
"\\`[A-Za-z]:[\\/]")
|
||||
((eq system-type 'cygwin)
|
||||
"\\`\\([\\/]\\|[A-Za-z]:\\)")
|
||||
("\\`/"))))
|
||||
(home
|
||||
(eval-when-compile
|
||||
(if (memq system-type '(cygwin windows-nt ms-dos))
|
||||
"\\`~[\\/]" "\\`~/")))
|
||||
(user-home
|
||||
(eval-when-compile
|
||||
(format "\\`\\(~.*?\\)\\(%s.*\\)?$"
|
||||
(if (memq system-type '(cygwin windows-nt ms-dos))
|
||||
"[\\/]" "/")))))
|
||||
(or (and (string-match-p drive filename) t)
|
||||
(and (string-match-p home filename) t)
|
||||
(save-excursion
|
||||
(when (string-match user-home filename)
|
||||
(let ((init (match-string 1 filename)))
|
||||
(not (string=
|
||||
(file-name-base (expand-file-name init))
|
||||
init))))))))
|
||||
|
||||
;;;; Defined in subr.el
|
||||
|
||||
(compat-defmacro setq-local (&rest pairs)
|
||||
"Handle multiple assignments."
|
||||
:prefix t
|
||||
(unless (zerop (mod (length pairs) 2))
|
||||
(error "PAIRS must have an even number of variable/value members"))
|
||||
(let (body)
|
||||
(while pairs
|
||||
(let* ((sym (pop pairs))
|
||||
(val (pop pairs)))
|
||||
(unless (symbolp sym)
|
||||
(error "Attempting to set a non-symbol: %s" (car pairs)))
|
||||
(push `(set (make-local-variable ,sym) ,val)
|
||||
body)))
|
||||
(cons 'progn (nreverse body))))
|
||||
|
||||
(compat-defun provided-mode-derived-p (mode &rest modes)
|
||||
"Non-nil if MODE is derived from one of MODES.
|
||||
Uses the `derived-mode-parent' property of the symbol to trace backwards.
|
||||
If you just want to check `major-mode', use `derived-mode-p'."
|
||||
:realname compat--provided-mode-derived-p
|
||||
;; If MODE is an alias, then look up the real mode function first.
|
||||
(let ((alias (symbol-function mode)))
|
||||
(when (and alias (symbolp alias))
|
||||
(setq mode alias)))
|
||||
(while
|
||||
(and
|
||||
(not (memq mode modes))
|
||||
(let* ((parent (get mode 'derived-mode-parent))
|
||||
(parentfn (symbol-function parent)))
|
||||
(setq mode (if (and parentfn (symbolp parentfn)) parentfn parent)))))
|
||||
mode)
|
||||
|
||||
;;* UNTESTED
|
||||
(defun derived-mode-p (&rest modes)
|
||||
"Non-nil if the current major mode is derived from one of MODES.
|
||||
Uses the `derived-mode-parent' property of the symbol to trace backwards."
|
||||
(apply #'compat--provided-mode-derived-p major-mode modes))
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defmacro ignore-error (condition &rest body)
|
||||
"Execute BODY; if the error CONDITION occurs, return nil.
|
||||
Otherwise, return result of last form in BODY.
|
||||
|
||||
CONDITION can also be a list of error conditions."
|
||||
(declare (debug t) (indent 1))
|
||||
`(condition-case nil (progn ,@body) (,condition nil)))
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defmacro dolist-with-progress-reporter (spec reporter-or-message &rest body)
|
||||
"Loop over a list and report progress in the echo area.
|
||||
Evaluate BODY with VAR bound to each car from LIST, in turn.
|
||||
Then evaluate RESULT to get return value, default nil.
|
||||
|
||||
REPORTER-OR-MESSAGE is a progress reporter object or a string. In the latter
|
||||
case, use this string to create a progress reporter.
|
||||
|
||||
At each iteration, print the reporter message followed by progress
|
||||
percentage in the echo area. After the loop is finished,
|
||||
print the reporter message followed by the word \"done\".
|
||||
|
||||
\(fn (VAR LIST [RESULT]) REPORTER-OR-MESSAGE BODY...)"
|
||||
(declare (indent 2) (debug ((symbolp form &optional form) form body)))
|
||||
(let ((prep (make-symbol "--dolist-progress-reporter--"))
|
||||
(count (make-symbol "--dolist-count--"))
|
||||
(list (make-symbol "--dolist-list--")))
|
||||
`(let ((,prep ,reporter-or-message)
|
||||
(,count 0)
|
||||
(,list ,(cadr spec)))
|
||||
(when (stringp ,prep)
|
||||
(setq ,prep (make-progress-reporter ,prep 0 (1- (length ,list)))))
|
||||
(dolist (,(car spec) ,list)
|
||||
,@body
|
||||
(progress-reporter-update ,prep (setq ,count (1+ ,count))))
|
||||
(progress-reporter-done ,prep)
|
||||
(or ,@(cdr (cdr spec)) nil))))
|
||||
|
||||
(compat-defun flatten-tree (tree)
|
||||
"Return a \"flattened\" copy of TREE.
|
||||
In other words, return a list of the non-nil terminal nodes, or
|
||||
leaves, of the tree of cons cells rooted at TREE. Leaves in the
|
||||
returned list are in the same order as in TREE.
|
||||
|
||||
\(flatten-tree \\='(1 (2 . 3) nil (4 5 (6)) 7))
|
||||
=> (1 2 3 4 5 6 7)"
|
||||
(let (elems)
|
||||
(while (consp tree)
|
||||
(let ((elem (pop tree)))
|
||||
(while (consp elem)
|
||||
(push (cdr elem) tree)
|
||||
(setq elem (car elem)))
|
||||
(if elem (push elem elems))))
|
||||
(if tree (push tree elems))
|
||||
(nreverse elems)))
|
||||
|
||||
(compat-defun xor (cond1 cond2)
|
||||
"Return the boolean exclusive-or of COND1 and COND2.
|
||||
If only one of the arguments is non-nil, return it; otherwise
|
||||
return nil."
|
||||
(declare (pure t) (side-effect-free error-free))
|
||||
(cond ((not cond1) cond2)
|
||||
((not cond2) cond1)))
|
||||
|
||||
(compat-defvar regexp-unmatchable "\\`a\\`"
|
||||
"Standard regexp guaranteed not to match any string at all."
|
||||
:constant t)
|
||||
|
||||
(compat-defun assoc-delete-all (key alist &optional test)
|
||||
"Delete from ALIST all elements whose car is KEY.
|
||||
Compare keys with TEST. Defaults to `equal'.
|
||||
Return the modified alist.
|
||||
Elements of ALIST that are not conses are ignored."
|
||||
:prefix t
|
||||
(unless test (setq test #'equal))
|
||||
(while (and (consp (car alist))
|
||||
(funcall test (caar alist) key))
|
||||
(setq alist (cdr alist)))
|
||||
(let ((tail alist) tail-cdr)
|
||||
(while (setq tail-cdr (cdr tail))
|
||||
(if (and (consp (car tail-cdr))
|
||||
(funcall test (caar tail-cdr) key))
|
||||
(setcdr tail (cdr tail-cdr))
|
||||
(setq tail tail-cdr))))
|
||||
alist)
|
||||
|
||||
;;;; Defined in simple.el
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defun decoded-time-second (time)
|
||||
"The seconds in TIME, which is a value returned by `decode-time'.
|
||||
This is an integer between 0 and 60 (inclusive). (60 is a leap
|
||||
second, which only some operating systems support.)"
|
||||
(nth 0 time))
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defun decoded-time-minute (time)
|
||||
"The minutes in TIME, which is a value returned by `decode-time'.
|
||||
This is an integer between 0 and 59 (inclusive)."
|
||||
(nth 1 time))
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defun decoded-time-hour (time)
|
||||
"The hours in TIME, which is a value returned by `decode-time'.
|
||||
This is an integer between 0 and 23 (inclusive)."
|
||||
(nth 2 time))
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defun decoded-time-day (time)
|
||||
"The day-of-the-month in TIME, which is a value returned by `decode-time'.
|
||||
This is an integer between 1 and 31 (inclusive)."
|
||||
(nth 3 time))
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defun decoded-time-month (time)
|
||||
"The month in TIME, which is a value returned by `decode-time'.
|
||||
This is an integer between 1 and 12 (inclusive). January is 1."
|
||||
(nth 4 time))
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defun decoded-time-year (time)
|
||||
"The year in TIME, which is a value returned by `decode-time'.
|
||||
This is a four digit integer."
|
||||
(nth 5 time))
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defun decoded-time-weekday (time)
|
||||
"The day-of-the-week in TIME, which is a value returned by `decode-time'.
|
||||
This is a number between 0 and 6, and 0 is Sunday."
|
||||
(nth 6 time))
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defun decoded-time-dst (time)
|
||||
"The daylight saving time in TIME, which is a value returned by `decode-time'.
|
||||
This is t if daylight saving time is in effect, and nil if not."
|
||||
(nth 7 time))
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defun decoded-time-zone (time)
|
||||
"The time zone in TIME, which is a value returned by `decode-time'.
|
||||
This is an integer indicating the UTC offset in seconds, i.e.,
|
||||
the number of seconds east of Greenwich."
|
||||
(nth 8 time))
|
||||
|
||||
;; TODO define gv-setters
|
||||
|
||||
;;;; Defined in files.el
|
||||
|
||||
(compat-defun file-size-human-readable (file-size &optional flavor space unit)
|
||||
"Handle the optional third and forth argument:
|
||||
|
||||
Optional third argument SPACE is a string put between the number and unit.
|
||||
It defaults to the empty string. We recommend a single space or
|
||||
non-breaking space, unless other constraints prohibit a space in that
|
||||
position.
|
||||
|
||||
Optional fourth argument UNIT is the unit to use. It defaults to \"B\"
|
||||
when FLAVOR is `iec' and the empty string otherwise. We recommend \"B\"
|
||||
in all cases, since that is the standard symbol for byte."
|
||||
:prefix t
|
||||
(let ((power (if (or (null flavor) (eq flavor 'iec))
|
||||
1024.0
|
||||
1000.0))
|
||||
(prefixes '("" "k" "M" "G" "T" "P" "E" "Z" "Y")))
|
||||
(while (and (>= file-size power) (cdr prefixes))
|
||||
(setq file-size (/ file-size power)
|
||||
prefixes (cdr prefixes)))
|
||||
(let* ((prefix (car prefixes))
|
||||
(prefixed-unit (if (eq flavor 'iec)
|
||||
(concat
|
||||
(if (string= prefix "k") "K" prefix)
|
||||
(if (string= prefix "") "" "i")
|
||||
(or unit "B"))
|
||||
(concat prefix unit))))
|
||||
(format (if (and (>= (mod file-size 1.0) 0.05)
|
||||
(< (mod file-size 1.0) 0.95))
|
||||
"%.1f%s%s"
|
||||
"%.0f%s%s")
|
||||
file-size
|
||||
(if (string= prefixed-unit "") "" (or space ""))
|
||||
prefixed-unit))))
|
||||
|
||||
(declare-function compat--file-name-quote "compat-26"
|
||||
(name &optional top))
|
||||
|
||||
;;*UNTESTED
|
||||
(compat-defun exec-path ()
|
||||
"Return list of directories to search programs to run in remote subprocesses.
|
||||
The remote host is identified by `default-directory'. For remote
|
||||
hosts that do not support subprocesses, this returns nil.
|
||||
If `default-directory' is a local directory, this function returns
|
||||
the value of the variable `exec-path'."
|
||||
:realname compat--exec-path
|
||||
(cond
|
||||
((let ((handler (find-file-name-handler default-directory 'exec-path)))
|
||||
;; FIXME: The handler was added in 27.1, and this compatibility
|
||||
;; function only applies to versions of Emacs before that.
|
||||
(when handler
|
||||
(condition-case nil
|
||||
(funcall handler 'exec-path)
|
||||
(error nil)))))
|
||||
((file-remote-p default-directory)
|
||||
;; TODO: This is not completely portable, even if "sh" and
|
||||
;; "getconf" should be provided on every POSIX system, the chance
|
||||
;; of this not working are greater than zero.
|
||||
;;
|
||||
;; FIXME: This invokes a shell process every time exec-path is
|
||||
;; called. It should instead be cached on a host-local basis.
|
||||
(with-temp-buffer
|
||||
(if (condition-case nil
|
||||
(zerop (process-file "sh" nil t nil "-c" "getconf PATH"))
|
||||
(file-missing t))
|
||||
(list "/bin" "/usr/bin")
|
||||
(let (path)
|
||||
(while (re-search-forward "\\([^:]+?\\)[\n:]" nil t)
|
||||
(push (match-string 1) path))
|
||||
(nreverse path)))))
|
||||
(exec-path)))
|
||||
|
||||
(declare-function compat--file-local-name "compat-26"
|
||||
(file))
|
||||
|
||||
;;*UNTESTED
|
||||
(compat-defun executable-find (command &optional remote)
|
||||
"Search for COMMAND in `exec-path' and return the absolute file name.
|
||||
Return nil if COMMAND is not found anywhere in `exec-path'. If
|
||||
REMOTE is non-nil, search on the remote host indicated by
|
||||
`default-directory' instead."
|
||||
:prefix t
|
||||
(if (and remote (file-remote-p default-directory))
|
||||
(let ((res (locate-file
|
||||
command
|
||||
(mapcar
|
||||
(apply-partially
|
||||
#'concat (file-remote-p default-directory))
|
||||
(compat--exec-path))
|
||||
exec-suffixes 'file-executable-p)))
|
||||
(when (stringp res) (compat--file-local-name res)))
|
||||
(executable-find command)))
|
||||
|
||||
;; TODO provide advice for directory-files-recursively
|
||||
|
||||
;;;; Defined in format-spec.el
|
||||
|
||||
;; TODO provide advice for format-spec
|
||||
|
||||
;;;; Defined in regexp-opt.el
|
||||
|
||||
(compat-defun regexp-opt (strings &optional paren)
|
||||
"Handle an empty list of strings."
|
||||
:prefix t
|
||||
(if (null strings)
|
||||
(let ((re "\\`a\\`"))
|
||||
(cond ((null paren)
|
||||
(concat "\\(?:" re "\\)"))
|
||||
((stringp paren)
|
||||
(concat paren re "\\)"))
|
||||
((eq paren 'words)
|
||||
(concat "\\<\\(" re "\\)\\>"))
|
||||
((eq paren 'symbols)
|
||||
(concat "\\_\\(<" re "\\)\\_>"))
|
||||
((concat "\\(" re "\\)"))))
|
||||
(regexp-opt strings paren)))
|
||||
|
||||
;;;; Defined in package.el
|
||||
|
||||
(declare-function lm-header "lisp-mnt")
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defun package-get-version ()
|
||||
"Return the version number of the package in which this is used.
|
||||
Assumes it is used from an Elisp file placed inside the top-level directory
|
||||
of an installed ELPA package.
|
||||
The return value is a string (or nil in case we can’t find it)."
|
||||
;; In a sense, this is a lie, but it does just what we want: precompute
|
||||
;; the version at compile time and hardcodes it into the .elc file!
|
||||
(declare (pure t))
|
||||
;; Hack alert!
|
||||
(let ((file
|
||||
(or (and (boundp 'byte-compile-current-file) byte-compile-current-file)
|
||||
load-file-name
|
||||
buffer-file-name)))
|
||||
(cond
|
||||
((null file) nil)
|
||||
;; Packages are normally installed into directories named "<pkg>-<vers>",
|
||||
;; so get the version number from there.
|
||||
((string-match
|
||||
"/[^/]+-\\([0-9]\\(?:[0-9.]\\|pre\\|beta\\|alpha\\|snapshot\\)+\\)/[^/]+\\'"
|
||||
file)
|
||||
(match-string 1 file))
|
||||
;; For packages run straight from the an elpa.git clone, there's no
|
||||
;; "-<vers>" in the directory name, so we have to fetch the version
|
||||
;; the hard way.
|
||||
((let* ((pkgdir (file-name-directory file))
|
||||
(pkgname (file-name-nondirectory (directory-file-name pkgdir)))
|
||||
(mainfile (expand-file-name (concat pkgname ".el") pkgdir)))
|
||||
(when (file-readable-p mainfile)
|
||||
(require 'lisp-mnt)
|
||||
(with-temp-buffer
|
||||
(insert-file-contents mainfile)
|
||||
(or (lm-header "package-version")
|
||||
(lm-header "version")))))))))
|
||||
|
||||
|
||||
;;;; Defined in dired.el
|
||||
|
||||
(declare-function
|
||||
dired-get-marked-files "dired.el"
|
||||
(&optional localp arg filter distinguish-one-marked error))
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defun dired-get-marked-files
|
||||
(&optional localp arg filter distinguish-one-marked error)
|
||||
"Return the marked files’ names as list of strings."
|
||||
:feature 'dired
|
||||
:prefix t
|
||||
(let ((result (dired-get-marked-files localp arg filter distinguish-one-marked)))
|
||||
(if (and (null result) error)
|
||||
(user-error (if (stringp error) error "No files specified"))
|
||||
result)))
|
||||
|
||||
;;;; Defined in time-date.el
|
||||
|
||||
(compat-defun date-days-in-month (year month)
|
||||
"The number of days in MONTH in YEAR."
|
||||
:feature 'time-date
|
||||
(unless (and (numberp month)
|
||||
(<= 1 month)
|
||||
(<= month 12))
|
||||
(error "Month %s is invalid" month))
|
||||
(if (= month 2)
|
||||
(if (date-leap-year-p year)
|
||||
29
|
||||
28)
|
||||
(if (memq month '(1 3 5 7 8 10 12))
|
||||
31
|
||||
30)))
|
||||
|
||||
(compat--inhibit-prefixed (provide 'compat-27))
|
||||
;;; compat-27.el ends here
|
||||
|
|
@ -1,882 +0,0 @@
|
|||
;;; compat-28.el --- Compatibility Layer for Emacs 28.1 -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2021, 2022 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Philip Kaludercic <philipk@posteo.net>
|
||||
;; Maintainer: Compat Development <~pkal/compat-devel@lists.sr.ht>
|
||||
;; URL: https://git.sr.ht/~pkal/compat/
|
||||
;; Keywords: lisp
|
||||
|
||||
;; 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:
|
||||
|
||||
;; Find here the functionality added in Emacs 28.1, needed by older
|
||||
;; versions.
|
||||
;;
|
||||
;; Only load this library if you need to use one of the following
|
||||
;; functions:
|
||||
;;
|
||||
;; - `unlock-buffer'
|
||||
;; - `string-width'
|
||||
;; - `directory-files'
|
||||
;; - `json-serialize'
|
||||
;; - `json-insert'
|
||||
;; - `json-parse-string'
|
||||
;; - `json-parse-buffer'
|
||||
;; - `count-windows'
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'compat-macs "compat-macs.el")
|
||||
|
||||
(compat-declare-version "28.1")
|
||||
|
||||
;;;; Defined in fns.c
|
||||
|
||||
;;* INCOMPLETE FEATURE: Should handle multibyte regular expressions
|
||||
(compat-defun string-search (needle haystack &optional start-pos)
|
||||
"Search for the string NEEDLE in the strign HAYSTACK.
|
||||
|
||||
The return value is the position of the first occurrence of
|
||||
NEEDLE in HAYSTACK, or nil if no match was found.
|
||||
|
||||
The optional START-POS argument says where to start searching in
|
||||
HAYSTACK and defaults to zero (start at the beginning).
|
||||
It must be between zero and the length of HAYSTACK, inclusive.
|
||||
|
||||
Case is always significant and text properties are ignored."
|
||||
:note "Prior to Emacs 27 `string-match' has issues handling
|
||||
multibyte regular expressions. As the compatibility function
|
||||
for `string-search' is implemented via `string-match', these
|
||||
issues are inherited."
|
||||
(when (and start-pos (or (< (length haystack) start-pos)
|
||||
(< start-pos 0)))
|
||||
(signal 'args-out-of-range (list start-pos)))
|
||||
(save-match-data
|
||||
(let ((case-fold-search nil))
|
||||
(string-match (regexp-quote needle) haystack start-pos))))
|
||||
|
||||
(compat-defun length= (sequence length)
|
||||
"Returns non-nil if SEQUENCE has a length equal to LENGTH."
|
||||
(cond
|
||||
((null sequence) (zerop length))
|
||||
((consp sequence)
|
||||
(and (null (nthcdr length sequence))
|
||||
(nthcdr (1- length) sequence)
|
||||
t))
|
||||
((arrayp sequence)
|
||||
(= (length sequence) length))
|
||||
((signal 'wrong-type-argument sequence))))
|
||||
|
||||
(compat-defun length< (sequence length)
|
||||
"Returns non-nil if SEQUENCE is shorter than LENGTH."
|
||||
(cond
|
||||
((null sequence) (not (zerop length)))
|
||||
((listp sequence)
|
||||
(null (nthcdr (1- length) sequence)))
|
||||
((arrayp sequence)
|
||||
(< (length sequence) length))
|
||||
((signal 'wrong-type-argument sequence))))
|
||||
|
||||
(compat-defun length> (sequence length)
|
||||
"Returns non-nil if SEQUENCE is longer than LENGTH."
|
||||
(cond
|
||||
((listp sequence)
|
||||
(and (nthcdr length sequence) t))
|
||||
((arrayp sequence)
|
||||
(> (length sequence) length))
|
||||
((signal 'wrong-type-argument sequence))))
|
||||
|
||||
;;;; Defined in fileio.c
|
||||
|
||||
(compat-defun file-name-concat (directory &rest components)
|
||||
"Append COMPONENTS to DIRECTORY and return the resulting string.
|
||||
Elements in COMPONENTS must be a string or nil.
|
||||
DIRECTORY or the non-final elements in COMPONENTS may or may not end
|
||||
with a slash -- if they don’t end with a slash, a slash will be
|
||||
inserted before contatenating."
|
||||
(let ((seperator (eval-when-compile
|
||||
(if (memq system-type '(ms-dos windows-nt cygwin))
|
||||
"\\" "/")))
|
||||
(last (if components (car (last components)) directory)))
|
||||
(mapconcat (lambda (part)
|
||||
(if (eq part last) ;the last component is not modified
|
||||
last
|
||||
(replace-regexp-in-string
|
||||
(concat seperator "+\\'") "" part)))
|
||||
(cons directory components)
|
||||
seperator)))
|
||||
|
||||
;;;; Defined in alloc.c
|
||||
|
||||
;;* UNTESTED (but also not necessary)
|
||||
(compat-defun garbage-collect-maybe (_factor)
|
||||
"Call ‘garbage-collect’ if enough allocation happened.
|
||||
FACTOR determines what \"enough\" means here: If FACTOR is a
|
||||
positive number N, it means to run GC if more than 1/Nth of the
|
||||
allocations needed to trigger automatic allocation took place.
|
||||
Therefore, as N gets higher, this is more likely to perform a GC.
|
||||
Returns non-nil if GC happened, and nil otherwise."
|
||||
:note "For releases of Emacs before version 28, this function will do nothing."
|
||||
;; Do nothing
|
||||
nil)
|
||||
|
||||
;;;; Defined in filelock.c
|
||||
|
||||
(compat-defun unlock-buffer ()
|
||||
"Handle `file-error' conditions:
|
||||
|
||||
Handles file system errors by calling ‘display-warning’ and
|
||||
continuing as if the error did not occur."
|
||||
:prefix t
|
||||
(condition-case error
|
||||
(unlock-buffer)
|
||||
(file-error
|
||||
(display-warning
|
||||
'(unlock-file)
|
||||
(message "%s, ignored" (error-message-string error))
|
||||
:warning))))
|
||||
|
||||
;;;; Defined in characters.c
|
||||
|
||||
(compat-defun string-width (string &optional from to)
|
||||
"Handle optional arguments FROM and TO:
|
||||
|
||||
Optional arguments FROM and TO specify the substring of STRING to
|
||||
consider, and are interpreted as in `substring'."
|
||||
:prefix t
|
||||
(let* ((len (length string))
|
||||
(from (or from 0))
|
||||
(to (or to len)))
|
||||
(if (and (= from 0) (= to len))
|
||||
(string-width string)
|
||||
(string-width (substring string from to)))))
|
||||
|
||||
;;;; Defined in dired.c
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defun directory-files (directory &optional full match nosort count)
|
||||
"Handle additional optional argument COUNT:
|
||||
|
||||
If COUNT is non-nil and a natural number, the function will
|
||||
return COUNT number of file names (if so many are present)."
|
||||
:prefix t
|
||||
(let ((files (directory-files directory full match nosort)))
|
||||
(when (natnump count)
|
||||
(setf (nthcdr count files) nil))
|
||||
files))
|
||||
|
||||
;;;; Defined in json.c
|
||||
|
||||
(declare-function json-insert nil (object &rest args))
|
||||
(declare-function json-serialize nil (object &rest args))
|
||||
(declare-function json-parse-string nil (string &rest args))
|
||||
(declare-function json-parse-buffer nil (&rest args))
|
||||
|
||||
(compat-defun json-serialize (object &rest args)
|
||||
"Handle top-level JSON values."
|
||||
:prefix t
|
||||
:min-version "27"
|
||||
(if (or (listp object) (vectorp object))
|
||||
(apply #'json-serialize object args)
|
||||
(substring (json-serialize (list object)) 1 -1)))
|
||||
|
||||
(compat-defun json-insert (object &rest args)
|
||||
"Handle top-level JSON values."
|
||||
:prefix t
|
||||
:min-version "27"
|
||||
(if (or (listp object) (vectorp object))
|
||||
(apply #'json-insert object args)
|
||||
;; `compat-json-serialize' is not sharp-quoted as the byte
|
||||
;; compiled doesn't always know that the function has been
|
||||
;; defined, but it will only be used in this function if the
|
||||
;; prefixed definition of `json-serialize' (see above) has also
|
||||
;; been defined.
|
||||
(insert (apply 'compat-json-serialize object args))))
|
||||
|
||||
(compat-defun json-parse-string (string &rest args)
|
||||
"Handle top-level JSON values."
|
||||
:prefix t
|
||||
:min-version "27"
|
||||
(if (string-match-p "\\`[[:space:]]*[[{]" string)
|
||||
(apply #'json-parse-string string args)
|
||||
;; Wrap the string in an array, and extract the value back using
|
||||
;; `elt', to ensure that no matter what the value of `:array-type'
|
||||
;; is we can access the first element.
|
||||
(elt (apply #'json-parse-string (concat "[" string "]") args) 0)))
|
||||
|
||||
(compat-defun json-parse-buffer (&rest args)
|
||||
"Handle top-level JSON values."
|
||||
:prefix t
|
||||
:min-version "27"
|
||||
(if (looking-at-p "[[:space:]]*[[{]")
|
||||
(apply #'json-parse-buffer args)
|
||||
(catch 'escape
|
||||
(atomic-change-group
|
||||
(with-syntax-table
|
||||
(let ((st (make-syntax-table)))
|
||||
(modify-syntax-entry ?\" "\"" st)
|
||||
(modify-syntax-entry ?. "_" st)
|
||||
st)
|
||||
(let ((inhibit-read-only t))
|
||||
(save-excursion
|
||||
(insert "[")
|
||||
(forward-sexp 1)
|
||||
(insert "]"))))
|
||||
(throw 'escape (elt (apply #'json-parse-buffer args) 0))))))
|
||||
|
||||
;;;; xfaces.c
|
||||
|
||||
(compat-defun color-values-from-color-spec (spec)
|
||||
"Parse color SPEC as a numeric color and return (RED GREEN BLUE).
|
||||
This function recognises the following formats for SPEC:
|
||||
|
||||
#RGB, where R, G and B are hex numbers of equal length, 1-4 digits each.
|
||||
rgb:R/G/B, where R, G, and B are hex numbers, 1-4 digits each.
|
||||
rgbi:R/G/B, where R, G and B are floating-point numbers in [0,1].
|
||||
|
||||
If SPEC is not in one of the above forms, return nil.
|
||||
|
||||
Each of the 3 integer members of the resulting list, RED, GREEN,
|
||||
and BLUE, is normalized to have its value in [0,65535]."
|
||||
(let ((case-fold-search nil))
|
||||
(save-match-data
|
||||
(cond
|
||||
((string-match
|
||||
;; (rx bos "#"
|
||||
;; (or (: (group-n 1 (= 1 hex)) (group-n 2 (= 1 hex)) (group-n 3 (= 1 hex)))
|
||||
;; (: (group-n 1 (= 2 hex)) (group-n 2 (= 2 hex)) (group-n 3 (= 2 hex)))
|
||||
;; (: (group-n 1 (= 3 hex)) (group-n 2 (= 3 hex)) (group-n 3 (= 3 hex)))
|
||||
;; (: (group-n 1 (= 4 hex)) (group-n 2 (= 4 hex)) (group-n 3 (= 4 hex))))
|
||||
;; eos)
|
||||
"\\`#\\(?:\\(?1:[[:xdigit:]]\\{1\\}\\)\\(?2:[[:xdigit:]]\\{1\\}\\)\\(?3:[[:xdigit:]]\\{1\\}\\)\\|\\(?1:[[:xdigit:]]\\{2\\}\\)\\(?2:[[:xdigit:]]\\{2\\}\\)\\(?3:[[:xdigit:]]\\{2\\}\\)\\|\\(?1:[[:xdigit:]]\\{3\\}\\)\\(?2:[[:xdigit:]]\\{3\\}\\)\\(?3:[[:xdigit:]]\\{3\\}\\)\\|\\(?1:[[:xdigit:]]\\{4\\}\\)\\(?2:[[:xdigit:]]\\{4\\}\\)\\(?3:[[:xdigit:]]\\{4\\}\\)\\)\\'"
|
||||
spec)
|
||||
(let ((max (1- (ash 1 (* (- (match-end 1) (match-beginning 1)) 4)))))
|
||||
(list (/ (* (string-to-number (match-string 1 spec) 16) 65535) max)
|
||||
(/ (* (string-to-number (match-string 2 spec) 16) 65535) max)
|
||||
(/ (* (string-to-number (match-string 3 spec) 16) 65535) max))))
|
||||
((string-match
|
||||
;; (rx bos "rgb:"
|
||||
;; (group (** 1 4 hex)) "/"
|
||||
;; (group (** 1 4 hex)) "/"
|
||||
;; (group (** 1 4 hex))
|
||||
;; eos)
|
||||
"\\`rgb:\\([[:xdigit:]]\\{1,4\\}\\)/\\([[:xdigit:]]\\{1,4\\}\\)/\\([[:xdigit:]]\\{1,4\\}\\)\\'"
|
||||
spec)
|
||||
(list (/ (* (string-to-number (match-string 1 spec) 16) 65535)
|
||||
(1- (ash 1 (* (- (match-end 1) (match-beginning 1)) 4))))
|
||||
(/ (* (string-to-number (match-string 2 spec) 16) 65535)
|
||||
(1- (ash 1 (* (- (match-end 2) (match-beginning 2)) 4))))
|
||||
(/ (* (string-to-number (match-string 3 spec) 16) 65535)
|
||||
(1- (ash 1 (* (- (match-end 3) (match-beginning 3)) 4))))))
|
||||
;; The "RGBi" (RGB Intensity) specification is defined by
|
||||
;; XCMS[0], see [1] for the implementation in Xlib.
|
||||
;;
|
||||
;; [0] http://www.nic.funet.fi/pub/X11/X11R4/DOCS/color/Xcms.text
|
||||
;; [1] https://gitlab.freedesktop.org/xorg/lib/libx11/-/blob/master/src/xcms/LRGB.c#L1392
|
||||
((string-match
|
||||
;; (rx bos "rgbi:" (* space)
|
||||
;; (group (? (or "-" "+"))
|
||||
;; (or (: (+ digit) (? "." (* digit)))
|
||||
;; (: "." (+ digit)))
|
||||
;; (? "e" (? (or "-" "+")) (+ digit)))
|
||||
;; "/" (* space)
|
||||
;; (group (? (or "-" "+"))
|
||||
;; (or (: (+ digit) (? "." (* digit)))
|
||||
;; (: "." (+ digit)))
|
||||
;; (? "e" (? (or "-" "+")) (+ digit)))
|
||||
;; "/" (* space)
|
||||
;; (group (? (or "-" "+"))
|
||||
;; (or (: (+ digit) (? "." (* digit)))
|
||||
;; (: "." (+ digit)))
|
||||
;; (? "e" (? (or "-" "+")) (+ digit)))
|
||||
;; eos)
|
||||
"\\`rgbi:[[:space:]]*\\([+-]?\\(?:[[:digit:]]+\\(?:\\.[[:digit:]]*\\)?\\|\\.[[:digit:]]+\\)\\(?:e[+-]?[[:digit:]]+\\)?\\)/[[:space:]]*\\([+-]?\\(?:[[:digit:]]+\\(?:\\.[[:digit:]]*\\)?\\|\\.[[:digit:]]+\\)\\(?:e[+-]?[[:digit:]]+\\)?\\)/[[:space:]]*\\([+-]?\\(?:[[:digit:]]+\\(?:\\.[[:digit:]]*\\)?\\|\\.[[:digit:]]+\\)\\(?:e[+-]?[[:digit:]]+\\)?\\)\\'"
|
||||
spec)
|
||||
(let ((r (round (* (string-to-number (match-string 1 spec)) 65535)))
|
||||
(g (round (* (string-to-number (match-string 2 spec)) 65535)))
|
||||
(b (round (* (string-to-number (match-string 3 spec)) 65535))))
|
||||
(when (and (<= 0 r) (<= r 65535)
|
||||
(<= 0 g) (<= g 65535)
|
||||
(<= 0 b) (<= b 65535))
|
||||
(list r g b))))))))
|
||||
|
||||
;;;; Defined in subr.el
|
||||
|
||||
;;* INCOMPLETE FEATURE: Should handle multibyte regular expressions
|
||||
(compat-defun string-replace (fromstring tostring instring)
|
||||
"Replace FROMSTRING with TOSTRING in INSTRING each time it occurs."
|
||||
(when (equal fromstring "")
|
||||
(signal 'wrong-length-argument '(0)))
|
||||
(let ((case-fold-search nil))
|
||||
(replace-regexp-in-string
|
||||
(regexp-quote fromstring)
|
||||
tostring instring
|
||||
t t)))
|
||||
|
||||
(compat-defun always (&rest _arguments)
|
||||
"Do nothing and return t.
|
||||
This function accepts any number of ARGUMENTS, but ignores them.
|
||||
Also see `ignore'."
|
||||
t)
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defun insert-into-buffer (buffer &optional start end)
|
||||
"Insert the contents of the current buffer into BUFFER.
|
||||
If START/END, only insert that region from the current buffer.
|
||||
Point in BUFFER will be placed after the inserted text."
|
||||
(let ((current (current-buffer)))
|
||||
(with-current-buffer buffer
|
||||
(insert-buffer-substring current start end))))
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defun replace-string-in-region (string replacement &optional start end)
|
||||
"Replace STRING with REPLACEMENT in the region from START to END.
|
||||
The number of replaced occurrences are returned, or nil if STRING
|
||||
doesn't exist in the region.
|
||||
|
||||
If START is nil, use the current point. If END is nil, use `point-max'.
|
||||
|
||||
Comparisons and replacements are done with fixed case."
|
||||
(if start
|
||||
(when (< start (point-min))
|
||||
(error "Start before start of buffer"))
|
||||
(setq start (point)))
|
||||
(if end
|
||||
(when (> end (point-max))
|
||||
(error "End after end of buffer"))
|
||||
(setq end (point-max)))
|
||||
(save-excursion
|
||||
(let ((matches 0)
|
||||
(case-fold-search nil))
|
||||
(goto-char start)
|
||||
(while (search-forward string end t)
|
||||
(delete-region (match-beginning 0) (match-end 0))
|
||||
(insert replacement)
|
||||
(setq matches (1+ matches)))
|
||||
(and (not (zerop matches))
|
||||
matches))))
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defun replace-regexp-in-region (regexp replacement &optional start end)
|
||||
"Replace REGEXP with REPLACEMENT in the region from START to END.
|
||||
The number of replaced occurrences are returned, or nil if REGEXP
|
||||
doesn't exist in the region.
|
||||
|
||||
If START is nil, use the current point. If END is nil, use `point-max'.
|
||||
|
||||
Comparisons and replacements are done with fixed case.
|
||||
|
||||
REPLACEMENT can use the following special elements:
|
||||
|
||||
`\\&' in NEWTEXT means substitute original matched text.
|
||||
`\\N' means substitute what matched the Nth `\\(...\\)'.
|
||||
If Nth parens didn't match, substitute nothing.
|
||||
`\\\\' means insert one `\\'.
|
||||
`\\?' is treated literally."
|
||||
(if start
|
||||
(when (< start (point-min))
|
||||
(error "Start before start of buffer"))
|
||||
(setq start (point)))
|
||||
(if end
|
||||
(when (> end (point-max))
|
||||
(error "End after end of buffer"))
|
||||
(setq end (point-max)))
|
||||
(save-excursion
|
||||
(let ((matches 0)
|
||||
(case-fold-search nil))
|
||||
(goto-char start)
|
||||
(while (re-search-forward regexp end t)
|
||||
(replace-match replacement t)
|
||||
(setq matches (1+ matches)))
|
||||
(and (not (zerop matches))
|
||||
matches))))
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defun buffer-local-boundp (symbol buffer)
|
||||
"Return non-nil if SYMBOL is bound in BUFFER.
|
||||
Also see `local-variable-p'."
|
||||
(catch 'fail
|
||||
(condition-case nil
|
||||
(buffer-local-value symbol buffer)
|
||||
(void-variable nil (throw 'fail nil)))
|
||||
t))
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defmacro with-existing-directory (&rest body)
|
||||
"Execute BODY with `default-directory' bound to an existing directory.
|
||||
If `default-directory' is already an existing directory, it's not changed."
|
||||
(declare (indent 0) (debug t))
|
||||
(let ((quit (make-symbol "with-existing-directory-quit")))
|
||||
`(catch ',quit
|
||||
(dolist (dir (list default-directory
|
||||
(expand-file-name "~/")
|
||||
(getenv "TMPDIR")
|
||||
"/tmp/"
|
||||
;; XXX: check if "/" works on non-POSIX
|
||||
;; system.
|
||||
"/"))
|
||||
(when (and dir (file-exists-p dir))
|
||||
(throw ',quit (let ((default-directory dir))
|
||||
,@body)))))))
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defmacro dlet (binders &rest body)
|
||||
"Like `let' but using dynamic scoping."
|
||||
(declare (indent 1) (debug let))
|
||||
`(let (_)
|
||||
,@(mapcar (lambda (binder)
|
||||
`(defvar ,(if (consp binder) (car binder) binder)))
|
||||
binders)
|
||||
(let ,binders ,@body)))
|
||||
|
||||
(compat-defun ensure-list (object)
|
||||
"Return OBJECT as a list.
|
||||
If OBJECT is already a list, return OBJECT itself. If it's
|
||||
not a list, return a one-element list containing OBJECT."
|
||||
(if (listp object)
|
||||
object
|
||||
(list object)))
|
||||
|
||||
(compat-defun subr-primitive-p (object)
|
||||
"Return t if OBJECT is a built-in primitive function."
|
||||
(subrp object))
|
||||
|
||||
;;;; Defined in subr-x.el
|
||||
|
||||
(compat-defun string-clean-whitespace (string)
|
||||
"Clean up whitespace in STRING.
|
||||
All sequences of whitespaces in STRING are collapsed into a
|
||||
single space character, and leading/trailing whitespace is
|
||||
removed."
|
||||
:feature 'subr-x
|
||||
(let ((blank "[[:blank:]\r\n]+"))
|
||||
(replace-regexp-in-string
|
||||
"^[[:blank:]\r\n]+\\|[[:blank:]\r\n]+$"
|
||||
""
|
||||
(replace-regexp-in-string
|
||||
blank " " string))))
|
||||
|
||||
(compat-defun string-fill (string length)
|
||||
"Clean up whitespace in STRING.
|
||||
All sequences of whitespaces in STRING are collapsed into a
|
||||
single space character, and leading/trailing whitespace is
|
||||
removed."
|
||||
:feature 'subr-x
|
||||
(with-temp-buffer
|
||||
(insert string)
|
||||
(goto-char (point-min))
|
||||
(let ((fill-column length)
|
||||
(adaptive-fill-mode nil))
|
||||
(fill-region (point-min) (point-max)))
|
||||
(buffer-string)))
|
||||
|
||||
(compat-defun string-lines (string &optional omit-nulls)
|
||||
"Split STRING into a list of lines.
|
||||
If OMIT-NULLS, empty lines will be removed from the results."
|
||||
:feature 'subr-x
|
||||
(split-string string "\n" omit-nulls))
|
||||
|
||||
(compat-defun string-pad (string length &optional padding start)
|
||||
"Pad STRING to LENGTH using PADDING.
|
||||
If PADDING is nil, the space character is used. If not nil, it
|
||||
should be a character.
|
||||
|
||||
If STRING is longer than the absolute value of LENGTH, no padding
|
||||
is done.
|
||||
|
||||
If START is nil (or not present), the padding is done to the end
|
||||
of the string, and if non-nil, padding is done to the start of
|
||||
the string."
|
||||
:feature 'subr-x
|
||||
(unless (natnump length)
|
||||
(signal 'wrong-type-argument (list 'natnump length)))
|
||||
(let ((pad-length (- length (length string))))
|
||||
(if (< pad-length 0)
|
||||
string
|
||||
(concat (and start
|
||||
(make-string pad-length (or padding ?\s)))
|
||||
string
|
||||
(and (not start)
|
||||
(make-string pad-length (or padding ?\s)))))))
|
||||
|
||||
(compat-defun string-chop-newline (string)
|
||||
"Remove the final newline (if any) from STRING."
|
||||
:feature 'subr-x
|
||||
(if (and (>= (length string) 1) (= (aref string (1- (length string))) ?\n))
|
||||
(substring string 0 -1)
|
||||
string))
|
||||
|
||||
(compat-defmacro named-let (name bindings &rest body)
|
||||
"Looping construct taken from Scheme.
|
||||
Like `let', bind variables in BINDINGS and then evaluate BODY,
|
||||
but with the twist that BODY can evaluate itself recursively by
|
||||
calling NAME, where the arguments passed to NAME are used
|
||||
as the new values of the bound variables in the recursive invocation."
|
||||
:feature 'subr-x
|
||||
(declare (indent 2) (debug (symbolp (&rest (symbolp form)) body)))
|
||||
(let ((fargs (mapcar (lambda (b)
|
||||
(let ((var (if (consp b) (car b) b)))
|
||||
(make-symbol (symbol-name var))))
|
||||
bindings))
|
||||
(aargs (mapcar (lambda (b) (if (consp b) (cadr b))) bindings))
|
||||
rargs)
|
||||
(dotimes (i (length bindings))
|
||||
(let ((b (nth i bindings)))
|
||||
(push (list (if (consp b) (car b) b) (nth i fargs))
|
||||
rargs)
|
||||
(setf (if (consp b) (car b) b)
|
||||
(nth i fargs))))
|
||||
(letrec
|
||||
((quit (make-symbol "quit")) (self (make-symbol "self"))
|
||||
(total-tco t)
|
||||
(macro (lambda (&rest args)
|
||||
(setq total-tco nil)
|
||||
`(funcall ,self . ,args)))
|
||||
;; Based on `cl--self-tco':
|
||||
(tco-progn (lambda (exprs)
|
||||
(append
|
||||
(butlast exprs)
|
||||
(list (funcall tco (car (last exprs)))))))
|
||||
(tco (lambda (expr)
|
||||
(cond
|
||||
((eq (car-safe expr) 'if)
|
||||
(append (list 'if
|
||||
(cadr expr)
|
||||
(funcall tco (nth 2 expr)))
|
||||
(funcall tco-progn (nthcdr 3 expr))))
|
||||
((eq (car-safe expr) 'cond)
|
||||
(let ((conds (cdr expr)) body)
|
||||
(while conds
|
||||
(let ((branch (pop conds)))
|
||||
(push (cond
|
||||
((cdr branch) ;has tail
|
||||
(funcall tco-progn branch))
|
||||
((null conds) ;last element
|
||||
(list t (funcall tco (car branch))))
|
||||
((progn
|
||||
branch)))
|
||||
body)))
|
||||
(cons 'cond (nreverse body))))
|
||||
((eq (car-safe expr) 'or)
|
||||
(if (cddr expr)
|
||||
(let ((var (make-symbol "var")))
|
||||
`(let ((,var ,(cadr expr)))
|
||||
(if ,var ,(funcall tco var)
|
||||
,(funcall tco (cons 'or (cddr expr))))))
|
||||
(funcall tco (cadr expr))))
|
||||
((eq (car-safe expr) 'condition-case)
|
||||
(append (list 'condition-case (cadr expr) (nth 2 expr))
|
||||
(mapcar
|
||||
(lambda (handler)
|
||||
(cons (car handler)
|
||||
(funcall tco-progn (cdr handler))))
|
||||
(nthcdr 3 expr))))
|
||||
((memq (car-safe expr) '(and progn))
|
||||
(cons (car expr) (funcall tco-progn (cdr expr))))
|
||||
((memq (car-safe expr) '(let let*))
|
||||
(append (list (car expr) (cadr expr))
|
||||
(funcall tco-progn (cddr expr))))
|
||||
((eq (car-safe expr) name)
|
||||
(let (sets (args (cdr expr)))
|
||||
(dolist (farg fargs)
|
||||
(push (list farg (pop args))
|
||||
sets))
|
||||
(cons 'setq (apply #'nconc (nreverse sets)))))
|
||||
(`(throw ',quit ,expr))))))
|
||||
(let ((tco-body (funcall tco (macroexpand-all (macroexp-progn body)))))
|
||||
(when tco-body
|
||||
(setq body `((catch ',quit
|
||||
(while t (let ,rargs ,@(macroexp-unprogn tco-body))))))))
|
||||
(let ((expand (macroexpand-all (macroexp-progn body) (list (cons name macro)))))
|
||||
(if total-tco
|
||||
`(let ,bindings ,expand)
|
||||
`(funcall
|
||||
(letrec ((,self (lambda ,fargs ,expand))) ,self)
|
||||
,@aargs))))))
|
||||
|
||||
;;;; Defined in files.el
|
||||
|
||||
(declare-function compat--string-trim-left "compat-26" (string &optional regexp))
|
||||
(declare-function compat--directory-name-p "compat-25" (name))
|
||||
(compat-defun file-name-with-extension (filename extension)
|
||||
"Set the EXTENSION of a FILENAME.
|
||||
The extension (in a file name) is the part that begins with the last \".\".
|
||||
|
||||
Trims a leading dot from the EXTENSION so that either \"foo\" or
|
||||
\".foo\" can be given.
|
||||
|
||||
Errors if the FILENAME or EXTENSION are empty, or if the given
|
||||
FILENAME has the format of a directory.
|
||||
|
||||
See also `file-name-sans-extension'."
|
||||
(let ((extn (compat--string-trim-left extension "[.]")))
|
||||
(cond
|
||||
((string= filename "")
|
||||
(error "Empty filename"))
|
||||
((string= extn "")
|
||||
(error "Malformed extension: %s" extension))
|
||||
((compat--directory-name-p filename)
|
||||
(error "Filename is a directory: %s" filename))
|
||||
(t
|
||||
(concat (file-name-sans-extension filename) "." extn)))))
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defun directory-empty-p (dir)
|
||||
"Return t if DIR names an existing directory containing no other files.
|
||||
Return nil if DIR does not name a directory, or if there was
|
||||
trouble determining whether DIR is a directory or empty.
|
||||
|
||||
Symbolic links to directories count as directories.
|
||||
See `file-symlink-p' to distinguish symlinks."
|
||||
(and (file-directory-p dir)
|
||||
(null (directory-files dir nil directory-files-no-dot-files-regexp t))))
|
||||
|
||||
(compat-defun file-modes-number-to-symbolic (mode &optional filetype)
|
||||
"Return a string describing a file's MODE.
|
||||
For instance, if MODE is #o700, then it produces `-rwx------'.
|
||||
FILETYPE if provided should be a character denoting the type of file,
|
||||
such as `?d' for a directory, or `?l' for a symbolic link and will override
|
||||
the leading `-' char."
|
||||
(string
|
||||
(or filetype
|
||||
(pcase (lsh mode -12)
|
||||
;; POSIX specifies that the file type is included in st_mode
|
||||
;; and provides names for the file types but values only for
|
||||
;; the permissions (e.g., S_IWOTH=2).
|
||||
|
||||
;; (#o017 ??) ;; #define S_IFMT 00170000
|
||||
(#o014 ?s) ;; #define S_IFSOCK 0140000
|
||||
(#o012 ?l) ;; #define S_IFLNK 0120000
|
||||
;; (8 ??) ;; #define S_IFREG 0100000
|
||||
(#o006 ?b) ;; #define S_IFBLK 0060000
|
||||
(#o004 ?d) ;; #define S_IFDIR 0040000
|
||||
(#o002 ?c) ;; #define S_IFCHR 0020000
|
||||
(#o001 ?p) ;; #define S_IFIFO 0010000
|
||||
(_ ?-)))
|
||||
(if (zerop (logand 256 mode)) ?- ?r)
|
||||
(if (zerop (logand 128 mode)) ?- ?w)
|
||||
(if (zerop (logand 64 mode))
|
||||
(if (zerop (logand 2048 mode)) ?- ?S)
|
||||
(if (zerop (logand 2048 mode)) ?x ?s))
|
||||
(if (zerop (logand 32 mode)) ?- ?r)
|
||||
(if (zerop (logand 16 mode)) ?- ?w)
|
||||
(if (zerop (logand 8 mode))
|
||||
(if (zerop (logand 1024 mode)) ?- ?S)
|
||||
(if (zerop (logand 1024 mode)) ?x ?s))
|
||||
(if (zerop (logand 4 mode)) ?- ?r)
|
||||
(if (zerop (logand 2 mode)) ?- ?w)
|
||||
(if (zerop (logand 512 mode))
|
||||
(if (zerop (logand 1 mode)) ?- ?x)
|
||||
(if (zerop (logand 1 mode)) ?T ?t))))
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defun file-backup-file-names (filename)
|
||||
"Return a list of backup files for FILENAME.
|
||||
The list will be sorted by modification time so that the most
|
||||
recent files are first."
|
||||
;; `make-backup-file-name' will get us the right directory for
|
||||
;; ordinary or numeric backups. It might create a directory for
|
||||
;; backups as a side-effect, according to `backup-directory-alist'.
|
||||
(let* ((filename (file-name-sans-versions
|
||||
(make-backup-file-name (expand-file-name filename))))
|
||||
(dir (file-name-directory filename))
|
||||
files)
|
||||
(dolist (file (file-name-all-completions
|
||||
(file-name-nondirectory filename) dir))
|
||||
(let ((candidate (concat dir file)))
|
||||
(when (and (backup-file-name-p candidate)
|
||||
(string= (file-name-sans-versions candidate) filename))
|
||||
(push candidate files))))
|
||||
(sort files #'file-newer-than-file-p)))
|
||||
|
||||
(compat-defun make-lock-file-name (filename)
|
||||
"Make a lock file name for FILENAME.
|
||||
This prepends \".#\" to the non-directory part of FILENAME, and
|
||||
doesn't respect `lock-file-name-transforms', as Emacs 28.1 and
|
||||
onwards does."
|
||||
(expand-file-name
|
||||
(concat
|
||||
".#" (file-name-nondirectory filename))
|
||||
(file-name-directory filename)))
|
||||
|
||||
;;;; Defined in files-x.el
|
||||
|
||||
(declare-function tramp-tramp-file-p "tramp" (name))
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defun null-device ()
|
||||
"Return the best guess for the null device."
|
||||
(require 'tramp)
|
||||
(if (tramp-tramp-file-p default-directory)
|
||||
"/dev/null"
|
||||
null-device))
|
||||
|
||||
;;;; Defined in minibuffer.el
|
||||
|
||||
(compat-defun format-prompt (prompt default &rest format-args)
|
||||
"Format PROMPT with DEFAULT.
|
||||
If FORMAT-ARGS is nil, PROMPT is used as a plain string. If
|
||||
FORMAT-ARGS is non-nil, PROMPT is used as a format control
|
||||
string, and FORMAT-ARGS are the arguments to be substituted into
|
||||
it. See `format' for details.
|
||||
|
||||
If DEFAULT is a list, the first element is used as the default.
|
||||
If not, the element is used as is.
|
||||
|
||||
If DEFAULT is nil or an empty string, no \"default value\" string
|
||||
is included in the return value."
|
||||
(concat
|
||||
(if (null format-args)
|
||||
prompt
|
||||
(apply #'format prompt format-args))
|
||||
(and default
|
||||
(or (not (stringp default))
|
||||
(> (length default) 0))
|
||||
(format " (default %s)"
|
||||
(if (consp default)
|
||||
(car default)
|
||||
default)))
|
||||
": "))
|
||||
|
||||
;;;; Defined in windows.el
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defun count-windows (&optional minibuf all-frames)
|
||||
"Handle optional argument ALL-FRAMES:
|
||||
|
||||
If ALL-FRAMES is non-nil, count the windows in all frames instead
|
||||
just the selected frame."
|
||||
:prefix t
|
||||
(if all-frames
|
||||
(let ((sum 0))
|
||||
(dolist (frame (frame-list))
|
||||
(with-selected-frame frame
|
||||
(setq sum (+ (count-windows minibuf) sum))))
|
||||
sum)
|
||||
(count-windows minibuf)))
|
||||
|
||||
;;;; Defined in thingatpt.el
|
||||
|
||||
(declare-function mouse-set-point "mouse" (event &optional promote-to-region))
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defun thing-at-mouse (event thing &optional no-properties)
|
||||
"Return the THING at mouse click.
|
||||
Like `thing-at-point', but tries to use the event
|
||||
where the mouse button is clicked to find a thing nearby."
|
||||
:feature 'thingatpt
|
||||
(save-excursion
|
||||
(mouse-set-point event)
|
||||
(thing-at-point thing no-properties)))
|
||||
|
||||
;;;; Defined in macroexp.el
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defun macroexp-file-name ()
|
||||
"Return the name of the file from which the code comes.
|
||||
Returns nil when we do not know.
|
||||
A non-nil result is expected to be reliable when called from a macro in order
|
||||
to find the file in which the macro's call was found, and it should be
|
||||
reliable as well when used at the top-level of a file.
|
||||
Other uses risk returning non-nil value that point to the wrong file."
|
||||
:feature 'macroexp
|
||||
(let ((file (car (last current-load-list))))
|
||||
(or (if (stringp file) file)
|
||||
(bound-and-true-p byte-compile-current-file))))
|
||||
|
||||
;;;; Defined in env.el
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defmacro with-environment-variables (variables &rest body)
|
||||
"Set VARIABLES in the environent and execute BODY.
|
||||
VARIABLES is a list of variable settings of the form (VAR VALUE),
|
||||
where VAR is the name of the variable (a string) and VALUE
|
||||
is its value (also a string).
|
||||
|
||||
The previous values will be be restored upon exit."
|
||||
(declare (indent 1) (debug (sexp body)))
|
||||
(unless (consp variables)
|
||||
(error "Invalid VARIABLES: %s" variables))
|
||||
`(let ((process-environment (copy-sequence process-environment)))
|
||||
,@(mapcar (lambda (elem)
|
||||
`(setenv ,(car elem) ,(cadr elem)))
|
||||
variables)
|
||||
,@body))
|
||||
|
||||
;;;; Defined in button.el
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defun button-buttonize (string callback &optional data)
|
||||
"Make STRING into a button and return it.
|
||||
When clicked, CALLBACK will be called with the DATA as the
|
||||
function argument. If DATA isn't present (or is nil), the button
|
||||
itself will be used instead as the function argument."
|
||||
:feature 'button
|
||||
(propertize string
|
||||
'face 'button
|
||||
'button t
|
||||
'follow-link t
|
||||
'category t
|
||||
'button-data data
|
||||
'keymap button-map
|
||||
'action callback))
|
||||
|
||||
;;;; Defined in autoload.el
|
||||
|
||||
(defvar generated-autoload-file)
|
||||
|
||||
;;* UNTESTED
|
||||
(compat-defun make-directory-autoloads (dir output-file)
|
||||
"Update autoload definitions for Lisp files in the directories DIRS.
|
||||
DIR can be either a single directory or a list of
|
||||
directories. (The latter usage is discouraged.)
|
||||
|
||||
The autoloads will be written to OUTPUT-FILE. If any Lisp file
|
||||
binds `generated-autoload-file' as a file-local variable, write
|
||||
its autoloads into the specified file instead.
|
||||
|
||||
The function does NOT recursively descend into subdirectories of the
|
||||
directory or directories specified."
|
||||
(let ((generated-autoload-file output-file))
|
||||
;; We intentionally don't sharp-quote
|
||||
;; `update-directory-autoloads', because it was deprecated in
|
||||
;; Emacs 28 and we don't want to trigger the byte compiler for
|
||||
;; newer versions.
|
||||
(apply 'update-directory-autoloads
|
||||
(if (listp dir) dir (list dir)))))
|
||||
|
||||
;;;; Defined in time-data.el
|
||||
|
||||
(compat-defun decoded-time-period (time)
|
||||
"Interpret DECODED as a period and return its length in seconds.
|
||||
For computational purposes, years are 365 days long and months
|
||||
are 30 days long."
|
||||
:feature 'time-date
|
||||
:version "28"
|
||||
;; Inlining the definitions from compat-27
|
||||
(+ (if (consp (nth 0 time))
|
||||
;; Fractional second.
|
||||
(/ (float (car (nth 0 time)))
|
||||
(cdr (nth 0 time)))
|
||||
(or (nth 0 time) 0))
|
||||
(* (or (nth 1 time) 0) 60)
|
||||
(* (or (nth 2 time) 0) 60 60)
|
||||
(* (or (nth 3 time) 0) 60 60 24)
|
||||
(* (or (nth 4 time) 0) 60 60 24 30)
|
||||
(* (or (nth 5 time) 0) 60 60 24 365)))
|
||||
|
||||
(compat--inhibit-prefixed (provide 'compat-28))
|
||||
;;; compat-28.el ends here
|
||||
|
|
@ -1,42 +0,0 @@
|
|||
;;; compat-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 "compat-27" "compat-27.el" (0 0 0 0))
|
||||
;;; Generated autoloads from compat-27.el
|
||||
|
||||
(register-definition-prefixes "compat-27" '("derived-mode-p"))
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil "compat-help" "compat-help.el" (0 0 0 0))
|
||||
;;; Generated autoloads from compat-help.el
|
||||
|
||||
(register-definition-prefixes "compat-help" '("compat---describe"))
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil "compat-macs" "compat-macs.el" (0 0 0 0))
|
||||
;;; Generated autoloads from compat-macs.el
|
||||
|
||||
(register-definition-prefixes "compat-macs" '("compat-"))
|
||||
|
||||
;;;***
|
||||
|
||||
;;;### (autoloads nil nil ("compat-24.el" "compat-25.el" "compat-26.el"
|
||||
;;;;;; "compat-28.el" "compat-font-lock.el" "compat-pkg.el" "compat.el")
|
||||
;;;;;; (0 0 0 0))
|
||||
|
||||
;;;***
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; coding: utf-8
|
||||
;; End:
|
||||
;;; compat-autoloads.el ends here
|
||||
|
|
@ -1,48 +0,0 @@
|
|||
;;; compat-font-lock.el --- -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2022 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Philip Kaludercic <philipk@posteo.net>
|
||||
;; Keywords:
|
||||
|
||||
;; 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:
|
||||
|
||||
;; Optional font-locking for `compat' definitions. Every symbol with
|
||||
;; an active compatibility definition will be highlighted.
|
||||
;;
|
||||
;; Load this file to enable the functionality.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(eval-and-compile
|
||||
(require 'cl-lib)
|
||||
(require 'compat-macs))
|
||||
|
||||
(defvar compat-generate-common-fn)
|
||||
(let ((compat-generate-common-fn
|
||||
(lambda (name _def-fn _install-fn check-fn attr _type)
|
||||
(unless (and (plist-get attr :no-highlight)
|
||||
(funcall check-fn))
|
||||
`(font-lock-add-keywords
|
||||
'emacs-lisp-mode
|
||||
',`((,(concat "\\_<\\("
|
||||
(regexp-quote (symbol-name name))
|
||||
"\\)\\_>")
|
||||
1 font-lock-preprocessor-face prepend)))))))
|
||||
(load "compat"))
|
||||
|
||||
(provide 'compat-font-lock)
|
||||
;;; compat-font-lock.el ends here
|
||||
|
|
@ -1,57 +0,0 @@
|
|||
;;; compat-help.el --- Documentation for compat functions -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2022 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Philip Kaludercic <philipk@posteo.net>
|
||||
|
||||
;; 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:
|
||||
|
||||
;; Load this file to insert `compat'-relevant documentation next to
|
||||
;; the regular documentation of a symbol.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(defun compat---describe (symbol)
|
||||
"Insert documentation for SYMBOL if it has compatibility code."
|
||||
(let ((compat (get symbol 'compat-def)))
|
||||
(when compat
|
||||
(let ((doc (get compat 'compat-doc))
|
||||
(start (point)))
|
||||
(when doc
|
||||
(insert "There is a ")
|
||||
(insert-button
|
||||
"compatibility notice"
|
||||
'action (let ((type (get compat 'compat-type)))
|
||||
(cond
|
||||
((memq type '(func macro advice))
|
||||
#'find-function)
|
||||
((memq type '(variable))
|
||||
#'find-variable)
|
||||
((error "Unknown type"))))
|
||||
'button-data compat)
|
||||
(insert (format " for %s (for versions of Emacs before %s):"
|
||||
(symbol-name symbol)
|
||||
(get compat 'compat-version)))
|
||||
(add-text-properties start (point) '(face bold))
|
||||
(newline 2)
|
||||
(insert (substitute-command-keys doc))
|
||||
(fill-region start (point))
|
||||
(newline 2))))))
|
||||
|
||||
(add-hook 'help-fns-describe-function-functions #'compat---describe)
|
||||
|
||||
(provide 'compat-help)
|
||||
;;; compat-help.el ends here
|
||||
|
|
@ -1,316 +0,0 @@
|
|||
;;; compat-macs.el --- Compatibility Macros -*- lexical-binding: t; no-byte-compile: t; -*-
|
||||
|
||||
;; Copyright (C) 2021, 2022 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Philip Kaludercic <philipk@posteo.net>
|
||||
;; Keywords: lisp
|
||||
|
||||
;; 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:
|
||||
|
||||
;; These macros are used to define compatibility functions, macros and
|
||||
;; advice.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(defmacro compat--ignore (&rest _)
|
||||
"Ignore all arguments."
|
||||
nil)
|
||||
|
||||
(defvar compat--inhibit-prefixed nil
|
||||
"Non-nil means that prefixed definitions are not loaded.
|
||||
A prefixed function is something like `compat-assoc', that is
|
||||
only made visible when the respective compatibility version file
|
||||
is loaded (in this case `compat-26').")
|
||||
|
||||
(defmacro compat--inhibit-prefixed (&rest body)
|
||||
"Ignore BODY unless `compat--inhibit-prefixed' is true."
|
||||
`(unless (bound-and-true-p compat--inhibit-prefixed)
|
||||
,@body))
|
||||
|
||||
(defvar compat-current-version nil
|
||||
"Default version to use when no explicit version was given.")
|
||||
|
||||
(defmacro compat-declare-version (version)
|
||||
"Set the Emacs version that is currently being handled to VERSION."
|
||||
;; FIXME: Avoid setting the version for any definition that might
|
||||
;; follow, but try to restrict it to the current file/buffer.
|
||||
(setq compat-current-version version)
|
||||
nil)
|
||||
|
||||
(defvar compat--generate-function #'compat--generate-default
|
||||
"Function used to generate compatibility code.
|
||||
The function must take six arguments: NAME, DEF-FN, INSTALL-FN,
|
||||
CHECK-FN, ATTR and TYPE. The resulting body is constructed by
|
||||
invoking the functions DEF-FN (passed the \"realname\" and the
|
||||
version number, returning the compatibility definition), the
|
||||
INSTALL-FN (passed the \"realname\" and returning the
|
||||
installation code), CHECK-FN (passed the \"realname\" and
|
||||
returning a check to see if the compatibility definition should
|
||||
be installed). ATTR is a plist used to modify the generated
|
||||
code. The following attributes are handled, all others are
|
||||
ignored:
|
||||
|
||||
- :min-version :: Prevent the compatibility definition from begin
|
||||
installed in versions older than indicated (string).
|
||||
|
||||
- :max-version :: Prevent the compatibility definition from begin
|
||||
installed in versions newer than indicated (string).
|
||||
|
||||
- :feature :: The library the code is supposed to be loaded
|
||||
with (via `eval-after-load').
|
||||
|
||||
- :cond :: Only install the compatibility code, iff the value
|
||||
evaluates to non-nil.
|
||||
|
||||
For prefixed functions, this can be interpreted as a test to
|
||||
`defalias' an existing definition or not.
|
||||
|
||||
- :no-highlight :: Do not highlight this definition as
|
||||
compatibility function.
|
||||
|
||||
- :version :: Manual specification of the version the compatee
|
||||
code was defined in (string).
|
||||
|
||||
- :realname :: Manual specification of a \"realname\" to use for
|
||||
the compatibility definition (symbol).
|
||||
|
||||
- :notes :: Additional notes that a developer using this
|
||||
compatibility function should keep in mind.
|
||||
|
||||
- :prefix :: Add a `compat-' prefix to the name, and define the
|
||||
compatibility code unconditionally.
|
||||
|
||||
TYPE is used to set the symbol property `compat-type' for NAME.")
|
||||
|
||||
(defun compat--generate-default (name def-fn install-fn check-fn attr type)
|
||||
"Generate a leaner compatibility definition.
|
||||
See `compat-generate-function' for details on the arguments NAME,
|
||||
DEF-FN, INSTALL-FN, CHECK-FN, ATTR and TYPE."
|
||||
(let* ((min-version (plist-get attr :min-version))
|
||||
(max-version (plist-get attr :max-version))
|
||||
(feature (plist-get attr :feature))
|
||||
(cond (plist-get attr :cond))
|
||||
(version (or (plist-get attr :version)
|
||||
compat-current-version))
|
||||
(realname (or (plist-get attr :realname)
|
||||
(intern (format "compat--%S" name))))
|
||||
(check (cond
|
||||
((or (and min-version
|
||||
(version< emacs-version min-version))
|
||||
(and max-version
|
||||
(version< max-version emacs-version)))
|
||||
'(compat--ignore))
|
||||
((plist-get attr :prefix)
|
||||
'(compat--inhibit-prefixed))
|
||||
((and version (version<= version emacs-version) (not cond))
|
||||
'(compat--ignore))
|
||||
(`(when (and ,(if cond cond t)
|
||||
,(funcall check-fn)))))))
|
||||
(cond
|
||||
((and (plist-get attr :prefix) (memq type '(func macro))
|
||||
(string-match "\\`compat-\\(.+\\)\\'" (symbol-name name))
|
||||
(let* ((actual-name (intern (match-string 1 (symbol-name name))))
|
||||
(body (funcall install-fn actual-name version)))
|
||||
(when (and (version<= version emacs-version)
|
||||
(fboundp actual-name))
|
||||
`(,@check
|
||||
,(if feature
|
||||
;; See https://nullprogram.com/blog/2018/02/22/:
|
||||
`(eval-after-load ,feature `(funcall ',(lambda () ,body)))
|
||||
body))))))
|
||||
((plist-get attr :realname)
|
||||
`(progn
|
||||
,(funcall def-fn realname version)
|
||||
(,@check
|
||||
,(let ((body (funcall install-fn realname version)))
|
||||
(if feature
|
||||
;; See https://nullprogram.com/blog/2018/02/22/:
|
||||
`(eval-after-load ,feature `(funcall ',(lambda () ,body)))
|
||||
body)))))
|
||||
((let* ((body (if (eq type 'advice)
|
||||
`(,@check
|
||||
,(funcall def-fn realname version)
|
||||
,(funcall install-fn realname version))
|
||||
`(,@check ,(funcall def-fn name version)))))
|
||||
(if feature
|
||||
;; See https://nullprogram.com/blog/2018/02/22/:
|
||||
`(eval-after-load ,feature `(funcall ',(lambda () ,body)))
|
||||
body))))))
|
||||
|
||||
(defun compat-generate-common (name def-fn install-fn check-fn attr type)
|
||||
"Common code for generating compatibility definitions.
|
||||
See `compat-generate-function' for details on the arguments NAME,
|
||||
DEF-FN, INSTALL-FN, CHECK-FN, ATTR and TYPE."
|
||||
(when (and (plist-get attr :cond) (plist-get attr :prefix))
|
||||
(error "A prefixed function %s cannot have a condition" name))
|
||||
(funcall compat--generate-function
|
||||
name def-fn install-fn check-fn attr type))
|
||||
|
||||
(defun compat-common-fdefine (type name arglist docstring rest)
|
||||
"Generate compatibility code for a function NAME.
|
||||
TYPE is one of `func', for functions and `macro' for macros, and
|
||||
`advice' ARGLIST is passed on directly to the definition, and
|
||||
DOCSTRING is prepended with a compatibility note. REST contains
|
||||
the remaining definition, that may begin with a property list of
|
||||
attributes (see `compat-generate-common')."
|
||||
(let ((oldname name) (body rest))
|
||||
(while (keywordp (car body))
|
||||
(setq body (cddr body)))
|
||||
;; It might be possible to set these properties otherwise. That
|
||||
;; should be looked into and implemented if it is the case.
|
||||
(when (and (listp (car-safe body)) (eq (caar body) 'declare))
|
||||
(when (version<= emacs-version "25")
|
||||
(delq (assq 'side-effect-free (car body)) (car body))
|
||||
(delq (assq 'pure (car body)) (car body))))
|
||||
;; Check if we want an explicitly prefixed function
|
||||
(when (plist-get rest :prefix)
|
||||
(setq name (intern (format "compat-%s" name))))
|
||||
(compat-generate-common
|
||||
name
|
||||
(lambda (realname version)
|
||||
`(,(cond
|
||||
((memq type '(func advice)) 'defun)
|
||||
((eq type 'macro) 'defmacro)
|
||||
((error "Unknown type")))
|
||||
,realname ,arglist
|
||||
;; Prepend compatibility notice to the actual
|
||||
;; documentation string.
|
||||
,(let ((type (cond
|
||||
((eq type 'func) "function")
|
||||
((eq type 'macro) "macro")
|
||||
((eq type 'advice) "advice")
|
||||
((error "Unknown type")))))
|
||||
(if version
|
||||
(format
|
||||
"[Compatibility %s for `%S', defined in Emacs %s]\n\n%s"
|
||||
type oldname version docstring)
|
||||
(format
|
||||
"[Compatibility %s for `%S']\n\n%s"
|
||||
type oldname docstring)))
|
||||
;; Advice may use the implicit variable `oldfun', but
|
||||
;; to avoid triggering the byte compiler, we make
|
||||
;; sure the argument is used at least once.
|
||||
,@(if (eq type 'advice)
|
||||
(cons '(ignore oldfun) body)
|
||||
body)))
|
||||
(lambda (realname _version)
|
||||
(cond
|
||||
((memq type '(func macro))
|
||||
;; Functions and macros are installed by
|
||||
;; aliasing the name of the compatible
|
||||
;; function to the name of the compatibility
|
||||
;; function.
|
||||
`(defalias ',name #',realname))
|
||||
((eq type 'advice)
|
||||
`(advice-add ',name :around #',realname))))
|
||||
(lambda ()
|
||||
(cond
|
||||
((memq type '(func macro))
|
||||
`(not (fboundp ',name)))
|
||||
((eq type 'advice) t)))
|
||||
rest type)))
|
||||
|
||||
(defmacro compat-defun (name arglist docstring &rest rest)
|
||||
"Define NAME with arguments ARGLIST as a compatibility function.
|
||||
The function must be documented in DOCSTRING. REST may begin
|
||||
with a plist, that is interpreted by the macro but not passed on
|
||||
to the actual function. See `compat-generate-common' for a
|
||||
listing of attributes.
|
||||
|
||||
The definition will only be installed, if the version this
|
||||
function was defined in, as indicated by the `:version'
|
||||
attribute, is greater than the current Emacs version."
|
||||
(declare (debug (&define name (&rest symbolp)
|
||||
stringp
|
||||
[&rest keywordp sexp]
|
||||
def-body))
|
||||
(doc-string 3) (indent 2))
|
||||
(compat-common-fdefine 'func name arglist docstring rest))
|
||||
|
||||
(defmacro compat-defmacro (name arglist docstring &rest rest)
|
||||
"Define NAME with arguments ARGLIST as a compatibility macro.
|
||||
The macro must be documented in DOCSTRING. REST may begin
|
||||
with a plist, that is interpreted by this macro but not passed on
|
||||
to the actual macro. See `compat-generate-common' for a
|
||||
listing of attributes.
|
||||
|
||||
The definition will only be installed, if the version this
|
||||
function was defined in, as indicated by the `:version'
|
||||
attribute, is greater than the current Emacs version."
|
||||
(declare (debug compat-defun) (doc-string 3) (indent 2))
|
||||
(compat-common-fdefine 'macro name arglist docstring rest))
|
||||
|
||||
(defmacro compat-advise (name arglist docstring &rest rest)
|
||||
"Define NAME with arguments ARGLIST as a compatibility advice.
|
||||
The advice function must be documented in DOCSTRING. REST may
|
||||
begin with a plist, that is interpreted by this macro but not
|
||||
passed on to the actual advice function. See
|
||||
`compat-generate-common' for a listing of attributes. The advice
|
||||
wraps the old definition, that is accessible via using the symbol
|
||||
`oldfun'.
|
||||
|
||||
The advice will only be installed, if the version this function
|
||||
was defined in, as indicated by the `:version' attribute, is
|
||||
greater than the current Emacs version."
|
||||
(declare (debug compat-defun) (doc-string 3) (indent 2))
|
||||
(compat-common-fdefine 'advice name (cons 'oldfun arglist) docstring rest))
|
||||
|
||||
(defmacro compat-defvar (name initval docstring &rest attr)
|
||||
"Declare compatibility variable NAME with initial value INITVAL.
|
||||
The obligatory documentation string DOCSTRING must be given.
|
||||
|
||||
The remaining arguments ATTR form a plist, modifying the
|
||||
behaviour of this macro. See `compat-generate-common' for a
|
||||
listing of attributes. Furthermore, `compat-defvar' also handles
|
||||
the attribute `:local' that either makes the variable permanent
|
||||
local with a value of `permanent' or just buffer local with any
|
||||
non-nil value."
|
||||
(declare (debug (name form stringp [&rest keywordp sexp]))
|
||||
(doc-string 3) (indent 2))
|
||||
;; Check if we want an explicitly prefixed function
|
||||
(let ((oldname name))
|
||||
(when (plist-get attr :prefix)
|
||||
(setq name (intern (format "compat-%s" name))))
|
||||
(compat-generate-common
|
||||
name
|
||||
(lambda (realname version)
|
||||
(let ((localp (plist-get attr :local)))
|
||||
`(progn
|
||||
(,(if (plist-get attr :constant) 'defconst 'defvar)
|
||||
,realname ,initval
|
||||
;; Prepend compatibility notice to the actual
|
||||
;; documentation string.
|
||||
,(if version
|
||||
(format
|
||||
"[Compatibility variable for `%S', defined in Emacs %s]\n\n%s"
|
||||
oldname version docstring)
|
||||
(format
|
||||
"[Compatibility variable for `%S']\n\n%s"
|
||||
oldname docstring)))
|
||||
;; Make variable as local if necessary
|
||||
,(cond
|
||||
((eq localp 'permanent)
|
||||
`(put ',realname 'permanent-local t))
|
||||
(localp
|
||||
`(make-variable-buffer-local ',realname))))))
|
||||
(lambda (realname _version)
|
||||
`(defvaralias ',name ',realname))
|
||||
(lambda ()
|
||||
`(not (boundp ',name)))
|
||||
attr 'variable)))
|
||||
|
||||
(provide 'compat-macs)
|
||||
;;; compat-macs.el ends here
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
;; Generated package description from compat.el -*- no-byte-compile: t -*-
|
||||
(define-package "compat" "28.1.2.2" "Emacs Lisp Compatibility Library" '((emacs "24.3") (nadvice "0.3")) :commit "d533692182c084bad623977b69f9dc298255eaab" :authors '(("Philip Kaludercic" . "philipk@posteo.net")) :maintainer '("Compat Development" . "~pkal/compat-devel@lists.sr.ht") :keywords '("lisp") :url "https://sr.ht/~pkal/compat")
|
||||
|
|
@ -1,58 +0,0 @@
|
|||
;;; compat.el --- Emacs Lisp Compatibility Library -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2021, 2022 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Philip Kaludercic <philipk@posteo.net>
|
||||
;; Maintainer: Compat Development <~pkal/compat-devel@lists.sr.ht>
|
||||
;; Version: 28.1.2.2
|
||||
;; URL: https://sr.ht/~pkal/compat
|
||||
;; Package-Requires: ((emacs "24.3") (nadvice "0.3"))
|
||||
;; Keywords: lisp
|
||||
|
||||
;; 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:
|
||||
|
||||
;; To allow for the usage of Emacs functions and macros that are
|
||||
;; defined in newer versions of Emacs, compat.el provides definitions
|
||||
;; that are installed ONLY if necessary. These reimplementations of
|
||||
;; functions and macros are at least subsets of the actual
|
||||
;; implementations. Be sure to read the documentation string to make
|
||||
;; sure.
|
||||
;;
|
||||
;; Not every function provided in newer versions of Emacs is provided
|
||||
;; here. Some depend on new features from the core, others cannot be
|
||||
;; implemented to a meaningful degree. Please consult the Compat
|
||||
;; manual for details. The main audience for this library are not
|
||||
;; regular users, but package maintainers. Therefore commands and
|
||||
;; user options are usually not implemented here.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(defvar compat--inhibit-prefixed)
|
||||
(let ((compat--inhibit-prefixed (not (bound-and-true-p compat-testing))))
|
||||
;; Instead of using `require', we manually check `features' and call
|
||||
;; `load' to avoid the issue of not using `provide' at the end of
|
||||
;; the file (which is disabled by `compat--inhibit-prefixed', so
|
||||
;; that the file can be loaded again at some later point when the
|
||||
;; prefixed definitions are needed).
|
||||
(dolist (vers '(24 25 26 27 28))
|
||||
(unless (memq (intern (format "compat-%d" vers)) features)
|
||||
(load (format "compat-%d%s" vers
|
||||
(if (bound-and-true-p compat-testing)
|
||||
".el" ""))
|
||||
nil t))))
|
||||
|
||||
(provide 'compat)
|
||||
;;; compat.el ends here
|
||||
File diff suppressed because it is too large
Load diff
|
|
@ -1,18 +0,0 @@
|
|||
This is the file .../info/dir, which contains the
|
||||
topmost node of the Info hierarchy, called (dir)Top.
|
||||
The first time you invoke Info you start off looking at this node.
|
||||
|
||||
File: dir, Node: Top This is the top of the INFO tree
|
||||
|
||||
This (the Directory node) gives a menu of major topics.
|
||||
Typing "q" exits, "H" lists all Info commands, "d" returns here,
|
||||
"h" gives a primer for first-timers,
|
||||
"mEmacs<Return>" visits the Emacs manual, etc.
|
||||
|
||||
In Emacs, you can click mouse button 2 on a menu item or cross reference
|
||||
to select it.
|
||||
|
||||
* Menu:
|
||||
|
||||
Emacs
|
||||
* Compat: (compat). Compatibility Library for Emacs Lisp.
|
||||
|
|
@ -1,83 +0,0 @@
|
|||
;;; dash-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 dash.el
|
||||
|
||||
(autoload 'dash-fontify-mode "dash" "\
|
||||
Toggle fontification of Dash special variables.
|
||||
|
||||
Dash-Fontify mode is a buffer-local minor mode intended for Emacs
|
||||
Lisp buffers. Enabling it causes the special variables bound in
|
||||
anaphoric Dash macros to be fontified. These anaphoras include
|
||||
`it', `it-index', `acc', and `other'. In older Emacs versions
|
||||
which do not dynamically detect macros, Dash-Fontify mode
|
||||
additionally fontifies Dash macro calls.
|
||||
|
||||
See also `dash-fontify-mode-lighter' and
|
||||
`global-dash-fontify-mode'.
|
||||
|
||||
This is a minor mode. If called interactively, toggle the
|
||||
`Dash-Fontify 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 `dash-fontify-mode'.
|
||||
|
||||
The mode's hook is called both when the mode is enabled and when
|
||||
it is disabled.
|
||||
|
||||
(fn &optional ARG)" t)
|
||||
(put 'global-dash-fontify-mode 'globalized-minor-mode t)
|
||||
(defvar global-dash-fontify-mode nil "\
|
||||
Non-nil if Global Dash-Fontify mode is enabled.
|
||||
See the `global-dash-fontify-mode' command
|
||||
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 `global-dash-fontify-mode'.")
|
||||
(custom-autoload 'global-dash-fontify-mode "dash" nil)
|
||||
(autoload 'global-dash-fontify-mode "dash" "\
|
||||
Toggle Dash-Fontify mode in all buffers.
|
||||
With prefix ARG, enable Global Dash-Fontify mode if ARG is positive;
|
||||
otherwise, disable it.
|
||||
|
||||
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.
|
||||
|
||||
Dash-Fontify mode is enabled in all buffers where
|
||||
`dash--turn-on-fontify-mode' would do it.
|
||||
|
||||
See `dash-fontify-mode' for more information on Dash-Fontify mode.
|
||||
|
||||
(fn &optional ARG)" t)
|
||||
(autoload 'dash-register-info-lookup "dash" "\
|
||||
Register the Dash Info manual with `info-lookup-symbol'.
|
||||
This allows Dash symbols to be looked up with \\[info-lookup-symbol]." t)
|
||||
(register-definition-prefixes "dash" '("!cdr" "!cons" "--" "->" "-a" "-butlast" "-c" "-d" "-e" "-f" "-gr" "-i" "-juxt" "-keep" "-l" "-m" "-no" "-o" "-p" "-r" "-s" "-t" "-u" "-value-to-list" "-when-let" "-zip" "dash-"))
|
||||
|
||||
;;; End of scraped data
|
||||
|
||||
(provide 'dash-autoloads)
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; no-native-compile: t
|
||||
;; coding: utf-8-emacs-unix
|
||||
;; End:
|
||||
|
||||
;;; dash-autoloads.el ends here
|
||||
|
|
@ -1,14 +0,0 @@
|
|||
(define-package "dash" "20240103.1301" "A modern list library for Emacs"
|
||||
'((emacs "24"))
|
||||
:commit "e32a70ca636bad42232b6c79f1491dc86802a721" :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:
|
||||
File diff suppressed because it is too large
Load diff
File diff suppressed because it is too large
Load diff
|
|
@ -1,18 +0,0 @@
|
|||
This is the file .../info/dir, which contains the
|
||||
topmost node of the Info hierarchy, called (dir)Top.
|
||||
The first time you invoke Info you start off looking at this node.
|
||||
|
||||
File: dir, Node: Top This is the top of the INFO tree
|
||||
|
||||
This (the Directory node) gives a menu of major topics.
|
||||
Typing "q" exits, "H" lists all Info commands, "d" returns here,
|
||||
"h" gives a primer for first-timers,
|
||||
"mEmacs<Return>" visits the Emacs manual, etc.
|
||||
|
||||
In Emacs, you can click mouse button 2 on a menu item or cross reference
|
||||
to select it.
|
||||
|
||||
* Menu:
|
||||
|
||||
Emacs
|
||||
* Dash: (dash.info). A modern list library for GNU Emacs.
|
||||
|
|
@ -1,83 +0,0 @@
|
|||
;;; dash-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 dash.el
|
||||
|
||||
(autoload 'dash-fontify-mode "dash" "\
|
||||
Toggle fontification of Dash special variables.
|
||||
|
||||
Dash-Fontify mode is a buffer-local minor mode intended for Emacs
|
||||
Lisp buffers. Enabling it causes the special variables bound in
|
||||
anaphoric Dash macros to be fontified. These anaphoras include
|
||||
`it', `it-index', `acc', and `other'. In older Emacs versions
|
||||
which do not dynamically detect macros, Dash-Fontify mode
|
||||
additionally fontifies Dash macro calls.
|
||||
|
||||
See also `dash-fontify-mode-lighter' and
|
||||
`global-dash-fontify-mode'.
|
||||
|
||||
This is a minor mode. If called interactively, toggle the
|
||||
`Dash-Fontify 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 `dash-fontify-mode'.
|
||||
|
||||
The mode's hook is called both when the mode is enabled and when
|
||||
it is disabled.
|
||||
|
||||
(fn &optional ARG)" t)
|
||||
(put 'global-dash-fontify-mode 'globalized-minor-mode t)
|
||||
(defvar global-dash-fontify-mode nil "\
|
||||
Non-nil if Global Dash-Fontify mode is enabled.
|
||||
See the `global-dash-fontify-mode' command
|
||||
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 `global-dash-fontify-mode'.")
|
||||
(custom-autoload 'global-dash-fontify-mode "dash" nil)
|
||||
(autoload 'global-dash-fontify-mode "dash" "\
|
||||
Toggle Dash-Fontify mode in all buffers.
|
||||
With prefix ARG, enable Global Dash-Fontify mode if ARG is positive;
|
||||
otherwise, disable it.
|
||||
|
||||
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.
|
||||
|
||||
Dash-Fontify mode is enabled in all buffers where
|
||||
`dash--turn-on-fontify-mode' would do it.
|
||||
|
||||
See `dash-fontify-mode' for more information on Dash-Fontify mode.
|
||||
|
||||
(fn &optional ARG)" t)
|
||||
(autoload 'dash-register-info-lookup "dash" "\
|
||||
Register the Dash Info manual with `info-lookup-symbol'.
|
||||
This allows Dash symbols to be looked up with \\[info-lookup-symbol]." t)
|
||||
(register-definition-prefixes "dash" '("!cdr" "!cons" "--" "->" "-a" "-butlast" "-c" "-d" "-e" "-f" "-gr" "-i" "-juxt" "-keep" "-l" "-m" "-no" "-o" "-p" "-r" "-s" "-t" "-u" "-value-to-list" "-when-let" "-zip" "dash-"))
|
||||
|
||||
;;; End of scraped data
|
||||
|
||||
(provide 'dash-autoloads)
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; no-native-compile: t
|
||||
;; coding: utf-8-emacs-unix
|
||||
;; End:
|
||||
|
||||
;;; dash-autoloads.el ends here
|
||||
|
|
@ -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:
|
||||
File diff suppressed because it is too large
Load diff
File diff suppressed because it is too large
Load diff
|
|
@ -1,18 +0,0 @@
|
|||
This is the file .../info/dir, which contains the
|
||||
topmost node of the Info hierarchy, called (dir)Top.
|
||||
The first time you invoke Info you start off looking at this node.
|
||||
|
||||
File: dir, Node: Top This is the top of the INFO tree
|
||||
|
||||
This (the Directory node) gives a menu of major topics.
|
||||
Typing "q" exits, "H" lists all Info commands, "d" returns here,
|
||||
"h" gives a primer for first-timers,
|
||||
"mEmacs<Return>" visits the Emacs manual, etc.
|
||||
|
||||
In Emacs, you can click mouse button 2 on a menu item or cross reference
|
||||
to select it.
|
||||
|
||||
* Menu:
|
||||
|
||||
Emacs
|
||||
* Dash: (dash.info). A modern list library for GNU Emacs.
|
||||
|
|
@ -1,8 +0,0 @@
|
|||
|
||||
######## ## ## ### ###### ######
|
||||
## ### ### ## ## ## ## ## ##
|
||||
## #### #### ## ## ## ##
|
||||
###### ## ### ## ## ## ## ######
|
||||
## ## ## ######### ## ##
|
||||
## ## ## ## ## ## ## ## ##
|
||||
######## ## ## ## ## ###### ######
|
||||
|
|
@ -1,6 +0,0 @@
|
|||
_______ .___ ___. ___ ______ _______.
|
||||
| ____|| \/ | / \ / | / |
|
||||
| |__ | \ / | / ^ \ | ,----' | (----`
|
||||
| __| | |\/| | / /_\ \ | | \ \
|
||||
| |____ | | | | / _____ \ | `----.----) |
|
||||
|_______||__| |__| /__/ \__\ \______|_______/
|
||||
|
|
@ -1,8 +0,0 @@
|
|||
_______ _____ ______ ________ ________ ________
|
||||
|\ ___ \ |\ _ \ _ \|\ __ \|\ ____\|\ ____\
|
||||
\ \ __/|\ \ \\\__\ \ \ \ \|\ \ \ \___|\ \ \___|_
|
||||
\ \ \_|/_\ \ \\|__| \ \ \ __ \ \ \ \ \_____ \
|
||||
\ \ \_|\ \ \ \ \ \ \ \ \ \ \ \ \____\|____|\ \
|
||||
\ \_______\ \__\ \ \__\ \__\ \__\ \_______\____\_\ \
|
||||
\|_______|\|__| \|__|\|__|\|__|\|_______|\_________\
|
||||
\|_________|
|
||||
|
|
@ -1,17 +0,0 @@
|
|||
_ ___ _ _
|
||||
_ ___ __ ___ __ _ ___
|
||||
__ _ ___ __ ___
|
||||
_ ___ _
|
||||
_ _ __ _
|
||||
___ __ _
|
||||
__ _
|
||||
_ _ _
|
||||
_ _ _
|
||||
_ _ _
|
||||
__ ___
|
||||
_ _ _ _
|
||||
_ _
|
||||
_ _
|
||||
_ _
|
||||
_
|
||||
__
|
||||
Binary file not shown.
|
Before Width: | Height: | Size: 43 KiB |
Binary file not shown.
|
Before Width: | Height: | Size: 32 KiB |
|
|
@ -1,39 +0,0 @@
|
|||
;;; dashboard-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 dashboard.el
|
||||
|
||||
(autoload 'dashboard-open "dashboard" "\
|
||||
Open (or refresh) the *dashboard* buffer.
|
||||
|
||||
(fn &rest _)" t)
|
||||
(autoload 'dashboard-setup-startup-hook "dashboard" "\
|
||||
Setup post initialization hooks unless a command line argument is provided.")
|
||||
(register-definition-prefixes "dashboard" '("dashboard-"))
|
||||
|
||||
|
||||
;;; Generated autoloads from dashboard-widgets.el
|
||||
|
||||
(register-definition-prefixes "dashboard-widgets" '("dashboard-" "recentf-list"))
|
||||
|
||||
;;; End of scraped data
|
||||
|
||||
(provide 'dashboard-autoloads)
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; no-native-compile: t
|
||||
;; coding: utf-8-emacs-unix
|
||||
;; End:
|
||||
|
||||
;;; dashboard-autoloads.el ends here
|
||||
|
|
@ -1,14 +0,0 @@
|
|||
(define-package "dashboard" "20240319.915" "A startup screen extracted from Spacemacs"
|
||||
'((emacs "26.1"))
|
||||
:commit "e34ce1b4730fb88a33a571b9065114b7a77645f0" :authors
|
||||
'(("Rakan Al-Hneiti" . "rakan.alhneiti@gmail.com"))
|
||||
:maintainers
|
||||
'(("Jesús Martínez" . "jesusmartinez93@gmail.com"))
|
||||
:maintainer
|
||||
'("Jesús Martínez" . "jesusmartinez93@gmail.com")
|
||||
:keywords
|
||||
'("startup" "screen" "tools" "dashboard")
|
||||
:url "https://github.com/emacs-dashboard/emacs-dashboard")
|
||||
;; Local Variables:
|
||||
;; no-byte-compile: t
|
||||
;; End:
|
||||
File diff suppressed because it is too large
Load diff
|
|
@ -1,556 +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'
|
||||
|
||||
You can also add your custom function or a lambda to the list.
|
||||
example:
|
||||
(lambda () (delete-char -1))"
|
||||
:type '(repeat function)
|
||||
:group 'dashboard)
|
||||
|
||||
(defcustom dashboard-navigation-cycle nil
|
||||
"Non-nil cycle the section navigation."
|
||||
:type 'boolean
|
||||
:group 'dashboard)
|
||||
|
||||
(defconst dashboard-buffer-name "*dashboard*"
|
||||
"Dashboard's buffer name.")
|
||||
|
||||
(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))))
|
||||
(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"))))
|
||||
|
||||
;;
|
||||
;;; 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 (fn)
|
||||
(funcall fn))
|
||||
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,8 +0,0 @@
|
|||
|
||||
######## ## ## ### ###### ######
|
||||
## ### ### ## ## ## ## ## ##
|
||||
## #### #### ## ## ## ##
|
||||
###### ## ### ## ## ## ## ######
|
||||
## ## ## ######### ## ##
|
||||
## ## ## ## ## ## ## ## ##
|
||||
######## ## ## ## ## ###### ######
|
||||
|
|
@ -1,6 +0,0 @@
|
|||
_______ .___ ___. ___ ______ _______.
|
||||
| ____|| \/ | / \ / | / |
|
||||
| |__ | \ / | / ^ \ | ,----' | (----`
|
||||
| __| | |\/| | / /_\ \ | | \ \
|
||||
| |____ | | | | / _____ \ | `----.----) |
|
||||
|_______||__| |__| /__/ \__\ \______|_______/
|
||||
|
|
@ -1,8 +0,0 @@
|
|||
_______ _____ ______ ________ ________ ________
|
||||
|\ ___ \ |\ _ \ _ \|\ __ \|\ ____\|\ ____\
|
||||
\ \ __/|\ \ \\\__\ \ \ \ \|\ \ \ \___|\ \ \___|_
|
||||
\ \ \_|/_\ \ \\|__| \ \ \ __ \ \ \ \ \_____ \
|
||||
\ \ \_|\ \ \ \ \ \ \ \ \ \ \ \ \____\|____|\ \
|
||||
\ \_______\ \__\ \ \__\ \__\ \__\ \_______\____\_\ \
|
||||
\|_______|\|__| \|__|\|__|\|__|\|_______|\_________\
|
||||
\|_________|
|
||||
|
|
@ -1,17 +0,0 @@
|
|||
_ ___ _ _
|
||||
_ ___ __ ___ __ _ ___
|
||||
__ _ ___ __ ___
|
||||
_ ___ _
|
||||
_ _ __ _
|
||||
___ __ _
|
||||
__ _
|
||||
_ _ _
|
||||
_ _ _
|
||||
_ _ _
|
||||
__ ___
|
||||
_ _ _ _
|
||||
_ _
|
||||
_ _
|
||||
_ _
|
||||
_
|
||||
__
|
||||
Binary file not shown.
|
Before Width: | Height: | Size: 43 KiB |
Binary file not shown.
|
Before Width: | Height: | Size: 32 KiB |
|
|
@ -1,39 +0,0 @@
|
|||
;;; dashboard-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 dashboard.el
|
||||
|
||||
(autoload 'dashboard-open "dashboard" "\
|
||||
Open (or refresh) the *dashboard* buffer.
|
||||
|
||||
(fn &rest _)" t)
|
||||
(autoload 'dashboard-setup-startup-hook "dashboard" "\
|
||||
Setup post initialization hooks unless a command line argument is provided.")
|
||||
(register-definition-prefixes "dashboard" '("dashboard-"))
|
||||
|
||||
|
||||
;;; Generated autoloads from dashboard-widgets.el
|
||||
|
||||
(register-definition-prefixes "dashboard-widgets" '("dashboard-" "recentf-list"))
|
||||
|
||||
;;; End of scraped data
|
||||
|
||||
(provide 'dashboard-autoloads)
|
||||
|
||||
;; Local Variables:
|
||||
;; version-control: never
|
||||
;; no-byte-compile: t
|
||||
;; no-update-autoloads: t
|
||||
;; no-native-compile: t
|
||||
;; coding: utf-8-emacs-unix
|
||||
;; End:
|
||||
|
||||
;;; dashboard-autoloads.el ends here
|
||||
|
|
@ -1,15 +0,0 @@
|
|||
(define-package "dashboard" "20240529.2058" "A startup screen extracted from Spacemacs"
|
||||
'((emacs "26.1"))
|
||||
:commit "3852301f9c6f3104d9cc98389612b5ef3452a7de" :authors
|
||||
'(("Rakan Al-Hneiti" . "rakan.alhneiti@gmail.com"))
|
||||
:maintainers
|
||||
'(("Jesús Martínez" . "jesusmartinez93@gmail.com")
|
||||
("Jen-Chieh" . "jcs090218@gmail.com"))
|
||||
:maintainer
|
||||
'("Jesús Martínez" . "jesusmartinez93@gmail.com")
|
||||
:keywords
|
||||
'("startup" "screen" "tools" "dashboard")
|
||||
:url "https://github.com/emacs-dashboard/emacs-dashboard")
|
||||
;; Local Variables:
|
||||
;; no-byte-compile: t
|
||||
;; End:
|
||||
Some files were not shown because too many files have changed in this diff Show more
Reference in a new issue