daniel/emacs
1
2
Fork 0
Code Issues 7 Pull Requests Projects Releases Wiki Activity

add lisp packages

Browse Source
This commit is contained in:
Daniel Weschke
2020-12-05 21:29:49 +01:00
parent 85e20365ae
commit a6e2395755
7272 changed files with 1363243 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

230
lisp/all-the-icons/all-the-icons-faces.el Normal file
View File

@@ -0,0 +1,230 @@
;;; 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

13
lisp/all-the-icons/all-the-icons-pkg.el Normal file
View File

@@ -0,0 +1,13 @@
(define-package "all-the-icons" "20200730.1545" "A library for inserting Developer icons"
'((emacs "24.3")
(memoize "1.0.1"))
:commit "8c0228053dd6693d926970d89270094be52b0f75" :keywords
'("convenient" "lisp")
:authors
'(("Dominic Charlesworth" . "dgc336@gmail.com"))
:maintainer
'("Dominic Charlesworth" . "dgc336@gmail.com")
:url "https://github.com/domtronn/all-the-icons.el")
;; Local Variables:
;; no-byte-compile: t
;; End:

1074
lisp/all-the-icons/all-the-icons.el Normal file
View File

File diff suppressed because it is too large Load Diff

70
lisp/all-the-icons/data/data-alltheicons.el Normal file
View File

@@ -0,0 +1,70 @@
(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)

641
lisp/all-the-icons/data/data-faicons.el Normal file
View File

@@ -0,0 +1,641 @@
(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)

489
lisp/all-the-icons/data/data-fileicons.el Normal file
View File

@@ -0,0 +1,489 @@
(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" )
( "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" )
( "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" . "\xe624" )
( "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" . "\xea54" )
( "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" )
( "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" )
( "perl6" . "\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" )
( "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" )
( "zimpl" . "\xe9c8" )
)
)
(provide 'data-fileicons)

935
lisp/all-the-icons/data/data-material.el Normal file
View File

@@ -0,0 +1,935 @@
(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)

165
lisp/all-the-icons/data/data-octicons.el Normal file
View File

@@ -0,0 +1,165 @@
(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)

594
lisp/all-the-icons/data/data-weathericons.el Normal file
View File

@@ -0,0 +1,594 @@
(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)

210
lisp/async/async-bytecomp.el Normal file
View File

@@ -0,0 +1,210 @@
;;; async-bytecomp.el --- Compile elisp files asynchronously -*- lexical-binding: t -*-
;; Copyright (C) 2014-2016 Free Software Foundation, Inc.
;; Authors: John Wiegley <jwiegley@gmail.com>
;; Thierry Volpiatto <thierry.volpiatto@gmail.com>
;; Keywords: dired async byte-compile
;; X-URL: https://github.com/jwiegley/dired-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 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 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 advicing the function `package--compile'.
;;; Code:
(require 'cl-lib)
(require 'async)
(defcustom async-bytecomp-allowed-packages
;; FIXME: Arguably the default should be `all', but currently
;; this minor mode is silently/forcefully enabled by Helm and Magit to ensure
;; they get compiled asynchronously, so this conservative default value is
;; here to make sure that the mode can be enabled without the user's
;; explicit consent.
'(async forge helm helm-core helm-ls-git helm-ls-hg magit)
"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', 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"))
;;;###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)
(if (file-exists-p async-byte-compile-log-file)
(let ((buf (get-buffer-create byte-compile-log-buffer))
(n 0))
(with-current-buffer buf
(goto-char (point-max))
(let ((inhibit-read-only t))
(insert-file-contents async-byte-compile-log-file)
(compilation-mode))
(display-buffer buf)
(delete-file async-byte-compile-log-file)
(unless quiet
(save-excursion
(goto-char (point-min))
(while (re-search-forward "^.*:Error:" nil t)
(cl-incf n)))
(if (> n 0)
(message "Failed to compile %d files in directory `%s'" n directory)
(message "Directory `%s' compiled asynchronously with warnings" directory)))))
(unless quiet
(message "Directory `%s' compiled asynchronously with success" directory))))))
(async-start
`(lambda ()
(require 'bytecomp)
,(async-inject-variables "\\`\\(load-path\\)\\|byte\\'")
(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))
(defadvice package--compile (around byte-compile-async)
(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.
(when (string= cur-package "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))
ad-do-it)))
;;;###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
(ad-activate 'package--compile)
(ad-deactivate '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)
(let ((bn (file-name-nondirectory file)))
(if (file-exists-p async-byte-compile-log-file)
(let ((buf (get-buffer-create byte-compile-log-buffer))
start)
(with-current-buffer buf
(goto-char (setq start (point-max)))
(let ((inhibit-read-only t))
(insert-file-contents async-byte-compile-log-file)
(compilation-mode))
(display-buffer buf)
(delete-file async-byte-compile-log-file)
(save-excursion
(goto-char start)
(if (re-search-forward "^.*:Error:" nil t)
(message "Failed to compile `%s'" bn)
(message "`%s' compiled asynchronously with warnings" bn)))))
(message "`%s' compiled asynchronously with success" bn))))))
(async-start
`(lambda ()
(require 'bytecomp)
,(async-inject-variables "\\`load-path\\'")
(let ((default-directory ,(file-name-directory file)))
(add-to-list 'load-path default-directory)
(byte-compile-file ,file)
(when (get-buffer byte-compile-log-buffer)
(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

8
lisp/async/async-pkg.el Normal file
View File

@@ -0,0 +1,8 @@
(define-package "async" "20200113.1745" "Asynchronous processing in Emacs"
'((emacs "24.3"))
:keywords
'("async")
:url "https://github.com/jwiegley/emacs-async")
;; Local Variables:
;; no-byte-compile: t
;; End:

408
lisp/async/async.el Normal file
View File

@@ -0,0 +1,408 @@
;;; async.el --- Asynchronous processing -*- lexical-binding: t -*-
;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
;; Author: John Wiegley <jwiegley@gmail.com>
;; Created: 18 Jun 2012
;; Version: 1.9.4
;; Package-Requires: ((emacs "24.3"))
;; Keywords: convenience async
;; 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 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:
;; 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))
(defgroup async nil
"Simple asynchronous processing in Emacs"
:group 'emacs)
(defcustom async-variables-noprops-function #'async--purecopy
"Default function to remove text properties in variables."
:group 'async
:type 'function)
(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)
(defvar async-callback-value nil)
(defvar async-callback-value-set nil)
(defvar async-current-process nil)
(defvar async--procvar nil)
(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)))
(defun async-inject-variables
(include-regexp &optional predicate exclude-regexp noprops)
"Return a `setq' form that replicates part of the calling environment.
It sets the value for every variable matching INCLUDE-REGEXP and
also PREDICATE. It will not perform injection for any variable
matching EXCLUDE-REGEXP (if present) or representing a `syntax-table'
i.e. ending by \"-syntax-table\".
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 (and sname (symbol-value sym))))
(when (and sname
(or (null include-regexp)
(string-match include-regexp sname))
(or (null exclude-regexp)
(not (string-match exclude-regexp sname)))
(not (string-match "-syntax-table\\'" sname)))
(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
(kill-buffer (current-buffer))))
(set (make-local-variable 'async-callback-value) proc)
(set (make-local-variable 'async-callback-value-set) t))
(goto-char (point-max))
(backward-sexp)
(async-handle-result async-callback (read (current-buffer))
(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--receive-sexp (&optional stream)
(let ((sexp (decode-coding-string (base64-decode-string
(read stream)) 'utf-8-auto))
;; Parent expects UTF-8 encoded text.
(coding-system-for-write 'utf-8-auto))
(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)))
(defun async--insert-sexp (sexp)
(let (print-level
print-length
(print-escape-nonascii t)
(print-circle 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-auto)
(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-auto))
(setq async-in-child-emacs t
debug-on-error async-debug)
(if debug-on-error
(prin1 (funcall
(async--receive-sexp (unless async-send-over-pipe
command-line-args-left))))
(condition-case err
(prin1 (funcall
(async--receive-sexp (unless async-send-over-pipe
command-line-args-left))))
(error
(prin1 (list 'async-signal err)))))))
(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 of VALUE is an async.el message packet."
(and (listp value)
(plist-get value :async-message)))
(defun async-send (&rest args)
"Send the given messages to the asychronous Emacs PROCESS."
(let ((args (append args '(:async-message t))))
(if async-in-child-emacs
(if async-callback
(funcall async-callback args))
(async--transmit-sexp (car args) (list 'quote (cdr args))))))
(defun async-receive ()
"Send the given messages to the asychronous Emacs PROCESS."
(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 "*")))
(proc (let ((process-connection-type nil))
(apply #'start-process name buf program program-args))))
(with-current-buffer buf
(set (make-local-variable 'async-callback) finish-func)
(set-process-sentinel proc #'async-when-done)
(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.")
;;;###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 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)
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-auto))
(setq async--procvar
(async-start-process
"emacs" (file-truename
(expand-file-name invocation-name
invocation-directory))
finish-func
async-quiet-switch "-l"
;; Using `locate-library' ensure we use the right file
;; when the .elc have been deleted.
(locate-library "async")
"-batch" "-f" "async-batch-invoke"
(if async-send-over-pipe
"<none>"
(with-temp-buffer
(async--insert-sexp (list 'quote sexp))
(buffer-string)))))
(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

408
lisp/async/dired-async.el Normal file
View File

@@ -0,0 +1,408 @@
;;; dired-async.el --- Asynchronous dired actions -*- lexical-binding: t -*-
;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
;; Authors: John Wiegley <jwiegley@gmail.com>
;; Thierry Volpiatto <thierry.volpiatto@gmail.com>
;; Keywords: dired async network
;; X-URL: https://github.com/jwiegley/dired-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 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 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
:group 'dired-async)
(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'."
:group 'dired-async
:type 'function)
(defcustom dired-async-log-file "/tmp/dired-async.log"
"File use to communicate errors from Child Emacs to host Emacs."
:group 'dired-async
:type 'string)
(defcustom dired-async-mode-lighter '(:eval
(when (eq major-mode 'dired-mode)
" Async"))
"Mode line lighter used for `dired-async-mode'."
:group 'dired-async
:risky t
:type 'sexp)
(defface dired-async-message
'((t (:foreground "yellow")))
"Face used for mode-line message."
:group 'dired-async)
(defface dired-async-failures
'((t (:foreground "red")))
"Face used for mode-line message."
:group 'dired-async)
(defface dired-async-mode-message
'((t (:foreground "Gold")))
"Face used for `dired-async--modeline-mode' lighter."
:group 'dired-async)
(define-minor-mode dired-async--modeline-mode
"Notify mode-line that an async process run."
:group 'dired-async
: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 ()
(cl-loop for p in (process-list)
when (cl-loop for c in (process-command p) thereis
(string= "async-batch-invoke" c))
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))))))
(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)
(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)))
(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))))))))
;; Start async process.
(when async-fn-list
(async-start `(lambda ()
(require 'cl-lib) (require 'dired-aux) (require 'dired-x)
,(async-inject-variables dired-async-env-variables-regexp)
(let ((dired-recursive-copies (quote always))
(dired-copy-preserve-time
,dired-copy-preserve-time))
(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)
;; 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)))
(defadvice wdired-do-renames (around wdired-async)
(let (wdired-use-interactive-rename)
ad-do-it))
(defadvice dired-create-files (around dired-async)
(dired-async-create-files file-creator operation fn-list
name-constructor marker-char))
;;;###autoload
(define-minor-mode dired-async-mode
"Do dired actions asynchronously."
:group 'dired-async
:lighter dired-async-mode-lighter
:global t
(if dired-async-mode
(if (fboundp 'advice-add)
(progn (advice-add 'dired-create-files :override #'dired-async-create-files)
(advice-add 'wdired-do-renames :around #'dired-async-wdired-do-renames))
(ad-activate 'dired-create-files)
(ad-activate 'wdired-do-renames))
(if (fboundp 'advice-remove)
(progn (advice-remove 'dired-create-files #'dired-async-create-files)
(advice-remove 'wdired-do-renames #'dired-async-wdired-do-renames))
(ad-deactivate 'dired-create-files)
(ad-deactivate '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

73
lisp/async/smtpmail-async.el Normal file
View File

@@ -0,0 +1,73 @@
;;; smtpmail-async.el --- Send e-mail with smtpmail.el asynchronously -*- lexical-binding: t -*-
;; Copyright (C) 2012-2016 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 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:
;; 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

147
lisp/biblio/biblio-arxiv.el Normal file
View File

@@ -0,0 +1,147 @@
;;; biblio-arxiv.el --- Lookup and import bibliographic entries from arXiv -*- lexical-binding: t -*-
;; Copyright (C) 2016 Clément Pit-Claudel
;; Author: Clément Pit-Claudel <clement.pitclaudel@live.com>
;; URL: https://github.com/cpitclaudel/biblio.el
;; 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:
;;
;; Lookup and download bibliographic records from arXiv using `arxiv-lookup'.
;; When a DOI is available, the metadata is fetched from the DOI's issuer;
;; otherwise, this package uses arXiv's metadata to generate an entry.
;;
;; This file implements a backend for the for the `biblio' package (which see for more
;; documentation).
;;; Code:
(require 'biblio-core)
(require 'biblio-doi)
(require 'timezone)
(defgroup biblio-arxiv nil
"arXiv support in biblio.el"
:group 'biblio)
(defcustom biblio-arxiv-bibtex-header "online"
"Which header to use for BibTeX entries generated from arXiv metadata."
:group 'biblio
:type 'string)
(defun biblio-arxiv--build-bibtex-1 (metadata)
"Create an unformated BibTeX record for METADATA."
(let-alist metadata
(format "@%s{NO_KEY,
author = {%s},
title = {{%s}},
year = {%s},
archivePrefix = {arXiv},
eprint = {%s},
primaryClass = {%s}}"
biblio-arxiv-bibtex-header
(biblio-join-1 " AND " .authors)
.title .year .identifier .category)))
(defun biblio-arxiv--build-bibtex (metadata)
"Create a BibTeX record for METADATA."
(let-alist metadata
(message "Auto-generating a BibTeX entry for %S." .id)
(biblio-format-bibtex (biblio-arxiv--build-bibtex-1 metadata) t)))
(defun biblio-arxiv--forward-bibtex (metadata forward-to)
"Forward BibTeX for arXiv entry METADATA to FORWARD-TO."
(let-alist metadata
(if (seq-empty-p .doi)
(funcall forward-to (biblio-arxiv--build-bibtex metadata))
(biblio-doi-forward-bibtex .doi forward-to))))
(defun biblio-arxiv--format-author (author)
"Format AUTHOR for arXiv search results."
(when (eq (car-safe author) 'author)
(let-alist (cdr author)
(biblio-join " "
(cadr .name)
(biblio-parenthesize (cadr .arxiv:affiliation))))))
(defun biblio-arxiv--extract-id (id)
"Extract identifier from ID, the URL of an arXiv abstract."
(replace-regexp-in-string "https?://arxiv.org/abs/" "" id))
(defun biblio-arxiv--pdf-url (id)
"Extract PDF url from ID of an arXiv entry."
(when id
(concat "https://arxiv.org/pdf/" id)))
(defun biblio-arxiv--extract-interesting-fields (entry)
"Prepare an arXiv search result ENTRY for display."
(let-alist entry
(let ((id (biblio-arxiv--extract-id (cadr .id))))
(list (cons 'doi (cadr .arxiv:doi))
(cons 'identifier id)
(cons 'year (aref (timezone-parse-date (cadr .published)) 0))
(cons 'title (cadr .title))
(cons 'authors (seq-map #'biblio-arxiv--format-author entry))
(cons 'container (cadr .arxiv:journal_ref))
(cons 'category
(biblio-alist-get 'term (car .arxiv:primary_category)))
(cons 'references (list (cadr .arxiv:doi) id))
(cons 'type "eprint")
(cons 'url (biblio-alist-get 'href (car .link)))
(cons 'direct-url (biblio-arxiv--pdf-url id))))))
(defun biblio-arxiv--entryp (entry)
"Check if ENTRY is an arXiv entry."
(eq (car-safe entry) 'entry))
(defun biblio-arxiv--parse-search-results ()
"Extract search results from arXiv response."
(biblio-decode-url-buffer 'utf-8)
(let-alist (xml-parse-region (point-min) (point-max))
(seq-map #'biblio-arxiv--extract-interesting-fields
(seq-filter #'biblio-arxiv--entryp .feed))))
(defun biblio-arxiv--url (query)
"Create an arXiv url to look up QUERY."
(format "https://export.arxiv.org/api/query?search_query=%s"
(url-encode-url query)))
;;;###autoload
(defun biblio-arxiv-backend (command &optional arg &rest more)
"A arXiv backend for biblio.el.
COMMAND, ARG, MORE: See `biblio-backends'."
(pcase command
(`name "arXiv")
(`prompt "arXiv query: ")
(`url (biblio-arxiv--url arg))
(`parse-buffer (biblio-arxiv--parse-search-results))
(`forward-bibtex (biblio-arxiv--forward-bibtex arg (car more)))
(`register (add-to-list 'biblio-backends #'biblio-arxiv-backend))))
;;;###autoload
(add-hook 'biblio-init-hook #'biblio-arxiv-backend)
;;;###autoload
(defun biblio-arxiv-lookup (&optional query)
"Start an arXiv search for QUERY, prompting if needed."
(interactive)
(biblio-lookup #'biblio-arxiv-backend query))
;;;###autoload
(defalias 'arxiv-lookup 'biblio-arxiv-lookup)
(provide 'biblio-arxiv)
;;; biblio-arxiv.el ends here

113
lisp/biblio/biblio-crossref.el Normal file
View File

@@ -0,0 +1,113 @@
;;; biblio-crossref.el --- Lookup and import bibliographic entries from CrossRef -*- lexical-binding: t -*-
;; Copyright (C) 2016 Clément Pit-Claudel
;; Author: Clément Pit-Claudel <clement.pitclaudel@live.com>
;; URL: https://github.com/cpitclaudel/biblio.el
;; 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:
;;
;; Lookup and download bibliographic records from CrossRef (a very nicely
;; curated metadata engine) using `crossref-lookup'.
;;
;; This file implements a backend for the `biblio' package (which see for more
;; documentation).
;;; Code:
(require 'biblio-core)
(require 'biblio-doi)
(defcustom biblio-crossref-user-email-address nil
"Email address to include in CrossRef queries, or nil.
CrossRef gives priority to queries that include an email address.
See URL `https://github.com/CrossRef/rest-api-doc#etiquette' for
more details."
:group 'biblio
:type '(choice (const :tag "Do not include an email address." nil)
(string :tag "Include an email address.")))
(defun biblio-crossref--forward-bibtex (metadata forward-to)
"Forward BibTeX for CrossRef entry METADATA to FORWARD-TO."
(biblio-doi-forward-bibtex (biblio-alist-get 'doi metadata) forward-to))
(defun biblio-crossref--format-affiliation (affiliation)
"Format AFFILIATION for CrossRef search results."
(mapconcat (apply-partially #'biblio-alist-get 'name) affiliation ", "))
(defun biblio-crossref--format-author (author)
"Format AUTHOR for CrossRef search results."
(let-alist author
(biblio-join " "
.given .family (biblio-parenthesize (biblio-crossref--format-affiliation .affiliation)))))
(defun biblio-crossref--extract-interesting-fields (item)
"Prepare a CrossRef search result ITEM for display."
(let-alist item
(list (cons 'doi .DOI)
(cons 'year (let ((year (aref (aref .issued.date-parts 0) 0)))
(and (numberp year) (number-to-string year))))
(cons 'title (biblio-join " "
(biblio-join-1 ", " .title)
(biblio-parenthesize (biblio-join-1 ", " .subtitle))))
(cons 'authors (seq-map #'biblio-crossref--format-author .author))
(cons 'publisher .publisher)
(cons 'container .container-title)
(cons 'references (seq-concatenate 'list (list .DOI) .isbn))
(cons 'type .type)
(cons 'url .URL))))
(defun biblio-crossref--parse-search-results ()
"Extract search results from CrossRef response."
(biblio-decode-url-buffer 'utf-8)
(let-alist (json-read)
(unless (string= .status "ok")
(display-warning 'biblio-crossref "CrossRef query failed"))
(seq-map #'biblio-crossref--extract-interesting-fields .message.items)))
(defun biblio-crossref--url (query)
"Create a CrossRef url to look up QUERY."
(format "https://api.crossref.org/works?query=%s%s"
(url-encode-url query)
(if biblio-crossref-user-email-address
(format "&mailto=%s" (url-encode-url biblio-crossref-user-email-address)) "")))
;;;###autoload
(defun biblio-crossref-backend (command &optional arg &rest more)
"A CrossRef backend for biblio.el.
COMMAND, ARG, MORE: See `biblio-backends'."
(pcase command
(`name "CrossRef")
(`prompt "CrossRef query: ")
(`url (biblio-crossref--url arg))
(`parse-buffer (biblio-crossref--parse-search-results))
(`forward-bibtex (biblio-crossref--forward-bibtex arg (car more)))
(`register (add-to-list 'biblio-backends #'biblio-crossref-backend))))
;;;###autoload
(add-hook 'biblio-init-hook #'biblio-crossref-backend)
;;;###autoload
(defun biblio-crossref-lookup (&optional query)
"Start a CrossRef search for QUERY, prompting if needed."
(interactive)
(biblio-lookup #'biblio-crossref-backend query))
;;;###autoload
(defalias 'crossref-lookup 'biblio-crossref-lookup)
(provide 'biblio-crossref)
;;; biblio-crossref.el ends here

95
lisp/biblio/biblio-dblp.el Normal file
View File

@@ -0,0 +1,95 @@
;;; biblio-dblp.el --- Lookup and import bibliographic entries from DBLP -*- lexical-binding: t -*-
;; Copyright (C) 2016 Clément Pit-Claudel
;; Author: Clément Pit-Claudel <clement.pitclaudel@live.com>
;; URL: https://github.com/cpitclaudel/biblio.el
;; 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:
;;
;; Lookup and download bibliographic records from DBLP (a great source of
;; references for Computer Science papers) using `dblp-lookup'.
;;
;; This file implements a backend for the for the `biblio' package (which see for more
;; documentation).
;;; Code:
(require 'biblio-core)
(defun biblio-dblp--forward-bibtex (metadata forward-to)
"Forward BibTeX for DBLP entry METADATA to FORWARD-TO."
(let* ((source-url (biblio-alist-get 'url metadata))
(url (replace-regexp-in-string "/rec/" "/rec/bib2/" source-url t t)))
(biblio-url-retrieve url (biblio-generic-url-callback
(lambda () ;; No allowed errors, so no arguments
"Parse DBLP BibTeX results."
(funcall forward-to
(biblio-response-as-utf-8)))))))
(defun biblio-dblp--extract-interesting-fields (item)
"Prepare a DBLP search result ITEM for display."
(let-alist (biblio-alist-get 'info item)
(list (cons 'year (cadr .year))
(cons 'title (cadr .title))
(cons 'authors (seq-map #'cl-caddr (cdr .authors)))
(cons 'container (cadr .venue))
(cons 'references nil)
(cons 'type (cadr .type))
(cons 'url (cadr .url)))))
(defun biblio-dblp--hitp (item)
"Check if ITEM is a DBLP hit."
(eq (car-safe item) 'hit))
(defun biblio-dblp--parse-search-results ()
"Extract search results from DBLP response."
(biblio-decode-url-buffer 'utf-8)
(let-alist (car (xml-parse-region (point-min) (point-max)))
(unless (string= (cadr .status) "OK")
(display-warning 'biblio-dblp "DBLP query failed"))
(seq-map #'biblio-dblp--extract-interesting-fields (seq-filter #'biblio-dblp--hitp .hits))))
(defun biblio-dblp--url (query)
"Create a DBLP url to look up QUERY."
(format "https://dblp.uni-trier.de/search/publ/api?q=%s&format=xml" (url-encode-url query)))
;;;###autoload
(defun biblio-dblp-backend (command &optional arg &rest more)
"A DBLP backend for biblio.el.
COMMAND, ARG, MORE: See `biblio-backends'."
(pcase command
(`name "DBLP")
(`prompt "DBLP query: ")
(`url (biblio-dblp--url arg))
(`parse-buffer (biblio-dblp--parse-search-results))
(`forward-bibtex (biblio-dblp--forward-bibtex arg (car more)))
(`register (add-to-list 'biblio-backends #'biblio-dblp-backend))))
;;;###autoload
(add-hook 'biblio-init-hook #'biblio-dblp-backend)
;;;###autoload
(defun biblio-dblp-lookup (&optional query)
"Start a DBLP search for QUERY, prompting if needed."
(interactive)
(biblio-lookup #'biblio-dblp-backend query))
;;;###autoload
(defalias 'dblp-lookup 'biblio-dblp-lookup)
(provide 'biblio-dblp)
;;; biblio-dblp.el ends here

157
lisp/biblio/biblio-dissemin.el Normal file
View File

@@ -0,0 +1,157 @@
;;; biblio-dissemin.el --- Lookup bibliographic information and open access records from Dissemin -*- lexical-binding: t -*-
;; Copyright (C) 2016 Clément Pit-Claudel
;; Author: Clément Pit-Claudel <clement.pitclaudel@live.com>
;; URL: https://github.com/cpitclaudel/biblio.el
;; 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:
;;
;; Lookup publication records on Dissemin by DOI using `dissemin-lookup'.
;;
;; This package also plugs into `biblio-selection-mode' by adding an entry to
;; the extended actions menu (`x') to quickly locate the Dissemin record of
;; e.g. a CrossRef entry.
;;; Code:
(require 'biblio-core)
(defun biblio-dissemin--format-author (author)
"Format a Dissemin AUTHOR entry."
(let-alist author
(format "%s %s" .name.first .name.last)))
(defun biblio-dissemin--insert-button (url prefix)
"Insert a button pointing to URL, prefixed by PREFIX."
(unless (seq-empty-p url)
(insert "\n" prefix)
(insert (biblio-make-url-button url))))
(defun biblio-dissemin--insert-record (record)
"Insert a Dissemin RECORD entry into the current buffer."
(let-alist record
(insert "\n\n")
(biblio-with-fontification 'font-lock-preprocessor-face
(biblio-insert-with-prefix ">> " .identifier))
(biblio-dissemin--insert-button .pdf_url " ")
(unless (string= .pdf_url .splash_url)
(biblio-dissemin--insert-button .splash_url " "))
(unless (seq-empty-p .abstract)
(insert "\n")
;; (biblio-with-fontification 'font-lock-doc-face
(biblio-insert-with-prefix " " .abstract))))
(defun biblio-dissemin--translate-classification (classification)
"Translate Dissemin's CLASSIFICATION for display."
(pcase classification
(`"OA" "Available from the publisher")
(`"OK" "Some versions may be shared by the author")
(`"UNK" "Sharing policy is unclear")
(`"CLOSED" "Subject to a restrictive sharing policy")
(_ classification)))
(defun biblio-dissemin--suggest-upload (doi)
"Insert a link to Dissemin's upload page for DOI."
(insert "\n\nDid you write this paper? ")
(biblio-with-fontification '(:weight bold)
(insert
(biblio-make-url-button (format "https://dissem.in/%s" doi) "upload it")))
(insert "!\n"))
(defun biblio-dissemin--pretty-print (paper doi)
"Pretty-print a Dissemin PAPER entry (with DOI) to current buffer."
(let-alist paper
(biblio-insert-result
(list (cons 'title .title)
(cons 'authors (seq-map #'biblio-dissemin--format-author .authors))
(cons 'open-access-status
(biblio-dissemin--translate-classification .classification)))
t)
(biblio-dissemin--insert-button .pdf_url " ")
(if (seq-empty-p .records)
(progn (insert "\n\n(no records)")
(when (member .classification '("OA" "OK"))
(biblio-dissemin--suggest-upload doi)))
(seq-do #'biblio-dissemin--insert-record .records))
(goto-char (point-min))))
(defun biblio-dissemin--print-results (paper doi)
"Create a buffer for Dissemin, and print PAPER (with DOI) into it."
(with-current-buffer (biblio-dissemin--make-buffer)
(let ((inhibit-read-only t))
(erase-buffer)
(help-mode)
(visual-line-mode)
(biblio-dissemin--pretty-print paper doi))
(setq buffer-read-only t)
(pop-to-buffer (current-buffer))))
(defun biblio-dissemin--make-buffer ()
"Create a buffer to display Dissemin results in."
(get-buffer-create "*Dissemin search results*"))
(defun biblio-dissemin--parse-buffer ()
"Extract search results from DBLP response."
(biblio-decode-url-buffer 'utf-8)
(let-alist (json-read)
(unless (string= .status "ok")
(display-warning 'biblio-dissemin "Dissemin query failed"))
.paper))
(defun biblio-dissemin--url (doi)
"Create a DBLP url to look up DOI."
(format "https://dissem.in/api/%s" (url-encode-url doi)))
(defun biblio-dissemin--callback (doi)
"Generate a callback to parse Dissemin results for DOI."
(lambda () ;; no allowed errors, so no arguments
(biblio-dissemin--print-results (biblio-dissemin--parse-buffer) doi)))
;;;###autoload
(defun biblio-dissemin-lookup (doi &optional cleanup)
"Retrieve a record by DOI from Dissemin, and display it.
Interactively, or if CLEANUP is non-nil, pass DOI through
`biblio-cleanup-doi'."
(interactive "MDOI: \nd")
(when cleanup
(setq doi (biblio-cleanup-doi doi)))
(let ((buf (biblio-dissemin--make-buffer)))
(biblio-url-retrieve (biblio-dissemin--url doi)
(biblio-generic-url-callback (biblio-dissemin--callback doi)))
buf))
;;;###autoload
(defalias 'dissemin-lookup 'biblio-dissemin-lookup)
(defun biblio-dissemin--lookup-record (record)
"Retrieve a RECORD from Dissemin, and display it.
RECORD is a formatted record as expected by `biblio-insert-result'."
(let-alist record
(if .doi (dissemin-lookup .doi)
(user-error "Dissemin needs a DOI, but this record does not contain one"))))
;;;###autoload
(defun biblio-dissemin--register-action ()
"Add Dissemin to list of `biblio-selection-mode' actions."
(add-to-list 'biblio-selection-mode-actions-alist
'("Dissemin (find open access copies of this article)" . biblio-dissemin--lookup-record)))
;;;###autoload
(add-hook 'biblio-selection-mode-hook #'biblio-dissemin--register-action)
(provide 'biblio-dissemin)
;;; biblio-dissemin.el ends here

124
lisp/biblio/biblio-doi.el Normal file
View File

@@ -0,0 +1,124 @@
;;; biblio-doi.el --- Retrieve BibTeX entries by DOI -*- lexical-binding: t -*-
;; Copyright (C) 2016 Clément Pit-Claudel
;; Author: Clément Pit-Claudel <clement.pitclaudel@live.com>
;; URL: https://github.com/cpitclaudel/biblio.el
;; 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:
;;
;; Retrieve and insert BibTeX records by DOI using `doi-insert-bibtex'.
;; Information is retrieved from DOI issuing sites of each DOI using the
;; “application/x-bibtex” and “text/bibliography” request types, falling back to
;; CrossCite if unavailable.
;;
;; This package integrates with `biblio-selection-mode', and is part of the more
;; general `biblio' package (which see for more documentation).
(require 'biblio-core)
;;; Code:
(defun biblio-doi--dx-url (doi)
"Create a doi.org url for DOI."
(format "https://doi.org/%s" doi))
(defun biblio-doi--crosscite-url (doi)
"Create a crosscite URL to use as a fallback for DOI.
Not all content providers provide BibTeX formatted entries, so
instead of failing reroute the request through crosscite, which
requests a generic format and crates the BibTeX on its own."
(format "https://crosscite.org/citeproc/format?doi=%s&style=bibtex&lang=en-US" doi))
(defconst biblio-doi--dx-mime-accept
;; “Accept:” header; Zenodo recognizes x-bibtex but not text/bibliography
"text/bibliography;style=bibtex, application/x-bibtex")
(defun biblio-doi--set-mime-accept ()
"Set `url-mime-accept-string' before contacting the DOI server."
;; Ugly: let-binding or buffer-locally setting `url-mime-accept-string' does
;; not work, because `url-http-create-request' can be called from a
;; sentinel, or from an entirely new buffer (after a redirection).
(setq url-mime-accept-string biblio-doi--dx-mime-accept))
(defun biblio-doi--restore-mime-accept ()
"Restore `url-mime-accept-string'."
(kill-local-variable 'url-mime-accept-string)
(setq-default url-mime-accept-string nil))
(defun biblio-doi--insert (bibtex buffer)
"Insert formatted BIBTEX into BUFFER."
(with-current-buffer buffer
(insert bibtex "\n\n")))
(defun biblio-doi--generic-url-callback-1 (errors forward-to)
"Helper function for `biblio-doi--generic-url-callback'.
ERRORS, FORWARD-TO: see there."
(funcall forward-to (unless errors (biblio-response-as-utf-8))))
(defun biblio-doi--generic-url-callback (cleanup-fn forward-to)
"Make an URL-ready callback.
Call CLEANUP-FN in any case, and FORWARD-TO with BibTeX source
or nil depending on whether an error occured. If error 406
occurs, forward nil; otherwise, signal the error. This is
essentially a thin wrapper around `biblio-generic-url-callback'."
(biblio-generic-url-callback
(lambda (&optional errors)
"Handle response from BibTeX server."
(biblio-doi--generic-url-callback-1 errors forward-to))
cleanup-fn '(http . 406)))
(defun biblio-doi--crosscite-callback (forward-to)
"Generate a handler for response of CrossCite server.
FORWARD-TO is the callback to call with the results of the search."
(biblio-doi--generic-url-callback #'ignore forward-to))
(defun biblio-doi--forward-bibtex-crosscite (doi forward-to)
"Forward BibTeX entry for DOI from CrossCite to FORWARD-TO."
(biblio-url-retrieve (biblio-doi--crosscite-url doi) (biblio-doi--crosscite-callback forward-to)))
(defun biblio-doi--dx-callback (forward-to)
"Generate a handler for response of DX server.
FORWARD-TO is the callback to call with the results of the search."
(biblio-doi--generic-url-callback #'biblio-doi--restore-mime-accept forward-to))
(defun biblio-doi--forward-bibtex-dx (doi forward-to)
"Forward BibTeX entry for DOI from doi.org to FORWARD-TO."
(biblio-doi--set-mime-accept)
(biblio-url-retrieve (biblio-doi--dx-url doi) (biblio-doi--dx-callback forward-to)))
(defun biblio-doi-forward-bibtex (doi forward-to)
"Pass BibTeX entry for DOI to FORWARD-TO."
(biblio-doi--forward-bibtex-dx
doi (lambda (result)
(if result (funcall forward-to result)
(biblio-doi--forward-bibtex-crosscite doi forward-to)))))
;;;###autoload
(defun doi-insert-bibtex (doi)
"Insert BibTeX entry matching DOI."
(interactive "MDOI: ")
(let ((target-buffer (current-buffer)))
(biblio-doi-forward-bibtex
(biblio-cleanup-doi doi)
(lambda (result)
(biblio-doi--insert
(biblio-format-bibtex result biblio-bibtex-use-autokey)
target-buffer)))))
(provide 'biblio-doi)
;;; biblio-doi.el ends here

58
lisp/biblio/biblio-download.el Normal file
View File

@@ -0,0 +1,58 @@
;;; biblio-download.el --- Lookup bibliographic information and open access records from Dissemin -*- lexical-binding: t -*-
;; Copyright (C) 2016 Clément Pit-Claudel
;; Author: Clément Pit-Claudel <clement.pitclaudel@live.com>
;; URL: https://github.com/cpitclaudel/biblio.el
;; 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:
;;
;; Download scientific papers directly from Emacs.
;;
;; This package plugs into `biblio-selection-mode' by adding an entry to the
;; extended actions menu (`x').
;;; Code:
(require 'biblio-core)
(defcustom biblio-download-directory nil
"Where to put downloaded papers."
:group 'biblio
:type 'directory)
(defun biblio-download--action (record)
"Retrieve a RECORD from Dissemin, and display it.
RECORD is a formatted record as expected by `biblio-insert-result'."
(let-alist record
(if .direct-url
(let* ((fname (concat .identifier ".pdf"))
(target (read-file-name "Save as (see also biblio-download-directory): "
biblio-download-directory fname nil fname)))
(url-copy-file .direct-url (expand-file-name target biblio-download-directory)))
(user-error "This record does not contain a direct URL (try arXiv or HAL)"))))
;;;###autoload
(defun biblio-download--register-action ()
"Add download to list of `biblio-selection-mode' actions."
(add-to-list 'biblio-selection-mode-actions-alist
'("Download this article" . biblio-download--action)))
;;;###autoload
(add-hook 'biblio-selection-mode-hook #'biblio-download--register-action)
(provide 'biblio-download)
;;; biblio-download.el ends here

106
lisp/biblio/biblio-hal.el Normal file
View File

@@ -0,0 +1,106 @@
;;; biblio-hal.el --- Lookup and import bibliographic entries from HAL (archives ouvertes) -*- lexical-binding: t -*-
;; Copyright (C) 2016 Clément Pit-Claudel
;; Author: Clément Pit-Claudel <clement.pitclaudel@live.com>
;; URL: https://github.com/cpitclaudel/biblio.el
;; 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:
;;
;; Lookup and download bibliographic records from HAL using `hal-lookup'.
;;
;; This file implements a backend for the for the `biblio' package (which see for more
;; documentation).
;;; Code:
(require 'biblio-core)
(defun biblio-hal--forward-bibtex (metadata forward-to)
"Forward BibTeX for HAL entry METADATA to FORWARD-TO."
(funcall forward-to (biblio-alist-get 'bibtex metadata)))
;; (defun biblio-hal--format-author (author)
;; "Format AUTHOR for HAL search results."
;; (pcase author
;; (`(,author . ,affiliation)
;; (biblio-join " " author (biblio-parenthesize affiliation)))))
(defun biblio-hal--extract-interesting-fields (item)
"Prepare a HAL search result ITEM for display."
(let-alist item
(list (cons 'doi .doiId_s)
(cons 'year (aref (timezone-parse-date .producedDate_tdate) 0))
(cons 'bibtex .label_bibtex)
(cons 'title (biblio-join " "
(biblio-join-1 ", " .title_s)
(biblio-parenthesize
(biblio-join-1 ", " .subtitle_s))))
(cons 'authors .authFullName_s)
;; Too many institutions? (biblio-parenthesize (biblio-join-1 ", " .structName_s))
(cons 'publisher .journalPublisher_s)
(cons 'container .journalTitle_s)
(cons 'references (biblio-remove-empty
(list .doiId_s .halId_s .arxivId_s)))
(cons 'type .submitType_s)
(cons 'url .uri_s)
(cons 'direct-url (car (append .files_s nil))))))
(defun biblio-hal--parse-search-results ()
"Extract search results from HAL response."
(biblio-decode-url-buffer 'utf-8)
(let-alist (json-read)
(unless .response
(display-warning 'biblio-hal "HAL query failed"))
(seq-map #'biblio-hal--extract-interesting-fields .response.docs)))
(defun biblio-hal--url (query)
"Create a HAL url to look up QUERY."
(format "https://api.archives-ouvertes.fr/search/?q=%s&wt=%s&fl=%s"
(url-encode-url query) "json"
(biblio-join "," ;; Use ‘*’ to show all fields
"arxivId_s" "halId_s" "doiId_s" ;; "journalIssn_s"
"title_s" "subtitle_s" "authFullName_s" "structName_s"
"journalPublisher_s" "submitType_s" ;; "abstract_s"
;; "journalTitle_s" "volume_s" "issue_s" "page_s" "writingDate_s"
"label_bibtex" "files_s" "uri_s" "producedDate_tdate")))
;;;###autoload
(defun biblio-hal-backend (command &optional arg &rest more)
"A HAL backend for biblio.el.
COMMAND, ARG, MORE: See `biblio-backends'."
(pcase command
(`name "HAL")
(`prompt "HAL (archives ouvertes) query: ")
(`url (biblio-hal--url arg))
(`parse-buffer (biblio-hal--parse-search-results))
(`forward-bibtex (biblio-hal--forward-bibtex arg (car more)))
(`register (add-to-list 'biblio-backends #'biblio-hal-backend))))
;;;###autoload
(add-hook 'biblio-init-hook #'biblio-hal-backend)
;;;###autoload
(defun biblio-hal-lookup (&optional query)
"Start a HAL search for QUERY, prompting if needed."
(interactive)
(biblio-lookup #'biblio-hal-backend query))
;;;###autoload
(defalias 'hal-lookup 'biblio-hal-lookup)
(provide 'biblio-hal)
;;; biblio-hal.el ends here

103
lisp/biblio/biblio-ieee.el Normal file
View File

@@ -0,0 +1,103 @@
;;; biblio-ieee.el --- Lookup and import bibliographic entries from IEEE -*- lexical-binding: t -*-
;; Copyright (C) 2019 Clément Pit-Claudel
;; Author: Clément Pit-Claudel <clement.pitclaudel@live.com>
;; URL: https://github.com/cpitclaudel/biblio.el
;; 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:
;;
;; Lookup and download bibliographic records from IEEE Xplore using
;; `ieee-lookup'.
;;
;; This package uses `biblio-selection-mode', and plugs into the more general
;; `biblio' package (which see for more documentation).
;;; Code:
(require 'biblio-core)
(require 'biblio-doi)
(defconst biblio-ieee--api-key "rfwzcsz3f9fkhklhii84xdfz"
"API key used to query IEEE; for use only with biblio.el!")
(defconst biblio-ieee--api-root-url
"https://ieeexploreapi.ieee.org/api/v1/search/articles")
(defun biblio-ieee--forward-bibtex (metadata forward-to)
"Forward BibTeX for IEEE Xplore entry METADATA to FORWARD-TO."
(biblio-doi-forward-bibtex (biblio-alist-get 'doi metadata) forward-to))
(defun biblio-ieee--format-author (author)
"Format AUTHOR for IEEE Xplore search results."
(let-alist author
(biblio-join " " .full_name (biblio-parenthesize .affiliation))))
(defun biblio-ieee--extract-interesting-fields (item)
"Prepare a IEEE Xplore search result ITEM for display."
(let-alist item
(list (cons 'doi .doi)
(cons 'year .publication_year)
(cons 'title .title)
(cons 'authors (seq-map #'biblio-ieee--format-author .authors.authors))
(cons 'publisher .publisher)
(cons 'container .publication_title)
(cons 'references (list .doi .isbn))
(cons 'type (or .index_terms.author_terms.terms
.index_terms.ieee_terms.terms))
(cons 'url .abstract_url)
(cons 'direct-url .pdf_url)
(cons 'open-access-status .access_type))))
(defun biblio-ieee--parse-search-results ()
"Extract search results from IEEE Xplore response."
(biblio-decode-url-buffer 'utf-8)
(let-alist (json-read)
(seq-map #'biblio-ieee--extract-interesting-fields .articles)))
(defun biblio-ieee--url (query)
"Create an IEEE Xplore url to look up QUERY."
(format "%s?querytext=%s&apikey=%s"
biblio-ieee--api-root-url
(url-encode-url query)
(rot13 biblio-ieee--api-key)))
;;;###autoload
(defun biblio-ieee-backend (command &optional arg &rest more)
"A IEEE Xplore backend for biblio.el.
COMMAND, ARG, MORE: See `biblio-backends'."
(pcase command
(`name "IEEE Xplore")
(`prompt "IEEE Xplore query: ")
(`url (biblio-ieee--url arg))
(`parse-buffer (biblio-ieee--parse-search-results))
(`forward-bibtex (biblio-ieee--forward-bibtex arg (car more)))
(`register (add-to-list 'biblio-backends #'biblio-ieee-backend))))
;;;###autoload
(add-hook 'biblio-init-hook #'biblio-ieee-backend)
;;;###autoload
(defun biblio-ieee-lookup (&optional query)
"Start a IEEE search for QUERY, prompting if needed."
(interactive)
(biblio-lookup #'biblio-ieee-backend query))
;;;###autoload
(defalias 'ieee-lookup 'biblio-ieee-lookup)
(provide 'biblio-ieee)
;;; biblio-ieee.el ends here

7
lisp/biblio/biblio-pkg.el Normal file
View File

@@ -0,0 +1,7 @@
(define-package "biblio" "20200416.1407" "Browse and import bibliographic references from CrossRef, arXiv, DBLP, HAL, Dissemin, and doi.org"
'((emacs "24.3")
(biblio-core "0.2"))
:commit "eb9baf1d2bf6a073d24ccb717025baa693e98f3e")
;; Local Variables:
;; no-byte-compile: t
;; End:

97
lisp/biblio/biblio.el Normal file
View File

@@ -0,0 +1,97 @@
;;; biblio.el --- Browse and import bibliographic references and BibTeX records from CrossRef, arXiv, DBLP, HAL, IEEE Xplore, Dissemin, and doi.org -*- lexical-binding: t -*-
;; Copyright (C) 2016 Clément Pit-Claudel
;; Author: Clément Pit-Claudel <clement.pitclaudel@live.com>
;; Version: 0.2
;; Package-Requires: ((emacs "24.3") (biblio-core "0.2"))
;; Keywords: bib, tex, convenience, hypermedia
;; URL: https://github.com/cpitclaudel/biblio.el
;; 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:
;; # biblio.el: An extensible Emacs package for browsing and fetching references
;;
;; biblio.el makes it easy to browse and gather bibliographic references and
;; publications from various sources, by keywords or by DOI. References are
;; automatically fetched from well-curated sources, and formatted as BibTeX.
;;
;; ## Supported sources:
;;
;; * ‘CrossRef’, an exhaustive academic search engine (recommended)
;; * ‘arXiv’, an archive of pre-prints in various scientific fields
;; * ‘DBLP’, a database of Computer Science publications
;; * ‘HAL’, a French repository of Open Access publications
;; * ‘doi.org’, a DOI resolver (to retrieve BibTeX records from DOIs)
;; * ‘CrossCite’, an alternative DOI resolver and BibTeX formatting service
;; * ‘Dissemin’, a database tracking the open access status of scholarly articles
;;
;; ## Usage
;;
;; Quick start: ‘M-x biblio-lookup’. Each source can also be accessed independently:
;;
;; * ‘M-x crossref-lookup’ to query CrossRef
;; * ‘M-x arxiv-lookup` to query arXiv
;; * `M-x dblp-lookup’ to query DBLP
;; * ‘M-x doi-insert’ to insert a BibTeX record by DOI
;; * ‘M-x dissemin-lookup’ to show information about the open access status of a
;; particular DOI
;;
;; Most of these commands work together: for example, ‘crossref-lookup’ displays a
;; list of results in ‘biblio-selection-mode’. In that mode, use:
;;
;; * ‘RET’ to visit the corresponding web page
;; * ‘c’ or ‘M-w’ to copy the BibTeX record of the current entry
;; * ‘i’ or ‘C-y’ to insert the BibTeX record of the current entry
;; * ‘x’ to run an extended action, such as fetching a Dissemin record
;;
;; ‘C’ and ‘I’ do the same as ‘c’ and ‘i’, but additionally close the search window.
;;
;; ## Examples
;;
;; * To insert a clean BibTeX entry for https://doi.org/10.1145/2676726.2677006
;; in the current buffer, use
;;
;; M-x crossref-lookup RET fiat deductive delaware RET i
;;
;; (the last ‘i’ inserts the BibTeX record of the currently selected entry in
;; your buffer).
;;
;; * To find publications by computer scientist Leslie Lamport, use ‘M-x
;; dblp-lookup RET author:Lamport RET’ (see more info about DBLP's syntax at
;; <https://dblp.uni-trier.de/search/>)
;;
;; * To check whether an article is freely available online, use ‘x’ in the list
;; of results. For example ‘M-x crossref-lookup RET Emacs stallman RET’
;; followed by ‘x Dissemin RET’ will help you find open access copies of
;; Stallman's paper on EMACS (spoiler: https://hdl.handle.net/1721.1/5736).
;;
;; See https://github.com/cpitclaudel/biblio.el for more information, including
;; documentation on extending this framework.
;;; Code:
(require 'biblio-core)
(require 'biblio-doi)
(require 'biblio-arxiv)
(require 'biblio-crossref)
(require 'biblio-dblp)
(require 'biblio-hal)
(require 'biblio-ieee)
(require 'biblio-dissemin)
(require 'biblio-download)
(provide 'biblio)
;;; biblio.el ends here

331
lisp/company-web/company-web-html.el Normal file
View File

@@ -0,0 +1,331 @@
;;; company-web-html.el --- company for html-mode & web-mode
;; Copyright (C) 2015 Olexandr Sydorchuck
;; Author: Olexandr Sydorchuck <olexandr.syd@gmail.com>
;; Keywords: html, company, auto-complete
;; 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:
;; Configuration:
;;
;;; Code:
(require 'company-web)
(defcustom company-web-html-emmet-enable t
"Enable emmet specified completion when `emmet-mode' active."
:group 'company-web
:type 'boolean)
(defcustom company-web-html-emmet-enable t
"Enable emmet specified completion when `emmet-mode' active."
:group 'company-web
:type 'boolean)
(defcustom company-web-html-emmet-preview-enable-advice t
"Enable advice for `emmet-preview-accept'. This advice check for visibility of company popup
and call `company-complete-selection' if so.
You may want disable it when you remap emmet-mode key map and change RET behavior."
:group 'company-web
:type 'boolean)
;; html grabs
(defconst company-web-html-get-tag-re
(concat "<[[:space:]]*\\(" company-web-selector "+\\)[[:space:]]")
"Regexp of html tag")
(defconst company-web-html-get-attribute-re
(concat "<[[:space:]]*\\(" company-web-selector "+\\)[^>]*"
"[^[:alnum:]>_-]\\(" company-web-selector "+\\)=")
"Regexp of html attribute")
(defun company-web-html-current-tag ()
"Return current html tag user is typing on."
(let ((bound (save-excursion
(if (re-search-backward ">" (company-web-backward-min-tag-bound) t)
(point)
(company-web-backward-min-tag-bound)))))
(save-excursion
(if (re-search-backward company-web-html-get-tag-re bound t)
(cons (match-string-no-properties 1) (point))
(cons nil (point))))))
(defun company-web-html-current-attribute (bound)
"Return current html tag's attribute user is typing on."
(save-excursion
(re-search-backward company-web-html-get-attribute-re bound t)
(match-string-no-properties 2)))
(defconst company-web-html-tag-regexp
(concat "<[[:space:]]*\\("
company-web-selector
"*\\)")
"A regular expression matching HTML tags.")
(defconst company-web-html-attribute-regexp
(concat "<[[:space:]]*" company-web-selector "[^>]*[[:space:]]+\\(.*\\)")
"A regular expression matching HTML attribute.")
(defconst company-web-html-value-regexp
(concat "\\w=[\"']\\(?:[^\"']+[ ;:]\\|\\)"
;; catch value
"\\([^\"']*\\)")
"A regular expression matching HTML attribute.")
;; emmet grabs
(defconst company-web-html-emmet-tag-separator
"\\(?:^\\|[\t( +>]+\\)")
(defconst company-web-html-emmet-tag-regexp
(concat company-web-html-emmet-tag-separator
"\\(" company-web-selector "*\\)")
"A regular expression matching emmet's tags.")
(defconst company-web-html-emmet-class-regexp
(concat company-web-html-emmet-tag-separator
;; tag
"\\(" company-web-selector "+\\|\\)"
;; maybe "/" after tag
"/?"
;; skip #foo or .bar or .foo.bar.baz
"[#.[:alnum:]-]*"
;; class
"[.]\\(" company-web-selector "*\\)")
"A regular expression matching emmet's class name.")
(defconst company-web-html-emmet-id-regexp
(concat company-web-html-emmet-tag-separator
;; tag
"\\(" company-web-selector "+\\|\\)"
;; maybe "/" after tag
"/?"
;; skip #foo or .bar or .foo.bar.baz
"[#.[:alnum:]-]*"
;; class
"[#]\\(" company-web-selector "*\\)")
"A regular expression matching emmet's class name.")
(defconst company-web-html-emmet-attr-regexp
(concat company-web-html-emmet-tag-separator
;; tag name
"\\(" company-web-selector "+\\)"
;; maybe "/" after tag
"/?"
;; skip not tag separator
"[^\t +>]*?"
;; untill found "["
"\\["
;; skip any defined attributes like foo="bar"
"\\(?:" company-web-selector "+=\"[^\"]*\"\\|\\)+"
;; current attribute
"\\(" company-web-selector "*\\)")
"A regular expression matching emmet's attribute name.")
(defconst company-web-html-emmet-value-regexp
(concat company-web-html-emmet-tag-separator
;; get tag name
"\\(" company-web-selector "+\\)"
;; maybe "/" after tag
"/?"
;; skip not tag separator
"[^\t +>]*?"
;; untill found "["
"\\["
;; skip any defined attributes like foo="bar"
"\\(?:" company-web-selector "+=\"[^\"]*\"\\|\\)+"
;; get current attribute
"\\(" company-web-selector "+\\)"
;; get current value
"=\"\\(.*\\)")
"A regular expression matching emmet's value name.")
(defun company-web-html-emmet-grab ()
(let* ((limit (company-web-backward-min-tag-bound))
(bound (save-excursion
(if (re-search-backward ">" limit t)
(point)
limit))))
(and company-web-html-emmet-enable
(bound-and-true-p emmet-mode)
(or
(company-grab company-web-html-emmet-tag-regexp 1 bound)
(company-grab company-web-html-emmet-class-regexp 2 bound)
(company-grab company-web-html-emmet-id-regexp 2 bound)
(company-grab company-web-html-emmet-attr-regexp 2 bound)
(company-grab company-web-html-emmet-value-regexp 3 bound)))))
(defun company-web-html-emmet-candidates()
(when (and company-web-html-emmet-enable
(bound-and-true-p emmet-mode))
(let* ((limit (company-web-backward-min-tag-bound))
(bound (save-excursion
(if (re-search-backward ">" limit t)
(point)
limit))))
(cond
((company-grab company-web-html-emmet-tag-regexp 1 bound)
(all-completions arg (company-web-candidates-tags)))
;; class (default for div tag)
((company-grab company-web-html-emmet-class-regexp 2 bound)
(let ((tag (company-grab company-web-html-emmet-class-regexp 1 bound)))
(if (string= "" tag)
(setq tag "div"))
(all-completions arg (company-web-candidates-attrib-values tag "class" bound))))
;; id (default for div tag)
((company-grab company-web-html-emmet-id-regexp 2 bound)
(let ((tag (company-grab company-web-html-emmet-id-regexp 1 bound)))
(if (string= "" tag)
(setq tag "div"))
(all-completions arg (company-web-candidates-attrib-values tag "id" bound))))
;; attributes (default for div)
((company-grab company-web-html-emmet-attr-regexp 2 bound)
(let ((tag (company-grab company-web-html-emmet-attr-regexp 1 bound)))
(if (string= "" tag)
(setq tag "div"))
(all-completions arg (company-web-candidates-attribute tag))))
;; attribute values
((company-grab company-web-html-emmet-value-regexp 3 bound)
(let ((tag (company-grab company-web-html-emmet-value-regexp 1 bound))
(attribute (company-grab company-web-html-emmet-value-regexp 2 bound)))
(all-completions arg (company-web-candidates-attrib-values tag attribute bound))))))))
(defadvice emmet-preview-accept (around emmet-with-company-accept)
"First call `company-complete-selection' if visible company popup."
(if (and company-web-html-emmet-enable
company-web-html-emmet-preview-enable-advice
company-pseudo-tooltip-overlay)
(company-complete-selection)
ad-do-it))
(defadvice emmet-preview-abort (around emmet-with-company-abort)
"First call `company-abort' if visible company popup."
(if (and company-web-html-emmet-enable
company-web-html-emmet-preview-enable-advice
company-pseudo-tooltip-overlay)
(company-abort)
ad-do-it))
(defun company-web-html-emmet-doc (arg)
(let* ((limit (company-web-backward-min-tag-bound))
(bound (save-excursion
(if (re-search-backward ">" limit t)
(point)
limit))))
(when (and company-web-html-emmet-enable
(bound-and-true-p emmet-mode))
(cond
((company-grab company-web-html-emmet-tag-regexp 1 bound)
(company-web-tag-doc arg))
;; class (default for div tag)
((company-grab company-web-html-emmet-class-regexp 2 bound)
(let ((tag (company-grab company-web-html-emmet-class-regexp 1 bound)))
(if (string= "" tag)
(setq tag "div"))
(company-web-attribute-doc tag arg)))
;; id (default for div tag)
((company-grab company-web-html-emmet-id-regexp 2 bound)
(let ((tag (company-grab company-web-html-emmet-id-regexp 1 bound)))
(if (string= "" tag)
(setq tag "div"))
(company-web-attribute-doc tag arg)))
;; attributes (default for div)
((company-grab company-web-html-emmet-attr-regexp 2 bound)
(let ((tag (company-grab company-web-html-emmet-attr-regexp 1 bound)))
(if (string= "" tag)
(setq tag "div"))
(company-web-attribute-doc tag arg)))
((company-grab company-web-html-emmet-value-regexp 3 bound)
(let ((tag (company-grab company-web-html-emmet-value-regexp 1 bound))
(attribute (company-grab company-web-html-emmet-value-regexp 2 bound)))
(company-web-attribute-doc tag arg)))))))
(defun company-web-html-prefix-tag ()
(company-web-grab-not-in-string company-web-html-tag-regexp 1 (company-web-backward-min-tag-bound)))
(defun company-web-html-prefix-attribute (bound)
(company-web-grab-not-in-string company-web-html-attribute-regexp 1 bound))
(defun company-web-html-prefix-value (bound)
(when (looking-back company-web-html-value-regexp bound)
(match-string-no-properties 1)))
;;;###autoload
(defun company-web-html (command &optional arg &rest ignored)
"`company-mode' completion back-end for `html-mode' and `web-mode'."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-web-html))
(ignore-case t)
(duplicates nil)
(prefix (and (or (derived-mode-p 'html-mode)
(derived-mode-p 'web-mode))
(let* ((tag-info (company-web-html-current-tag))
(tag (car tag-info))
(tag-bound (cdr tag-info)))
(or (and tag (company-web-html-prefix-value tag-bound))
(and tag (company-web-html-prefix-attribute tag-bound))
(company-web-html-prefix-tag)
(company-web-html-emmet-grab)
))))
(candidates
(let* ((tag-info (company-web-html-current-tag))
(tag (car tag-info))
(tag-bound (cdr tag-info)))
(cond
;; value
((and tag (company-web-html-prefix-value tag-bound))
(all-completions arg (company-web-candidates-attrib-values tag
(company-web-html-current-attribute tag-bound) tag-bound)))
;; attr
((and tag (company-web-html-prefix-attribute tag-bound))
(all-completions arg (company-web-candidates-attribute tag)))
;; tag
((company-web-html-prefix-tag)
(all-completions arg (company-web-candidates-tags)))
;; emmet
((company-web-html-emmet-grab)
(company-web-html-emmet-candidates))
)))
(annotation (company-web-annotation arg))
(doc-buffer
;; No need grab for attribute value, attribute regexp will match enyway
(let* ((tag-info (company-web-html-current-tag))
(tag (car tag-info))
(tag-bound (cdr tag-info)))
(cond
;; value
((and tag (company-web-html-prefix-value tag-bound))
(company-web-candidate-prop-doc arg))
;; attr
((and tag (company-web-html-prefix-attribute tag-bound))
(company-web-attribute-doc tag arg))
;; tag
((company-web-html-prefix-tag)
(company-web-tag-doc arg))
;; emmet
((company-web-html-emmet-grab)
(company-web-html-emmet-doc arg))
)))))
(provide 'company-web-html)
;;; company-web-html.el ends here

162
lisp/company-web/company-web-jade.el Normal file
View File

@@ -0,0 +1,162 @@
;;; company-web-jade.el --- company for jade-mode
;; Copyright (C) 2015 Olexandr Sydorchuck
;; Author: Olexandr Sydorchuck <olexandr.syd@gmail.com>
;; Keywords: jade, company, auto-complete, javascript
;; 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:
;; Configuration:
;;
;;; Code:
(require 'company-web)
(defconst company-web-jade-get-tag-re
(concat "^[\t ]*\\(" company-web-selector "+\\)[.#(]")
"Regexp of jade attribute or tag")
(defconst company-web-jade-get-attribute-re
(concat "[^[:alnum:]-]\\(" company-web-selector "+\\) *=")
"Regexp of jade attribute or tag")
(defun company-web-jade-current-tag ()
"Return current jade tag user is typing on."
(save-excursion
(re-search-backward company-web-jade-get-tag-re nil t)
(match-string 1)))
(defun company-web-jade-current-attribute ()
"Return current jade tag's attribute user is typing on."
(save-excursion
(re-search-backward company-web-jade-get-attribute-re nil t)
(match-string 1)))
(defconst company-web-jade-id-regexp
(concat
;; tag or nil(div)
"^ *\\(" company-web-selector "+\\|\\)"
;; classes ?
"[.[:alnum:]-]*"
;; id?
"#\\(" company-web-selector "*\\|\\)")
"A regular expression matching Jade #idofdiv:
#bar -> <div id=\"bar\">
or
span#bar -> <span id=\"bar\">
.")
(defconst company-web-jade-class-regexp
(concat
;; tag or nil(div)
"^ *\\(" company-web-selector "+\\|\\)"
"[#.[:alnum:]-]*"
;; last class
"[.]\\(" company-web-selector "*\\)")
"A regular expression matching Jade div's class:
.foo -> <div class=\"foo\">
or
span.foo
or
#foo.baz -> <div id=\"foo\" class=\"baz\">
or
span#foo.baz.bar
.")
(defconst company-web-jade-tag-regexp
(concat "^[\t ]*\\(" company-web-selector "*\\)")
"A regular expression matching Jade tags.")
(defconst company-web-jade-attribute-regexp
(concat "\\(?:,\\|(\\)[ ]*\\(.*\\)")
"A regular expression matching Jade attribute.")
(defconst company-web-jade-value-regexp
(concat "\\w *= *[\"']\\(?:[^\"']+[ ]\\|\\)"
;; catch value
"\\([^\"']*\\)")
"A regular expression matching Jade attribute.")
;;;###autoload
(defun company-web-jade (command &optional arg &rest ignored)
"`company-mode' completion back-end for `jade-mode'."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-web-jade))
(ignore-case t)
(duplicates nil)
(prefix (let ((bound (company-web-backward-min-tag-bound)))
(and (or (derived-mode-p 'jade-mode)
(derived-mode-p 'pug-mode))
(or (company-grab company-web-jade-value-regexp 1 bound)
(company-grab company-web-jade-tag-regexp 1 bound)
(company-grab company-web-jade-id-regexp 2 bound)
(company-grab company-web-jade-class-regexp 2 bound)
(company-grab company-web-jade-attribute-regexp 1 bound)))))
(candidates
(let ((bound (company-web-backward-min-tag-bound)))
(cond
;; value
((company-grab company-web-jade-value-regexp 1 bound)
(all-completions arg (company-web-candidates-attrib-values (company-web-jade-current-tag)
(company-web-jade-current-attribute)
bound)))
;; class ".foo" or id "#bar"
((and (not (company-web-is-point-in-string-face))
(company-grab company-web-jade-id-regexp 1 bound))
(let ((tag (company-grab company-web-jade-id-regexp 1 bound)))
(if (string= "" tag)
(setq tag "div"))
(all-completions arg (company-web-candidates-attrib-values tag "id" bound))))
((company-web-grab-not-in-string company-web-jade-class-regexp 1 bound)
(let ((tag (company-grab company-web-jade-class-regexp 1 bound)))
(if (string= "" tag)
(setq tag "div"))
(all-completions arg (company-web-candidates-attrib-values tag "class" bound))))
;; tag
((company-web-grab-not-in-string company-web-jade-tag-regexp 1 bound)
(all-completions arg (company-web-candidates-tags)))
;; attr
((company-web-grab-not-in-string company-web-jade-attribute-regexp 1 bound)
(all-completions arg (company-web-candidates-attribute (company-web-jade-current-tag)))))))
(annotation (company-web-annotation arg))
(doc-buffer
(let ((bound (company-web-backward-min-tag-bound)))
(cond
((or (company-web-grab-not-in-string company-web-jade-id-regexp 1 bound)
(company-web-grab-not-in-string company-web-jade-class-regexp 2 bound)
(company-grab company-web-jade-value-regexp 1 bound))
(company-web-candidate-prop-doc arg))
;; tag
((company-grab company-web-jade-tag-regexp 1 bound)
(company-web-tag-doc arg))
;; attr
((company-grab company-web-jade-attribute-regexp 1 bound)
(company-web-attribute-doc (company-web-jade-current-tag) arg)))))))
(provide 'company-web-jade)
;;; company-web-jade.el ends here

15
lisp/company-web/company-web-pkg.el Normal file
View File

@@ -0,0 +1,15 @@
(define-package "company-web" "20180402.1155" "Company version of ac-html, complete for web,html,emmet,jade,slim modes"
'((company "0.8.0")
(dash "2.8.0")
(cl-lib "0.5.0")
(web-completion-data "0.1.0"))
:commit "f0cc9187c9c34f72ad71f5649a69c74f996bae9a" :keywords
'("html" "company")
:authors
'(("Olexandr Sydorchuk" . "olexandr.syd@gmail.com"))
:maintainer
'("Olexandr Sydorchuk" . "olexandr.syd@gmail.com")
:url "https://github.com/osv/company-web")
;; Local Variables:
;; no-byte-compile: t
;; End:

162
lisp/company-web/company-web-slim.el Normal file
View File

@@ -0,0 +1,162 @@
;;; company-web-slim.el --- company for slim-mode
;; Copyright (C) 2015 Olexandr Sydorchuck
;; Author: Olexandr Sydorchuck <olexandr.syd@gmail.com>
;; Keywords: slim, company, auto-complete, javascript
;; 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:
;; Configuration:
;;
;;; Code:
(require 'company-web)
(defconst company-web-slim-get-tag-re
(concat "^[\t ]*\\(" company-web-selector "+\\)")
"Regexp of slim attribute or tag")
(defconst company-web-slim-get-attribute-re
(concat "[^[:alnum:]-]\\(" company-web-selector "+\\) *=")
"Regexp of slim attribute or tag")
(defun company-web-slim-current-tag ()
"Return current slim tag user is typing on."
(save-excursion
(re-search-backward company-web-slim-get-tag-re nil t)
(match-string 1)))
(defun company-web-slim-current-attribute ()
"Return current slim tag's attribute user is typing on."
(save-excursion
(re-search-backward company-web-slim-get-attribute-re nil t)
(match-string 1)))
(defconst company-web-slim-id-regexp
(concat
;; tag or nil(div)
"^ *\\(" company-web-selector "+\\|\\)"
;; classes ?
"[.[:alnum:]-]*"
;; id?
"#\\(" company-web-selector "*\\|\\)")
"A regular expression matching Slim #id:
#bar -> <div id=\"bar\">
or
span#bar -> <span id=\"bar\">
.")
(defconst company-web-slim-class-regexp
(concat
;; tag or nil(div)
"^ *\\(" company-web-selector "+\\|\\)"
"[#.[:alnum:]-]*"
;; last class
"[.]\\(" company-web-selector "*\\)")
"A regular expression matching Slim div's class:
.foo -> <div class=\"foo\">
or
span.foo
or
#foo.baz -> <div id=\"foo\" class=\"baz\">
or
span#foo.baz.bar
.")
(defconst company-web-slim-tag-regexp
(concat "^[\t ]*\\(" company-web-selector "*\\)")
"A regular expression matching Slim tags.")
(defconst company-web-slim-attribute-regexp
(concat "\\(?:" ; attribute may start after tag and: "[", "(", "{"
"[[({]" ;
"\\|" ; or
" +\\)" ; after whitespace
"\\(" company-web-selector "*\\)")
"A regular expression matching Slim attribute.")
(defconst company-web-slim-value-regexp
(concat "\\w *= *[\"]\\(?:[^\"]+[ ]\\|\\)"
;; catch value
"\\([^\"]*\\)")
"A regular expression matching Slim attribute.")
;;;###autoload
(defun company-web-slim (command &optional arg &rest ignored)
"`company-mode' completion back-end for `slim-mode'."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-web-slim))
(ignore-case t)
(duplicates nil)
(prefix (let ((bound (company-web-backward-min-tag-bound)))
(and (derived-mode-p 'slim-mode)
(or (company-grab company-web-slim-value-regexp 1 bound)
(company-grab company-web-slim-tag-regexp 1 bound)
(company-grab company-web-slim-id-regexp 2 bound)
(company-grab company-web-slim-class-regexp 2 bound)
(company-grab company-web-slim-attribute-regexp 1 bound)))))
(candidates
(let ((bound (company-web-backward-min-tag-bound)))
(cond
;; value
((company-grab company-web-slim-value-regexp 1 bound)
(all-completions arg (company-web-candidates-attrib-values (company-web-slim-current-tag)
(company-web-slim-current-attribute)
bound)))
;; class ".foo" or id "#bar"
((company-web-grab-not-in-string company-web-slim-id-regexp 1 bound)
(let ((tag (company-grab company-web-slim-id-regexp 1 bound)))
(if (string= "" tag)
(setq tag "div"))
(all-completions arg (company-web-candidates-attrib-values tag "id" bound))))
((company-web-grab-not-in-string company-web-slim-class-regexp 1 bound)
(let ((tag (company-grab company-web-slim-class-regexp 1 bound)))
(if (string= "" tag)
(setq tag "div"))
(all-completions arg (company-web-candidates-attrib-values tag "class" bound))))
;; tag
((company-web-grab-not-in-string company-web-slim-tag-regexp 1 bound)
(all-completions arg (company-web-candidates-tags)))
;; attr
((company-web-grab-not-in-string company-web-slim-attribute-regexp 1 bound)
(all-completions arg (company-web-candidates-attribute (company-web-slim-current-tag)))))))
(annotation (company-web-annotation arg))
(doc-buffer
(let ((bound (company-web-backward-min-tag-bound)))
(cond
((or (company-web-grab-not-in-string company-web-slim-id-regexp 1 bound)
(company-web-grab-not-in-string company-web-slim-class-regexp 2 bound)
(company-grab company-web-slim-value-regexp 1 bound))
(company-web-candidate-prop-doc arg))
;; tag
((company-grab company-web-slim-tag-regexp 1 bound)
(company-web-tag-doc arg))
;; attr
((company-grab company-web-slim-attribute-regexp 1 bound)
(company-web-attribute-doc (company-web-slim-current-tag) arg)))))))
(provide 'company-web-slim)
;;; company-web-slim.el ends here

312
lisp/company-web/company-web.el Normal file
View File

@@ -0,0 +1,312 @@
;;; company-web.el --- Company version of ac-html, complete for web,html,emmet,jade,slim modes
;; Copyright (C) 2015 Olexandr Sydorchuk
;; Author: Olexandr Sydorchuk <olexandr.syd@gmail.com>
;; Version: 2.1
;; Keywords: html, company
;; Package-Requires: ((company "0.8.0") (dash "2.8.0") (cl-lib "0.5.0") (web-completion-data "0.1.0"))
;; URL: https://github.com/osv/company-web
;; 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:
;; Same as ac-html, but for `company' completion framework.
;; Configuration:
;;
;; (add-to-list 'company-backends 'company-web-html)
;; (add-to-list 'company-backends 'company-web-jade)
;; (add-to-list 'company-backends 'company-web-slim)
;;
;; or, for example, setup web-mode-hook:
;;
;; (define-key web-mode-map (kbd "C-'") 'company-web-html)
;; (add-hook 'web-mode-hook (lambda ()
;; (set (make-local-variable 'company-backends) '(company-web-html company-files))
;; (company-mode t)))
;;
;; When you use `emmet-mode' (with `web-mode' and `html-mode')
;; you may autocomplete as well as regular html complete.
;;
;; P.S: You may be interested in next packages:
;;
;; `ac-html-bootstrap' - Twitter:Bootstrap completion data for company-web (and ac-html as well)
;; `ac-html-csswatcher' - Watch your project CSS/Less files for classes and ids
;; `ac-html-angular' - Angular 1.5 completion data;
;;; Code:
(require 'web-completion-data)
(require 'company)
(require 'company-css)
(require 'dash)
(require 'cl-lib)
(defgroup company-web nil
"HTML Complete, Company back-end."
:group 'company
:prefix "company-web-")
(defcustom company-web-framework-name-truncate-length 10
"Truncation length for type framework-name"
:type 'integer
:group 'company-web)
(defcustom company-web-complete-css t
"Enable `style' attribute CSS autocomplete."
:group 'company-web
:type 'boolean)
(defcustom company-web-backward-tag-limit 2048
"Bound for backward searching to determinate where html tag is started. Big value may decrease perfomance"
:group 'company-web :type 'integer)
(defun company-web-backward-min-tag-bound ()
(max (- (point) company-web-backward-tag-limit)
(point-min)))
(defface company-web-doc-base-face
'((((class color) (background light))
:foreground "navy" :inherit variable-pitch)
(((class color) (background dark))
:foreground "DeepSkyBlue" :inherit variable-pitch)
(t))
"Face for description text."
:group 'company-web)
(defface company-web-doc-text-1-face
'((t :inherit company-web-doc-base-face))
"Face for description text."
:group 'company-web)
(defface company-web-doc-header-1-face
'((t :inherit company-web-doc-base-face :weight bold))
"Face for header text."
:group 'company-web)
(defface company-web-doc-important-face
'((t :inherit company-web-doc-base-face :weight bold))
"Face in square braces, ex: [HTML5]."
:group 'company-web)
(defface company-web-doc-warning-face
'((t :inherit font-lock-warning-face))
"Face for depracated, other warnings."
:group 'company-web)
(defface company-web-doc-tag-face
'((t :inherit font-lock-function-name-face))
"Face html tag face."
:group 'company-web)
(defface company-web-doc-attribute-face
'((t :inherit font-lock-type-face))
"Face html tag face."
:group 'company-web)
(defvar company-web-string-check-faces '(font-lock-string-face web-mode-html-attr-value-face)
"List of string faces to check.")
(defun company-web-load-list-from-file (filepath)
"Return a list separated by \\n from FILEPATH."
(with-temp-buffer
(insert-file-contents filepath)
(split-string (buffer-string) "\n" t)))
(defun company-web-is-point-in-string-face ()
"t if text's face(s) at point is in `company-web-string-check-faces'."
(let ((faces (get-text-property (point) 'face)))
(if (listp faces)
;; slim-mode define list of string-face (bug), so intersect
(cl-intersection faces company-web-string-check-faces)
(memq faces company-web-string-check-faces))))
(defun company-web-read-file (file-in-source-dir)
"Return string content of FILE-IN-SOURCE-DIR from `web-completion-data-sources'."
(let ((file (cdr (nth 0 (company-web-all-files-named file-in-source-dir)))))
;; Just read from the first file.
(when file
(with-temp-buffer
(insert-file-contents file)
(buffer-string)))))
(defun company-web-all-files-named (file-name)
"Get a list of file named FILE-NAME in all directory specified by
`web-completion-data-sources'.
Returns an alist. car is source name, cdr is the file path."
(let (return-files source-dir-path)
(mapc (lambda (name-dir-cons-cell)
(setq source-dir-path (cdr name-dir-cons-cell))
(setq source-dir-path
(cond ((stringp source-dir-path) source-dir-path)
((and (symbolp source-dir-path)
(boundp source-dir-path))
(symbol-value source-dir-path))
(t
(error "[company-html] invalid element %s in\
`web-completion-data-sources'" source-dir-path))))
(when source-dir-path
(setq source-dir-path (expand-file-name file-name source-dir-path))
(when (file-exists-p source-dir-path)
(add-to-list 'return-files (cons (car name-dir-cons-cell) source-dir-path))
)))
web-completion-data-sources)
return-files))
(defun company-web-make-candidate (framework-name items)
"Make popup-item for each item with FRAMEWORK-NAME.
FRAMEWORK-NAME will be truncated to `companu-html-framework-name-truncate-length'.
ITEMS is a list of string where name and documentation are
separated by one space.
Documentation newlines are escaped by \"\\n\".
If item have no inline documentation, DOCUMENTATION will be used.
DOCUMENTATION is string or function."
(let ((annotation
(truncate-string-to-width framework-name company-web-framework-name-truncate-length 0 nil nil)))
(mapcar (lambda (item)
(if (string-match "\\(.*?\\) \\(.*\\)" item)
(propertize (match-string 1 item)
'annotation annotation
'doc (replace-regexp-in-string "\\\\n" "\n"
(match-string 2 item)))
(propertize item
'annotation annotation)))
items)))
;; candidate getters
(defun company-web-candidates-tags ()
(-flatten
(mapcar (lambda (source-name-and-file-path)
(company-web-make-candidate
(car source-name-and-file-path)
(company-web-load-list-from-file (cdr source-name-and-file-path))))
(company-web-all-files-named "html-tag-list"))))
(defun company-web-candidates-attribute (tag)
"Attribute candidates of TAG."
(unless (string= "" tag)
(let* ((items (mapcar (lambda (plist-framwork-and-file)
(company-web-make-candidate
(concat (car plist-framwork-and-file) ", G")
(company-web-load-list-from-file (cdr plist-framwork-and-file))))
(company-web-all-files-named "html-attributes-list/global"))))
(add-to-list 'items
(mapcar (lambda (plist-framwork-and-file)
(company-web-make-candidate
(car plist-framwork-and-file)
(company-web-load-list-from-file (cdr plist-framwork-and-file))))
(company-web-all-files-named (concat "html-attributes-list/" tag))))
(-flatten items))))
(defun company-web-candidates-attrib-values-internal (tag attribute)
"Attribute candidates for TAG and ATTRIBUTE."
(let* ((items (mapcar (lambda (plist-framwork-and-file)
(company-web-make-candidate
(car plist-framwork-and-file)
(company-web-load-list-from-file (cdr plist-framwork-and-file))))
(company-web-all-files-named (format "html-attributes-complete/%s-%s" tag attribute)))))
(add-to-list 'items
(mapcar (lambda (plist-framwork-and-file)
(company-web-make-candidate
(concat (car plist-framwork-and-file) ", G")
(company-web-load-list-from-file (cdr plist-framwork-and-file))))
(company-web-all-files-named (concat "html-attributes-complete/global-" attribute))))
(-flatten items)))
(defun company-web-candidates-attrib-values (tag attribute bound)
(if (and company-web-complete-css
(string= attribute "style")
(save-excursion (re-search-backward "[\"']" bound t))
(save-excursion (re-search-backward "\\([[:alpha:]@_-]\\) *:[^;]*\\=" bound t)))
(-flatten (company-web-make-candidate "CSS" (company-css-property-values
(company-grab company-css-property-value-regexp 1 bound))))
(company-web-candidates-attrib-values-internal tag attribute)))
(defun company-web-annotation (candidate)
"Return type annotation for chosen CANDIDATE."
(concat
(unless company-tooltip-align-annotations " -> ")
(get-text-property 0 'annotation candidate)))
(defvar company-web-doc-font-lock-keywords
(list
'("\\(\\[.*?\\]+\\)" 1 'company-web-doc-important-face t)
'("\\b\\(deprecated\\)\\b" 1 'company-web-doc-warning-face t)
'("<\\([[:alnum:]-]+\\)" 1 'company-web-doc-tag-face t)
'("</\\([[:alnum:]-]+\\)>" 1 'company-web-doc-tag-face t)
'("\\([[:alnum:]-]+\\)=" 1 'company-web-doc-attribute-face t)
'("\\(?:^\\| \\)\\.\\([[:alnum:]-]+\\)" 1 'company-web-doc-attribute-face t)
'("^[_ [:alnum:]-]+:" . 'company-web-doc-header-1-face)))
(defun company-web-doc-buffer (&optional string)
(with-current-buffer (get-buffer-create "*html-documentation*")
(set (make-local-variable 'font-lock-defaults)
'(company-web-doc-font-lock-keywords))
(font-lock-mode t)
(erase-buffer)
(when string
(save-excursion
(insert string)))
(current-buffer)))
;; end
(defun company-web-candidate-prop-doc (candidate)
"Return documentation for chosen CANDIDATE.
Property of doc CANDIDATE"
(company-web-doc-buffer (get-text-property 0 'doc candidate)))
(defun company-web-tag-doc (candidate)
"Return documentation for chosen CANDIDATE.
Property of doc CANDIDATE or load file from `html-tag-short-docs/CANDIDATE'"
(let ((doc (get-text-property 0 'doc candidate)))
(unless doc
(let ((doc-file (cdr (car (company-web-all-files-named (concat "html-tag-short-docs/" candidate))))))
(when doc-file
(setq doc (company-web-read-file doc-file)))))
(when doc
(company-web-doc-buffer doc))))
(defun company-web-attribute-doc (tag candidate)
"Return documentation for chosen CANDIDATE.
Property of doc CANDIDATE or load file from `html-attributes-short-docs/global-CANDIDATE' or
`html-attributes-short-docs/TAG-CANDIDATE'"
(let ((doc (get-text-property 0 'doc candidate)))
(unless doc
(let ((doc-file (cdr (car (company-web-all-files-named (concat "html-attributes-short-docs/" tag "-" candidate))))))
(when doc-file
(setq doc (company-web-read-file doc-file)))))
(unless doc
(let ((doc-file (cdr (car (company-web-all-files-named (concat "html-attributes-short-docs/global-" candidate))))))
(when doc-file
(setq doc (company-web-read-file doc-file)))))
(when doc
(company-web-doc-buffer doc))))
(defun company-web-grab-not-in-string (regexp expression bound)
"Like `company-grab' but not in string"
(and (not (company-web-is-point-in-string-face))
(company-grab regexp expression bound)))
(defconst company-web-selector "[[:alnum:]_-]"
"Regexp of html attribute or tag")
(provide 'company-web)
;;; company-web.el ends here

50
lisp/company/company-abbrev.el Normal file
View File

@@ -0,0 +1,50 @@
;;; company-abbrev.el --- company-mode completion backend for abbrev
;; Copyright (C) 2009-2011, 2015 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'company)
(require 'cl-lib)
(require 'abbrev)
(defun company-abbrev-insert (match)
"Replace MATCH with the expanded abbrev."
(expand-abbrev))
;;;###autoload
(defun company-abbrev (command &optional arg &rest ignored)
"`company-mode' completion backend for abbrev."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-abbrev
'company-abbrev-insert))
(prefix (company-grab-symbol))
(candidates (nconc
(delete "" (all-completions arg global-abbrev-table))
(delete "" (all-completions arg local-abbrev-table))))
(meta (abbrev-expansion arg))))
(provide 'company-abbrev)
;;; company-abbrev.el ends here

63
lisp/company/company-bbdb.el Normal file
View File

@@ -0,0 +1,63 @@
;;; company-bbdb.el --- company-mode completion backend for BBDB in message-mode
;; Copyright (C) 2013-2014, 2016 Free Software Foundation, Inc.
;; Author: Jan Tatarik <jan.tatarik@gmail.com>
;; 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 <http://www.gnu.org/licenses/>.
(require 'company)
(require 'cl-lib)
(declare-function bbdb-record-get-field "bbdb")
(declare-function bbdb-records "bbdb")
(declare-function bbdb-dwim-mail "bbdb-com")
(declare-function bbdb-search "bbdb-com")
(defgroup company-bbdb nil
"Completion backend for BBDB."
:group 'company)
(defcustom company-bbdb-modes '(message-mode)
"Major modes in which `company-bbdb' may complete."
:type '(repeat (symbol :tag "Major mode"))
:package-version '(company . "0.8.8"))
(defun company-bbdb--candidates (arg)
(cl-mapcan (lambda (record)
(mapcar (lambda (mail) (bbdb-dwim-mail record mail))
(bbdb-record-get-field record 'mail)))
(eval '(bbdb-search (bbdb-records) arg nil arg))))
;;;###autoload
(defun company-bbdb (command &optional arg &rest ignore)
"`company-mode' completion backend for BBDB."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-bbdb))
(prefix (and (memq major-mode company-bbdb-modes)
(featurep 'bbdb-com)
(let ((case-fold-search t))
(looking-back
"^\\([^ :]*-\\)?\\(To\\|B?Cc\\|From\\):.*? *\\([^,;]*\\)"
(line-beginning-position)))
(match-string-no-properties 3)))
(candidates (company-bbdb--candidates arg))
(sorted t)
(no-cache t)))
(provide 'company-bbdb)
;;; company-bbdb.el ends here

208
lisp/company/company-capf.el Normal file
View File

@@ -0,0 +1,208 @@
;;; company-capf.el --- company-mode completion-at-point-functions backend -*- lexical-binding: t -*-
;; Copyright (C) 2013-2019 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; The CAPF back-end provides a bridge to the standard
;; completion-at-point-functions facility, and thus can support any major mode
;; that defines a proper completion function, including emacs-lisp-mode,
;; css-mode and nxml-mode.
;;; Code:
(require 'company)
(require 'cl-lib)
;; Amortizes several calls to a c-a-p-f from the same position.
(defvar company--capf-cache nil)
;; FIXME: Provide a way to save this info once in Company itself
;; (https://github.com/company-mode/company-mode/pull/845).
(defvar-local company-capf--current-completion-data nil
"Value last returned by `company-capf' when called with `candidates'.
For most properties/actions, this is just what we need: the exact values
that accompanied the completion table that's currently is use.
`company-capf', however, could be called at some different positions during
a completion session (most importantly, by `company-sort-by-occurrence'),
so we can't just use the preceding variable instead.")
(defun company--capf-data ()
(let ((cache company--capf-cache))
(if (and (equal (current-buffer) (car cache))
(equal (point) (car (setq cache (cdr cache))))
(equal (buffer-chars-modified-tick) (car (setq cache (cdr cache)))))
(cadr cache)
(let ((data (company--capf-data-real)))
(setq company--capf-cache
(list (current-buffer) (point) (buffer-chars-modified-tick) data))
data))))
(defun company--capf-data-real ()
(cl-letf* (((default-value 'completion-at-point-functions)
;; Ignore tags-completion-at-point-function because it subverts
;; company-etags in the default value of company-backends, where
;; the latter comes later.
(remove 'tags-completion-at-point-function
(default-value 'completion-at-point-functions)))
(completion-at-point-functions (company--capf-workaround))
(data (run-hook-wrapped 'completion-at-point-functions
;; Ignore misbehaving functions.
#'completion--capf-wrapper 'optimist)))
(when (and (consp (cdr data)) (integer-or-marker-p (nth 1 data))) data)))
(declare-function python-shell-get-process "python")
(defun company--capf-workaround ()
;; For http://debbugs.gnu.org/cgi/bugreport.cgi?bug=18067
(if (or (not (listp completion-at-point-functions))
(not (memq 'python-completion-complete-at-point completion-at-point-functions))
(python-shell-get-process))
completion-at-point-functions
(remq 'python-completion-complete-at-point completion-at-point-functions)))
(defun company-capf--save-current-data (data)
(setq company-capf--current-completion-data data)
(add-hook 'company-after-completion-hook
#'company-capf--clear-current-data nil t))
(defun company-capf--clear-current-data (_ignored)
(setq company-capf--current-completion-data nil))
(defvar-local company-capf--sorted nil)
(defun company-capf (command &optional arg &rest _args)
"`company-mode' backend using `completion-at-point-functions'."
(interactive (list 'interactive))
(pcase command
(`interactive (company-begin-backend 'company-capf))
(`prefix
(let ((res (company--capf-data)))
(when res
(let ((length (plist-get (nthcdr 4 res) :company-prefix-length))
(prefix (buffer-substring-no-properties (nth 1 res) (point))))
(cond
((> (nth 2 res) (point)) 'stop)
(length (cons prefix length))
(t prefix))))))
(`candidates
(company-capf--candidates arg))
(`sorted
company-capf--sorted)
(`match
;; Ask the for the `:company-match' function. If that doesn't help,
;; fallback to sniffing for face changes to get a suitable value.
(let ((f (plist-get (nthcdr 4 company-capf--current-completion-data)
:company-match)))
(if f (funcall f arg)
(let* ((match-start nil) (pos -1)
(prop-value nil) (faces nil)
(has-face-p nil) chunks
(limit (length arg)))
(while (< pos limit)
(setq pos
(if (< pos 0) 0 (next-property-change pos arg limit)))
(setq prop-value (or
(get-text-property pos 'face arg)
(get-text-property pos 'font-lock-face arg))
faces (if (listp prop-value) prop-value (list prop-value))
has-face-p (memq 'completions-common-part faces))
(cond ((and (not match-start) has-face-p)
(setq match-start pos))
((and match-start (not has-face-p))
(push (cons match-start pos) chunks)
(setq match-start nil))))
(nreverse chunks)))))
(`duplicates t)
(`no-cache t) ;Not much can be done here, as long as we handle
;non-prefix matches.
(`meta
(let ((f (plist-get (nthcdr 4 company-capf--current-completion-data)
:company-docsig)))
(when f (funcall f arg))))
(`doc-buffer
(let ((f (plist-get (nthcdr 4 company-capf--current-completion-data)
:company-doc-buffer)))
(when f (funcall f arg))))
(`location
(let ((f (plist-get (nthcdr 4 company-capf--current-completion-data)
:company-location)))
(when f (funcall f arg))))
(`annotation
(let ((f (plist-get (nthcdr 4 company-capf--current-completion-data)
:annotation-function)))
(when f (funcall f arg))))
(`require-match
(plist-get (nthcdr 4 (company--capf-data)) :company-require-match))
(`init nil) ;Don't bother: plenty of other ways to initialize the code.
(`post-completion
(company--capf-post-completion arg))
))
(defun company-capf--candidates (input)
(let ((res (company--capf-data)))
(company-capf--save-current-data res)
(when res
(let* ((table (nth 3 res))
(pred (plist-get (nthcdr 4 res) :predicate))
(meta (completion-metadata
(buffer-substring (nth 1 res) (nth 2 res))
table pred))
(candidates (completion-all-completions input table pred
(length input)
meta))
(sortfun (cdr (assq 'display-sort-function meta)))
(last (last candidates))
(base-size (and (numberp (cdr last)) (cdr last))))
(when base-size
(setcdr last nil))
(setq company-capf--sorted (functionp sortfun))
(when sortfun
(setq candidates (funcall sortfun candidates)))
(if (not (zerop (or base-size 0)))
(let ((before (substring input 0 base-size)))
(mapcar (lambda (candidate)
(concat before candidate))
candidates))
candidates)))))
(defun company--capf-post-completion (arg)
(let* ((res company-capf--current-completion-data)
(exit-function (plist-get (nthcdr 4 res) :exit-function))
(table (nth 3 res)))
(if exit-function
;; We can more or less know when the user is done with completion,
;; so we do something different than `completion--done'.
(funcall exit-function arg
;; FIXME: Should probably use an additional heuristic:
;; completion-at-point doesn't know when the user picked a
;; particular candidate explicitly (it only checks whether
;; further completions exist). Whereas company user can press
;; RET (or use implicit completion with company-tng).
(if (= (car (completion-boundaries arg table nil ""))
(length arg))
'sole
'finished)))))
(provide 'company-capf)
;;; company-capf.el ends here

389
lisp/company/company-clang.el Normal file
View File

@@ -0,0 +1,389 @@
;;; company-clang.el --- company-mode completion backend for Clang -*- lexical-binding: t -*-
;; Copyright (C) 2009, 2011, 2013-2019 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'company)
(require 'company-template)
(require 'cl-lib)
(defgroup company-clang nil
"Completion backend for Clang."
:group 'company)
(defcustom company-clang-executable
(executable-find "clang")
"Location of clang executable."
:type 'file)
(defcustom company-clang-begin-after-member-access t
"When non-nil, automatic completion will start whenever the current
symbol is preceded by \".\", \"->\" or \"::\", ignoring
`company-minimum-prefix-length'.
If `company-begin-commands' is a list, it should include `c-electric-lt-gt'
and `c-electric-colon', for automatic completion right after \">\" and
\":\"."
:type 'boolean)
(defcustom company-clang-use-compile-flags-txt nil
"When non-nil, use flags from compile_flags.txt if present.
The lines from that files will be appended to `company-clang-arguments'.
And if such file is found, Clang is called from the directory containing
it. That allows the flags use relative file names within the project."
:type 'boolean
:safe 'booleanp)
(defcustom company-clang-arguments nil
"Additional arguments to pass to clang when completing.
Prefix files (-include ...) can be selected with `company-clang-set-prefix'
or automatically through a custom `company-clang-prefix-guesser'."
:type '(repeat (string :tag "Argument")))
(defcustom company-clang-prefix-guesser 'company-clang-guess-prefix
"A function to determine the prefix file for the current buffer."
:type '(function :tag "Guesser function" nil))
(defvar company-clang-modes '(c-mode c++-mode objc-mode)
"Major modes which clang may complete.")
(defcustom company-clang-insert-arguments t
"When non-nil, insert function arguments as a template after completion."
:type 'boolean
:package-version '(company . "0.8.0"))
;; prefix ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar company-clang--prefix nil)
(defsubst company-clang--guess-pch-file (file)
(let ((dir (directory-file-name (file-name-directory file))))
(when (equal (file-name-nondirectory dir) "Classes")
(setq dir (file-name-directory dir)))
(car (directory-files dir t "\\([^.]h\\|[^h]\\).pch\\'" t))))
(defsubst company-clang--file-substring (file beg end)
(with-temp-buffer
(insert-file-contents-literally file nil beg end)
(buffer-string)))
(defun company-clang-guess-prefix ()
"Try to guess the prefix file for the current buffer."
;; Prefixes seem to be called .pch. Pre-compiled headers do, too.
;; So we look at the magic number to rule them out.
(let* ((file (company-clang--guess-pch-file buffer-file-name))
(magic-number (and file (company-clang--file-substring file 0 4))))
(unless (member magic-number '("CPCH" "gpch"))
file)))
(defun company-clang-set-prefix (&optional prefix)
"Use PREFIX as a prefix (-include ...) file for clang completion."
(interactive (let ((def (funcall company-clang-prefix-guesser)))
(unless (stringp def)
(setq def default-directory))
(list (read-file-name "Prefix file: "
(when def (file-name-directory def))
def t (when def (file-name-nondirectory def))))))
;; TODO: pre-compile?
(setq company-clang--prefix (and (stringp prefix)
(file-regular-p prefix)
prefix)))
;; Clean-up on exit.
(add-hook 'kill-emacs-hook 'company-clang-set-prefix)
;; parsing ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; TODO: Handle Pattern (syntactic hints would be neat).
;; Do we ever see OVERLOAD (or OVERRIDE)?
(defconst company-clang--completion-pattern
"^COMPLETION: \\_<\\(%s[a-zA-Z0-9_:]*\\)\\(?:\\(?: (InBase)\\)? : \\(.*\\)$\\)?$")
(defconst company-clang--error-buffer-name "*clang-error*")
(defun company-clang--lang-option ()
(if (eq major-mode 'objc-mode)
(if (string= "m" (file-name-extension buffer-file-name))
"objective-c" "objective-c++")
(substring (symbol-name major-mode) 0 -5)))
(defun company-clang--parse-output (prefix _objc)
(goto-char (point-min))
(let ((pattern (format company-clang--completion-pattern
(regexp-quote prefix)))
(case-fold-search nil)
lines match)
(while (re-search-forward pattern nil t)
(setq match (match-string-no-properties 1))
(unless (equal match "Pattern")
(save-match-data
(when (string-match ":" match)
(setq match (substring match 0 (match-beginning 0)))))
(let ((meta (match-string-no-properties 2)))
(when (and meta (not (string= match meta)))
(put-text-property 0 1 'meta
(company-clang--strip-formatting meta)
match)))
(push match lines)))
lines))
(defun company-clang--meta (candidate)
(get-text-property 0 'meta candidate))
(defun company-clang--annotation (candidate)
(let ((ann (company-clang--annotation-1 candidate)))
(if (not (and ann (string-prefix-p "(*)" ann)))
ann
(with-temp-buffer
(insert ann)
(search-backward ")")
(let ((pt (1+ (point))))
(re-search-forward ".\\_>" nil t)
(delete-region pt (point)))
(buffer-string)))))
(defun company-clang--annotation-1 (candidate)
(let ((meta (company-clang--meta candidate)))
(cond
((null meta) nil)
((string-match "[^:]:[^:]" meta)
(substring meta (1+ (match-beginning 0))))
((string-match "(anonymous)" meta) nil)
((string-match "\\((.*)[ a-z]*\\'\\)" meta)
(let ((paren (match-beginning 1)))
(if (not (eq (aref meta (1- paren)) ?>))
(match-string 1 meta)
(with-temp-buffer
(insert meta)
(goto-char paren)
(substring meta (1- (search-backward "<"))))))))))
(defun company-clang--strip-formatting (text)
(replace-regexp-in-string
"#]" " "
(replace-regexp-in-string "[<{[]#\\|#[>}]" "" text t)
t))
(defun company-clang--handle-error (res args)
(goto-char (point-min))
(let* ((buf (get-buffer-create company-clang--error-buffer-name))
(cmd (concat company-clang-executable " " (mapconcat 'identity args " ")))
(pattern (format company-clang--completion-pattern ""))
(message-truncate-lines t)
(err (if (and (re-search-forward pattern nil t)
;; Something in the Windows build?
;; Looks like Clang doesn't always include the error text
;; before completions (even if exited with error).
(> (match-beginning 0) (point-min)))
(buffer-substring-no-properties (point-min)
(1- (match-beginning 0)))
;; Warn the user more aggressively if no match was found.
(message "clang failed with error %d: %s" res cmd)
(buffer-string))))
(with-current-buffer buf
(let ((inhibit-read-only t))
(erase-buffer)
(insert (current-time-string)
(format "\nclang failed with error %d:\n" res)
cmd "\n\n")
(insert err)
(setq buffer-read-only t)
(goto-char (point-min))))))
(defun company-clang--start-process (prefix callback &rest args)
(let* ((objc (derived-mode-p 'objc-mode))
(buf (get-buffer-create "*clang-output*"))
;; Looks unnecessary in Emacs 25.1 and later.
(process-adaptive-read-buffering nil)
(existing-process (get-buffer-process buf)))
(when existing-process
(kill-process existing-process))
(with-current-buffer buf
(erase-buffer)
(setq buffer-undo-list t))
(let* ((process-connection-type nil)
(process (apply #'start-file-process "company-clang" buf
company-clang-executable args)))
(set-process-sentinel
process
(lambda (proc status)
(unless (string-match-p "hangup\\|killed" status)
(funcall
callback
(let ((res (process-exit-status proc)))
(with-current-buffer buf
(unless (eq 0 res)
(company-clang--handle-error res args))
;; Still try to get any useful input.
(company-clang--parse-output prefix objc)))))))
(unless (company-clang--auto-save-p)
(send-region process (point-min) (point-max))
(send-string process "\n")
(process-send-eof process)))))
(defsubst company-clang--build-location (pos)
(save-excursion
(goto-char pos)
(format "%s:%d:%d"
(if (company-clang--auto-save-p) buffer-file-name "-")
(line-number-at-pos)
(1+ (length
(encode-coding-region
(line-beginning-position)
(point)
'utf-8
t))))))
(defsubst company-clang--build-complete-args (pos)
(append '("-fsyntax-only" "-Xclang" "-code-completion-macros")
(unless (company-clang--auto-save-p)
(list "-x" (company-clang--lang-option)))
(company-clang--arguments)
(when (stringp company-clang--prefix)
(list "-include" (expand-file-name company-clang--prefix)))
(list "-Xclang" (format "-code-completion-at=%s"
(company-clang--build-location pos)))
(list (if (company-clang--auto-save-p) buffer-file-name "-"))))
(defun company-clang--arguments ()
(let ((fname "compile_flags.txt")
(args company-clang-arguments)
current-dir-rel)
(when company-clang-use-compile-flags-txt
(let ((dir (locate-dominating-file default-directory fname)))
(when dir
(setq current-dir-rel (file-relative-name default-directory dir))
(setq default-directory dir)
(with-temp-buffer
(insert-file-contents fname)
(setq args
(append
args
(split-string (buffer-substring-no-properties
(point-min) (point-max))
"[\n\r]+"
t
"[ \t]+"))))
(unless (equal current-dir-rel "./")
(push (format "-I%s" current-dir-rel) args)))))
args))
(defun company-clang--candidates (prefix callback)
(and (company-clang--auto-save-p)
(buffer-modified-p)
(basic-save-buffer))
(when (null company-clang--prefix)
(company-clang-set-prefix (or (funcall company-clang-prefix-guesser)
'none)))
(let ((default-directory default-directory))
(apply 'company-clang--start-process
prefix
callback
(company-clang--build-complete-args
(if (company-clang--check-version 4.0 9.0)
(point)
(- (point) (length prefix)))))))
(defun company-clang--prefix ()
(if company-clang-begin-after-member-access
(company-grab-symbol-cons "\\.\\|->\\|::" 2)
(company-grab-symbol)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defconst company-clang-required-version 1.1)
(defvar company-clang--version nil)
(defun company-clang--auto-save-p ()
(not
(company-clang--check-version 2.9 3.1)))
(defun company-clang--check-version (min apple-min)
(pcase company-clang--version
(`(apple . ,ver) (>= ver apple-min))
(`(normal . ,ver) (>= ver min))
(_ (error "pcase-exhaustive is not in Emacs 24.3!"))))
(defsubst company-clang-version ()
"Return the version of `company-clang-executable'."
(with-temp-buffer
(call-process company-clang-executable nil t nil "--version")
(goto-char (point-min))
(if (re-search-forward
"\\(clang\\|Apple LLVM\\|bcc32x\\|bcc64\\) version \\([0-9.]+\\)" nil t)
(cons
(if (equal (match-string-no-properties 1) "Apple LLVM")
'apple
'normal)
(string-to-number (match-string-no-properties 2)))
0)))
(defun company-clang (command &optional arg &rest ignored)
"`company-mode' completion backend for Clang.
Clang is a parser for C and ObjC. Clang version 1.1 or newer is required.
Additional command line arguments can be specified in
`company-clang-arguments'. Prefix files (-include ...) can be selected
with `company-clang-set-prefix' or automatically through a custom
`company-clang-prefix-guesser'.
With Clang versions before 2.9, we have to save the buffer before
performing completion. With Clang 2.9 and later, buffer contents are
passed via standard input."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-clang))
(init (when (memq major-mode company-clang-modes)
(unless company-clang-executable
(error "Company found no clang executable"))
(setq company-clang--version (company-clang-version))
(unless (company-clang--check-version
company-clang-required-version
company-clang-required-version)
(error "Company requires clang version %s"
company-clang-required-version))))
(prefix (and (memq major-mode company-clang-modes)
buffer-file-name
company-clang-executable
(not (company-in-string-or-comment))
(or (company-clang--prefix) 'stop)))
(candidates (cons :async
(lambda (cb) (company-clang--candidates arg cb))))
(meta (company-clang--meta arg))
(annotation (company-clang--annotation arg))
(post-completion (let ((anno (company-clang--annotation arg)))
(when (and company-clang-insert-arguments anno)
(insert anno)
(if (string-match "\\`:[^:]" anno)
(company-template-objc-templatify anno)
(company-template-c-like-templatify
(concat arg anno))))))))
(provide 'company-clang)
;;; company-clang.el ends here

206
lisp/company/company-cmake.el Normal file
View File

@@ -0,0 +1,206 @@
;;; company-cmake.el --- company-mode completion backend for CMake
;; Copyright (C) 2013-2014, 2017-2018 Free Software Foundation, Inc.
;; Author: Chen Bin <chenbin DOT sh AT gmail>
;; Version: 0.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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; company-cmake offers completions for module names, variable names and
;; commands used by CMake. And their descriptions.
;;; Code:
(require 'company)
(require 'cl-lib)
(defgroup company-cmake nil
"Completion backend for CMake."
:group 'company)
(defcustom company-cmake-executable
(executable-find "cmake")
"Location of cmake executable."
:type 'file)
(defvar company-cmake-executable-arguments
'("--help-command-list"
"--help-module-list"
"--help-variable-list")
"The arguments we pass to cmake, separately.
They affect which types of symbols we get completion candidates for.")
(defvar company-cmake--completion-pattern
"^\\(%s[a-zA-Z0-9_<>]%s\\)$"
"Regexp to match the candidates.")
(defvar company-cmake-modes '(cmake-mode)
"Major modes in which cmake may complete.")
(defvar company-cmake--candidates-cache nil
"Cache for the raw candidates.")
(defvar company-cmake--meta-command-cache nil
"Cache for command arguments to retrieve descriptions for the candidates.")
(defun company-cmake--replace-tags (rlt)
(setq rlt (replace-regexp-in-string
"\\(.*?\\(IS_GNU\\)?\\)<LANG>\\(.*\\)"
(lambda (_match)
(mapconcat 'identity
(if (match-beginning 2)
'("\\1CXX\\3" "\\1C\\3" "\\1G77\\3")
'("\\1CXX\\3" "\\1C\\3" "\\1Fortran\\3"))
"\n"))
rlt t))
(setq rlt (replace-regexp-in-string
"\\(.*\\)<CONFIG>\\(.*\\)"
(mapconcat 'identity '("\\1DEBUG\\2" "\\1RELEASE\\2"
"\\1RELWITHDEBINFO\\2" "\\1MINSIZEREL\\2")
"\n")
rlt))
rlt)
(defun company-cmake--fill-candidates-cache (arg)
"Fill candidates cache if needed."
(let (rlt)
(unless company-cmake--candidates-cache
(setq company-cmake--candidates-cache (make-hash-table :test 'equal)))
;; If hash is empty, fill it.
(unless (gethash arg company-cmake--candidates-cache)
(with-temp-buffer
(let ((res (call-process company-cmake-executable nil t nil arg)))
(unless (zerop res)
(message "cmake executable exited with error=%d" res)))
(setq rlt (buffer-string)))
(setq rlt (company-cmake--replace-tags rlt))
(puthash arg rlt company-cmake--candidates-cache))
))
(defun company-cmake--parse (prefix content cmd)
(let ((start 0)
(pattern (format company-cmake--completion-pattern
(regexp-quote prefix)
(if (zerop (length prefix)) "+" "*")))
(lines (split-string content "\n"))
match
rlt)
(dolist (line lines)
(when (string-match pattern line)
(let ((match (match-string 1 line)))
(when match
(puthash match cmd company-cmake--meta-command-cache)
(push match rlt)))))
rlt))
(defun company-cmake--candidates (prefix)
(let (results
cmd-opts
str)
(unless company-cmake--meta-command-cache
(setq company-cmake--meta-command-cache (make-hash-table :test 'equal)))
(dolist (arg company-cmake-executable-arguments)
(company-cmake--fill-candidates-cache arg)
(setq cmd-opts (replace-regexp-in-string "-list$" "" arg) )
(setq str (gethash arg company-cmake--candidates-cache))
(when str
(setq results (nconc results
(company-cmake--parse prefix str cmd-opts)))))
results))
(defun company-cmake--unexpand-candidate (candidate)
(cond
((string-match "^CMAKE_\\(C\\|CXX\\|Fortran\\)\\(_.*\\)$" candidate)
(setq candidate (concat "CMAKE_<LANG>" (match-string 2 candidate))))
;; C flags
((string-match "^\\(.*_\\)IS_GNU\\(C\\|CXX\\|G77\\)$" candidate)
(setq candidate (concat (match-string 1 candidate) "IS_GNU<LANG>")))
;; C flags
((string-match "^\\(.*_\\)OVERRIDE_\\(C\\|CXX\\|Fortran\\)$" candidate)
(setq candidate (concat (match-string 1 candidate) "OVERRIDE_<LANG>")))
((string-match "^\\(.*\\)\\(_DEBUG\\|_RELEASE\\|_RELWITHDEBINFO\\|_MINSIZEREL\\)\\(.*\\)$" candidate)
(setq candidate (concat (match-string 1 candidate)
"_<CONFIG>"
(match-string 3 candidate)))))
candidate)
(defun company-cmake--meta (candidate)
(let ((cmd-opts (gethash candidate company-cmake--meta-command-cache))
result)
(setq candidate (company-cmake--unexpand-candidate candidate))
;; Don't cache the documentation of every candidate (command)
;; Cache in this case will cost too much memory.
(with-temp-buffer
(call-process company-cmake-executable nil t nil cmd-opts candidate)
;; Go to the third line, trim it and return the result.
;; Tested with cmake 2.8.9.
(goto-char (point-min))
(forward-line 2)
(setq result (buffer-substring-no-properties (line-beginning-position)
(line-end-position)))
(setq result (replace-regexp-in-string "^[ \t\n\r]+" "" result))
result)))
(defun company-cmake--doc-buffer (candidate)
(let ((cmd-opts (gethash candidate company-cmake--meta-command-cache)))
(setq candidate (company-cmake--unexpand-candidate candidate))
(with-temp-buffer
(call-process company-cmake-executable nil t nil cmd-opts candidate)
;; Go to the third line, trim it and return the doc buffer.
;; Tested with cmake 2.8.9.
(goto-char (point-min))
(forward-line 2)
(company-doc-buffer
(buffer-substring-no-properties (line-beginning-position)
(point-max))))))
(defun company-cmake-prefix-dollar-brace-p ()
"Test if the current symbol follows ${."
(save-excursion
(skip-syntax-backward "w_")
(and (eq (char-before (point)) ?\{)
(eq (char-before (1- (point))) ?$))))
(defun company-cmake (command &optional arg &rest ignored)
"`company-mode' completion backend for CMake.
CMake is a cross-platform, open-source make system."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-cmake))
(init (when (memq major-mode company-cmake-modes)
(unless company-cmake-executable
(error "Company found no cmake executable"))))
(prefix (and (memq major-mode company-cmake-modes)
(or (not (company-in-string-or-comment))
(company-cmake-prefix-dollar-brace-p))
(company-grab-symbol)))
(candidates (company-cmake--candidates arg))
(meta (company-cmake--meta arg))
(doc-buffer (company-cmake--doc-buffer arg))
))
(provide 'company-cmake)
;;; company-cmake.el ends here

446
lisp/company/company-css.el Normal file
View File

@@ -0,0 +1,446 @@
;;; company-css.el --- company-mode completion backend for css-mode -*- lexical-binding: t -*-
;; Copyright (C) 2009, 2011, 2014, 2018 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; In Emacs >= 26, company-capf is used instead.
;;; Code:
(require 'company)
(require 'cl-lib)
(declare-function web-mode-language-at-pos "web-mode" (&optional pos))
(defconst company-css-property-alist
;; see http://www.w3.org/TR/CSS21/propidx.html
'(("azimuth" angle "left-side" "far-left" "left" "center-left" "center"
"center-right" "right" "far-right" "right-side" "behind" "leftwards"
"rightwards")
("background" background-color background-image background-repeat
background-attachment background-position
background-clip background-origin background-size)
("background-attachment" "scroll" "fixed")
("background-color" color "transparent")
("background-image" uri "none")
("background-position" percentage length "left" "center" "right" percentage
length "top" "center" "bottom" "left" "center" "right" "top" "center"
"bottom")
("background-repeat" "repeat" "repeat-x" "repeat-y" "no-repeat")
("border" border-width border-style border-color)
("border-bottom" border)
("border-bottom-color" border-color)
("border-bottom-style" border-style)
("border-bottom-width" border-width)
("border-collapse" "collapse" "separate")
("border-color" color "transparent")
("border-left" border)
("border-left-color" border-color)
("border-left-style" border-style)
("border-left-width" border-width)
("border-right" border)
("border-right-color" border-color)
("border-right-style" border-style)
("border-right-width" border-width)
("border-spacing" length length)
("border-style" border-style)
("border-top" border)
("border-top-color" border-color)
("border-top-style" border-style)
("border-top-width" border-width)
("border-width" border-width)
("bottom" length percentage "auto")
("caption-side" "top" "bottom")
("clear" "none" "left" "right" "both")
("clip" shape "auto")
("color" color)
("content" "normal" "none" string uri counter "attr()" "open-quote"
"close-quote" "no-open-quote" "no-close-quote")
("counter-increment" identifier integer "none")
("counter-reset" identifier integer "none")
("cue" cue-before cue-after)
("cue-after" uri "none")
("cue-before" uri "none")
("cursor" uri "*" "auto" "crosshair" "default" "pointer" "move" "e-resize"
"ne-resize" "nw-resize" "n-resize" "se-resize" "sw-resize" "s-resize"
"w-resize" "text" "wait" "help" "progress")
("direction" "ltr" "rtl")
("display" "inline" "block" "list-item" "run-in" "inline-block" "table"
"inline-table" "table-row-group" "table-header-group" "table-footer-group"
"table-row" "table-column-group" "table-column" "table-cell"
"table-caption" "none")
("elevation" angle "below" "level" "above" "higher" "lower")
("empty-cells" "show" "hide")
("float" "left" "right" "none")
("font" font-style font-weight font-size "/" line-height
font-family "caption" "icon" "menu" "message-box" "small-caption"
"status-bar" "normal" "small-caps"
;; CSS3
font-stretch)
("font-family" family-name generic-family)
("font-size" absolute-size relative-size length percentage)
("font-style" "normal" "italic" "oblique")
("font-weight" "normal" "bold" "bolder" "lighter" "100" "200" "300" "400"
"500" "600" "700" "800" "900")
("height" length percentage "auto")
("left" length percentage "auto")
("letter-spacing" "normal" length)
("line-height" "normal" number length percentage)
("list-style" list-style-type list-style-position list-style-image)
("list-style-image" uri "none")
("list-style-position" "inside" "outside")
("list-style-type" "disc" "circle" "square" "decimal" "decimal-leading-zero"
"lower-roman" "upper-roman" "lower-greek" "lower-latin" "upper-latin"
"armenian" "georgian" "lower-alpha" "upper-alpha" "none")
("margin" margin-width)
("margin-bottom" margin-width)
("margin-left" margin-width)
("margin-right" margin-width)
("margin-top" margin-width)
("max-height" length percentage "none")
("max-width" length percentage "none")
("min-height" length percentage)
("min-width" length percentage)
("orphans" integer)
("outline" outline-color outline-style outline-width)
("outline-color" color "invert")
("outline-style" border-style)
("outline-width" border-width)
("overflow" "visible" "hidden" "scroll" "auto"
;; CSS3:
"no-display" "no-content")
("padding" padding-width)
("padding-bottom" padding-width)
("padding-left" padding-width)
("padding-right" padding-width)
("padding-top" padding-width)
("page-break-after" "auto" "always" "avoid" "left" "right")
("page-break-before" "auto" "always" "avoid" "left" "right")
("page-break-inside" "avoid" "auto")
("pause" time percentage)
("pause-after" time percentage)
("pause-before" time percentage)
("pitch" frequency "x-low" "low" "medium" "high" "x-high")
("pitch-range" number)
("play-during" uri "mix" "repeat" "auto" "none")
("position" "static" "relative" "absolute" "fixed")
("quotes" string string "none")
("richness" number)
("right" length percentage "auto")
("speak" "normal" "none" "spell-out")
("speak-header" "once" "always")
("speak-numeral" "digits" "continuous")
("speak-punctuation" "code" "none")
("speech-rate" number "x-slow" "slow" "medium" "fast" "x-fast" "faster"
"slower")
("stress" number)
("table-layout" "auto" "fixed")
("text-align" "left" "right" "center" "justify")
("text-indent" length percentage)
("text-transform" "capitalize" "uppercase" "lowercase" "none")
("top" length percentage "auto")
("unicode-bidi" "normal" "embed" "bidi-override")
("vertical-align" "baseline" "sub" "super" "top" "text-top" "middle"
"bottom" "text-bottom" percentage length)
("visibility" "visible" "hidden" "collapse")
("voice-family" specific-voice generic-voice "*" specific-voice
generic-voice)
("volume" number percentage "silent" "x-soft" "soft" "medium" "loud"
"x-loud")
("white-space" "normal" "pre" "nowrap" "pre-wrap" "pre-line")
("widows" integer)
("width" length percentage "auto")
("word-spacing" "normal" length)
("z-index" "auto" integer)
;; CSS3
("align-content" align-stretch "space-between" "space-around")
("align-items" align-stretch "baseline")
("align-self" align-items "auto")
("animation" animation-name animation-duration animation-timing-function
animation-delay animation-iteration-count animation-direction
animation-fill-mode)
("animation-delay" time)
("animation-direction" "normal" "reverse" "alternate" "alternate-reverse")
("animation-duration" time)
("animation-fill-mode" "none" "forwards" "backwards" "both")
("animation-iteration-count" integer "infinite")
("animation-name" "none")
("animation-play-state" "paused" "running")
("animation-timing-function" transition-timing-function
"step-start" "step-end" "steps(,)")
("backface-visibility" "visible" "hidden")
("background-clip" background-origin)
("background-origin" "border-box" "padding-box" "content-box")
("background-size" length percentage "auto" "cover" "contain")
("border-image" border-image-outset border-image-repeat border-image-source
border-image-slice border-image-width)
("border-image-outset" length)
("border-image-repeat" "stretch" "repeat" "round" "space")
("border-image-source" uri "none")
("border-image-slice" length)
("border-image-width" length percentage)
("border-radius" length)
("border-top-left-radius" length)
("border-top-right-radius" length)
("border-bottom-left-radius" length)
("border-bottom-right-radius" length)
("box-decoration-break" "slice" "clone")
("box-shadow" length color)
("box-sizing" "content-box" "border-box")
("break-after" "auto" "always" "avoid" "left" "right" "page" "column"
"avoid-page" "avoid-column")
("break-before" break-after)
("break-inside" "avoid" "auto")
("columns" column-width column-count)
("column-count" integer)
("column-fill" "auto" "balance")
("column-gap" length "normal")
("column-rule" column-rule-width column-rule-style column-rule-color)
("column-rule-color" color)
("column-rule-style" border-style)
("column-rule-width" border-width)
("column-span" "all" "none")
("column-width" length "auto")
("filter" url "blur()" "brightness()" "contrast()" "drop-shadow()"
"grayscale()" "hue-rotate()" "invert()" "opacity()" "saturate()" "sepia()")
("flex" flex-grow flex-shrink flex-basis)
("flex-basis" percentage length "auto")
("flex-direction" "row" "row-reverse" "column" "column-reverse")
("flex-flow" flex-direction flex-wrap)
("flex-grow" number)
("flex-shrink" number)
("flex-wrap" "nowrap" "wrap" "wrap-reverse")
("font-feature-setting" normal string number)
("font-kerning" "auto" "normal" "none")
("font-language-override" "normal" string)
("font-size-adjust" "none" number)
("font-stretch" "normal" "ultra-condensed" "extra-condensed" "condensed"
"semi-condensed" "semi-expanded" "expanded" "extra-expanded" "ultra-expanded")
("font-synthesis" "none" "weight" "style")
("font-variant" font-variant-alternates font-variant-caps
font-variant-east-asian font-variant-ligatures font-variant-numeric
font-variant-position)
("font-variant-alternates" "normal" "historical-forms" "stylistic()"
"styleset()" "character-variant()" "swash()" "ornaments()" "annotation()")
("font-variant-caps" "normal" "small-caps" "all-small-caps" "petite-caps"
"all-petite-caps" "unicase" "titling-caps")
("font-variant-east-asian" "jis78" "jis83" "jis90" "jis04" "simplified"
"traditional" "full-width" "proportional-width" "ruby")
("font-variant-ligatures" "normal" "none" "common-ligatures"
"no-common-ligatures" "discretionary-ligatures" "no-discretionary-ligatures"
"historical-ligatures" "no-historical-ligatures" "contextual" "no-contextual")
("font-variant-numeric" "normal" "ordinal" "slashed-zero"
"lining-nums" "oldstyle-nums" "proportional-nums" "tabular-nums"
"diagonal-fractions" "stacked-fractions")
("font-variant-position" "normal" "sub" "super")
("hyphens" "none" "manual" "auto")
("justify-content" align-common "space-between" "space-around")
("line-break" "auto" "loose" "normal" "strict")
("marquee-direction" "forward" "reverse")
("marquee-play-count" integer "infinite")
("marquee-speed" "slow" "normal" "fast")
("marquee-style" "scroll" "slide" "alternate")
("opacity" number)
("order" number)
("outline-offset" length)
("overflow-x" overflow)
("overflow-y" overflow)
("overflow-style" "auto" "marquee-line" "marquee-block")
("overflow-wrap" "normal" "break-word")
("perspective" "none" length)
("perspective-origin" percentage length "left" "center" "right" "top" "bottom")
("resize" "none" "both" "horizontal" "vertical")
("tab-size" integer length)
("text-align-last" "auto" "start" "end" "left" "right" "center" "justify")
("text-decoration" text-decoration-color text-decoration-line text-decoration-style)
("text-decoration-color" color)
("text-decoration-line" "none" "underline" "overline" "line-through" "blink")
("text-decoration-style" "solid" "double" "dotted" "dashed" "wavy")
("text-overflow" "clip" "ellipsis")
("text-shadow" color length)
("text-underline-position" "auto" "under" "left" "right")
("transform" "matrix(,,,,,)" "translate(,)" "translateX()" "translateY()"
"scale()" "scaleX()" "scaleY()" "rotate()" "skewX()" "skewY()" "none")
("transform-origin" perspective-origin)
("transform-style" "flat" "preserve-3d")
("transition" transition-property transition-duration
transition-timing-function transition-delay)
("transition-delay" time)
("transition-duration" time)
("transition-timing-function"
"ease" "linear" "ease-in" "ease-out" "ease-in-out" "cubic-bezier(,,,)")
("transition-property" "none" "all" identifier)
("word-wrap" overflow-wrap)
("word-break" "normal" "break-all" "keep-all"))
"A list of CSS properties and their possible values.")
(defconst company-css-value-classes
'((absolute-size "xx-small" "x-small" "small" "medium" "large" "x-large"
"xx-large")
(align-common "flex-start" "flex-end" "center")
(align-stretch align-common "stretch")
(border-style "none" "hidden" "dotted" "dashed" "solid" "double" "groove"
"ridge" "inset" "outset")
(border-width "thick" "medium" "thin")
(color "aqua" "black" "blue" "fuchsia" "gray" "green" "lime" "maroon" "navy"
"olive" "orange" "purple" "red" "silver" "teal" "white" "yellow")
(counter "counter(,)")
(family-name "Courier" "Helvetica" "Times")
(generic-family "serif" "sans-serif" "cursive" "fantasy" "monospace")
(generic-voice "male" "female" "child")
(margin-width "auto") ;; length percentage
(relative-size "larger" "smaller")
(shape "rect(,,,)")
(uri "url()"))
"A list of CSS property value classes and their contents.")
;; missing, because not completable
;; <angle><frequency><identifier><integer><length><number><padding-width>
;; <percentage><specific-voice><string><time><uri>
(defconst company-css-html-tags
'("a" "abbr" "acronym" "address" "applet" "area" "b" "base" "basefont" "bdo"
"big" "blockquote" "body" "br" "button" "caption" "center" "cite" "code"
"col" "colgroup" "dd" "del" "dfn" "dir" "div" "dl" "dt" "em" "fieldset"
"font" "form" "frame" "frameset" "h1" "h2" "h3" "h4" "h5" "h6" "head" "hr"
"html" "i" "iframe" "img" "input" "ins" "isindex" "kbd" "label" "legend"
"li" "link" "map" "menu" "meta" "noframes" "noscript" "object" "ol"
"optgroup" "option" "p" "param" "pre" "q" "s" "samp" "script" "select"
"small" "span" "strike" "strong" "style" "sub" "sup" "table" "tbody" "td"
"textarea" "tfoot" "th" "thead" "title" "tr" "tt" "u" "ul" "var"
;; HTML5
"section" "article" "aside" "header" "footer" "nav" "figure" "figcaption"
"time" "mark" "main")
"A list of HTML tags for use in CSS completion.")
(defconst company-css-pseudo-classes
'("active" "after" "before" "first" "first-child" "first-letter" "first-line"
"focus" "hover" "lang" "left" "link" "right" "visited")
"Identifiers for CSS pseudo-elements and pseudo-classes.")
(defconst company-css-property-cache (make-hash-table :size 115 :test 'equal))
(defun company-css-property-values (attribute)
"Access the `company-css-property-alist' cached and flattened."
(or (gethash attribute company-css-property-cache)
(let (results)
(dolist (value (cdr (assoc attribute company-css-property-alist)))
(if (symbolp value)
(dolist (child (or (cdr (assoc value company-css-value-classes))
(company-css-property-values
(symbol-name value))))
(push child results))
(push value results)))
(setq results (sort results 'string<))
(puthash attribute
(if (fboundp 'delete-consecutive-dups)
(delete-consecutive-dups results)
(delete-dups results))
company-css-property-cache)
results)))
;;; bracket detection
(defconst company-css-braces-syntax-table
(let ((table (make-syntax-table)))
(setf (aref table ?{) '(4 . 125))
(setf (aref table ?}) '(5 . 123))
table)
"A syntax table giving { and } paren syntax.")
(defun company-css-inside-braces-p ()
"Return non-nil, if point is within matched { and }."
(ignore-errors
(with-syntax-table company-css-braces-syntax-table
(let ((parse-sexp-ignore-comments t))
(scan-lists (point) -1 1)))))
;;; tags
(defconst company-css-tag-regexp
(concat "\\(?:\\`\\|}\\)[[:space:]]*"
;; multiple
"\\(?:"
;; previous tags:
"\\(?:#\\|\\_<[[:alpha:]]\\)[[:alnum:]-#]*\\(?:\\[[^]]*\\]\\)?"
;; space or selectors
"\\(?:[[:space:]]+\\|[[:space:]]*[+,>][[:space:]]*\\)"
"\\)*"
"\\(\\(?:#\\|\\_<[[:alpha:]]\\)\\(?:[[:alnum:]-#]*\\_>\\)?\\_>\\|\\)"
"\\=")
"A regular expression matching CSS tags.")
;;; pseudo id
(defconst company-css-pseudo-regexp
(concat "\\(?:\\`\\|}\\)[[:space:]]*"
;; multiple
"\\(?:"
;; previous tags:
"\\(?:#\\|\\_<[[:alpha:]]\\)[[:alnum:]-#]*\\(?:\\[[^]]*\\]\\)?"
;; space or delimiters
"\\(?:[[:space:]]+\\|[[:space:]]*[+,>][[:space:]]*\\)"
"\\)*"
"\\(?:\\(?:\\#\\|\\_<[[:alpha:]]\\)[[:alnum:]-#]*\\):"
"\\([[:alpha:]-]+\\_>\\|\\)\\_>\\=")
"A regular expression matching CSS pseudo classes.")
;;; properties
(defun company-css-grab-property ()
"Return the CSS property before point, if any.
Returns \"\" if no property found, but feasible at this position."
(when (company-css-inside-braces-p)
(company-grab-symbol)))
;;; values
(defconst company-css-property-value-regexp
"\\_<\\([[:alpha:]-]+\\):\\(?:[^{};]*[[:space:]]+\\)?\\([^{};]*\\_>\\|\\)\\="
"A regular expression matching CSS tags.")
;;;###autoload
(defun company-css (command &optional arg &rest ignored)
"`company-mode' completion backend for `css-mode'."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-css))
(prefix (and (or (derived-mode-p 'css-mode)
(and (derived-mode-p 'web-mode)
(string= (web-mode-language-at-pos) "css")))
(or (company-grab company-css-tag-regexp 1)
(company-grab company-css-pseudo-regexp 1)
(company-grab company-css-property-value-regexp 2
(line-beginning-position))
(company-css-grab-property))))
(candidates
(cond
((company-grab company-css-tag-regexp 1)
(all-completions arg company-css-html-tags))
((company-grab company-css-pseudo-regexp 1)
(all-completions arg company-css-pseudo-classes))
((company-grab company-css-property-value-regexp 2
(line-beginning-position))
(all-completions arg
(company-css-property-values
(company-grab company-css-property-value-regexp 1))))
((company-css-grab-property)
(all-completions arg company-css-property-alist))))
(sorted t)))
(provide 'company-css)
;;; company-css.el ends here

104
lisp/company/company-dabbrev-code.el Normal file
View File

@@ -0,0 +1,104 @@
;;; company-dabbrev-code.el --- dabbrev-like company-mode backend for code -*- lexical-binding: t -*-
;; Copyright (C) 2009, 2011, 2014 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'company)
(require 'company-dabbrev)
(require 'cl-lib)
(defgroup company-dabbrev-code nil
"dabbrev-like completion backend for code."
:group 'company)
(defcustom company-dabbrev-code-modes
'(prog-mode
batch-file-mode csharp-mode css-mode erlang-mode haskell-mode jde-mode
lua-mode python-mode)
"Modes that use `company-dabbrev-code'.
In all these modes (and their derivatives) `company-dabbrev-code' will
complete only symbols, not text in comments or strings. In other modes
`company-dabbrev-code' will pass control to other backends
\(e.g. `company-dabbrev'\). Value t means complete in all modes."
:type '(choice (repeat :tag "Some modes" (symbol :tag "Major mode"))
(const :tag "All modes" t)))
(defcustom company-dabbrev-code-other-buffers t
"Determines whether `company-dabbrev-code' should search other buffers.
If `all', search all other buffers, except the ignored ones. If t, search
buffers with the same major mode. If `code', search all buffers with major
modes in `company-dabbrev-code-modes', or derived from one of them. See
also `company-dabbrev-code-time-limit'."
:type '(choice (const :tag "Off" nil)
(const :tag "Same major mode" t)
(const :tag "Code major modes" code)
(const :tag "All" all)))
(defcustom company-dabbrev-code-time-limit .1
"Determines how long `company-dabbrev-code' should look for matches."
:type '(choice (const :tag "Off" nil)
(number :tag "Seconds")))
(defcustom company-dabbrev-code-everywhere nil
"Non-nil to offer completions in comments and strings."
:type 'boolean)
(defcustom company-dabbrev-code-ignore-case nil
"Non-nil to ignore case when collecting completion candidates."
:type 'boolean)
(defun company-dabbrev-code--make-regexp (prefix)
(concat "\\_<" (if (equal prefix "")
"\\([a-zA-Z]\\|\\s_\\)"
(regexp-quote prefix))
"\\(\\sw\\|\\s_\\)*\\_>"))
;;;###autoload
(defun company-dabbrev-code (command &optional arg &rest ignored)
"dabbrev-like `company-mode' backend for code.
The backend looks for all symbols in the current buffer that aren't in
comments or strings."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-dabbrev-code))
(prefix (and (or (eq t company-dabbrev-code-modes)
(apply #'derived-mode-p company-dabbrev-code-modes))
(or company-dabbrev-code-everywhere
(not (company-in-string-or-comment)))
(or (company-grab-symbol) 'stop)))
(candidates (let ((case-fold-search company-dabbrev-code-ignore-case))
(company-dabbrev--search
(company-dabbrev-code--make-regexp arg)
company-dabbrev-code-time-limit
(pcase company-dabbrev-code-other-buffers
(`t (list major-mode))
(`code company-dabbrev-code-modes)
(`all `all))
(not company-dabbrev-code-everywhere))))
(ignore-case company-dabbrev-code-ignore-case)
(duplicates t)))
(provide 'company-dabbrev-code)
;;; company-dabbrev-code.el ends here

206
lisp/company/company-dabbrev.el Normal file
View File

@@ -0,0 +1,206 @@
;;; company-dabbrev.el --- dabbrev-like company-mode completion backend -*- lexical-binding: t -*-
;; Copyright (C) 2009, 2011, 2014, 2015, 2016 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'company)
(require 'cl-lib)
(defgroup company-dabbrev nil
"dabbrev-like completion backend."
:group 'company)
(defcustom company-dabbrev-other-buffers 'all
"Determines whether `company-dabbrev' should search other buffers.
If `all', search all other buffers, except the ignored ones. If t, search
buffers with the same major mode. See also `company-dabbrev-time-limit'."
:type '(choice (const :tag "Off" nil)
(const :tag "Same major mode" t)
(const :tag "All" all)))
(defcustom company-dabbrev-ignore-buffers "\\`[ *]"
"Regexp matching the names of buffers to ignore.
Or a function that returns non-nil for such buffers."
:type '(choice (regexp :tag "Regexp")
(function :tag "Predicate"))
:package-version '(company . "0.9.0"))
(defcustom company-dabbrev-time-limit .1
"Determines how many seconds `company-dabbrev' should look for matches."
:type '(choice (const :tag "Off" nil)
(number :tag "Seconds")))
(defcustom company-dabbrev-char-regexp "\\sw"
"A regular expression matching the characters `company-dabbrev' looks for."
:type 'regexp)
(defcustom company-dabbrev-ignore-case 'keep-prefix
"Non-nil to ignore case when collecting completion candidates.
When it's `keep-prefix', the text before point will remain unchanged after
candidate is inserted, even some of its characters have different case."
:type '(choice
(const :tag "Don't ignore case" nil)
(const :tag "Ignore case" t)
(const :tag "Keep case before point" keep-prefix)))
(defcustom company-dabbrev-downcase 'case-replace
"Whether to downcase the returned candidates.
The value of nil means keep them as-is.
`case-replace' means use the value of `case-replace'.
Any other value means downcase.
If you set this value to nil, you may also want to set
`company-dabbrev-ignore-case' to any value other than `keep-prefix'."
:type '(choice
(const :tag "Keep as-is" nil)
(const :tag "Downcase" t)
(const :tag "Use case-replace" case-replace)))
(defcustom company-dabbrev-minimum-length 4
"The minimum length for the completion candidate to be included.
This variable affects both `company-dabbrev' and `company-dabbrev-code'."
:type 'integer
:package-version '(company . "0.8.3"))
(defcustom company-dabbrev-ignore-invisible nil
"Non-nil to skip invisible text."
:type 'boolean
:package-version '(company . "0.9.0"))
(defmacro company-dabbrev--time-limit-while (test start limit freq &rest body)
(declare (indent 3) (debug t))
`(let ((company-time-limit-while-counter 0))
(catch 'done
(while ,test
,@body
(and ,limit
(= (cl-incf company-time-limit-while-counter) ,freq)
(setq company-time-limit-while-counter 0)
(> (float-time (time-since ,start)) ,limit)
(throw 'done 'company-time-out))))))
(defun company-dabbrev--make-regexp ()
(concat "\\(?:" company-dabbrev-char-regexp "\\)+"))
(defun company-dabbrev--search-buffer (regexp pos symbols start limit
ignore-comments)
(save-excursion
(cl-labels ((maybe-collect-match
()
(let ((match (match-string-no-properties 0)))
(when (and (>= (length match) company-dabbrev-minimum-length)
(not (and company-dabbrev-ignore-invisible
(invisible-p (match-beginning 0)))))
(push match symbols)))))
(goto-char (if pos (1- pos) (point-min)))
;; Search before pos.
(let ((tmp-end (point)))
(company-dabbrev--time-limit-while (and (not (input-pending-p))
(> tmp-end (point-min)))
start limit 1
(ignore-errors
(forward-char -10000))
(forward-line 0)
(save-excursion
;; Before, we used backward search, but it matches non-greedily, and
;; that forced us to use the "beginning/end of word" anchors in
;; `company-dabbrev--make-regexp'. It's also about 2x slower.
(while (and (not (input-pending-p))
(re-search-forward regexp tmp-end t))
(if (and ignore-comments (save-match-data (company-in-string-or-comment)))
(re-search-forward "\\s>\\|\\s!\\|\\s\"" tmp-end t)
(maybe-collect-match))))
(setq tmp-end (point))))
(goto-char (or pos (point-min)))
;; Search after pos.
(company-dabbrev--time-limit-while (and (not (input-pending-p))
(re-search-forward regexp nil t))
start limit 25
(if (and ignore-comments (save-match-data (company-in-string-or-comment)))
(re-search-forward "\\s>\\|\\s!\\|\\s\"" nil t)
(maybe-collect-match)))
symbols)))
(defun company-dabbrev--search (regexp &optional limit other-buffer-modes
ignore-comments)
(let* ((start (current-time))
(symbols (company-dabbrev--search-buffer regexp (point) nil start limit
ignore-comments)))
(when other-buffer-modes
(cl-dolist (buffer (delq (current-buffer) (buffer-list)))
(unless (if (stringp company-dabbrev-ignore-buffers)
(string-match-p company-dabbrev-ignore-buffers
(buffer-name buffer))
(funcall company-dabbrev-ignore-buffers buffer))
(with-current-buffer buffer
(when (or (eq other-buffer-modes 'all)
(apply #'derived-mode-p other-buffer-modes))
(setq symbols
(company-dabbrev--search-buffer regexp nil symbols start
limit ignore-comments)))))
(and limit
(> (float-time (time-since start)) limit)
(cl-return))))
symbols))
(defun company-dabbrev--prefix ()
;; Not in the middle of a word.
(unless (looking-at company-dabbrev-char-regexp)
;; Emacs can't do greedy backward-search.
(company-grab-line (format "\\(?:^\\| \\)[^ ]*?\\(\\(?:%s\\)*\\)"
company-dabbrev-char-regexp)
1)))
(defun company-dabbrev--filter (prefix candidates)
(let ((completion-ignore-case company-dabbrev-ignore-case))
(all-completions prefix candidates)))
;;;###autoload
(defun company-dabbrev (command &optional arg &rest ignored)
"dabbrev-like `company-mode' completion backend."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-dabbrev))
(prefix (company-dabbrev--prefix))
(candidates
(let* ((case-fold-search company-dabbrev-ignore-case)
(words (company-dabbrev--search (company-dabbrev--make-regexp)
company-dabbrev-time-limit
(pcase company-dabbrev-other-buffers
(`t (list major-mode))
(`all `all))))
(downcase-p (if (eq company-dabbrev-downcase 'case-replace)
case-replace
company-dabbrev-downcase)))
(setq words (company-dabbrev--filter arg words))
(if downcase-p
(mapcar 'downcase words)
words)))
(ignore-case company-dabbrev-ignore-case)
(duplicates t)))
(provide 'company-dabbrev)
;;; company-dabbrev.el ends here

186
lisp/company/company-eclim.el Normal file
View File

@@ -0,0 +1,186 @@
;;; company-eclim.el --- company-mode completion backend for Eclim
;; Copyright (C) 2009, 2011, 2013, 2015 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; Using `emacs-eclim' together with (or instead of) this backend is
;; recommended, as it allows you to use other Eclim features.
;;
;; The alternative backend provided by `emacs-eclim' uses `yasnippet'
;; instead of `company-template' to expand function calls, and it supports
;; some languages other than Java.
;;; Code:
(require 'company)
(require 'company-template)
(require 'cl-lib)
(defgroup company-eclim nil
"Completion backend for Eclim."
:group 'company)
(defun company-eclim-executable-find ()
(let (file)
(cl-dolist (eclipse-root '("/Applications/eclipse" "/usr/lib/eclipse"
"/usr/local/lib/eclipse"))
(and (file-exists-p (setq file (expand-file-name "plugins" eclipse-root)))
(setq file (car (last (directory-files file t "^org.eclim_"))))
(file-exists-p (setq file (expand-file-name "bin/eclim" file)))
(cl-return file)))))
(defcustom company-eclim-executable
(or (bound-and-true-p eclim-executable)
(executable-find "eclim")
(company-eclim-executable-find))
"Location of eclim executable."
:type 'file)
(defcustom company-eclim-auto-save t
"Determines whether to save the buffer when retrieving completions.
eclim can only complete correctly when the buffer has been saved."
:type '(choice (const :tag "Off" nil)
(const :tag "On" t)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar-local company-eclim--project-dir 'unknown)
(defvar-local company-eclim--project-name nil)
(declare-function json-read "json")
(defvar json-array-type)
(defun company-eclim--call-process (&rest args)
(let ((coding-system-for-read 'utf-8)
res)
(require 'json)
(with-temp-buffer
(if (= 0 (setq res (apply 'call-process company-eclim-executable nil t nil
"-command" args)))
(let ((json-array-type 'list))
(goto-char (point-min))
(unless (eobp)
(json-read)))
(message "Company-eclim command failed with error %d:\n%s" res
(buffer-substring (point-min) (point-max)))
nil))))
(defun company-eclim--project-list ()
(company-eclim--call-process "project_list"))
(defun company-eclim--project-dir ()
(if (eq company-eclim--project-dir 'unknown)
(let ((dir (locate-dominating-file buffer-file-name ".project")))
(when dir
(setq company-eclim--project-dir
(directory-file-name
(expand-file-name dir)))))
company-eclim--project-dir))
(defun company-eclim--project-name ()
(or company-eclim--project-name
(let ((dir (company-eclim--project-dir)))
(when dir
(setq company-eclim--project-name
(cl-loop for project in (company-eclim--project-list)
when (equal (cdr (assoc 'path project)) dir)
return (cdr (assoc 'name project))))))))
(defun company-eclim--candidates (prefix)
(interactive "d")
(let ((project-file (file-relative-name buffer-file-name
(company-eclim--project-dir)))
completions)
(when company-eclim-auto-save
(when (buffer-modified-p)
(basic-save-buffer))
;; FIXME: Sometimes this isn't finished when we complete.
(company-eclim--call-process "java_src_update"
"-p" (company-eclim--project-name)
"-f" project-file))
(dolist (item (cdr (assoc 'completions
(company-eclim--call-process
"java_complete" "-p" (company-eclim--project-name)
"-f" project-file
"-o" (number-to-string
(company-eclim--search-point prefix))
"-e" "utf-8"
"-l" "standard"))))
(let* ((meta (cdr (assoc 'info item)))
(completion meta))
(when (string-match " ?[(:-]" completion)
(setq completion (substring completion 0 (match-beginning 0))))
(put-text-property 0 1 'meta meta completion)
(push completion completions)))
(let ((completion-ignore-case nil))
(all-completions prefix completions))))
(defun company-eclim--search-point (prefix)
(if (or (cl-plusp (length prefix)) (eq (char-before) ?.))
(1- (point))
(point)))
(defun company-eclim--meta (candidate)
(get-text-property 0 'meta candidate))
(defun company-eclim--annotation (candidate)
(let ((meta (company-eclim--meta candidate)))
(when (string-match "\\(([^-]*\\) -" meta)
(substring meta (match-beginning 1) (match-end 1)))))
(defun company-eclim--prefix ()
(let ((prefix (company-grab-symbol)))
(when prefix
;; Completion candidates for annotations don't include '@'.
(when (eq ?@ (string-to-char prefix))
(setq prefix (substring prefix 1)))
prefix)))
(defun company-eclim (command &optional arg &rest ignored)
"`company-mode' completion backend for Eclim.
Eclim provides access to Eclipse Java IDE features for other editors.
Eclim version 1.7.13 or newer (?) is required.
Completions only work correctly when the buffer has been saved.
`company-eclim-auto-save' determines whether to do this automatically."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-eclim))
(prefix (and (derived-mode-p 'java-mode 'jde-mode)
buffer-file-name
company-eclim-executable
(company-eclim--project-name)
(not (company-in-string-or-comment))
(or (company-eclim--prefix) 'stop)))
(candidates (company-eclim--candidates arg))
(meta (company-eclim--meta arg))
;; because "" doesn't return everything
(no-cache (equal arg ""))
(annotation (company-eclim--annotation arg))
(post-completion (let ((anno (company-eclim--annotation arg)))
(when anno
(insert anno)
(company-template-c-like-templatify anno))))))
(provide 'company-eclim)
;;; company-eclim.el ends here

226
lisp/company/company-elisp.el Normal file
View File

@@ -0,0 +1,226 @@
;;; company-elisp.el --- company-mode completion backend for Emacs Lisp -*- lexical-binding: t -*-
;; Copyright (C) 2009, 2011-2013, 2017 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; In newer versions of Emacs, company-capf is used instead.
;;; Code:
(require 'company)
(require 'cl-lib)
(require 'help-mode)
(require 'find-func)
(defgroup company-elisp nil
"Completion backend for Emacs Lisp."
:group 'company)
(defcustom company-elisp-detect-function-context t
"If enabled, offer Lisp functions only in appropriate contexts.
Functions are offered for completion only after ' and \(."
:type '(choice (const :tag "Off" nil)
(const :tag "On" t)))
(defcustom company-elisp-show-locals-first t
"If enabled, locally bound variables and functions are displayed
first in the candidates list."
:type '(choice (const :tag "Off" nil)
(const :tag "On" t)))
(defun company-elisp--prefix ()
(let ((prefix (company-grab-symbol)))
(if prefix
(when (if (company-in-string-or-comment)
(= (char-before (- (point) (length prefix))) ?`)
(company-elisp--should-complete))
prefix)
'stop)))
(defun company-elisp--predicate (symbol)
(or (boundp symbol)
(fboundp symbol)
(facep symbol)
(featurep symbol)))
(defun company-elisp--fns-regexp (&rest names)
(concat "\\_<\\(?:cl-\\)?" (regexp-opt names) "\\*?\\_>"))
(defvar company-elisp-parse-limit 30)
(defvar company-elisp-parse-depth 100)
(defvar company-elisp-defun-names '("defun" "defmacro" "defsubst"))
(defvar company-elisp-var-binding-regexp
(apply #'company-elisp--fns-regexp "let" "lambda" "lexical-let"
company-elisp-defun-names)
"Regular expression matching head of a multiple variable bindings form.")
(defvar company-elisp-var-binding-regexp-1
(company-elisp--fns-regexp "dolist" "dotimes")
"Regular expression matching head of a form with one variable binding.")
(defvar company-elisp-fun-binding-regexp
(company-elisp--fns-regexp "flet" "labels")
"Regular expression matching head of a function bindings form.")
(defvar company-elisp-defuns-regexp
(concat "([ \t\n]*"
(apply #'company-elisp--fns-regexp company-elisp-defun-names)))
(defun company-elisp--should-complete ()
(let ((start (point))
(depth (car (syntax-ppss))))
(not
(when (> depth 0)
(save-excursion
(up-list (- depth))
(when (looking-at company-elisp-defuns-regexp)
(forward-char)
(forward-sexp 1)
(unless (= (point) start)
(condition-case nil
(let ((args-end (scan-sexps (point) 2)))
(or (null args-end)
(> args-end start)))
(scan-error
t)))))))))
(defun company-elisp--locals (prefix functions-p)
(let ((regexp (concat "[ \t\n]*\\(\\_<" (regexp-quote prefix)
"\\(?:\\sw\\|\\s_\\)*\\_>\\)"))
(pos (point))
res)
(condition-case nil
(save-excursion
(dotimes (_ company-elisp-parse-depth)
(up-list -1)
(save-excursion
(when (eq (char-after) ?\()
(forward-char 1)
(when (ignore-errors
(save-excursion (forward-list)
(<= (point) pos)))
(skip-chars-forward " \t\n")
(cond
((looking-at (if functions-p
company-elisp-fun-binding-regexp
company-elisp-var-binding-regexp))
(down-list 1)
(condition-case nil
(dotimes (_ company-elisp-parse-limit)
(save-excursion
(when (looking-at "[ \t\n]*(")
(down-list 1))
(when (looking-at regexp)
(cl-pushnew (match-string-no-properties 1) res)))
(forward-sexp))
(scan-error nil)))
((unless functions-p
(looking-at company-elisp-var-binding-regexp-1))
(down-list 1)
(when (looking-at regexp)
(cl-pushnew (match-string-no-properties 1) res)))))))))
(scan-error nil))
res))
(defun company-elisp-candidates (prefix)
(let* ((predicate (company-elisp--candidates-predicate prefix))
(locals (company-elisp--locals prefix (eq predicate 'fboundp)))
(globals (company-elisp--globals prefix predicate))
(locals (cl-loop for local in locals
when (not (member local globals))
collect local)))
(if company-elisp-show-locals-first
(append (sort locals 'string<)
(sort globals 'string<))
(append locals globals))))
(defun company-elisp--globals (prefix predicate)
(all-completions prefix obarray predicate))
(defun company-elisp--candidates-predicate (prefix)
(let* ((completion-ignore-case nil)
(beg (- (point) (length prefix)))
(before (char-before beg)))
(if (and company-elisp-detect-function-context
(not (memq before '(?' ?`))))
(if (and (eq before ?\()
(not
(save-excursion
(ignore-errors
(goto-char (1- beg))
(or (company-elisp--before-binding-varlist-p)
(progn
(up-list -1)
(company-elisp--before-binding-varlist-p)))))))
'fboundp
'boundp)
'company-elisp--predicate)))
(defun company-elisp--before-binding-varlist-p ()
(save-excursion
(and (prog1 (search-backward "(")
(forward-char 1))
(looking-at company-elisp-var-binding-regexp))))
(defun company-elisp--doc (symbol)
(let* ((symbol (intern symbol))
(doc (if (fboundp symbol)
(documentation symbol t)
(documentation-property symbol 'variable-documentation t))))
(and (stringp doc)
(string-match ".*$" doc)
(match-string 0 doc))))
;;;###autoload
(defun company-elisp (command &optional arg &rest ignored)
"`company-mode' completion backend for Emacs Lisp."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-elisp))
(prefix (and (derived-mode-p 'emacs-lisp-mode 'inferior-emacs-lisp-mode)
(company-elisp--prefix)))
(candidates (company-elisp-candidates arg))
(sorted company-elisp-show-locals-first)
(meta (company-elisp--doc arg))
(doc-buffer (let ((symbol (intern arg)))
(save-window-excursion
(ignore-errors
(cond
((fboundp symbol) (describe-function symbol))
((boundp symbol) (describe-variable symbol))
((featurep symbol) (describe-package symbol))
((facep symbol) (describe-face symbol))
(t (signal 'user-error nil)))
(help-buffer)))))
(location (let ((sym (intern arg)))
(cond
((fboundp sym) (find-definition-noselect sym nil))
((boundp sym) (find-definition-noselect sym 'defvar))
((featurep sym) (cons (find-file-noselect (find-library-name
(symbol-name sym)))
0))
((facep sym) (find-definition-noselect sym 'defface)))))))
(provide 'company-elisp)
;;; company-elisp.el ends here

108
lisp/company/company-etags.el Normal file
View File

@@ -0,0 +1,108 @@
;;; company-etags.el --- company-mode completion backend for etags
;; Copyright (C) 2009-2011, 2014 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'company)
(require 'cl-lib)
(require 'etags)
(defgroup company-etags nil
"Completion backend for etags."
:group 'company)
(defcustom company-etags-use-main-table-list t
"Always search `tags-table-list' if set.
If this is disabled, `company-etags' will try to find the one table for each
buffer automatically."
:type '(choice (const :tag "off" nil)
(const :tag "on" t)))
(defcustom company-etags-ignore-case nil
"Non-nil to ignore case in completion candidates."
:type 'boolean
:package-version '(company . "0.7.3"))
(defcustom company-etags-everywhere nil
"Non-nil to offer completions in comments and strings.
Set it to t or to a list of major modes."
:type '(choice (const :tag "Off" nil)
(const :tag "Any supported mode" t)
(repeat :tag "Some major modes"
(symbol :tag "Major mode")))
:package-version '(company . "0.9.0"))
(defvar company-etags-modes '(prog-mode c-mode objc-mode c++-mode java-mode
jde-mode pascal-mode perl-mode python-mode))
(defvar-local company-etags-buffer-table 'unknown)
(defun company-etags-find-table ()
(let ((file (expand-file-name
"TAGS"
(locate-dominating-file (or buffer-file-name
default-directory)
"TAGS"))))
(when (and file (file-regular-p file))
(list file))))
(defun company-etags-buffer-table ()
(or (and company-etags-use-main-table-list tags-table-list)
(if (eq company-etags-buffer-table 'unknown)
(setq company-etags-buffer-table (company-etags-find-table))
company-etags-buffer-table)))
(defun company-etags--candidates (prefix)
(let ((tags-table-list (company-etags-buffer-table))
(tags-file-name tags-file-name)
(completion-ignore-case company-etags-ignore-case))
(and (or tags-file-name tags-table-list)
(fboundp 'tags-completion-table)
(save-excursion
(visit-tags-table-buffer)
(all-completions prefix (tags-completion-table))))))
;;;###autoload
(defun company-etags (command &optional arg &rest ignored)
"`company-mode' completion backend for etags."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-etags))
(prefix (and (apply #'derived-mode-p company-etags-modes)
(or (eq t company-etags-everywhere)
(apply #'derived-mode-p company-etags-everywhere)
(not (company-in-string-or-comment)))
(company-etags-buffer-table)
(or (company-grab-symbol) 'stop)))
(candidates (company-etags--candidates arg))
(location (let ((tags-table-list (company-etags-buffer-table)))
(when (fboundp 'find-tag-noselect)
(save-excursion
(let ((buffer (find-tag-noselect arg)))
(cons buffer (with-current-buffer buffer (point))))))))
(ignore-case company-etags-ignore-case)))
(provide 'company-etags)
;;; company-etags.el ends here

151
lisp/company/company-files.el Normal file
View File

@@ -0,0 +1,151 @@
;;; company-files.el --- company-mode completion backend for file names
;; Copyright (C) 2009-2011, 2014-2015 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'company)
(require 'cl-lib)
(defgroup company-files nil
"Completion backend for file names."
:group 'company)
(defcustom company-files-exclusions nil
"File name extensions and directory names to ignore.
The values should use the same format as `completion-ignored-extensions'."
:type '(const string)
:package-version '(company . "0.9.1"))
(defun company-files--directory-files (dir prefix)
;; Don't use directory-files. It produces directories without trailing /.
(condition-case err
(let ((comp (sort (file-name-all-completions prefix dir)
(lambda (s1 s2) (string-lessp (downcase s1) (downcase s2))))))
(when company-files-exclusions
(setq comp (company-files--exclusions-filtered comp)))
(if (equal prefix "")
(delete "../" (delete "./" comp))
comp))
(file-error nil)))
(defun company-files--exclusions-filtered (completions)
(let* ((dir-exclusions (cl-delete-if-not #'company-files--trailing-slash-p
company-files-exclusions))
(file-exclusions (cl-set-difference company-files-exclusions
dir-exclusions)))
(cl-loop for c in completions
unless (if (company-files--trailing-slash-p c)
(member c dir-exclusions)
(cl-find-if (lambda (exclusion)
(string-suffix-p exclusion c))
file-exclusions))
collect c)))
(defvar company-files--regexps
(let* ((root (if (eq system-type 'windows-nt)
"[a-zA-Z]:/"
"/"))
(begin (concat "\\(?:\\.\\{1,2\\}/\\|~/\\|" root "\\)")))
(list (concat "\"\\(" begin "[^\"\n]*\\)")
(concat "\'\\(" begin "[^\'\n]*\\)")
(concat "\\(?:[ \t=\[]\\|^\\)\\(" begin "[^ \t\n]*\\)"))))
(defun company-files--grab-existing-name ()
;; Grab the file name.
;; When surrounded with quotes, it can include spaces.
(let (file dir)
(and (cl-dolist (regexp company-files--regexps)
(when (setq file (company-grab-line regexp 1))
(cl-return file)))
(company-files--connected-p file)
(setq dir (file-name-directory file))
(not (string-match "//" dir))
(file-exists-p dir)
file)))
(defun company-files--connected-p (file)
(or (not (file-remote-p file))
(file-remote-p file nil t)))
(defun company-files--trailing-slash-p (file)
;; `file-directory-p' is very expensive on remotes. We are relying on
;; `file-name-all-completions' returning directories with trailing / instead.
(let ((len (length file)))
(and (> len 0) (eq (aref file (1- len)) ?/))))
(defvar company-files--completion-cache nil)
(defun company-files--complete (prefix)
(let* ((dir (file-name-directory prefix))
(file (file-name-nondirectory prefix))
(key (list file
(expand-file-name dir)
(nth 5 (file-attributes dir))))
(completion-ignore-case read-file-name-completion-ignore-case))
(unless (company-file--keys-match-p key (car company-files--completion-cache))
(let* ((candidates (mapcar (lambda (f) (concat dir f))
(company-files--directory-files dir file)))
(directories (unless (file-remote-p dir)
(cl-remove-if-not (lambda (f)
(and (company-files--trailing-slash-p f)
(not (file-remote-p f))
(company-files--connected-p f)))
candidates)))
(children (and directories
(cl-mapcan (lambda (d)
(mapcar (lambda (c) (concat d c))
(company-files--directory-files d "")))
directories))))
(setq company-files--completion-cache
(cons key (append candidates children)))))
(all-completions prefix
(cdr company-files--completion-cache))))
(defun company-file--keys-match-p (new old)
(and (equal (cdr old) (cdr new))
(string-prefix-p (car old) (car new))))
(defun company-files--post-completion (arg)
(when (company-files--trailing-slash-p arg)
(delete-char -1)))
;;;###autoload
(defun company-files (command &optional arg &rest ignored)
"`company-mode' completion backend existing file names.
Completions works for proper absolute and relative files paths.
File paths with spaces are only supported inside strings."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-files))
(prefix (company-files--grab-existing-name))
(candidates (company-files--complete arg))
(location (cons (dired-noselect
(file-name-directory (directory-file-name arg))) 1))
(post-completion (company-files--post-completion arg))
(sorted t)
(no-cache t)))
(provide 'company-files)
;;; company-files.el ends here

119
lisp/company/company-gtags.el Normal file
View File

@@ -0,0 +1,119 @@
;;; company-gtags.el --- company-mode completion backend for GNU Global
;; Copyright (C) 2009-2011, 2014-2020 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'company)
(require 'company-template)
(require 'cl-lib)
(defgroup company-gtags nil
"Completion backend for GNU Global."
:group 'company)
(define-obsolete-variable-alias
'company-gtags-gnu-global-program-name
'company-gtags-executable "earlier")
(defcustom company-gtags-executable
(executable-find "global")
"Location of GNU global executable."
:type 'string)
(defcustom company-gtags-insert-arguments t
"When non-nil, insert function arguments as a template after completion."
:type 'boolean
:package-version '(company . "0.8.1"))
(defvar-local company-gtags--tags-available-p 'unknown)
(defcustom company-gtags-modes '(prog-mode jde-mode)
"Modes that use `company-gtags'.
In all these modes (and their derivatives) `company-gtags' will perform
completion."
:type '(repeat (symbol :tag "Major mode"))
:package-version '(company . "0.8.4"))
(defun company-gtags--tags-available-p ()
(if (eq company-gtags--tags-available-p 'unknown)
(setq company-gtags--tags-available-p
(locate-dominating-file buffer-file-name "GTAGS"))
company-gtags--tags-available-p))
(defun company-gtags--fetch-tags (prefix)
(with-temp-buffer
(let (tags)
;; For some reason Global v 6.6.3 is prone to returning exit status 1
;; even on successful searches when '-T' is used.
(when (/= 3 (process-file company-gtags-executable nil
;; "-T" goes through all the tag files listed in GTAGSLIBPATH
(list (current-buffer) nil) nil "-xGqT" (concat "^" prefix)))
(goto-char (point-min))
(cl-loop while
(re-search-forward (concat
"^"
"\\([^ ]*\\)" ;; completion
"[ \t]+\\([[:digit:]]+\\)" ;; linum
"[ \t]+\\([^ \t]+\\)" ;; file
"[ \t]+\\(.*\\)" ;; definition
"$"
) nil t)
collect
(propertize (match-string 1)
'meta (match-string 4)
'location (cons (expand-file-name (match-string 3))
(string-to-number (match-string 2)))
))))))
(defun company-gtags--annotation (arg)
(let ((meta (get-text-property 0 'meta arg)))
(when (string-match (concat (regexp-quote arg) "\\((.*)\\).*") meta)
(match-string 1 meta))))
;;;###autoload
(defun company-gtags (command &optional arg &rest ignored)
"`company-mode' completion backend for GNU Global."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-gtags))
(prefix (and company-gtags-executable
buffer-file-name
(apply #'derived-mode-p company-gtags-modes)
(not (company-in-string-or-comment))
(company-gtags--tags-available-p)
(or (company-grab-symbol) 'stop)))
(candidates (company-gtags--fetch-tags arg))
(sorted t)
(duplicates t)
(annotation (company-gtags--annotation arg))
(meta (get-text-property 0 'meta arg))
(location (get-text-property 0 'location arg))
(post-completion (let ((anno (company-gtags--annotation arg)))
(when (and company-gtags-insert-arguments anno)
(insert anno)
(company-template-c-like-templatify anno))))))
(provide 'company-gtags)
;;; company-gtags.el ends here

82
lisp/company/company-ispell.el Normal file
View File

@@ -0,0 +1,82 @@
;;; company-ispell.el --- company-mode completion backend using Ispell
;; Copyright (C) 2009-2011, 2013-2016 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'company)
(require 'cl-lib)
(require 'ispell)
(defgroup company-ispell nil
"Completion backend using Ispell."
:group 'company)
(defcustom company-ispell-dictionary nil
"Dictionary to use for `company-ispell'.
If nil, use `ispell-complete-word-dict'."
:type '(choice (const :tag "default (nil)" nil)
(file :tag "dictionary" t)))
(defvar company-ispell-available 'unknown)
(defalias 'company-ispell--lookup-words
(if (fboundp 'ispell-lookup-words)
'ispell-lookup-words
'lookup-words))
(defun company-ispell-available ()
(when (eq company-ispell-available 'unknown)
(condition-case err
(progn
(company-ispell--lookup-words "WHATEVER")
(setq company-ispell-available t))
(error
(message "Company-Ispell: %s" (error-message-string err))
(setq company-ispell-available nil))))
company-ispell-available)
;;;###autoload
(defun company-ispell (command &optional arg &rest ignored)
"`company-mode' completion backend using Ispell."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-ispell))
(prefix (when (company-ispell-available)
(company-grab-word)))
(candidates
(let ((words (company-ispell--lookup-words
arg
(or company-ispell-dictionary ispell-complete-word-dict)))
(completion-ignore-case t))
(if (string= arg "")
;; Small optimization.
words
;; Work around issue #284.
(all-completions arg words))))
(sorted t)
(ignore-case 'keep-prefix)))
(provide 'company-ispell)
;;; company-ispell.el ends here

314
lisp/company/company-keywords.el Normal file
View File

@@ -0,0 +1,314 @@
;;; company-keywords.el --- A company backend for programming language keywords
;; Copyright (C) 2009-2011, 2016 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'company)
(require 'cl-lib)
(defun company-keywords-upper-lower (&rest lst)
;; Upcase order is different for _.
(nconc (sort (mapcar 'upcase lst) 'string<) lst))
(defvar company-keywords-alist
;; Please contribute corrections or additions.
`((c++-mode
;; from https://en.cppreference.com/w/cpp/keyword
"alignas" "alignof" "and" "and_eq" "asm" "atomic_cancel" "atomic_commit"
"atomic_noexcept" "auto" "bitand" "bitor" "bool" "break" "case" "catch"
"char" "char16_t" "char32_t" "char8_t" "class" "co_await" "co_return"
"co_yield" "compl" "concept" "const" "const_cast" "consteval" "constexpr"
"constinit" "continue" "decltype" "default" "delete" "do" "double"
"dynamic_cast" "else" "enum" "explicit" "export" "extern" "false" "final"
"float" "for" "friend" "goto" "if" "import" "inline" "int" "long" "module"
"mutable" "namespace" "new" "noexcept" "not" "not_eq" "nullptr" "operator"
"or" "or_eq" "override" "private" "protected" "public" "reflexpr" "register"
"reinterpret_cast" "requires" "return" "short" "signed" "sizeof" "static"
"static_assert" "static_cast" "struct" "switch" "synchronized" "template"
"this" "thread_local" "throw" "true" "try" "typedef" "typeid" "typename"
"union" "unsigned" "using" "virtual" "void" "volatile" "wchar_t" "while"
"xor" "xor_eq")
(c-mode
;; from https://en.cppreference.com/w/c/keyword
"_Alignas" "_Alignof" "_Atomic" "_Bool" "_Complex" "_Generic" "_Imaginary"
"_Noreturn" "_Static_assert" "_Thread_local"
"auto" "break" "case" "char" "const" "continue" "default" "do"
"double" "else" "enum" "extern" "float" "for" "goto" "if" "inline"
"int" "long" "register" "restrict" "return" "short" "signed" "sizeof"
"static" "struct" "switch" "typedef" "union" "unsigned" "void" "volatile"
"while")
(csharp-mode
"abstract" "add" "alias" "as" "base" "bool" "break" "byte" "case"
"catch" "char" "checked" "class" "const" "continue" "decimal" "default"
"delegate" "do" "double" "else" "enum" "event" "explicit" "extern"
"false" "finally" "fixed" "float" "for" "foreach" "get" "global" "goto"
"if" "implicit" "in" "int" "interface" "internal" "is" "lock" "long"
"namespace" "new" "null" "object" "operator" "out" "override" "params"
"partial" "private" "protected" "public" "readonly" "ref" "remove"
"return" "sbyte" "sealed" "set" "short" "sizeof" "stackalloc" "static"
"string" "struct" "switch" "this" "throw" "true" "try" "typeof" "uint"
"ulong" "unchecked" "unsafe" "ushort" "using" "value" "var" "virtual"
"void" "volatile" "where" "while" "yield")
(d-mode
;; from http://www.digitalmars.com/d/2.0/lex.html
"abstract" "alias" "align" "asm"
"assert" "auto" "body" "bool" "break" "byte" "case" "cast" "catch"
"cdouble" "cent" "cfloat" "char" "class" "const" "continue" "creal"
"dchar" "debug" "default" "delegate" "delete" "deprecated" "do"
"double" "else" "enum" "export" "extern" "false" "final" "finally"
"float" "for" "foreach" "foreach_reverse" "function" "goto" "idouble"
"if" "ifloat" "import" "in" "inout" "int" "interface" "invariant"
"ireal" "is" "lazy" "long" "macro" "mixin" "module" "new" "nothrow"
"null" "out" "override" "package" "pragma" "private" "protected"
"public" "pure" "real" "ref" "return" "scope" "short" "static" "struct"
"super" "switch" "synchronized" "template" "this" "throw" "true" "try"
"typedef" "typeid" "typeof" "ubyte" "ucent" "uint" "ulong" "union"
"unittest" "ushort" "version" "void" "volatile" "wchar" "while" "with")
(f90-mode .
;; from f90.el
;; ".AND." ".GE." ".GT." ".LT." ".LE." ".NE." ".OR." ".TRUE." ".FALSE."
,(company-keywords-upper-lower
"abs" "abstract" "achar" "acos" "adjustl" "adjustr" "aimag" "aint"
"align" "all" "all_prefix" "all_scatter" "all_suffix" "allocatable"
"allocate" "allocated" "and" "anint" "any" "any_prefix" "any_scatter"
"any_suffix" "asin" "assign" "assignment" "associate" "associated"
"asynchronous" "atan" "atan2" "backspace" "bind" "bit_size" "block"
"btest" "c_alert" "c_associated" "c_backspace" "c_bool"
"c_carriage_return" "c_char" "c_double" "c_double_complex" "c_f_pointer"
"c_f_procpointer" "c_float" "c_float_complex" "c_form_feed" "c_funloc"
"c_funptr" "c_horizontal_tab" "c_int" "c_int16_t" "c_int32_t" "c_int64_t"
"c_int8_t" "c_int_fast16_t" "c_int_fast32_t" "c_int_fast64_t"
"c_int_fast8_t" "c_int_least16_t" "c_int_least32_t" "c_int_least64_t"
"c_int_least8_t" "c_intmax_t" "c_intptr_t" "c_loc" "c_long"
"c_long_double" "c_long_double_complex" "c_long_long" "c_new_line"
"c_null_char" "c_null_funptr" "c_null_ptr" "c_ptr" "c_short"
"c_signed_char" "c_size_t" "c_vertical_tab" "call" "case" "ceiling"
"char" "character" "character_storage_size" "class" "close" "cmplx"
"command_argument_count" "common" "complex" "conjg" "contains" "continue"
"copy_prefix" "copy_scatter" "copy_suffix" "cos" "cosh" "count"
"count_prefix" "count_scatter" "count_suffix" "cpu_time" "cshift"
"cycle" "cyclic" "data" "date_and_time" "dble" "deallocate" "deferred"
"digits" "dim" "dimension" "distribute" "do" "dot_product" "double"
"dprod" "dynamic" "elemental" "else" "elseif" "elsewhere" "end" "enddo"
"endfile" "endif" "entry" "enum" "enumerator" "eoshift" "epsilon" "eq"
"equivalence" "eqv" "error_unit" "exit" "exp" "exponent" "extends"
"extends_type_of" "external" "extrinsic" "false" "file_storage_size"
"final" "floor" "flush" "forall" "format" "fraction" "function" "ge"
"generic" "get_command" "get_command_argument" "get_environment_variable"
"goto" "grade_down" "grade_up" "gt" "hpf_alignment" "hpf_distribution"
"hpf_template" "huge" "iachar" "iall" "iall_prefix" "iall_scatter"
"iall_suffix" "iand" "iany" "iany_prefix" "iany_scatter" "iany_suffix"
"ibclr" "ibits" "ibset" "ichar" "ieee_arithmetic" "ieee_exceptions"
"ieee_features" "ieee_get_underflow_mode" "ieee_set_underflow_mode"
"ieee_support_underflow_control" "ieor" "if" "ilen" "implicit"
"import" "include" "independent" "index" "inherit" "input_unit"
"inquire" "int" "integer" "intent" "interface" "intrinsic" "ior"
"iostat_end" "iostat_eor" "iparity" "iparity_prefix" "iparity_scatter"
"iparity_suffix" "ishft" "ishftc" "iso_c_binding" "iso_fortran_env"
"kind" "lbound" "le" "leadz" "len" "len_trim" "lge" "lgt" "lle" "llt"
"log" "log10" "logical" "lt" "matmul" "max" "maxexponent" "maxloc"
"maxval" "maxval_prefix" "maxval_scatter" "maxval_suffix" "merge"
"min" "minexponent" "minloc" "minval" "minval_prefix" "minval_scatter"
"minval_suffix" "mod" "module" "modulo" "move_alloc" "mvbits" "namelist"
"ne" "nearest" "neqv" "new" "new_line" "nint" "non_intrinsic"
"non_overridable" "none" "nopass" "not" "null" "nullify"
"number_of_processors" "numeric_storage_size" "only" "onto" "open"
"operator" "optional" "or" "output_unit" "pack" "parameter" "parity"
"parity_prefix" "parity_scatter" "parity_suffix" "pass" "pause"
"pointer" "popcnt" "poppar" "precision" "present" "print" "private"
"procedure" "processors" "processors_shape" "product" "product_prefix"
"product_scatter" "product_suffix" "program" "protected" "public"
"pure" "radix" "random_number" "random_seed" "range" "read" "real"
"realign" "recursive" "redistribute" "repeat" "reshape" "result"
"return" "rewind" "rrspacing" "same_type_as" "save" "scale" "scan"
"select" "selected_char_kind" "selected_int_kind" "selected_real_kind"
"sequence" "set_exponent" "shape" "sign" "sin" "sinh" "size" "spacing"
"spread" "sqrt" "stop" "subroutine" "sum" "sum_prefix" "sum_scatter"
"sum_suffix" "system_clock" "tan" "tanh" "target" "template" "then"
"tiny" "transfer" "transpose" "trim" "true" "type" "ubound" "unpack"
"use" "value" "verify" "volatile" "wait" "where" "while" "with" "write"))
(go-mode
;; 1. Keywords ref: https://golang.org/ref/spec#Keywords
;; 2. Builtin functions and types ref: https://golang.org/pkg/builtin/
"append" "bool" "break" "byte" "cap" "case" "chan" "close" "complex" "complex128"
"complex64" "const" "continue" "copy" "default" "defer" "delete" "else" "error"
"fallthrough" "false" "float32" "float64" "for" "func" "go" "goto" "if" "imag"
"import" "int" "int16" "int32" "int64" "int8" "interface" "len" "make"
"map" "new" "nil" "package" "panic" "print" "println" "range" "real" "recover"
"return" "rune" "select" "string" "struct" "switch" "true" "type" "uint" "uint16"
"uint32" "uint64" "uint8" "uintptr" "var")
(java-mode
"abstract" "assert" "boolean" "break" "byte" "case" "catch" "char" "class"
"continue" "default" "do" "double" "else" "enum" "extends" "final"
"finally" "float" "for" "if" "implements" "import" "instanceof" "int"
"interface" "long" "native" "new" "package" "private" "protected" "public"
"return" "short" "static" "strictfp" "super" "switch" "synchronized"
"this" "throw" "throws" "transient" "try" "void" "volatile" "while")
(javascript-mode
;; https://tc39.github.io/ecma262/ + async, static and undefined
"async" "await" "break" "case" "catch" "class" "const" "continue"
"debugger" "default" "delete" "do" "else" "enum" "export" "extends" "false"
"finally" "for" "function" "if" "import" "in" "instanceof" "let" "new"
"null" "return" "static" "super" "switch" "this" "throw" "true" "try"
"typeof" "undefined" "var" "void" "while" "with" "yield")
(kotlin-mode
"abstract" "annotation" "as" "break" "by" "catch" "class" "companion"
"const" "constructor" "continue" "data" "do" "else" "enum" "false" "final"
"finally" "for" "fun" "if" "import" "in" "init" "inner" "interface"
"internal" "is" "lateinit" "nested" "null" "object" "open" "out" "override"
"package" "private" "protected" "public" "return" "super" "this" "throw"
"trait" "true" "try" "typealias" "val" "var" "when" "while")
(objc-mode
"@catch" "@class" "@encode" "@end" "@finally" "@implementation"
"@interface" "@private" "@protected" "@protocol" "@public"
"@selector" "@synchronized" "@throw" "@try" "alloc" "autorelease"
"bycopy" "byref" "in" "inout" "oneway" "out" "release" "retain")
(perl-mode
;; from cperl.el
"AUTOLOAD" "BEGIN" "CHECK" "CORE" "DESTROY" "END" "INIT" "__END__"
"__FILE__" "__LINE__" "abs" "accept" "alarm" "and" "atan2" "bind"
"binmode" "bless" "caller" "chdir" "chmod" "chomp" "chop" "chown" "chr"
"chroot" "close" "closedir" "cmp" "connect" "continue" "cos"
"crypt" "dbmclose" "dbmopen" "defined" "delete" "die" "do" "dump" "each"
"else" "elsif" "endgrent" "endhostent" "endnetent" "endprotoent"
"endpwent" "endservent" "eof" "eq" "eval" "exec" "exists" "exit" "exp"
"fcntl" "fileno" "flock" "for" "foreach" "fork" "format" "formline"
"ge" "getc" "getgrent" "getgrgid" "getgrnam" "gethostbyaddr"
"gethostbyname" "gethostent" "getlogin" "getnetbyaddr" "getnetbyname"
"getnetent" "getpeername" "getpgrp" "getppid" "getpriority"
"getprotobyname" "getprotobynumber" "getprotoent" "getpwent" "getpwnam"
"getpwuid" "getservbyname" "getservbyport" "getservent" "getsockname"
"getsockopt" "glob" "gmtime" "goto" "grep" "gt" "hex" "if" "index" "int"
"ioctl" "join" "keys" "kill" "last" "lc" "lcfirst" "le" "length"
"link" "listen" "local" "localtime" "lock" "log" "lstat" "lt" "map"
"mkdir" "msgctl" "msgget" "msgrcv" "msgsnd" "my" "ne" "next" "no"
"not" "oct" "open" "opendir" "or" "ord" "our" "pack" "package" "pipe"
"pop" "pos" "print" "printf" "push" "q" "qq" "quotemeta" "qw" "qx"
"rand" "read" "readdir" "readline" "readlink" "readpipe" "recv" "redo"
"ref" "rename" "require" "reset" "return" "reverse" "rewinddir" "rindex"
"rmdir" "scalar" "seek" "seekdir" "select" "semctl" "semget" "semop"
"send" "setgrent" "sethostent" "setnetent" "setpgrp" "setpriority"
"setprotoent" "setpwent" "setservent" "setsockopt" "shift" "shmctl"
"shmget" "shmread" "shmwrite" "shutdown" "sin" "sleep" "socket"
"socketpair" "sort" "splice" "split" "sprintf" "sqrt" "srand" "stat"
"study" "sub" "substr" "symlink" "syscall" "sysopen" "sysread" "system"
"syswrite" "tell" "telldir" "tie" "time" "times" "tr" "truncate" "uc"
"ucfirst" "umask" "undef" "unless" "unlink" "unpack" "unshift" "untie"
"until" "use" "utime" "values" "vec" "wait" "waitpid"
"wantarray" "warn" "while" "write" "x" "xor" "y")
(php-mode
"__CLASS__" "__DIR__" "__FILE__" "__FUNCTION__" "__LINE__" "__METHOD__"
"__NAMESPACE__" "_once" "abstract" "and" "array" "as" "break" "case"
"catch" "cfunction" "class" "clone" "const" "continue" "declare"
"default" "die" "do" "echo" "else" "elseif" "empty" "enddeclare"
"endfor" "endforeach" "endif" "endswitch" "endwhile" "eval" "exception"
"exit" "extends" "final" "for" "foreach" "function" "global"
"goto" "if" "implements" "include" "instanceof" "interface"
"isset" "list" "namespace" "new" "old_function" "or" "php_user_filter"
"print" "private" "protected" "public" "require" "require_once" "return"
"static" "switch" "this" "throw" "try" "unset" "use" "var" "while" "xor")
(python-mode
;; https://docs.python.org/3/reference/lexical_analysis.html#keywords
"False" "None" "True" "and" "as" "assert" "break" "class" "continue" "def"
"del" "elif" "else" "except" "exec" "finally" "for" "from" "global" "if"
"import" "in" "is" "lambda" "nonlocal" "not" "or" "pass" "print" "raise"
"return" "try" "while" "with" "yield")
(ruby-mode
"BEGIN" "END" "alias" "and" "begin" "break" "case" "class" "def" "defined?"
"do" "else" "elsif" "end" "ensure" "false" "for" "if" "in" "module"
"next" "nil" "not" "or" "redo" "rescue" "retry" "return" "self" "super"
"then" "true" "undef" "unless" "until" "when" "while" "yield")
;; From https://doc.rust-lang.org/grammar.html#keywords
;; but excluding unused reserved words: https://www.reddit.com/r/rust/comments/34fq0k/is_there_a_good_list_of_rusts_keywords/cqucvnj
(rust-mode
"Self"
"as" "box" "break" "const" "continue" "crate" "else" "enum" "extern"
"false" "fn" "for" "if" "impl" "in" "let" "loop" "macro" "match" "mod"
"move" "mut" "pub" "ref" "return" "self" "static" "struct" "super"
"trait" "true" "type" "unsafe" "use" "where" "while")
(scala-mode
"abstract" "case" "catch" "class" "def" "do" "else" "extends" "false"
"final" "finally" "for" "forSome" "if" "implicit" "import" "lazy" "match"
"new" "null" "object" "override" "package" "private" "protected"
"return" "sealed" "super" "this" "throw" "trait" "true" "try" "type" "val"
"var" "while" "with" "yield")
(swift-mode
"Protocol" "Self" "Type" "and" "as" "assignment" "associatedtype"
"associativity" "available" "break" "case" "catch" "class" "column" "continue"
"convenience" "default" "defer" "deinit" "didSet" "do" "dynamic" "dynamicType"
"else" "elseif" "endif" "enum" "extension" "fallthrough" "false" "file"
"fileprivate" "final" "for" "func" "function" "get" "guard" "higherThan" "if"
"import" "in" "indirect" "infix" "init" "inout" "internal" "is" "lazy" "left"
"let" "line" "lowerThan" "mutating" "nil" "none" "nonmutating" "open"
"operator" "optional" "override" "postfix" "precedence" "precedencegroup"
"prefix" "private" "protocol" "public" "repeat" "required" "rethrows" "return"
"right" "selector" "self" "set" "static" "struct" "subscript" "super" "switch"
"throw" "throws" "true" "try" "typealias" "unowned" "var" "weak" "where"
"while" "willSet")
(julia-mode
"abstract" "break" "case" "catch" "const" "continue" "do" "else" "elseif"
"end" "eval" "export" "false" "finally" "for" "function" "global" "if"
"ifelse" "immutable" "import" "importall" "in" "let" "macro" "module"
"otherwise" "quote" "return" "switch" "throw" "true" "try" "type"
"typealias" "using" "while"
)
;; From https://github.com/apache/thrift/blob/master/contrib/thrift.el
(thrift-mode
"binary" "bool" "byte" "const" "double" "enum" "exception" "extends"
"i16" "i32" "i64" "include" "list" "map" "oneway" "optional" "required"
"service" "set" "string" "struct" "throws" "typedef" "void"
)
;; aliases
(js2-mode . javascript-mode)
(js2-jsx-mode . javascript-mode)
(espresso-mode . javascript-mode)
(js-mode . javascript-mode)
(js-jsx-mode . javascript-mode)
(rjsx-mode . javascript-mode)
(cperl-mode . perl-mode)
(jde-mode . java-mode)
(ess-julia-mode . julia-mode)
(enh-ruby-mode . ruby-mode))
"Alist mapping major-modes to sorted keywords for `company-keywords'.")
;;;###autoload
(defun company-keywords (command &optional arg &rest ignored)
"`company-mode' backend for programming language keywords."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-keywords))
(prefix (and (assq major-mode company-keywords-alist)
(not (company-in-string-or-comment))
(or (company-grab-symbol) 'stop)))
(candidates
(let ((completion-ignore-case nil)
(symbols (cdr (assq major-mode company-keywords-alist))))
(all-completions arg (if (consp symbols)
symbols
(cdr (assq symbols company-keywords-alist))))))
(sorted t)))
(provide 'company-keywords)
;;; company-keywords.el ends here

143
lisp/company/company-nxml.el Normal file
View File

@@ -0,0 +1,143 @@
;;; company-nxml.el --- company-mode completion backend for nxml-mode
;; Copyright (C) 2009-2011, 2013, 2018 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; In Emacs >= 26, company-capf is used instead.
;;; Code:
(require 'company)
(require 'cl-lib)
(defvar rng-open-elements)
(defvar rng-validate-mode)
(defvar rng-in-attribute-regex)
(defvar rng-in-attribute-value-regex)
(declare-function rng-set-state-after "rng-nxml")
(declare-function rng-match-possible-start-tag-names "rng-match")
(declare-function rng-adjust-state-for-attribute "rng-nxml")
(declare-function rng-match-possible-attribute-names "rng-match")
(declare-function rng-adjust-state-for-attribute-value "rng-nxml")
(declare-function rng-match-possible-value-strings "rng-match")
(defconst company-nxml-token-regexp
"\\(?:[_[:alpha:]][-._[:alnum:]]*\\_>\\)")
(defvar company-nxml-in-attribute-value-regexp
(replace-regexp-in-string "w" company-nxml-token-regexp
"<w\\(?::w\\)?\
\\(?:[ \t\r\n]+w\\(?::w\\)?[ \t\r\n]*=\
\[ \t\r\n]*\\(?:\"[^\"]*\"\\|'[^']*'\\)\\)*\
\[ \t\r\n]+\\(w\\(:w\\)?\\)[ \t\r\n]*=[ \t\r\n]*\
\\(\"\\([^\"]*\\>\\)\\|'\\([^']*\\>\\)\\)\\="
t t))
(defvar company-nxml-in-tag-name-regexp
(replace-regexp-in-string "w" company-nxml-token-regexp
"<\\(/?w\\(?::w?\\)?\\)?\\=" t t))
(defun company-nxml-all-completions (prefix alist)
(let ((candidates (mapcar 'cdr alist))
(case-fold-search nil)
filtered)
(when (cdar rng-open-elements)
(push (concat "/" (cdar rng-open-elements)) candidates))
(setq candidates (sort (all-completions prefix candidates) 'string<))
(while candidates
(unless (equal (car candidates) (car filtered))
(push (car candidates) filtered))
(pop candidates))
(nreverse filtered)))
(defmacro company-nxml-prepared (&rest body)
(declare (indent 0) (debug t))
`(let ((lt-pos (save-excursion (search-backward "<" nil t)))
xmltok-dtd)
(when (and lt-pos (= (rng-set-state-after lt-pos) lt-pos))
,@body)))
(defun company-nxml-tag (command &optional arg &rest ignored)
(cl-case command
(prefix (and (derived-mode-p 'nxml-mode)
rng-validate-mode
(company-grab company-nxml-in-tag-name-regexp 1)))
(candidates (company-nxml-prepared
(company-nxml-all-completions
arg (rng-match-possible-start-tag-names))))
(sorted t)))
(defun company-nxml-attribute (command &optional arg &rest ignored)
(cl-case command
(prefix (and (derived-mode-p 'nxml-mode)
rng-validate-mode
(memq (char-after) '(?\ ?\t ?\n)) ;; outside word
(company-grab rng-in-attribute-regex 1)))
(candidates (company-nxml-prepared
(and (rng-adjust-state-for-attribute
lt-pos (- (point) (length arg)))
(company-nxml-all-completions
arg (rng-match-possible-attribute-names)))))
(sorted t)))
(defun company-nxml-attribute-value (command &optional arg &rest ignored)
(cl-case command
(prefix (and (derived-mode-p 'nxml-mode)
rng-validate-mode
(and (memq (char-after) '(?' ?\" ?\ ?\t ?\n)) ;; outside word
(looking-back company-nxml-in-attribute-value-regexp nil)
(or (match-string-no-properties 4)
(match-string-no-properties 5)
""))))
(candidates (company-nxml-prepared
(let (attr-start attr-end colon)
(and (looking-back rng-in-attribute-value-regex lt-pos)
(setq colon (match-beginning 2)
attr-start (match-beginning 1)
attr-end (match-end 1))
(rng-adjust-state-for-attribute lt-pos attr-start)
(rng-adjust-state-for-attribute-value
attr-start colon attr-end)
(all-completions
arg (rng-match-possible-value-strings))))))))
;;;###autoload
(defun company-nxml (command &optional arg &rest ignored)
"`company-mode' completion backend for `nxml-mode'."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-nxml))
(prefix (or (company-nxml-tag 'prefix)
(company-nxml-attribute 'prefix)
(company-nxml-attribute-value 'prefix)))
(candidates (cond
((company-nxml-tag 'prefix)
(company-nxml-tag 'candidates arg))
((company-nxml-attribute 'prefix)
(company-nxml-attribute 'candidates arg))
((company-nxml-attribute-value 'prefix)
(sort (company-nxml-attribute-value 'candidates arg)
'string<))))
(sorted t)))
(provide 'company-nxml)
;;; company-nxml.el ends here

57
lisp/company/company-oddmuse.el Normal file
View File

@@ -0,0 +1,57 @@
;;; company-oddmuse.el --- company-mode completion backend for oddmuse-mode
;; Copyright (C) 2009-2011, 2014 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'company)
(require 'cl-lib)
(eval-when-compile (require 'yaoddmuse nil t))
(eval-when-compile (require 'oddmuse nil t))
(defvar company-oddmuse-link-regexp
"\\(\\<[A-Z][[:alnum:]]*\\>\\)\\|\\[\\[\\([[:alnum:]]+\\>\\|\\)")
(defun company-oddmuse-get-page-table ()
(cl-case major-mode
(yaoddmuse-mode (with-no-warnings
(yaoddmuse-get-pagename-table yaoddmuse-wikiname)))
(oddmuse-mode (with-no-warnings
(oddmuse-make-completion-table oddmuse-wiki)))))
;;;###autoload
(defun company-oddmuse (command &optional arg &rest ignored)
"`company-mode' completion backend for `oddmuse-mode'."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-oddmuse))
(prefix (let ((case-fold-search nil))
(and (memq major-mode '(oddmuse-mode yaoddmuse-mode))
(looking-back company-oddmuse-link-regexp (point-at-bol))
(or (match-string 1)
(match-string 2)))))
(candidates (all-completions arg (company-oddmuse-get-page-table)))))
(provide 'company-oddmuse)
;;; company-oddmuse.el ends here

12
lisp/company/company-pkg.el Normal file
View File

@@ -0,0 +1,12 @@
(define-package "company" "20200616.2354" "Modular text completion framework"
'((emacs "24.3"))
:commit "1f56bec0ba7ce336eb8661b4d34e4b024d7dd04c" :keywords
'("abbrev" "convenience" "matching")
:authors
'(("Nikolaj Schumacher"))
:maintainer
'("Dmitry Gutov" . "dgutov@yandex.ru")
:url "http://company-mode.github.io/")
;; Local Variables:
;; no-byte-compile: t
;; End:

168
lisp/company/company-semantic.el Normal file
View File

@@ -0,0 +1,168 @@
;;; company-semantic.el --- company-mode completion backend using Semantic
;; Copyright (C) 2009-2011, 2013-2016 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'company)
(require 'company-template)
(require 'cl-lib)
(defvar semantic-idle-summary-function)
(declare-function semantic-documentation-for-tag "semantic/doc" )
(declare-function semantic-analyze-current-context "semantic/analyze")
(declare-function semantic-analyze-possible-completions "semantic/complete")
(declare-function semantic-analyze-find-tags-by-prefix "semantic/analyze/fcn")
(declare-function semantic-tag-class "semantic/tag")
(declare-function semantic-tag-name "semantic/tag")
(declare-function semantic-tag-start "semantic/tag")
(declare-function semantic-tag-buffer "semantic/tag")
(declare-function semantic-active-p "semantic")
(declare-function semantic-format-tag-prototype "semantic/format")
(defgroup company-semantic nil
"Completion backend using Semantic."
:group 'company)
(defcustom company-semantic-metadata-function 'company-semantic-summary-and-doc
"The function turning a semantic tag into doc information."
:type 'function)
(defcustom company-semantic-begin-after-member-access t
"When non-nil, automatic completion will start whenever the current
symbol is preceded by \".\", \"->\" or \"::\", ignoring
`company-minimum-prefix-length'.
If `company-begin-commands' is a list, it should include `c-electric-lt-gt'
and `c-electric-colon', for automatic completion right after \">\" and
\":\"."
:type 'boolean)
(defcustom company-semantic-insert-arguments t
"When non-nil, insert function arguments as a template after completion."
:type 'boolean
:package-version '(company . "0.9.0"))
(defvar company-semantic-modes '(c-mode c++-mode jde-mode java-mode))
(defvar-local company-semantic--current-tags nil
"Tags for the current context.")
(defun company-semantic-documentation-for-tag (tag)
(when (semantic-tag-buffer tag)
;; When TAG's buffer is unknown, the function below raises an error.
(semantic-documentation-for-tag tag)))
(defun company-semantic-doc-or-summary (tag)
(or (company-semantic-documentation-for-tag tag)
(and (require 'semantic-idle nil t)
(require 'semantic/idle nil t)
(funcall semantic-idle-summary-function tag nil t))))
(defun company-semantic-summary-and-doc (tag)
(let ((doc (company-semantic-documentation-for-tag tag))
(summary (funcall semantic-idle-summary-function tag nil t)))
(and (stringp doc)
(string-match "\n*\\(.*\\)$" doc)
(setq doc (match-string 1 doc)))
(concat summary
(when doc
(if (< (+ (length doc) (length summary) 4) (window-width))
" -- "
"\n"))
doc)))
(defun company-semantic-doc-buffer (tag)
(let ((doc (company-semantic-documentation-for-tag tag)))
(when doc
(company-doc-buffer
(concat (funcall semantic-idle-summary-function tag nil t)
"\n"
doc)))))
(defsubst company-semantic-completions (prefix)
(ignore-errors
(let ((completion-ignore-case nil)
(context (semantic-analyze-current-context)))
(setq company-semantic--current-tags
(semantic-analyze-possible-completions context 'no-unique))
(all-completions prefix company-semantic--current-tags))))
(defun company-semantic-completions-raw (prefix)
(setq company-semantic--current-tags nil)
(dolist (tag (semantic-analyze-find-tags-by-prefix prefix))
(unless (eq (semantic-tag-class tag) 'include)
(push tag company-semantic--current-tags)))
(delete "" (mapcar 'semantic-tag-name company-semantic--current-tags)))
(defun company-semantic-annotation (argument tags)
(let* ((tag (assq argument tags))
(kind (when tag (elt tag 1))))
(cl-case kind
(function (let* ((prototype (semantic-format-tag-prototype tag nil nil))
(par-pos (string-match "(" prototype)))
(when par-pos (substring prototype par-pos)))))))
(defun company-semantic--prefix ()
(if company-semantic-begin-after-member-access
(company-grab-symbol-cons "\\.\\|->\\|::" 2)
(company-grab-symbol)))
;;;###autoload
(defun company-semantic (command &optional arg &rest ignored)
"`company-mode' completion backend using CEDET Semantic."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-semantic))
(prefix (and (featurep 'semantic)
(semantic-active-p)
(memq major-mode company-semantic-modes)
(not (company-in-string-or-comment))
(or (company-semantic--prefix) 'stop)))
(candidates (if (and (equal arg "")
(not (looking-back "->\\|\\.\\|::" (- (point) 2))))
(company-semantic-completions-raw arg)
(company-semantic-completions arg)))
(meta (funcall company-semantic-metadata-function
(assoc arg company-semantic--current-tags)))
(annotation (company-semantic-annotation arg
company-semantic--current-tags))
(doc-buffer (company-semantic-doc-buffer
(assoc arg company-semantic--current-tags)))
;; Because "" is an empty context and doesn't return local variables.
(no-cache (equal arg ""))
(duplicates t)
(location (let ((tag (assoc arg company-semantic--current-tags)))
(when (buffer-live-p (semantic-tag-buffer tag))
(cons (semantic-tag-buffer tag)
(semantic-tag-start tag)))))
(post-completion (let ((anno (company-semantic-annotation
arg company-semantic--current-tags)))
(when (and company-semantic-insert-arguments anno)
(insert anno)
(company-template-c-like-templatify (concat arg anno)))
))))
(provide 'company-semantic)
;;; company-semantic.el ends here

272
lisp/company/company-template.el Normal file
View File

@@ -0,0 +1,272 @@
;;; company-template.el --- utility library for template expansion
;; Copyright (C) 2009, 2010, 2014-2017 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; 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 <http://www.gnu.org/licenses/>.
;;; Code:
(require 'cl-lib)
(defface company-template-field
'((((background dark)) (:background "yellow" :foreground "black"))
(((background light)) (:background "orange" :foreground "black")))
"Face used for editable text in template fields."
:group 'company-faces)
(defvar company-template-forward-field-item
'(menu-item "" company-template-forward-field
:filter company-template--keymap-filter))
(defvar company-template-nav-map
(let ((keymap (make-sparse-keymap)))
(define-key keymap [tab] company-template-forward-field-item)
(define-key keymap (kbd "TAB") company-template-forward-field-item)
keymap))
(defvar company-template-clear-field-item
'(menu-item "" company-template-clear-field
:filter company-template--keymap-filter))
(defvar company-template-field-map
(let ((keymap (make-sparse-keymap)))
(set-keymap-parent keymap company-template-nav-map)
(define-key keymap (kbd "C-d") company-template-clear-field-item)
keymap))
(defvar-local company-template--buffer-templates nil)
;; interactive ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun company-template-templates-at (pos)
(let (os)
(dolist (o (overlays-at pos))
;; FIXME: Always return the whole list of templates?
;; We remove templates not at point after every command.
(when (memq o company-template--buffer-templates)
(push o os)))
os))
(defun company-template-move-to-first (templ)
(interactive)
(goto-char (overlay-start templ))
(company-template-forward-field))
(defun company-template-forward-field ()
(interactive)
(let ((start (point))
(next-field-start (company-template-find-next-field)))
(push-mark)
(goto-char next-field-start)
(company-template-remove-field (company-template-field-at start))))
(defun company-template-clear-field ()
"Clear the field at point."
(interactive)
(let ((ovl (company-template-field-at (point))))
(when ovl
(company-template-remove-field ovl t)
(let ((after-clear-fn
(overlay-get ovl 'company-template-after-clear)))
(when (functionp after-clear-fn)
(funcall after-clear-fn))))))
(defun company-template--keymap-filter (cmd)
(unless (run-hook-with-args-until-success 'yas-keymap-disable-hook)
cmd))
(defun company-template--after-clear-c-like-field ()
"Function that can be called after deleting a field of a c-like template.
For c-like templates it is set as `after-post-fn' property on fields in
`company-template-add-field'. If there is a next field, delete everything
from point to it. If there is no field after point, remove preceding comma
if present."
(let* ((pos (point))
(next-field-start (company-template-find-next-field))
(last-field-p (not (company-template-field-at next-field-start))))
(cond ((and (not last-field-p)
(< pos next-field-start)
(string-match "^[ ]*,+[ ]*$" (buffer-substring-no-properties
pos next-field-start)))
(delete-region pos next-field-start))
((and last-field-p
(looking-back ",+[ ]*" (line-beginning-position)))
(delete-region (match-beginning 0) pos)))))
(defun company-template-find-next-field ()
(let* ((start (point))
(templates (company-template-templates-at start))
(minimum (apply 'max (mapcar 'overlay-end templates)))
(fields (cl-loop for templ in templates
append (overlay-get templ 'company-template-fields))))
(dolist (pos (mapcar 'overlay-start fields) minimum)
(and pos
(> pos start)
(< pos minimum)
(setq minimum pos)))))
(defun company-template-field-at (&optional point)
(cl-loop for ovl in (overlays-at (or point (point)))
when (overlay-get ovl 'company-template-parent)
return ovl))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun company-template-declare-template (beg end)
(let ((ov (make-overlay beg end)))
;; (overlay-put ov 'face 'highlight)
(overlay-put ov 'keymap company-template-nav-map)
(overlay-put ov 'priority 101)
(overlay-put ov 'evaporate t)
(push ov company-template--buffer-templates)
(add-hook 'post-command-hook 'company-template-post-command nil t)
ov))
(defun company-template-remove-template (templ)
(mapc 'company-template-remove-field
(overlay-get templ 'company-template-fields))
(setq company-template--buffer-templates
(delq templ company-template--buffer-templates))
(delete-overlay templ))
(defun company-template-add-field (templ beg end &optional display after-clear-fn)
"Add new field to template TEMPL spanning from BEG to END.
When DISPLAY is non-nil, set the respective property on the overlay.
Leave point at the end of the field.
AFTER-CLEAR-FN is a function that can be used to apply custom behavior
after deleting a field in `company-template-remove-field'."
(cl-assert templ)
(when (> end (overlay-end templ))
(move-overlay templ (overlay-start templ) end))
(let ((ov (make-overlay beg end))
(siblings (overlay-get templ 'company-template-fields)))
;; (overlay-put ov 'evaporate t)
(overlay-put ov 'intangible t)
(overlay-put ov 'face 'company-template-field)
(when display
(overlay-put ov 'display display))
(overlay-put ov 'company-template-parent templ)
(overlay-put ov 'insert-in-front-hooks '(company-template-insert-hook))
(when after-clear-fn
(overlay-put ov 'company-template-after-clear after-clear-fn))
(overlay-put ov 'keymap company-template-field-map)
(overlay-put ov 'priority 101)
(push ov siblings)
(overlay-put templ 'company-template-fields siblings)))
(defun company-template-remove-field (ovl &optional clear)
(when (overlayp ovl)
(when (overlay-buffer ovl)
(when clear
(delete-region (overlay-start ovl) (overlay-end ovl)))
(delete-overlay ovl))
(let* ((templ (overlay-get ovl 'company-template-parent))
(siblings (overlay-get templ 'company-template-fields)))
(setq siblings (delq ovl siblings))
(overlay-put templ 'company-template-fields siblings))))
(defun company-template-clean-up (&optional pos)
"Clean up all templates that don't contain POS."
(let ((local-ovs (overlays-at (or pos (point)))))
(dolist (templ company-template--buffer-templates)
(unless (memq templ local-ovs)
(company-template-remove-template templ)))))
;; hooks ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun company-template-insert-hook (ovl after-p &rest _ignore)
"Called when a snippet input prompt is modified."
(unless after-p
(company-template-remove-field ovl t)))
(defun company-template-post-command ()
(company-template-clean-up)
(unless company-template--buffer-templates
(remove-hook 'post-command-hook 'company-template-post-command t)))
;; common ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun company-template-c-like-templatify (call)
(let* ((end (point-marker))
(beg (- (point) (length call)))
(templ (company-template-declare-template beg end))
paren-open paren-close)
(with-syntax-table (make-syntax-table (syntax-table))
(modify-syntax-entry ?< "(")
(modify-syntax-entry ?> ")")
(when (search-backward ")" beg t)
(setq paren-close (point-marker))
(forward-char 1)
(delete-region (point) end)
(backward-sexp)
(forward-char 1)
(setq paren-open (point-marker)))
(when (search-backward ">" beg t)
(let ((angle-close (point-marker)))
(forward-char 1)
(backward-sexp)
(forward-char)
(company-template--c-like-args templ angle-close)))
(when (looking-back "\\((\\*)\\)(" (line-beginning-position))
(delete-region (match-beginning 1) (match-end 1)))
(when paren-open
(goto-char paren-open)
(company-template--c-like-args templ paren-close)))
(if (overlay-get templ 'company-template-fields)
(company-template-move-to-first templ)
(company-template-remove-template templ)
(goto-char end))))
(defun company-template--c-like-args (templ end)
(let ((last-pos (point)))
(while (re-search-forward "\\([^,]+\\),?" end 'move)
(when (zerop (car (parse-partial-sexp last-pos (point))))
(company-template-add-field templ last-pos (match-end 1) nil
#'company-template--after-clear-c-like-field)
(skip-chars-forward " ")
(setq last-pos (point))))))
;; objc ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun company-template-objc-templatify (selector)
(let* ((end (point-marker))
(beg (- (point) (length selector) 1))
(templ (company-template-declare-template beg end))
(cnt 0))
(save-excursion
(goto-char beg)
(catch 'stop
(while (search-forward ":" end t)
(if (looking-at "\\(([^)]*)\\) ?")
(company-template-add-field templ (point) (match-end 1))
;; Not sure which conditions this case manifests under, but
;; apparently it did before, when I wrote the first test for this
;; function. FIXME: Revisit it.
(company-template-add-field templ (point)
(progn
(insert (format "arg%d" cnt))
(point)))
(when (< (point) end)
(insert " "))
(cl-incf cnt))
(when (>= (point) end)
(throw 'stop t)))))
(company-template-move-to-first templ)))
(provide 'company-template)
;;; company-template.el ends here

71
lisp/company/company-tempo.el Normal file
View File

@@ -0,0 +1,71 @@
;;; company-tempo.el --- company-mode completion backend for tempo
;; Copyright (C) 2009-2011, 2015 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'company)
(require 'cl-lib)
(require 'tempo)
(defgroup company-tempo nil
"Tempo completion backend."
:group 'company)
(defcustom company-tempo-expand nil
"Whether to expand a tempo tag after completion."
:type '(choice (const :tag "Off" nil)
(const :tag "On" t)))
(defsubst company-tempo-lookup (match)
(cdr (assoc match (tempo-build-collection))))
(defun company-tempo-insert (match)
"Replace MATCH with the expanded tempo template."
(search-backward match)
(goto-char (match-beginning 0))
(replace-match "")
(call-interactively (company-tempo-lookup match)))
(defsubst company-tempo-meta (match)
(let ((templ (company-tempo-lookup match))
doc)
(and templ
(setq doc (documentation templ t))
(car (split-string doc "\n" t)))))
;;;###autoload
(defun company-tempo (command &optional arg &rest ignored)
"`company-mode' completion backend for tempo."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-tempo))
(prefix (or (car (tempo-find-match-string tempo-match-finder)) ""))
(candidates (all-completions arg (tempo-build-collection)))
(meta (company-tempo-meta arg))
(post-completion (when company-tempo-expand (company-tempo-insert arg)))
(sorted t)))
(provide 'company-tempo)
;;; company-tempo.el ends here

197
lisp/company/company-tng.el Normal file
View File

@@ -0,0 +1,197 @@
;;; company-tng.el --- company-mode configuration for single-button interaction
;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
;; Author: Nikita Leshenko
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; company-tng (Tab and Go) allows you to perform completion using just TAB.
;; Pressing it will both select the next completion candidate in the list and
;; insert it into the buffer (or make it look like it's inserted, in fact).
;;
;; It cycles the candidates like `yank-pop' or `dabbrev-expand' or Vim:
;; Pressing TAB selects the first item in the completion menu and inserts it in
;; the buffer. Pressing TAB again selects the second item and replaces the
;; "inserted" item with the second one. This can continue as long as the user
;; wishes to cycle through the menu. You can also press S-TAB to select the
;; previous candidate, of course.
;;
;; The benefits are that you only have to use one shortcut key and there is no
;; need to confirm the entry.
;;
;; Usage:
;;
;; To apply the default configuration for company-tng call
;; `company-tng-configure-default' from your init script.
;;
;; You can also configure company-tng manually:
;;
;; Add `company-tng-frontend' to `company-frontends':
;;
;; (add-to-list 'company-frontends 'company-tng-frontend)
;;
;; We recommend to bind TAB to `company-select-next', S-TAB to
;; `company-select-previous', and unbind RET and other now-unnecessary
;; keys from `company-active-map':
;;
;; (define-key company-active-map (kbd "TAB") 'company-select-next)
;; (define-key company-active-map (kbd "<backtab>") 'company-select-previous)
;; (define-key company-active-map (kbd "RET") nil)
;;
;; Note that it's not necessary to rebind keys to use this frontend,
;; you can use the arrow keys or M-n/M-p to select and insert
;; candidates. You also need to decide which keys to unbind, depending
;; on whether you want them to do the Company action or the default
;; Emacs action (for example C-s or C-w).
;;
;; We recommend to disable `company-require-match' to allow free typing at any
;; point.
;;
;; By default, company-tng doesn't work well with backends that insert function
;; arguments into the buffer and (optionally) expand them into a snippet
;; (usually performed in `post-completion' using yasnippet or company-template).
;; In company-tng, completion candidates
;; are inserted into the buffer as the user selects them and the completion is
;; finished implicitly when the user continues typing after selecting a
;; candidate. Modifying the buffer (by expanding a snippet) when the user
;; continues typing would be surprising and undesirable, since the candidate was
;; already inserted into the buffer.
;;
;; For this reason `company-tng-configure-default' disables arguments insertion
;; for a number of popular backends. If the backend you are using is not among
;; them, you might have to configure it not to do that yourself.
;;
;; YASnippet and company-tng both use TAB, which causes conflicts. The
;; recommended way to use YASnippet with company-tng is to choose a different
;; key for expanding a snippet and moving to the next snippet field:
;;
;; (define-key yas-minor-mode-map "\C-j" 'yas-expand)
;; (define-key yas-keymap "\C-j" 'yas-next-field-or-maybe-expand)
;; (dolist (keymap (list yas-minor-mode-map yas-keymap))
;; (define-key keymap (kbd "TAB") nil)
;; (define-key keymap [(tab)] nil))
;;; Code:
(require 'company)
(require 'cl-lib)
(defvar-local company-tng--overlay nil)
;;;###autoload
(defun company-tng-frontend (command)
"When the user changes the selection at least once, this
frontend will display the candidate in the buffer as if it's
already there and any key outside of `company-active-map' will
confirm the selection and finish the completion."
(cl-case command
(show
(let ((ov (make-overlay (point) (point))))
(setq company-tng--overlay ov)
(overlay-put ov 'priority 2))
(advice-add 'company-select-next :before-until 'company-tng--allow-unselected)
(advice-add 'company-fill-propertize :filter-args 'company-tng--adjust-tooltip-highlight))
(update
(let ((ov company-tng--overlay)
(selected (nth company-selection company-candidates))
(prefix (length company-prefix)))
(move-overlay ov (- (point) prefix) (point))
(overlay-put ov
(if (= prefix 0) 'after-string 'display)
(and company-selection-changed selected))))
(hide
(when company-tng--overlay
(delete-overlay company-tng--overlay)
(kill-local-variable 'company-tng--overlay))
(advice-remove 'company-select-next 'company-tng--allow-unselected)
(advice-remove 'company-fill-propertize 'company-tng--adjust-tooltip-highlight))
(pre-command
(when (and company-selection-changed
(not (company--company-command-p (this-command-keys))))
(company--unread-this-command-keys)
(setq this-command 'company-complete-selection)))))
(defvar company-clang-insert-arguments)
(defvar company-semantic-insert-arguments)
(defvar company-rtags-insert-arguments)
(defvar lsp-enable-snippet)
;;;###autoload
(defun company-tng-configure-default ()
"Applies the default configuration to enable company-tng."
(setq company-require-match nil)
(setq company-frontends '(company-tng-frontend
company-pseudo-tooltip-frontend
company-echo-metadata-frontend))
(setq company-clang-insert-arguments nil
company-semantic-insert-arguments nil
company-rtags-insert-arguments nil
lsp-enable-snippet nil)
(advice-add #'eglot--snippet-expansion-fn :override #'ignore)
(let ((keymap company-active-map))
(define-key keymap [return] nil)
(define-key keymap (kbd "RET") nil)
(define-key keymap [tab] 'company-select-next)
(define-key keymap (kbd "TAB") 'company-select-next)
(define-key keymap [backtab] 'company-select-previous)
(define-key keymap (kbd "S-TAB") 'company-select-previous)))
(defun company-tng--allow-unselected (&optional arg)
"Advice `company-select-next' to allow for an 'unselected'
state. Unselected means that no user interaction took place on the
completion candidates and it's marked by setting
`company-selection-changed' to nil. This advice will call the underlying
`company-select-next' unless we need to transition to or from an unselected
state.
Possible state transitions:
- (arg > 0) unselected -> first candidate selected
- (arg < 0) first candidate selected -> unselected
- (arg < 0 wrap-round) unselected -> last candidate selected
- (arg < 0 no wrap-round) unselected -> unselected
There is no need to advice `company-select-previous' because it calls
`company-select-next' internally."
(cond
;; Selecting next
((or (not arg) (> arg 0))
(unless company-selection-changed
(company-set-selection (1- (or arg 1)) 'force-update)
t))
;; Selecting previous
((< arg 0)
(when (and company-selection-changed
(< (+ company-selection arg) 0))
(company-set-selection 0)
(setq company-selection-changed nil)
(company-call-frontends 'update)
t)
)))
(defun company-tng--adjust-tooltip-highlight (args)
"Prevent the tooltip from highlighting the current selection if it wasn't
made explicitly (i.e. `company-selection-changed' is true)"
(unless company-selection-changed
;; The 4th arg of `company-fill-propertize' is selected
(setf (nth 3 args) nil))
args)
(provide 'company-tng)
;;; company-tng.el ends here

123
lisp/company/company-xcode.el Normal file
View File

@@ -0,0 +1,123 @@
;;; company-xcode.el --- company-mode completion backend for Xcode projects
;; Copyright (C) 2009-2011, 2014 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'company)
(require 'cl-lib)
(defgroup company-xcode nil
"Completion backend for Xcode projects."
:group 'company)
(defcustom company-xcode-xcodeindex-executable (executable-find "xcodeindex")
"Location of xcodeindex executable."
:type 'file)
(defvar company-xcode-tags nil)
(defun company-xcode-reset ()
"Reset the cached tags."
(interactive)
(setq company-xcode-tags nil))
(defcustom company-xcode-types
'("Class" "Constant" "Enum" "Macro" "Modeled Class" "Structure"
"Type" "Union" "Function")
"The types of symbols offered by `company-xcode'.
No context-enabled completion is available. Types like methods will be
offered regardless of whether the class supports them. The defaults should be
valid in most contexts."
:set (lambda (variable value)
(set variable value)
(company-xcode-reset))
:type '(set (const "Category") (const "Class") (const "Class Method")
(const "Class Variable") (const "Constant") (const "Enum")
(const "Field") (const "Instance Method")
(const "Instance Variable") (const "Macro")
(const "Modeled Class") (const "Modeled Method")
(const "Modeled Property") (const "Property") (const "Protocol")
(const "Structure") (const "Type") (const "Union")
(const "Variable") (const "Function")))
(defvar-local company-xcode-project 'unknown)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun company-xcode-fetch (project-bundle)
(setq project-bundle (directory-file-name project-bundle))
(message "Retrieving dump from %s..." project-bundle)
(with-temp-buffer
(let ((default-directory (file-name-directory project-bundle)))
(call-process company-xcode-xcodeindex-executable nil (current-buffer)
nil "dump" "-project"
(file-name-nondirectory project-bundle) "-quiet")
(goto-char (point-min))
(let ((regexp (concat "^\\([^\t\n]*\\)\t[^\t\n]*\t"
(regexp-opt company-xcode-types)
"\t[^\t\n]*\t[^\t\n]*"))
candidates)
(while (re-search-forward regexp nil t)
(cl-pushnew (match-string 1) candidates :test #'equal))
(message "Retrieving dump from %s...done" project-bundle)
candidates))))
(defun company-xcode-find-project ()
(let ((dir (if buffer-file-name
(file-name-directory buffer-file-name)
(expand-file-name default-directory)))
(prev-dir nil)
file)
(while (not (or file (equal dir prev-dir)))
(setq file (car (directory-files dir t ".xcodeproj\\'" t))
prev-dir dir
dir (file-name-directory (directory-file-name dir))))
file))
(defun company-xcode-tags ()
(when (eq company-xcode-project 'unknown)
(setq company-xcode-project (company-xcode-find-project)))
(when company-xcode-project
(cdr (or (assoc company-xcode-project company-xcode-tags)
(car (push (cons company-xcode-project
(company-xcode-fetch company-xcode-project))
company-xcode-tags))))))
;;;###autoload
(defun company-xcode (command &optional arg &rest ignored)
"`company-mode' completion backend for Xcode projects."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-xcode))
(prefix (and company-xcode-xcodeindex-executable
(company-xcode-tags)
(not (company-in-string-or-comment))
(or (company-grab-symbol) 'stop)))
(candidates (let ((completion-ignore-case nil))
(company-xcode-tags)
(all-completions arg (company-xcode-tags))))))
(provide 'company-xcode)
;;; company-xcode.el ends here

176
lisp/company/company-yasnippet.el Normal file
View File

@@ -0,0 +1,176 @@
;;; company-yasnippet.el --- company-mode completion backend for Yasnippet
;; Copyright (C) 2014, 2015, 2020 Free Software Foundation, Inc.
;; Author: Dmitry Gutov
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(require 'company)
(require 'cl-lib)
(declare-function yas--table-hash "yasnippet")
(declare-function yas--get-snippet-tables "yasnippet")
(declare-function yas-expand-snippet "yasnippet")
(declare-function yas--template-content "yasnippet")
(declare-function yas--template-expand-env "yasnippet")
(declare-function yas--warning "yasnippet")
(defvar company-yasnippet-annotation-fn
(lambda (name)
(concat
(unless company-tooltip-align-annotations " -> ")
name))
"Function to format completion annotation.
It has to accept one argument: the snippet's name.")
(defun company-yasnippet--key-prefixes ()
;; Mostly copied from `yas--templates-for-key-at-point'.
(defvar yas-key-syntaxes)
(save-excursion
(let ((original (point))
(methods yas-key-syntaxes)
prefixes
method)
(while methods
(unless (eq method (car methods))
(goto-char original))
(setq method (car methods))
(cond ((stringp method)
(skip-syntax-backward method)
(setq methods (cdr methods)))
((functionp method)
(unless (eq (funcall method original)
'again)
(setq methods (cdr methods))))
(t
(setq methods (cdr methods))
(yas--warning "Invalid element `%s' in `yas-key-syntaxes'" method)))
(let ((prefix (buffer-substring-no-properties (point) original)))
(unless (equal prefix (car prefixes))
(push prefix prefixes))))
prefixes)))
(defun company-yasnippet--candidates (prefix)
;; Process the prefixes in reverse: unlike Yasnippet, we look for prefix
;; matches, so the longest prefix with any matches should be the most useful.
(cl-loop with tables = (yas--get-snippet-tables)
for key-prefix in (company-yasnippet--key-prefixes)
;; Only consider keys at least as long as the symbol at point.
when (>= (length key-prefix) (length prefix))
thereis (company-yasnippet--completions-for-prefix prefix
key-prefix
tables)))
(defun company-yasnippet--completions-for-prefix (prefix key-prefix tables)
(cl-mapcan
(lambda (table)
(let ((keyhash (yas--table-hash table))
res)
(when keyhash
(maphash
(lambda (key value)
(when (and (stringp key)
(string-prefix-p key-prefix key))
(maphash
(lambda (name template)
(push
(propertize key
'yas-annotation name
'yas-template template
'yas-prefix-offset (- (length key-prefix)
(length prefix)))
res))
value)))
keyhash))
res))
tables))
(defun company-yasnippet--doc (arg)
(let ((template (get-text-property 0 'yas-template arg))
(mode major-mode)
(file-name (buffer-file-name)))
(with-current-buffer (company-doc-buffer)
(let ((buffer-file-name file-name))
(yas-minor-mode 1)
(condition-case error
(yas-expand-snippet (yas--template-content template))
(error
(message "%s" (error-message-string error))))
(delay-mode-hooks
(let ((inhibit-message t))
(if (eq mode 'web-mode)
(progn
(setq mode 'html-mode)
(funcall mode))
(funcall mode)))
(ignore-errors (font-lock-ensure))))
(current-buffer))))
;;;###autoload
(defun company-yasnippet (command &optional arg &rest ignore)
"`company-mode' backend for `yasnippet'.
This backend should be used with care, because as long as there are
snippets defined for the current major mode, this backend will always
shadow backends that come after it. Recommended usages:
* In a buffer-local value of `company-backends', grouped with a backend or
several that provide actual text completions.
(add-hook 'js-mode-hook
(lambda ()
(set (make-local-variable 'company-backends)
'((company-dabbrev-code company-yasnippet)))))
* After keyword `:with', grouped with other backends.
(push '(company-semantic :with company-yasnippet) company-backends)
* Not in `company-backends', just bound to a key.
(global-set-key (kbd \"C-c y\") 'company-yasnippet)
"
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-yasnippet))
(prefix
;; Should probably use `yas--current-key', but that's bound to be slower.
;; How many trigger keys start with non-symbol characters anyway?
(and (bound-and-true-p yas-minor-mode)
(company-grab-symbol)))
(annotation
(funcall company-yasnippet-annotation-fn
(get-text-property 0 'yas-annotation arg)))
(candidates (company-yasnippet--candidates arg))
(doc-buffer (company-yasnippet--doc arg))
(no-cache t)
(post-completion
(let ((template (get-text-property 0 'yas-template arg))
(prefix-offset (get-text-property 0 'yas-prefix-offset arg)))
(yas-expand-snippet (yas--template-content template)
(- (point) (length arg) prefix-offset)
(point)
(yas--template-expand-env template))))))
(provide 'company-yasnippet)
;;; company-yasnippet.el ends here

3247
lisp/company/company.el Normal file
View File

File diff suppressed because it is too large Load Diff

9
lisp/dash/dash-pkg.el Normal file
View File

@@ -0,0 +1,9 @@
(define-package "dash" "20200524.1947" "A modern list library for Emacs" 'nil :commit "732d92eac56023a4fb4a5dc3d9d4e274ebf44bf9" :keywords
'("lists")
:authors
'(("Magnar Sveen" . "magnars@gmail.com"))
:maintainer
'("Magnar Sveen" . "magnars@gmail.com"))
;; Local Variables:
;; no-byte-compile: t
;; End:

3072
lisp/dash/dash.el Normal file
View File

File diff suppressed because it is too large Load Diff

3410
lisp/dash/dash.info Normal file
View File

File diff suppressed because it is too large Load Diff

18
lisp/dash/dir Normal file
View File

@@ -0,0 +1,18 @@
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

8
lisp/dashboard/banners/1.txt Normal file
View File

@@ -0,0 +1,8 @@
######## ## ## ### ###### ######
## ### ### ## ## ## ## ## ##
## #### #### ## ## ## ##
###### ## ### ## ## ## ## ######
## ## ## ######### ## ##
## ## ## ## ## ## ## ## ##
######## ## ## ## ## ###### ######

6
lisp/dashboard/banners/2.txt Normal file
View File

@@ -0,0 +1,6 @@
_______ .___ ___. ___ ______ _______.
| ____|| \/ | / \ / | / |
| |__ | \ / | / ^ \ | ,----' | (----`
| __| | |\/| | / /_\ \ | | \ \
| |____ | | | | / _____ \ | `----.----) |
|_______||__| |__| /__/ \__\ \______|_______/

8
lisp/dashboard/banners/3.txt Normal file
View File

@@ -0,0 +1,8 @@
_______ _____ ______ ________ ________ ________
|\ ___ \ |\ _ \ _ \|\ __ \|\ ____\|\ ____\
\ \ __/|\ \ \\\__\ \ \ \ \|\ \ \ \___|\ \ \___|_
\ \ \_|/_\ \ \\|__| \ \ \ __ \ \ \ \ \_____ \
\ \ \_|\ \ \ \ \ \ \ \ \ \ \ \ \____\|____|\ \
\ \_______\ \__\ \ \__\ \__\ \__\ \_______\____\_\ \
\|_______|\|__| \|__|\|__|\|__|\|_______|\_________\
\|_________|

BIN
lisp/dashboard/banners/emacs.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 43 KiB

BIN
lisp/dashboard/banners/logo.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 32 KiB

13
lisp/dashboard/dashboard-pkg.el Normal file
View File

@@ -0,0 +1,13 @@
(define-package "dashboard" "20200306.1344" "A startup screen extracted from Spacemacs"
'((emacs "25.3")
(page-break-lines "0.11"))
:commit "bf38867ae80902d58207974b4a2bba4249324599" :keywords
'("startup" "screen" "tools" "dashboard")
:authors
'(("Rakan Al-Hneiti"))
:maintainer
'("Rakan Al-Hneiti")
:url "https://github.com/emacs-dashboard/emacs-dashboard")
;; Local Variables:
;; no-byte-compile: t
;; End:

729
lisp/dashboard/dashboard-widgets.el Normal file
View File

@@ -0,0 +1,729 @@
;;; dashboard-widgets.el --- A startup screen extracted from Spacemacs -*- lexical-binding: t -*-
;; Copyright (c) 2016-2020 Rakan Al-Hneiti & Contributors
;;
;; Author: Rakan Al-Hneiti
;; 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.8.0-SNAPSHOT
;; Keywords: startup, screen, tools, dashboard
;; Package-Requires: ((emacs "25.3") (page-break-lines "0.11"))
;;; Commentary:
;; An extensible Emacs dashboard, with sections for
;; bookmarks, projectile projects, org-agenda and more.
;;; Code:
(require 'cl-lib)
;; Compiler pacifier
(declare-function all-the-icons-icon-for-dir "ext:all-the-icons.el")
(declare-function all-the-icons-icon-for-file "ext:all-the-icons.el")
(declare-function bookmark-get-filename "ext:bookmark.el")
(declare-function bookmark-all-names "ext:bookmark.el")
(declare-function calendar-date-compare "ext:calendar.el")
(declare-function projectile-cleanup-known-projects "ext:projectile.el")
(declare-function projectile-load-known-projects "ext:projectile.el")
(declare-function projectile-mode "ext:projectile.el")
(declare-function projectile-relevant-known-projects "ext:projectile.el")
(declare-function org-agenda-format-item "ext:org-agenda.el")
(declare-function org-compile-prefix-format "ext:org-agenda.el")
(declare-function org-entry-is-done-p "ext:org.el")
(declare-function org-get-category "ext:org.el")
(declare-function org-get-deadline-time "ext:org.el")
(declare-function org-get-heading "ext:org.el")
(declare-function org-get-scheduled-time "ext:org.el")
(declare-function org-get-tags "ext:org.el")
(declare-function org-map-entries "ext:org.el")
(declare-function org-outline-level "ext:org.el")
(defvar all-the-icons-dir-icon-alist)
(defvar package-activated-list)
(defcustom dashboard-page-separator "\n\f\n"
"Separator to use between the different pages."
:type 'string
:group 'dashboard)
(defcustom dashboard-image-banner-max-height 0
"Maximum height of banner image.
This setting applies only if Emacs is compiled with Imagemagick
support. When value is non-zero the image banner will be resized
to the specified height, with aspect ratio preserved."
:type 'integer
:group 'dashboard)
(defcustom dashboard-image-banner-max-width 0
"Maximum width of banner image.
This setting applies if Emacs is compiled with Imagemagick
support. When value is non-zero the image banner will be resized
to the specified width, with aspect ratio preserved."
:type 'integer
:group 'dashboard)
(defcustom dashboard-set-heading-icons nil
"When non nil, heading sections will have icons."
:type 'boolean
:group 'dashboard)
(defcustom dashboard-set-file-icons nil
"When non nil, file lists will have icons."
:type 'boolean
:group 'dashboard)
(defcustom dashboard-set-navigator nil
"When non nil, a navigator will be displayed under the banner."
:type 'boolean
:group 'dashboard)
(defcustom dashboard-set-init-info t
"When non nil, init info will be displayed under the banner."
:type 'boolean
:group 'dashboard)
(defcustom dashboard-set-footer t
"When non nil, a footer will be displayed at the bottom."
:type 'boolean
:group 'dashboard)
(defcustom dashboard-footer-messages
'("The one true editor, Emacs!"
"Who the hell uses VIM anyway? Go Evil!"
"Free as free speech, free as free Beer"
"Richard Stallman is proud of you"
"Happy coding!"
"Vi Vi Vi, the editor of the beast"
"Welcome to the church of Emacs"
"While any text editor can save your files,\
only Emacs can save your soul"
"I showed you my source code, pls respond")
"A list of messages, one of which dashboard chooses to display."
:type 'list
:group 'dashboard)
(defcustom dashboard-show-shortcuts t
"Whether to show shortcut keys for each section."
:type 'boolean
:group 'dashboard)
(defcustom dashboard-org-agenda-categories nil
"Specify the Categories to consider when using agenda in dashboard.
Example:
'(\"Tasks\" \"Habits\")"
:type 'list
:group 'dashboard)
(defconst dashboard-banners-directory
(concat (file-name-directory
(locate-library "dashboard"))
"/banners/"))
(defconst dashboard-banner-official-png
(expand-file-name (concat dashboard-banners-directory "emacs.png"))
"Emacs banner image.")
(defconst dashboard-banner-logo-png
(expand-file-name (concat dashboard-banners-directory "logo.png"))
"Emacs banner image.")
(defconst dashboard-banner-length 75
"Width of a banner.")
(defcustom dashboard-banner-logo-title "Welcome to Emacs!"
"Specify the startup banner."
:type 'string
:group 'dashboard)
(defcustom dashboard-navigator-buttons nil
"Specify the navigator buttons.
The format is: 'icon title help action face prefix suffix'.
Example:
'((\"☆\" \"Star\" \"Show stars\" (lambda (&rest _) (show-stars)) 'warning \"[\" \"]\"))"
:type '(repeat (repeat (list string string string function symbol string string)))
:group 'dashboard)
(defcustom dashboard-init-info
;; Check if package.el was loaded and if package loading was enabled
(if (bound-and-true-p package-alist)
(format "%d packages loaded in %s"
(length package-activated-list) (emacs-init-time))
(if (and (boundp 'straight--profile-cache) (hash-table-p straight--profile-cache))
(format "%d packages loaded in %s"
(hash-table-size straight--profile-cache) (emacs-init-time))
(format "Emacs started in %s" (emacs-init-time))))
"Init info with packages loaded and init time."
:type 'boolean
:group 'dashboard)
(defcustom dashboard-footer
(let ((list '("The one true editor, Emacs!"
"Who the hell uses VIM anyway? Go Evil!"
"Free as free speech, free as free Beer"
"Richard Stallman is proud of you"
"Happy coding!"
"Vi Vi Vi, the editor of the beast"
"Welcome to the church of Emacs"
"While any text editor can save your files,\
only Emacs can save your soul"
"I showed you my source code, pls respond"
)))
(nth (random (1- (1+ (length list)))) list))
"A footer with some short message."
:type 'string
:group 'dashboard)
(defcustom dashboard-footer-icon
(if (and (display-graphic-p)
(or (fboundp 'all-the-icons-fileicon)
(require 'all-the-icons nil 'noerror)))
(all-the-icons-fileicon "emacs"
:height 1.1
:v-adjust -0.05
:face 'font-lock-keyword-face)
(propertize ">" 'face 'dashboard-footer))
"Footer's icon."
:type 'string
:group 'dashboard)
(defcustom dashboard-startup-banner 'official
"Specify the startup banner.
Default value is `official', it displays
the Emacs logo. `logo' displays Emacs alternative logo.
An integer value is the index of text
banner. A string value must be a path to a .PNG file.
If the value is nil then no banner is displayed."
:type '(choice (const :tag "offical" official)
(const :tag "logo" logo)
(string :tag "a png path"))
:group 'dashboard)
(defcustom dashboard-buffer-last-width nil
"Previous width of dashboard-buffer."
:type 'integer
:group 'dashboard)
(defcustom dashboard-item-generators '((recents . dashboard-insert-recents)
(bookmarks . dashboard-insert-bookmarks)
(projects . dashboard-insert-projects)
(agenda . dashboard-insert-agenda)
(registers . dashboard-insert-registers))
"Association list of items to how to generate in the startup buffer.
Will be of the form `(list-type . list-function)'.
Possible values for list-type are: `recents', `bookmarks', `projects',
`agenda' ,`registers'."
:type '(repeat (alist :key-type symbol :value-type function))
:group 'dashboard)
(defcustom dashboard-items '((recents . 5)
(bookmarks . 5)
(agenda . 5))
"Association list of items to show in the startup buffer.
Will be of the form `(list-type . list-size)'.
If nil it is disabled. Possible values for list-type are:
`recents' `bookmarks' `projects' `agenda' `registers'."
:type '(repeat (alist :key-type symbol :value-type integer))
:group 'dashboard)
(defcustom dashboard-items-default-length 20
"Length used for startup lists with otherwise unspecified bounds.
Set to nil for unbounded."
:type 'integer
:group 'dashboard)
(defcustom dashboard-heading-icons '((recents . "history")
(bookmarks . "bookmark")
(agenda . "calendar")
(projects . "rocket")
(registers . "database"))
"Association list for the icons of the heading sections.
Will be of the form `(list-type . icon-name-string)`.
If nil it is disabled. Possible values for list-type are:
`recents' `bookmarks' `projects' `agenda' `registers'"
:type '(repeat (alist :key-type symbol :value-type string))
:group 'dashboard)
(defvar recentf-list nil)
;;
;; Faces
;;
(defface dashboard-text-banner
'((t (:inherit font-lock-keyword-face)))
"Face used for text banners."
:group 'dashboard)
(defface dashboard-banner-logo-title
'((t :inherit default))
"Face used for the banner title."
:group 'dashboard)
(defface dashboard-navigator
'((t (:inherit font-lock-keyword-face)))
"Face used for the navigator."
:group 'dashboard)
(defface dashboard-heading
'((t (:inherit font-lock-keyword-face)))
"Face used for widget headings."
:group 'dashboard)
(defface dashboard-footer
'((t (:inherit font-lock-doc-face)))
"Face used for widget headings."
:group 'dashboard)
(define-obsolete-face-alias
'dashboard-text-banner-face 'dashboard-text-banner "1.2.6")
(define-obsolete-face-alias
'dashboard-banner-logo-title-face 'dashboard-banner-logo-title "1.2.6")
(define-obsolete-face-alias
'dashboard-heading-face 'dashboard-heading "1.2.6")
;;
;; Generic widget helpers
;;
(defun dashboard-subseq (seq start end)
"Return the subsequence of SEQ from START to END..
Uses `cl-subseq`, but accounts for end points greater than the size of the
list.
Return entire list if `END' is omitted."
(let ((len (length seq)))
(cl-subseq seq start (and (number-or-marker-p end)
(min len end)))))
(defmacro dashboard-insert-shortcut (shortcut-char
search-label
&optional no-next-line)
"Insert a shortcut SHORTCUT-CHAR for a given SEARCH-LABEL.
Optionally, provide NO-NEXT-LINE to move the cursor forward a line."
`(progn
(eval-when-compile (defvar dashboard-mode-map))
(let ((sym (make-symbol (format "Jump to \"%s\"" ,search-label))))
(fset sym (lambda ()
(interactive)
(unless (search-forward ,search-label (point-max) t)
(search-backward ,search-label (point-min) t))
,@(unless no-next-line
'((forward-line 1)))
(back-to-indentation)))
(eval-after-load 'dashboard
(define-key dashboard-mode-map ,shortcut-char sym)))))
(defun dashboard-append (msg &optional _messagebuf)
"Append MSG to dashboard buffer.
If MESSAGEBUF is not nil then MSG is also written in message buffer."
(with-current-buffer (get-buffer-create "*dashboard*")
(goto-char (point-max))
(let ((buffer-read-only nil))
(insert msg))))
(defun dashboard-modify-heading-icons (alist)
"Append ALIST items to `dashboard-heading-icons' to modify icons."
(dolist (icon alist)
(add-to-list 'dashboard-heading-icons icon)))
(defun dashboard-insert-page-break ()
"Insert a page break line in dashboard buffer."
(dashboard-append dashboard-page-separator))
(defun dashboard-insert-heading (heading &optional shortcut)
"Insert a widget HEADING in dashboard buffer, adding SHORTCUT if provided."
(when (and (display-graphic-p)
dashboard-set-heading-icons)
;; Try loading `all-the-icons'
(unless (or (fboundp 'all-the-icons-octicon)
(require 'all-the-icons nil 'noerror))
(error "Package `all-the-icons' isn't installed"))
(insert (cond
((string-equal heading "Recent Files:")
(all-the-icons-octicon (cdr (assoc 'recents dashboard-heading-icons))
:height 1.2 :v-adjust 0.0 :face 'dashboard-heading))
((string-equal heading "Bookmarks:")
(all-the-icons-octicon (cdr (assoc 'bookmarks dashboard-heading-icons))
:height 1.2 :v-adjust 0.0 :face 'dashboard-heading))
((or (string-equal heading "Agenda for today:")
(string-equal heading "Agenda for the coming week:"))
(all-the-icons-octicon (cdr (assoc 'agenda dashboard-heading-icons))
:height 1.2 :v-adjust 0.0 :face 'dashboard-heading))
((string-equal heading "Registers:")
(all-the-icons-octicon (cdr (assoc 'registers dashboard-heading-icons))
:height 1.2 :v-adjust 0.0 :face 'dashboard-heading))
((string-equal heading "Projects:")
(all-the-icons-octicon (cdr (assoc 'projects dashboard-heading-icons))
:height 1.2 :v-adjust 0.0 :face 'dashboard-heading))
(t " ")))
(insert " "))
(insert (propertize heading 'face 'dashboard-heading))
(if shortcut (insert (format " (%s)" shortcut))))
(defun dashboard-center-line (string)
"Center a STRING accoring to it's size."
(insert (make-string (max 0 (floor (/ (- dashboard-banner-length
(+ (length string) 1)) 2))) ?\ )))
;;
;; BANNER
;;
(defun dashboard-insert-ascii-banner-centered (file)
"Insert banner from FILE."
(let ((ascii-banner
(with-temp-buffer
(insert-file-contents file)
(let ((banner-width 0))
(while (not (eobp))
(let ((line-length (- (line-end-position) (line-beginning-position))))
(if (< banner-width line-length)
(setq banner-width line-length)))
(forward-line 1))
(goto-char 0)
(let ((margin
(max 0 (floor (/ (- dashboard-banner-length banner-width) 2)))))
(while (not (eobp))
(insert (make-string margin ?\ ))
(forward-line 1))))
(buffer-string))))
(put-text-property 0 (length ascii-banner) 'face 'dashboard-text-banner ascii-banner)
(insert ascii-banner)))
(defun dashboard-insert-image-banner (banner)
"Display an image BANNER."
(when (file-exists-p banner)
(let* ((title dashboard-banner-logo-title)
(spec
(if (image-type-available-p 'imagemagick)
(apply 'create-image banner 'imagemagick nil
(append (when (> dashboard-image-banner-max-width 0)
(list :max-width dashboard-image-banner-max-width))
(when (> dashboard-image-banner-max-height 0)
(list :max-height dashboard-image-banner-max-height))))
(create-image banner)))
(size (image-size spec))
(width (car size))
(left-margin (max 0 (floor (- dashboard-banner-length width) 2))))
(goto-char (point-min))
(insert "\n")
(insert (make-string left-margin ?\ ))
(insert-image spec)
(insert "\n\n")
(when title
(dashboard-center-line title)
(insert (format "%s\n\n" (propertize title 'face 'dashboard-banner-logo-title)))))))
;;
;; INIT INFO
;;
(defun dashboard-insert-init-info ()
"Insert init info when `dashboard-set-init-info' is t."
(when dashboard-set-init-info
(dashboard-center-line dashboard-init-info)
(insert
(propertize dashboard-init-info 'face 'font-lock-comment-face))))
(defun dashboard-get-banner-path (index)
"Return the full path to banner with index INDEX."
(concat dashboard-banners-directory (format "%d.txt" index)))
(defun dashboard-choose-banner ()
"Return the full path of a banner based on the dotfile value."
(when dashboard-startup-banner
(cond ((eq 'official dashboard-startup-banner)
(if (and (display-graphic-p) (image-type-available-p 'png))
dashboard-banner-official-png
(dashboard-get-banner-path 1)))
((eq 'logo dashboard-startup-banner)
(if (and (display-graphic-p) (image-type-available-p 'png))
dashboard-banner-logo-png
(dashboard-get-banner-path 1)))
((integerp dashboard-startup-banner)
(dashboard-get-banner-path dashboard-startup-banner))
((and dashboard-startup-banner
(image-type-available-p (intern (file-name-extension
dashboard-startup-banner)))
(display-graphic-p))
(if (file-exists-p dashboard-startup-banner)
dashboard-startup-banner
(message (format "could not find banner %s"
dashboard-startup-banner))
(dashboard-get-banner-path 1)))
(t (dashboard-get-banner-path 1)))))
(defun dashboard-insert-banner ()
"Insert Banner at the top of the dashboard."
(goto-char (point-max))
(let ((banner (dashboard-choose-banner))
(buffer-read-only nil))
(progn
(when banner
(if (image-type-available-p (intern (file-name-extension banner)))
(dashboard-insert-image-banner banner)
(dashboard-insert-ascii-banner-centered banner))
(dashboard-insert-navigator)
(dashboard-insert-init-info)))))
(defun dashboard-insert-navigator ()
"Insert Navigator of the dashboard."
(when (and dashboard-set-navigator dashboard-navigator-buttons)
(dolist (line dashboard-navigator-buttons)
(dolist (btn line)
(let* ((icon (car btn))
(title (cadr btn))
(help (or (cadr (cdr btn)) ""))
(action (or (cadr (cddr btn)) #'ignore))
(face (or (cadr (cddr (cdr btn))) 'dashboard-navigator))
(prefix (or (cadr (cddr (cddr btn))) (propertize "[" 'face face)))
(suffix (or (cadr (cddr (cddr (cdr btn)))) (propertize "]" 'face face))))
(widget-create 'item
:tag (concat
(when icon
(propertize icon 'face `(:inherit
,(get-text-property 0 'face icon)
:inherit
,face)))
(when (and icon title
(not (string-equal icon ""))
(not (string-equal title "")))
(propertize " " 'face 'variable-pitch))
(when title (propertize title 'face face)))
:help-echo help
:action action
:button-face `(:underline nil)
:mouse-face 'highlight
:button-prefix prefix
:button-suffix suffix
:format "%[%t%]")
(insert " ")))
(let* ((width (current-column)))
(beginning-of-line)
(dashboard-center-line (make-string width ?\s))
(end-of-line))
(insert "\n"))
(insert "\n")))
(defmacro dashboard-insert-section (section-name list list-size shortcut action &rest widget-params)
"Add a section with SECTION-NAME and LIST of LIST-SIZE items to the dashboard.
SHORTCUT is the keyboard shortcut used to access the section.
ACTION is theaction taken when the user activates the widget button.
WIDGET-PARAMS are passed to the \"widget-create\" function."
`(progn
(dashboard-insert-heading ,section-name
(if (and ,list dashboard-show-shortcuts) ,shortcut))
(if ,list
(when (dashboard-insert-section-list
,section-name
(dashboard-subseq ,list 0 ,list-size)
,action
,@widget-params)
(dashboard-insert-shortcut ,shortcut ,section-name))
(insert "\n --- No items ---"))))
;;
;; Section list
;;
(defmacro dashboard-insert-section-list (section-name list action &rest rest)
"Insert into SECTION-NAME a LIST of items, expanding ACTION and passing REST to widget creation."
`(when (car ,list)
(mapc
(lambda (el)
(let ((tag ,@rest))
(insert "\n ")
(when (and (display-graphic-p)
dashboard-set-file-icons
(or (fboundp 'all-the-icons-icon-for-dir)
(require 'all-the-icons nil 'noerror)))
(let* ((path (car (last (split-string ,@rest " - "))))
(icon (if (and (not (file-remote-p path))
(file-directory-p path))
(all-the-icons-icon-for-dir path nil "")
(cond
((string-equal ,section-name "Agenda for today:")
(all-the-icons-octicon "primitive-dot" :height 1.0 :v-adjust 0.01))
((file-remote-p path)
(all-the-icons-octicon "radio-tower" :height 1.0 :v-adjust 0.01))
(t (all-the-icons-icon-for-file (file-name-nondirectory path)
:v-adjust -0.05))))))
(setq tag (concat icon " " ,@rest))))
(widget-create 'item
:tag tag
:action ,action
:button-face `(:underline nil)
:mouse-face 'highlight
:button-prefix ""
:button-suffix ""
:format "%[%t%]")))
,list)))
;; Footer
(defun dashboard-random-footer ()
"Return a random footer from `dashboard-footer-messages'."
(nth (random (length dashboard-footer-messages)) dashboard-footer-messages))
(defun dashboard-insert-footer ()
"Insert footer of dashboard."
(let ((footer (and dashboard-set-footer (dashboard-random-footer))))
(when footer
(insert "\n")
(dashboard-center-line footer)
(insert dashboard-footer-icon)
(insert " ")
(insert (propertize footer 'face 'dashboard-footer))
(insert "\n"))))
;;
;; Recentf
;;
(defun dashboard-insert-recents (list-size)
"Add the list of LIST-SIZE items from recently edited files."
(recentf-mode)
(dashboard-insert-section
"Recent Files:"
recentf-list
list-size
"r"
`(lambda (&rest ignore) (find-file-existing ,el))
(abbreviate-file-name el)))
;;
;; Bookmarks
;;
(defun dashboard-insert-bookmarks (list-size)
"Add the list of LIST-SIZE items of bookmarks."
(require 'bookmark)
(dashboard-insert-section
"Bookmarks:"
(dashboard-subseq (bookmark-all-names)
0 list-size)
list-size
"m"
`(lambda (&rest ignore) (bookmark-jump ,el))
(let ((file (bookmark-get-filename el)))
(if file
(format "%s - %s" el (abbreviate-file-name file))
el))))
;;
;; Projectile
;;
(defun dashboard-insert-projects (list-size)
"Add the list of LIST-SIZE items of projects."
(require 'projectile)
(let ((inhibit-message t) (message-log-max nil))
(projectile-cleanup-known-projects))
(projectile-load-known-projects)
(dashboard-insert-section
"Projects:"
(dashboard-subseq (projectile-relevant-known-projects)
0 list-size)
list-size
"p"
`(lambda (&rest ignore) (projectile-switch-project-by-name ,el))
(abbreviate-file-name el)))
;;
;; Org Agenda
;;
(defun dashboard-timestamp-to-gregorian-date (timestamp)
"Convert TIMESTAMP to a gregorian date.
The result can be used with functions like
`calendar-date-compare'."
(let ((decoded-timestamp (decode-time timestamp)))
(list (nth 4 decoded-timestamp)
(nth 3 decoded-timestamp)
(nth 5 decoded-timestamp))))
(defun dashboard-date-due-p (timestamp &optional due-date)
"Check if TIMESTAMP is today or in the past.
If DUE-DATE is nil, compare TIMESTAMP to today; otherwise,
compare to the date in DUE-DATE.
The time part of both TIMESTAMP and DUE-DATE is ignored, only the
date part is considered."
(unless due-date
(setq due-date (current-time)))
(setq due-date (time-add due-date 86400))
(let* ((gregorian-date (dashboard-timestamp-to-gregorian-date timestamp))
(gregorian-due-date (dashboard-timestamp-to-gregorian-date due-date)))
(calendar-date-compare (list gregorian-date)
(list gregorian-due-date))))
(defun dashboard-get-agenda ()
"Get agenda items for today or for a week from now."
(org-compile-prefix-format 'agenda)
(let ((due-date nil))
(if (and (boundp 'show-week-agenda-p) show-week-agenda-p)
(setq due-date (time-add (current-time) (* 86400 7)))
(setq due-date nil)
)
(let* ((filtered-entries nil))
(org-map-entries
(lambda ()
(let* ((schedule-time (org-get-scheduled-time (point)))
(deadline-time (org-get-deadline-time (point)))
(item (org-agenda-format-item
(format-time-string "%Y-%m-%d" schedule-time)
(org-get-heading t t)
(org-outline-level)
(org-get-category)
(org-get-tags)
t))
(loc (point))
(file (buffer-file-name)))
(if (or (equal dashboard-org-agenda-categories nil)
(member (org-get-category) dashboard-org-agenda-categories))
(when (and (not (org-entry-is-done-p))
(or (and schedule-time (dashboard-date-due-p schedule-time due-date))
(and deadline-time (dashboard-date-due-p deadline-time due-date))))
(setq filtered-entries
(append filtered-entries
(list (list item schedule-time deadline-time loc file))))))))
nil
'agenda)
filtered-entries)))
(defun dashboard-insert-agenda (list-size)
"Add the list of LIST-SIZE items of agenda."
(require 'org-agenda)
(require 'calendar)
(let ((agenda (dashboard-get-agenda)))
(dashboard-insert-section
(or (and (boundp 'show-week-agenda-p) show-week-agenda-p "Agenda for the coming week:")
"Agenda for today:")
agenda
list-size
"a"
`(lambda (&rest ignore)
(let ((buffer (find-file-other-window (nth 4 ',el))))
(with-current-buffer buffer
(goto-char (nth 3 ',el)))
(switch-to-buffer buffer)))
(format "%s" (nth 0 el)))))
;;
;; Registers
;;
(defun dashboard-insert-registers (list-size)
"Add the list of LIST-SIZE items of registers."
(require 'register)
(dashboard-insert-section
"Registers:"
register-alist
list-size
"e"
(lambda (&rest _ignore) (jump-to-register (car el)))
(format "%c - %s" (car el) (register-describe-oneline (car el)))))
(provide 'dashboard-widgets)
;;; dashboard-widgets.el ends here

258
lisp/dashboard/dashboard.el Normal file
View File

@@ -0,0 +1,258 @@
;;; dashboard.el --- A startup screen extracted from Spacemacs -*- lexical-binding: t -*-
;; Copyright (c) 2016-2020 Rakan Al-Hneiti & Contributors
;;
;; Author: Rakan Al-Hneiti
;; 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.8.0-SNAPSHOT
;; Keywords: startup, screen, tools, dashboard
;; Package-Requires: ((emacs "25.3") (page-break-lines "0.11"))
;;; Commentary:
;; An extensible Emacs dashboard, with sections for
;; bookmarks, projectile projects, org-agenda and more.
;;; Code:
(require 'seq)
(require 'page-break-lines)
(require 'recentf)
(require 'dashboard-widgets)
;; 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 [down-mouse-1] 'widget-button-click)
(define-key map (kbd "g") #'dashboard-refresh-buffer)
(define-key map (kbd "}") #'dashboard-next-section)
(define-key map (kbd "{") #'dashboard-previous-section)
map)
"Keymap for dashboard mode.")
(define-derived-mode dashboard-mode special-mode "Dashboard"
"Dashboard major mode for startup screen.
\\<dashboard-mode-map>
"
:group 'dashboard
:syntax-table nil
:abbrev-table nil
(buffer-disable-undo)
(whitespace-mode -1)
(linum-mode -1)
(when (>= emacs-major-version 26)
(display-line-numbers-mode -1))
(page-break-lines-mode 1)
(setq inhibit-startup-screen t)
(setq buffer-read-only t
truncate-lines t))
(defgroup dashboard nil
"Extensible startup screen."
:group 'applications)
(defcustom dashboard-center-content nil
"Whether to center content within the window."
:type 'boolean
:group 'dashboard)
(defconst dashboard-buffer-name "*dashboard*"
"Dashboard's buffer name.")
(defvar dashboard--section-starts nil
"List of section starting positions.")
(defun dashboard-previous-section ()
"Navigate back to previous section."
(interactive)
(let ((current-section-start nil)
(current-position (point))
(previous-section-start nil))
(dolist (elt dashboard--section-starts)
(when (and current-section-start
(not previous-section-start))
(setq previous-section-start elt))
(when (and (not current-section-start)
(< elt current-position))
(setq current-section-start elt)))
(goto-char (if (eq current-position current-section-start)
previous-section-start
current-section-start))))
(defun dashboard-next-section ()
"Navigate forward to next section."
(interactive)
(let ((current-position (point))
(next-section-start nil)
(section-starts (reverse dashboard--section-starts)))
(dolist (elt section-starts)
(when (and (not next-section-start)
(> elt current-position))
(setq next-section-start elt)))
(when next-section-start
(goto-char next-section-start))))
(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 nil)
(goal-column nil))
(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))
(defun dashboard-return ()
"Hit return key in dashboard buffer."
(interactive)
(let ((start-ln (line-number-at-pos))
(fd-cnt 0)
(diff-line nil)
(entry-pt nil))
(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-maximum-section-length ()
"For the just-inserted section, calculate the length of the longest line."
(let ((max-line-length 0))
(save-excursion
(dashboard-previous-section)
(while (not (eobp))
(setq max-line-length
(max max-line-length
(- (line-end-position) (line-beginning-position))))
(forward-line)))
max-line-length))
(defun dashboard-insert-startupify-lists ()
"Insert the list of widgets into the buffer."
(interactive)
(let ((buffer-exists (buffer-live-p (get-buffer dashboard-buffer-name)))
(recentf-is-on (recentf-enabled-p))
(origial-recentf-list recentf-list)
(dashboard-num-recents (or (cdr (assoc 'recents dashboard-items)) 0))
(max-line-length 0))
;; disable recentf mode,
;; so we don't flood the recent files list with org mode files
;; do this by making a copy of the part of the list we'll use
;; let dashboard widgets change that
;; then restore the orginal list afterwards
;; (this avoids many saves/loads that would result from
;; disabling/enabling recentf-mode)
(if recentf-is-on
(setq recentf-list (seq-take recentf-list dashboard-num-recents)))
(when (or (not (eq dashboard-buffer-last-width (window-width)))
(not buffer-exists))
(setq dashboard-banner-length (window-width)
dashboard-buffer-last-width dashboard-banner-length)
(with-current-buffer (get-buffer-create dashboard-buffer-name)
(let ((buffer-read-only nil))
(erase-buffer)
(dashboard-insert-banner)
(dashboard-insert-page-break)
(setq dashboard--section-starts nil)
(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))))
(add-to-list 'dashboard--section-starts (point))
(funcall item-generator list-size)
(setq max-line-length
(max max-line-length (dashboard-maximum-section-length)))
(dashboard-insert-page-break)))
dashboard-items)
(when dashboard-center-content
(when dashboard--section-starts
(goto-char (car (last dashboard--section-starts))))
(let ((margin (floor (/ (max (- (window-width) max-line-length) 0) 2))))
(while (not (eobp))
(and (not (eq ? (char-after)))
(insert (make-string margin ?\ )))
(forward-line 1))))
(dashboard-insert-footer))
(dashboard-mode)
(goto-char (point-min))))
(if recentf-is-on
(setq recentf-list origial-recentf-list))))
(add-hook 'window-setup-hook
(lambda ()
(add-hook 'window-size-change-functions 'dashboard-resize-on-hook)
(dashboard-resize-on-hook)))
(defun dashboard-refresh-buffer ()
"Refresh buffer."
(interactive)
(kill-buffer dashboard-buffer-name)
(dashboard-insert-startupify-lists)
(switch-to-buffer dashboard-buffer-name))
(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)))))
;;;###autoload
(defun dashboard-setup-startup-hook ()
"Setup post initialization hooks.
If a command line argument is provided,
assume a filename and skip displaying Dashboard."
(when (< (length command-line-args) 2 )
(add-hook 'after-init-hook (lambda ()
;; Display useful lists of items
(dashboard-insert-startupify-lists)))
(add-hook 'emacs-startup-hook '(lambda ()
(switch-to-buffer "*dashboard*")
(goto-char (point-min))
(redisplay)))))
(provide 'dashboard)
;;; dashboard.el ends here

68
lisp/diff-hl/diff-hl-amend.el Normal file
View File

@@ -0,0 +1,68 @@
;; Copyright (C) 2012-2013 Free Software Foundation, Inc.
;; Author: Dmitry Gutov <dgutov@yandex.ru>
;; URL: https://github.com/dgutov/diff-hl
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Toggle in the current buffer with `M-x diff-hl-amend-mode'.
;; Toggle in all buffers with `M-x global-diff-hl-amend-mode'.
;;; Code:
(require 'diff-hl)
;;;###autoload
(define-minor-mode diff-hl-amend-mode
"Show changes against the second-last revision in `diff-hl-mode'.
Most useful with backends that support rewriting local commits,
and most importantly, 'amending' the most recent one.
Currently only supports Git, Mercurial and Bazaar."
:lighter " Amend"
(if diff-hl-amend-mode
(progn
(diff-hl-amend-setup)
(add-hook 'after-revert-hook 'diff-hl-amend-setup nil t))
(remove-hook 'after-revert-hook 'diff-hl-amend-setup t)
(setq-local diff-hl-reference-revision nil))
(when diff-hl-mode
(diff-hl-update)))
(defun diff-hl-amend-setup ()
(let ((backend (vc-backend buffer-file-name)))
(when backend
(setq-local diff-hl-reference-revision
(cl-case backend
(Git
"HEAD^")
(Hg
"-2")
(Bzr
"revno:-2"))))))
;;;###autoload
(define-globalized-minor-mode global-diff-hl-amend-mode diff-hl-amend-mode
turn-on-diff-hl-amend-mode)
(defun turn-on-diff-hl-amend-mode ()
"Turn on `diff-hl-amend-mode' in a buffer if appropriate."
(and buffer-file-name (diff-hl-amend-mode 1)))
(provide 'diff-hl-amend)
;;; diff-hl-amend.el ends here

184
lisp/diff-hl/diff-hl-dired.el Normal file
View File

@@ -0,0 +1,184 @@
;;; diff-hl-dired.el --- Highlight changed files in Dired -*- lexical-binding: t -*-
;; Copyright (C) 2012-2017 Free Software Foundation, Inc.
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;; To enable in all Dired buffers, add this to your init file:
;;
;; (add-hook 'dired-mode-hook 'diff-hl-dired-mode)
;;
;; or
;;
;; (add-hook 'dired-mode-hook 'diff-hl-dired-mode-unless-remote)
;;
;; to do it only in local Dired buffers.
;;; Code:
(require 'diff-hl)
(require 'dired)
(require 'vc-hooks)
(defvar diff-hl-dired-process-buffer nil)
(defgroup diff-hl-dired nil
"VC diff highlighting on the side of a Dired window."
:group 'diff-hl)
(defface diff-hl-dired-insert
'((default :inherit diff-hl-insert))
"Face used to highlight added files.")
(defface diff-hl-dired-delete
'((default :inherit diff-hl-delete))
"Face used to highlight directories with deleted files.")
(defface diff-hl-dired-change
'((default :inherit diff-hl-change))
"Face used to highlight changed files.")
(defface diff-hl-dired-unknown
'((default :inherit dired-ignored))
"Face used to highlight unregistered files.")
(defface diff-hl-dired-ignored
'((default :inherit dired-ignored))
"Face used to highlight unregistered files.")
(defcustom diff-hl-dired-extra-indicators t
"Non-nil to indicate ignored files."
:type 'boolean)
(defcustom diff-hl-dired-ignored-backends '(RCS)
"VC backends to ignore.
The directories registered to one of these backends won't have
status indicators."
:type `(repeat (choice ,@(mapcar
(lambda (name)
`(const :tag ,(symbol-name name) ,name))
vc-handled-backends))))
;;;###autoload
(define-minor-mode diff-hl-dired-mode
"Toggle VC diff highlighting on the side of a Dired window."
:lighter ""
(if diff-hl-dired-mode
(progn
(diff-hl-maybe-define-bitmaps)
(set (make-local-variable 'diff-hl-dired-process-buffer) nil)
(add-hook 'dired-after-readin-hook 'diff-hl-dired-update nil t))
(remove-hook 'dired-after-readin-hook 'diff-hl-dired-update t)
(diff-hl-dired-clear)))
(defun diff-hl-dired-update ()
"Highlight the Dired buffer."
(let ((backend (ignore-errors (vc-responsible-backend default-directory)))
(def-dir default-directory)
(buffer (current-buffer))
dirs-alist files-alist)
(when (and backend (not (memq backend diff-hl-dired-ignored-backends)))
(diff-hl-dired-clear)
(if (buffer-live-p diff-hl-dired-process-buffer)
(let ((proc (get-buffer-process diff-hl-dired-process-buffer)))
(when proc (kill-process proc)))
(setq diff-hl-dired-process-buffer
(generate-new-buffer " *diff-hl-dired* tmp status")))
(with-current-buffer diff-hl-dired-process-buffer
(setq default-directory (expand-file-name def-dir))
(erase-buffer)
(diff-hl-dired-status-files
backend def-dir
(when diff-hl-dired-extra-indicators
(cl-loop for file in (directory-files def-dir)
unless (member file '("." ".." ".hg"))
collect file))
(lambda (entries &optional more-to-come)
(when (buffer-live-p buffer)
(with-current-buffer buffer
(dolist (entry entries)
(cl-destructuring-bind (file state &rest r) entry
;; Work around http://debbugs.gnu.org/18605
(setq file (replace-regexp-in-string "\\` " "" file))
(let ((type (plist-get
'(edited change added insert removed delete
unregistered unknown ignored ignored)
state)))
(if (string-match "\\`\\([^/]+\\)/" file)
(let* ((dir (match-string 1 file))
(value (cdr (assoc dir dirs-alist))))
(unless (eq value type)
(cond
((eq state 'up-to-date))
((null value)
(push (cons dir type) dirs-alist))
((not (eq type 'ignored))
(setcdr (assoc dir dirs-alist) 'change)))))
(push (cons file type) files-alist)))))
(unless more-to-come
(diff-hl-dired-highlight-items
(append dirs-alist files-alist))))
(unless more-to-come
(kill-buffer diff-hl-dired-process-buffer))))
)))))
(defun diff-hl-dired-status-files (backend dir files update-function)
"Using version control BACKEND, return list of (FILE STATE EXTRA) entries
for DIR containing FILES. Call UPDATE-FUNCTION as entries are added."
(if (version< "25" emacs-version)
(vc-call-backend backend 'dir-status-files dir files update-function)
(vc-call-backend backend 'dir-status-files dir files nil update-function)))
(when (version< emacs-version "24.4.51.5")
;; Work around http://debbugs.gnu.org/19386
(defadvice vc-git-dir-status-goto-stage (around
diff-hl-dired-skip-up-to-date
(stage files update-function)
activate)
(when (eq stage 'ls-files-up-to-date)
(setq stage 'diff-index))
ad-do-it))
(defun diff-hl-dired-highlight-items (alist)
"Highlight ALIST containing (FILE . TYPE) elements."
(dolist (pair alist)
(let ((file (car pair))
(type (cdr pair)))
(save-excursion
(goto-char (point-min))
(when (and type (dired-goto-file-1
file (expand-file-name file) nil))
(let* ((diff-hl-fringe-bmp-function 'diff-hl-fringe-bmp-from-type)
(diff-hl-fringe-face-function 'diff-hl-dired-face-from-type)
(o (diff-hl-add-highlighting type 'single)))
(overlay-put o 'modification-hooks '(diff-hl-overlay-modified))
))))))
(defun diff-hl-dired-face-from-type (type _pos)
(intern (format "diff-hl-dired-%s" type)))
(defalias 'diff-hl-dired-clear 'diff-hl-remove-overlays)
;;;###autoload
(defun diff-hl-dired-mode-unless-remote ()
(unless (file-remote-p default-directory)
(diff-hl-dired-mode)))
(provide 'diff-hl-dired)
;;; diff-hl-dired.el ends here

177
lisp/diff-hl/diff-hl-flydiff.el Normal file
View File

@@ -0,0 +1,177 @@
;; Copyright (C) 2015-2018 Free Software Foundation, Inc.
;; Author: Jonathan Hayase <PythonNut@gmail.com>
;; URL: https://github.com/dgutov/diff-hl
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This mode enables diffing on-the-fly (i.e. without saving the buffer first)
;; Toggle in all buffers with M-x diff-hl-flydiff-mode
;;; Code:
(require 'diff-hl)
(require 'diff)
(unless (require 'nadvice nil t)
(error "`diff-hl-flydiff-mode' requires Emacs 24.4 or newer"))
(defgroup diff-hl-flydiff nil
"Highlight changes on the fly"
:group 'diff-hl)
(defcustom diff-hl-flydiff-delay 0.3
"The idle delay in seconds before highlighting is updated."
:type 'number)
(defvar diff-hl-flydiff-modified-tick nil)
(defvar diff-hl-flydiff-timer nil)
(make-variable-buffer-local 'diff-hl-flydiff-modified-tick)
(defun diff-hl-flydiff/vc-git--symbolic-ref (file)
(or
(vc-file-getprop file 'vc-git-symbolic-ref)
(let* (process-file-side-effects
(str (vc-git--run-command-string nil "symbolic-ref" "HEAD")))
(vc-file-setprop file 'vc-git-symbolic-ref
(if str
(if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str)
(match-string 2 str)
str))))))
(defun diff-hl-flydiff/vc-git-working-revision (_file)
"Git-specific version of `vc-working-revision'."
(let (process-file-side-effects)
(vc-git--rev-parse "HEAD")))
(defun diff-hl-flydiff/vc-git-mode-line-string (file)
"Return a string for `vc-mode-line' to put in the mode line for FILE."
(let* ((rev (vc-working-revision file))
(disp-rev (or (diff-hl-flydiff/vc-git--symbolic-ref file)
(substring rev 0 7)))
(def-ml (vc-default-mode-line-string 'Git file))
(help-echo (get-text-property 0 'help-echo def-ml))
(face (get-text-property 0 'face def-ml)))
(propertize (replace-regexp-in-string (concat rev "\\'") disp-rev def-ml t t)
'face face
'help-echo (concat help-echo "\nCurrent revision: " rev))))
;; Polyfill concrete revisions for vc-git-working-revision in Emacs 24.4, 24.5
(when (version<= emacs-version "25.0")
(with-eval-after-load 'vc-git
(advice-add 'vc-git-working-revision :override
#'diff-hl-flydiff/vc-git-working-revision)
(advice-add 'vc-git-mode-line-string :override
#'diff-hl-flydiff/vc-git-mode-line-string)))
(defun diff-hl-flydiff/working-revision (file)
"Like vc-working-revision, but always up-to-date"
(vc-file-setprop file 'vc-working-revision
(vc-call-backend (vc-backend file) 'working-revision file)))
(defun diff-hl-flydiff-make-temp-file-name (file rev &optional manual)
"Return a backup file name for REV or the current version of FILE.
If MANUAL is non-nil it means that a name for backups created by
the user should be returned."
(let* ((auto-save-file-name-transforms
`((".*" ,temporary-file-directory t))))
(expand-file-name
(concat (make-auto-save-file-name)
".~" (subst-char-in-string
?/ ?_ rev)
(unless manual ".") "~")
temporary-file-directory)))
(defun diff-hl-flydiff-create-revision (file revision)
"Read REVISION of FILE into a buffer and return the buffer."
(let ((automatic-backup (diff-hl-flydiff-make-temp-file-name file revision))
(filebuf (get-file-buffer file))
(filename (diff-hl-flydiff-make-temp-file-name file revision 'manual)))
(unless (file-exists-p filename)
(if (file-exists-p automatic-backup)
(rename-file automatic-backup filename nil)
(with-current-buffer filebuf
(let ((coding-system-for-read 'no-conversion)
(coding-system-for-write 'no-conversion))
(condition-case nil
(with-temp-file filename
(let ((outbuf (current-buffer)))
;; Change buffer to get local value of
;; vc-checkout-switches.
(with-current-buffer filebuf
(vc-call find-revision file revision outbuf))))
(error
(when (file-exists-p filename)
(delete-file filename))))))))
filename))
(defun diff-hl-flydiff-buffer-with-head (file &optional backend)
"View the differences between BUFFER and its associated file.
This requires the external program `diff' to be in your `exec-path'."
(interactive)
(vc-ensure-vc-buffer)
(setq diff-hl-flydiff-modified-tick (buffer-chars-modified-tick))
(save-current-buffer
(let* ((temporary-file-directory
(if (file-directory-p "/dev/shm/")
"/dev/shm/"
temporary-file-directory))
(rev (diff-hl-flydiff-create-revision
file
(or diff-hl-reference-revision
(diff-hl-flydiff/working-revision file)))))
;; FIXME: When against staging, do it differently!
(diff-no-select rev (current-buffer) "-U 0 --strip-trailing-cr" 'noasync
(get-buffer-create " *diff-hl-diff*")))))
(defun diff-hl-flydiff-update ()
(unless (or
(not diff-hl-mode)
(eq diff-hl-flydiff-modified-tick (buffer-chars-modified-tick))
(not buffer-file-name)
(not (file-exists-p buffer-file-name))
(file-remote-p default-directory))
(diff-hl-update)))
(defun diff-hl-flydiff/modified-p (state)
(buffer-modified-p))
;;;###autoload
(define-minor-mode diff-hl-flydiff-mode
"Perform highlighting on-the-fly.
This is a global minor mode. It alters how `diff-hl-mode' works."
:lighter "" :global t
(if diff-hl-flydiff-mode
(progn
(advice-add 'diff-hl-overlay-modified :override #'ignore)
(advice-add 'diff-hl-modified-p :before-until
#'diff-hl-flydiff/modified-p)
(advice-add 'diff-hl-changes-buffer :override
#'diff-hl-flydiff-buffer-with-head)
(setq diff-hl-flydiff-timer
(run-with-idle-timer diff-hl-flydiff-delay t #'diff-hl-flydiff-update)))
(advice-remove 'diff-hl-overlay-modified #'ignore)
(advice-remove 'diff-hl-modified-p #'diff-hl-flydiff/modified-p)
(advice-remove 'diff-hl-changes-buffer #'diff-hl-flydiff-buffer-with-head)
(and diff-hl-flydiff-timer
(cancel-timer diff-hl-flydiff-timer))))
(provide 'diff-hl-flydiff)

154
lisp/diff-hl/diff-hl-margin.el Normal file
View File

@@ -0,0 +1,154 @@
;;; diff-hl-margin.el --- Highlight buffer changes on margins -*- lexical-binding: t -*-
;; Copyright (C) 2012-2017 Free Software Foundation, Inc.
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This is a global mode, it modifies `diff-hl-mode' to use the margin
;; instead of the fringe. To toggle, type `M-x diff-hl-margin-mode'.
;;
;; Compared to the default behavior, this makes `diff-hl-mode'
;; indicators show up even when Emacs is running in a terminal.
;;
;; On the flip side, the indicators look simpler, and they are
;; incompatible with `linum-mode' or any other mode that uses the
;; margin.
;;
;; You might want to enable it conditionally in your init file
;; depending on whether Emacs is running in graphical mode:
;;
;; (unless (window-system) (diff-hl-margin-mode))
(require 'cl-lib)
(require 'diff-hl)
(require 'diff-hl-dired)
(defvar diff-hl-margin-old-highlight-function nil)
(defgroup diff-hl-margin nil
"Highlight buffer changes on margin"
:group 'diff-hl)
(defface diff-hl-margin-insert
'((default :inherit diff-hl-insert))
"Face used to highlight inserted lines on the margin.")
(defface diff-hl-margin-delete
'((default :inherit diff-hl-delete))
"Face used to highlight deleted lines on the margin.")
(defface diff-hl-margin-change
'((default :inherit diff-hl-change))
"Face used to highlight changed lines on the margin.")
(defface diff-hl-margin-ignored
'((default :inherit dired-ignored))
"Face used to highlight changed lines on the margin.")
(defface diff-hl-margin-unknown
'((default :inherit dired-ignored))
"Face used to highlight changed lines on the margin.")
(defcustom diff-hl-margin-symbols-alist
'((insert . "+") (delete . "-") (change . "!")
(unknown . "?") (ignored . "i"))
"Associative list from symbols to strings."
:type '(alist :key-type symbol
:value-type string
:options (insert delete change unknown ignored))
:set (lambda (symbol value)
(defvar diff-hl-margin-spec-cache)
(set-default symbol value)
(setq diff-hl-margin-spec-cache nil)))
;;;###autoload
(define-minor-mode diff-hl-margin-mode
"Toggle displaying `diff-hl-mode' highlights on the margin."
:lighter "" :global t
(if diff-hl-margin-mode
(progn
(add-hook 'diff-hl-mode-on-hook 'diff-hl-margin-minor-mode)
(add-hook 'diff-hl-mode-off-hook 'diff-hl-margin-minor-mode-off)
(add-hook 'diff-hl-dired-mode-on-hook 'diff-hl-margin-minor-mode)
(add-hook 'diff-hl-dired-mode-off-hook 'diff-hl-margin-minor-mode-off))
(remove-hook 'diff-hl-mode-on-hook 'diff-hl-margin-minor-mode)
(remove-hook 'diff-hl-mode-off-hook 'diff-hl-margin-minor-mode-off)
(remove-hook 'diff-hl-dired-mode-on-hook 'diff-hl-margin-minor-mode)
(remove-hook 'diff-hl-dired-mode-off-hook 'diff-hl-margin-minor-mode-off))
(dolist (buf (buffer-list))
(with-current-buffer buf
(cond
(diff-hl-mode
(diff-hl-margin-minor-mode (if diff-hl-margin-mode 1 -1))
(diff-hl-update))
(diff-hl-dired-mode
(diff-hl-margin-minor-mode (if diff-hl-margin-mode 1 -1))
(diff-hl-dired-update))))))
(define-minor-mode diff-hl-margin-minor-mode
"Toggle displaying `diff-hl-mode' highlights on the margin locally.
You probably shouldn't use this function directly."
:lighter ""
(let ((width-var (intern (format "%s-margin-width" diff-hl-side))))
(if diff-hl-margin-minor-mode
(progn
(set (make-local-variable 'diff-hl-margin-old-highlight-function)
diff-hl-highlight-function)
(set (make-local-variable 'diff-hl-highlight-function)
'diff-hl-highlight-on-margin)
(set width-var 1))
(when diff-hl-margin-old-highlight-function
(setq diff-hl-highlight-function diff-hl-margin-old-highlight-function
diff-hl-margin-old-highlight-function nil))
(set width-var 0)))
(dolist (win (get-buffer-window-list))
(set-window-buffer win (current-buffer))))
(define-obsolete-variable-alias 'diff-hl-margin-side 'diff-hl-side "1.7.1")
(defun diff-hl-margin-minor-mode-off ()
(diff-hl-margin-minor-mode -1))
(defvar diff-hl-margin-spec-cache nil)
(defun diff-hl-margin-spec-cache ()
(or diff-hl-margin-spec-cache
(setq diff-hl-margin-spec-cache
(diff-hl-margin-build-spec-cache))))
(defun diff-hl-margin-build-spec-cache ()
(cl-loop for (type . char) in diff-hl-margin-symbols-alist
nconc
(cl-loop for side in '(left right)
collect
(cons
(cons type side)
(propertize
" " 'display
`((margin ,(intern (format "%s-margin" side)))
,(propertize char 'face
(intern (format "diff-hl-margin-%s" type)))))))))
(defun diff-hl-highlight-on-margin (ovl type _shape)
(let ((spec (cdr (assoc (cons type diff-hl-side)
(diff-hl-margin-spec-cache)))))
(overlay-put ovl 'before-string spec)))
(provide 'diff-hl-margin)
;;; diff-hl-margin.el ends here

13
lisp/diff-hl/diff-hl-pkg.el Normal file
View File

@@ -0,0 +1,13 @@
(define-package "diff-hl" "20200604.1223" "Highlight uncommitted changes using VC"
'((cl-lib "0.2")
(emacs "24.3"))
:commit "176f931a9bfc6bc6fc5360c6ed7128ff96b21289" :keywords
'("vc" "diff")
:authors
'(("Dmitry Gutov" . "dgutov@yandex.ru"))
:maintainer
'("Dmitry Gutov" . "dgutov@yandex.ru")
:url "https://github.com/dgutov/diff-hl")
;; Local Variables:
;; no-byte-compile: t
;; End:

669
lisp/diff-hl/diff-hl.el Normal file
View File

@@ -0,0 +1,669 @@
;;; diff-hl.el --- Highlight uncommitted changes using VC -*- lexical-binding: t -*-
;; Copyright (C) 2012-2020 Free Software Foundation, Inc.
;; Author: Dmitry Gutov <dgutov@yandex.ru>
;; URL: https://github.com/dgutov/diff-hl
;; Keywords: vc, diff
;; Version: 1.8.7
;; Package-Requires: ((cl-lib "0.2") (emacs "24.3"))
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
;; `diff-hl-mode' highlights uncommitted changes on the side of the
;; window (using the fringe, by default), allows you to jump between
;; the hunks and revert them selectively.
;; Provided commands:
;;
;; `diff-hl-diff-goto-hunk' C-x v =
;; `diff-hl-revert-hunk' C-x v n
;; `diff-hl-previous-hunk' C-x v [
;; `diff-hl-next-hunk' C-x v ]
;;
;; The mode takes advantage of `smartrep' if it is installed.
;; Add either of the following to your init file.
;;
;; To use it in all buffers:
;;
;; (global-diff-hl-mode)
;;
;; Only in `prog-mode' buffers, with `vc-dir' integration:
;;
;; (add-hook 'prog-mode-hook 'turn-on-diff-hl-mode)
;; (add-hook 'vc-dir-mode-hook 'turn-on-diff-hl-mode)
;;; Code:
(require 'fringe)
(require 'diff-mode)
(require 'vc)
(require 'vc-dir)
(eval-when-compile
(require 'cl-lib)
(require 'vc-git)
(require 'vc-hg)
(require 'face-remap)
(declare-function smartrep-define-key 'smartrep))
(defgroup diff-hl nil
"VC diff highlighting on the side of a window"
:group 'vc)
(defface diff-hl-insert
'((default :inherit diff-added)
(((class color)) :foreground "green4"))
"Face used to highlight inserted lines."
:group 'diff-hl)
(defface diff-hl-delete
'((default :inherit diff-removed)
(((class color)) :foreground "red3"))
"Face used to highlight deleted lines."
:group 'diff-hl)
(defface diff-hl-change
'((default :foreground "blue3")
(((class color) (min-colors 88) (background light))
:background "#ddddff")
(((class color) (min-colors 88) (background dark))
:background "#333355"))
"Face used to highlight changed lines."
:group 'diff-hl)
(defcustom diff-hl-command-prefix (kbd "C-x v")
"The prefix for all `diff-hl' commands."
:group 'diff-hl
:type 'string)
(defcustom diff-hl-draw-borders t
"Non-nil to draw borders around fringe indicators."
:group 'diff-hl
:type 'boolean)
(defcustom diff-hl-ask-before-revert-hunk t
"Non-nil to ask for confirmation before revert a hunk."
:group 'diff-hl
:type 'boolean)
(defcustom diff-hl-highlight-function 'diff-hl-highlight-on-fringe
"Function to highlight the current line. Its arguments are
overlay, change type and position within a hunk."
:group 'diff-hl
:type 'function)
(defcustom diff-hl-fringe-bmp-function 'diff-hl-fringe-bmp-from-pos
"Function to choose the fringe bitmap for a given change type
and position within a hunk. Should accept two arguments."
:group 'diff-hl
:type '(choice (const diff-hl-fringe-bmp-from-pos)
(const diff-hl-fringe-bmp-from-type)
function))
(defcustom diff-hl-fringe-face-function 'diff-hl-fringe-face-from-type
"Function to choose the fringe face for a given change type
and position within a hunk. Should accept two arguments."
:group 'diff-hl
:type 'function)
(defcustom diff-hl-side 'left
"Which side to use for indicators."
:type '(choice (const left)
(const right))
:set (lambda (var value)
(let ((on (bound-and-true-p global-diff-hl-mode)))
(when on (global-diff-hl-mode -1))
(set-default var value)
(when on (global-diff-hl-mode 1)))))
(defcustom diff-hl-highlight-revert-hunk-function
#'diff-hl-revert-highlight-first-column
"Function to highlight the current hunk in `diff-hl-revert-hunk'.
The function is called at the beginning of the hunk and passed
the end position as its only argument."
:type '(choice (const :tag "Do nothing" ignore)
(const :tag "Highlight the first column"
diff-hl-revert-highlight-first-column)))
(defvar diff-hl-reference-revision nil
"Revision to diff against. nil means the most recent one.")
(defun diff-hl-define-bitmaps ()
(let* ((scale (if (and (boundp 'text-scale-mode-amount)
(numberp text-scale-mode-amount))
(expt text-scale-mode-step text-scale-mode-amount)
1))
(spacing (or (and (display-graphic-p) (default-value 'line-spacing)) 0))
(h (+ (ceiling (* (frame-char-height) scale))
(if (floatp spacing)
(truncate (* (frame-char-height) spacing))
spacing)))
(w (min (frame-parameter nil (intern (format "%s-fringe" diff-hl-side)))
16))
(_ (when (zerop w) (setq w 16)))
(middle (make-vector h (expt 2 (1- w))))
(ones (1- (expt 2 w)))
(top (copy-sequence middle))
(bottom (copy-sequence middle))
(single (copy-sequence middle)))
(aset top 0 ones)
(aset bottom (1- h) ones)
(aset single 0 ones)
(aset single (1- h) ones)
(define-fringe-bitmap 'diff-hl-bmp-top top h w 'top)
(define-fringe-bitmap 'diff-hl-bmp-middle middle h w 'center)
(define-fringe-bitmap 'diff-hl-bmp-bottom bottom h w 'bottom)
(define-fringe-bitmap 'diff-hl-bmp-single single h w 'top)
(define-fringe-bitmap 'diff-hl-bmp-i [3 3 0 3 3 3 3 3 3 3] nil 2 'center)
(let* ((w2 (* (/ w 2) 2))
;; When fringes are disabled, it's easier to fix up the width,
;; instead of doing nothing (#20).
(w2 (if (zerop w2) 2 w2))
(delete-row (- (expt 2 (1- w2)) 2))
(middle-pos (1- (/ w2 2)))
(middle-bit (expt 2 middle-pos))
(insert-bmp (make-vector w2 (* 3 middle-bit))))
(define-fringe-bitmap 'diff-hl-bmp-delete (make-vector 2 delete-row) w2 w2)
(aset insert-bmp 0 0)
(aset insert-bmp middle-pos delete-row)
(aset insert-bmp (1+ middle-pos) delete-row)
(aset insert-bmp (1- w2) 0)
(define-fringe-bitmap 'diff-hl-bmp-insert insert-bmp w2 w2)
)))
(defun diff-hl-maybe-define-bitmaps ()
(when (window-system) ;; No fringes in the console.
(unless (fringe-bitmap-p 'diff-hl-bmp-empty)
(diff-hl-define-bitmaps)
(define-fringe-bitmap 'diff-hl-bmp-empty [0] 1 1 'center))))
(defun diff-hl-maybe-redefine-bitmaps ()
(when (window-system)
(diff-hl-define-bitmaps)))
(defvar diff-hl-spec-cache (make-hash-table :test 'equal))
(defun diff-hl-fringe-spec (type pos side)
(let* ((key (list type pos side
diff-hl-fringe-face-function
diff-hl-fringe-bmp-function))
(val (gethash key diff-hl-spec-cache)))
(unless val
(let* ((face-sym (funcall diff-hl-fringe-face-function type pos))
(bmp-sym (funcall diff-hl-fringe-bmp-function type pos)))
(setq val (propertize " " 'display `((,(intern (format "%s-fringe" side))
,bmp-sym ,face-sym))))
(puthash key val diff-hl-spec-cache)))
val))
(defun diff-hl-fringe-face-from-type (type _pos)
(intern (format "diff-hl-%s" type)))
(defun diff-hl-fringe-bmp-from-pos (_type pos)
(intern (format "diff-hl-bmp-%s" pos)))
(defun diff-hl-fringe-bmp-from-type (type _pos)
(cl-case type
(unknown 'question-mark)
(change 'exclamation-mark)
(ignored 'diff-hl-bmp-i)
(t (intern (format "diff-hl-bmp-%s" type)))))
(defvar vc-svn-diff-switches)
(defmacro diff-hl-with-diff-switches (body)
`(let ((vc-git-diff-switches
;; https://github.com/dgutov/diff-hl/issues/67
(cons "-U0"
;; https://github.com/dgutov/diff-hl/issues/9
(and (boundp 'vc-git-diff-switches)
(listp vc-git-diff-switches)
(cl-remove-if-not
(lambda (arg)
(member arg '("--histogram" "--patience" "--minimal")))
vc-git-diff-switches))))
(vc-hg-diff-switches nil)
(vc-svn-diff-switches nil)
(vc-diff-switches '("-U0"))
,@(when (boundp 'vc-disable-async-diff)
'((vc-disable-async-diff t))))
,body))
(defun diff-hl-modified-p (state)
(or (memq state '(edited conflict))
(and (eq state 'up-to-date)
;; VC state is stale in after-revert-hook.
(or revert-buffer-in-progress-p
;; Diffing against an older revision.
diff-hl-reference-revision))))
(defun diff-hl-changes-buffer (file backend)
;; FIXME: To diff against the staging area, call 'git diff-files -p'.
(let ((buf-name " *diff-hl* "))
(condition-case err
(diff-hl-with-diff-switches
(vc-call-backend backend 'diff (list file)
diff-hl-reference-revision nil
buf-name))
(error
;; https://github.com/dgutov/diff-hl/issues/117
(when (string-match-p "\\`Failed (status 128)" (error-message-string err))
(diff-hl-with-diff-switches
(vc-call-backend backend 'diff (list file)
"4b825dc642cb6eb9a060e54bf8d69288fbee4904"
nil
buf-name)))))
buf-name))
(defun diff-hl-changes ()
(let* ((file buffer-file-name)
(backend (vc-backend file)))
(when backend
(let ((state (vc-state file backend)))
(cond
((diff-hl-modified-p state)
(let* (diff-auto-refine-mode res)
(with-current-buffer (diff-hl-changes-buffer file backend)
(goto-char (point-min))
(unless (eobp)
(ignore-errors
(diff-beginning-of-hunk t))
(while (looking-at diff-hunk-header-re-unified)
(let ((line (string-to-number (match-string 3)))
(len (let ((m (match-string 4)))
(if m (string-to-number m) 1)))
(beg (point)))
(diff-end-of-hunk)
(let* ((inserts (diff-count-matches "^\\+" beg (point)))
(deletes (diff-count-matches "^-" beg (point)))
(type (cond ((zerop deletes) 'insert)
((zerop inserts) 'delete)
(t 'change))))
(when (eq type 'delete)
(setq len 1)
(cl-incf line))
(push (list line len type) res))))))
(nreverse res)))
((eq state 'added)
`((1 ,(line-number-at-pos (point-max)) insert)))
((eq state 'removed)
`((1 ,(line-number-at-pos (point-max)) delete))))))))
(defun diff-hl-update ()
(let ((changes (diff-hl-changes))
(current-line 1))
(diff-hl-remove-overlays)
(save-excursion
(save-restriction
(widen)
(goto-char (point-min))
(dolist (c changes)
(cl-destructuring-bind (line len type) c
(forward-line (- line current-line))
(setq current-line line)
(let ((hunk-beg (point)))
(while (cl-plusp len)
(diff-hl-add-highlighting
type
(cond
((not diff-hl-draw-borders) 'empty)
((and (= len 1) (= line current-line)) 'single)
((= len 1) 'bottom)
((= line current-line) 'top)
(t 'middle)))
(forward-line 1)
(cl-incf current-line)
(cl-decf len))
(let ((h (make-overlay hunk-beg (point)))
(hook '(diff-hl-overlay-modified)))
(overlay-put h 'diff-hl t)
(overlay-put h 'diff-hl-hunk t)
(overlay-put h 'modification-hooks hook)
(overlay-put h 'insert-in-front-hooks hook)
(overlay-put h 'insert-behind-hooks hook)))))))))
(defun diff-hl-add-highlighting (type shape)
(let ((o (make-overlay (point) (point))))
(overlay-put o 'diff-hl t)
(funcall diff-hl-highlight-function o type shape)
o))
(defun diff-hl-highlight-on-fringe (ovl type shape)
(overlay-put ovl 'before-string (diff-hl-fringe-spec type shape
diff-hl-side)))
(defun diff-hl-remove-overlays (&optional beg end)
(save-restriction
(widen)
(dolist (o (overlays-in (or beg (point-min)) (or end (point-max))))
(when (overlay-get o 'diff-hl) (delete-overlay o)))))
(defun diff-hl-overlay-modified (ov after-p _beg _end &optional _length)
"Delete the hunk overlay and all our line overlays inside it."
(unless after-p
(when (overlay-buffer ov)
(diff-hl-remove-overlays (overlay-start ov) (overlay-end ov))
(delete-overlay ov))))
(defvar diff-hl-timer nil)
(defun diff-hl-edit (_beg _end _len)
"DTRT when we've `undo'-ne the buffer into unmodified state."
(when undo-in-progress
(when diff-hl-timer
(cancel-timer diff-hl-timer))
(setq diff-hl-timer
(run-with-idle-timer 0.01 nil #'diff-hl-after-undo (current-buffer)))))
(defun diff-hl-after-undo (buffer)
(with-current-buffer buffer
(unless (buffer-modified-p)
(diff-hl-update))))
(defun diff-hl-diff-goto-hunk-1 ()
(vc-buffer-sync)
(let* ((line (line-number-at-pos))
(buffer (current-buffer)))
(vc-diff-internal t (vc-deduce-fileset) diff-hl-reference-revision nil t)
(vc-exec-after `(if (< (line-number-at-pos (point-max)) 3)
(with-current-buffer ,buffer (diff-hl-remove-overlays))
(diff-hl-diff-skip-to ,line)
(setq vc-sentinel-movepoint (point))))))
(defun diff-hl-diff-goto-hunk ()
"Run VC diff command and go to the line corresponding to the current."
(interactive)
(with-current-buffer (or (buffer-base-buffer) (current-buffer))
(diff-hl-diff-goto-hunk-1)))
(defun diff-hl-diff-skip-to (line)
"In `diff-mode', skip to the hunk and line corresponding to LINE
in the source file, or the last line of the hunk above it."
(diff-hunk-next)
(let (found)
(while (and (looking-at diff-hunk-header-re-unified) (not found))
(let ((hunk-line (string-to-number (match-string 3)))
(len (let ((m (match-string 4)))
(if m (string-to-number m) 1))))
(if (> line (+ hunk-line len))
(diff-hunk-next)
(setq found t)
(if (< line hunk-line)
;; Retreat to the previous hunk.
(forward-line -1)
(let ((to-go (1+ (- line hunk-line))))
(while (cl-plusp to-go)
(forward-line 1)
(unless (looking-at "^-")
(cl-decf to-go))))))))))
(defface diff-hl-reverted-hunk-highlight
'((default :inverse-video t))
"Face used to highlight the first column of the hunk to be reverted.")
(defun diff-hl-revert-highlight-first-column (end)
(let ((inhibit-read-only t))
(save-excursion
(while (< (point) end)
(font-lock-prepend-text-property (point) (1+ (point)) 'font-lock-face
'diff-hl-reverted-hunk-highlight)
(forward-line 1)))))
(defun diff-hl-revert-hunk-1 ()
(save-restriction
(widen)
(vc-buffer-sync)
(let ((diff-buffer (generate-new-buffer-name "*diff-hl*"))
(buffer (current-buffer))
(line (save-excursion
(unless (diff-hl-hunk-overlay-at (point))
(diff-hl-previous-hunk))
(line-number-at-pos)))
(fileset (vc-deduce-fileset)))
(unwind-protect
(progn
(vc-diff-internal nil fileset diff-hl-reference-revision nil
nil diff-buffer)
(vc-exec-after
`(let (beg-line end-line m-end)
(when (eobp)
(with-current-buffer ,buffer (diff-hl-remove-overlays))
(user-error "Buffer is up-to-date"))
(let (diff-auto-refine-mode)
(diff-hl-diff-skip-to ,line))
(save-excursion
(while (looking-at "[-+]") (forward-line 1))
(setq end-line (line-number-at-pos (point)))
(setq m-end (point-marker))
(unless (eobp) (diff-split-hunk)))
(unless (looking-at "[-+]") (forward-line -1))
(while (looking-at "[-+]") (forward-line -1))
(setq beg-line (line-number-at-pos (point)))
(unless (looking-at "@")
(forward-line 1)
(diff-split-hunk))
(funcall diff-hl-highlight-revert-hunk-function m-end)
(let ((wbh (window-body-height)))
(if (>= wbh (- end-line beg-line))
(recenter (/ (+ wbh (- beg-line end-line) 2) 2))
(recenter 1)))
(when diff-auto-refine-mode
(diff-refine-hunk))
(if diff-hl-ask-before-revert-hunk
(unless (yes-or-no-p (format "Revert current hunk in %s? "
,(cl-caadr fileset)))
(user-error "Revert canceled")))
(let ((diff-advance-after-apply-hunk nil))
(save-window-excursion
(diff-apply-hunk t)))
(with-current-buffer ,buffer
(save-buffer))
(message "Hunk reverted"))))
(quit-windows-on diff-buffer t)))))
(defun diff-hl-revert-hunk ()
"Revert the diff hunk with changes at or above the point."
(interactive)
(with-current-buffer (or (buffer-base-buffer) (current-buffer))
(diff-hl-revert-hunk-1)))
(defun diff-hl-hunk-overlay-at (pos)
(cl-loop for o in (overlays-in pos (1+ pos))
when (overlay-get o 'diff-hl-hunk)
return o))
(defun diff-hl-next-hunk (&optional backward)
"Go to the beginning of the next hunk in the current buffer."
(interactive)
(let ((pos (save-excursion
(catch 'found
(while (not (if backward (bobp) (eobp)))
(goto-char (if backward
(previous-overlay-change (point))
(next-overlay-change (point))))
(let ((o (diff-hl-hunk-overlay-at (point))))
(when (and o (= (overlay-start o) (point)))
(throw 'found (overlay-start o)))))))))
(if pos
(goto-char pos)
(user-error "No further hunks found"))))
(defun diff-hl-previous-hunk ()
"Go to the beginning of the previous hunk in the current buffer."
(interactive)
(diff-hl-next-hunk t))
(defun diff-hl-mark-hunk ()
(interactive)
(let ((hunk (diff-hl-hunk-overlay-at (point))))
(unless hunk
(user-error "No hunk at point"))
(goto-char (overlay-start hunk))
(push-mark (overlay-end hunk) nil t)))
(defvar diff-hl-command-map
(let ((map (make-sparse-keymap)))
(define-key map "n" 'diff-hl-revert-hunk)
(define-key map "[" 'diff-hl-previous-hunk)
(define-key map "]" 'diff-hl-next-hunk)
map))
(fset 'diff-hl-command-map diff-hl-command-map)
(defvar diff-hl-lighter ""
"Mode line lighter for Diff Hl.
The value of this variable is a mode line template as in
`mode-line-format'.")
;;;###autoload
(define-minor-mode diff-hl-mode
"Toggle VC diff highlighting."
:lighter diff-hl-lighter
:keymap `(([remap vc-diff] . diff-hl-diff-goto-hunk)
(,diff-hl-command-prefix . diff-hl-command-map))
(if diff-hl-mode
(progn
(diff-hl-maybe-define-bitmaps)
(add-hook 'after-save-hook 'diff-hl-update nil t)
(add-hook 'after-change-functions 'diff-hl-edit nil t)
(add-hook (if vc-mode
;; Defer until the end of this hook, so that its
;; elements can modify the update behavior.
'diff-hl-mode-on-hook
;; If we're only opening the file now,
;; `vc-find-file-hook' likely hasn't run yet, so
;; let's wait until the state information is
;; saved, in order not to fetch it twice.
'find-file-hook)
'diff-hl-update t t)
(add-hook 'vc-checkin-hook 'diff-hl-update nil t)
(add-hook 'after-revert-hook 'diff-hl-update nil t)
;; Magit does call `auto-revert-handler', but it usually
;; doesn't do much, because `buffer-stale--default-function'
;; doesn't care about changed VC state.
;; https://github.com/magit/magit/issues/603
(add-hook 'magit-revert-buffer-hook 'diff-hl-update nil t)
;; Magit versions 2.0-2.3 don't do the above and call this
;; instead, but only when they don't call `revert-buffer':
(add-hook 'magit-not-reverted-hook 'diff-hl-update nil t)
(add-hook 'text-scale-mode-hook 'diff-hl-maybe-redefine-bitmaps nil t))
(remove-hook 'after-save-hook 'diff-hl-update t)
(remove-hook 'after-change-functions 'diff-hl-edit t)
(remove-hook 'find-file-hook 'diff-hl-update t)
(remove-hook 'vc-checkin-hook 'diff-hl-update t)
(remove-hook 'after-revert-hook 'diff-hl-update t)
(remove-hook 'magit-revert-buffer-hook 'diff-hl-update t)
(remove-hook 'magit-not-reverted-hook 'diff-hl-update t)
(remove-hook 'text-scale-mode-hook 'diff-hl-maybe-redefine-bitmaps t)
(diff-hl-remove-overlays)))
(when (require 'smartrep nil t)
(let (smart-keys)
(cl-labels ((scan (map)
(map-keymap
(lambda (event binding)
(if (consp binding)
(scan binding)
(when (characterp event)
(push (cons (string event) binding) smart-keys))))
map)))
(scan diff-hl-command-map)
(smartrep-define-key diff-hl-mode-map diff-hl-command-prefix smart-keys))))
(declare-function magit-toplevel "magit-git")
(declare-function magit-unstaged-files "magit-git")
(defvar diff-hl--magit-unstaged-files nil)
(defun diff-hl-magit-pre-refresh ()
(setq diff-hl--magit-unstaged-files (magit-unstaged-files t)))
(defun diff-hl-magit-post-refresh ()
(let* ((topdir (magit-toplevel))
(modified-files
(mapcar (lambda (file) (expand-file-name file topdir))
(delete-consecutive-dups
(sort
(nconc (magit-unstaged-files t)
diff-hl--magit-unstaged-files)
#'string<))))
(unmodified-states '(up-to-date ignored unregistered)))
(setq diff-hl--magit-unstaged-files nil)
(dolist (buf (buffer-list))
(when (and (buffer-local-value 'diff-hl-mode buf)
(not (buffer-modified-p buf))
;; Solve the "cloned indirect buffer" problem
;; (diff-hl-mode could be non-nil there, even if
;; buffer-file-name is nil):
(buffer-file-name buf)
(file-in-directory-p (buffer-file-name buf) topdir)
(file-exists-p (buffer-file-name buf)))
(with-current-buffer buf
(let* ((file buffer-file-name)
(backend (vc-backend file)))
(when backend
(cond
((member file modified-files)
(when (memq (vc-state file) unmodified-states)
(vc-state-refresh file backend))
(diff-hl-update))
((not (memq (vc-state file backend) unmodified-states))
(vc-state-refresh file backend)
(diff-hl-update))))))))))
(defun diff-hl-dir-update ()
(dolist (pair (if (vc-dir-marked-files)
(vc-dir-marked-only-files-and-states)
(vc-dir-child-files-and-states)))
(when (eq 'up-to-date (cdr pair))
(let ((buffer (find-buffer-visiting (car pair))))
(when buffer
(with-current-buffer buffer
(diff-hl-remove-overlays)))))))
(define-minor-mode diff-hl-dir-mode
"Toggle `diff-hl-mode' integration in a `vc-dir-mode' buffer."
:lighter ""
(if diff-hl-dir-mode
(add-hook 'vc-checkin-hook 'diff-hl-dir-update t t)
(remove-hook 'vc-checkin-hook 'diff-hl-dir-update t)))
;;;###autoload
(defun turn-on-diff-hl-mode ()
"Turn on `diff-hl-mode' or `diff-hl-dir-mode' in a buffer if appropriate."
(cond
(buffer-file-name
(diff-hl-mode 1))
((eq major-mode 'vc-dir-mode)
(diff-hl-dir-mode 1))))
;;;###autoload
(define-globalized-minor-mode global-diff-hl-mode diff-hl-mode
turn-on-diff-hl-mode :after-hook (diff-hl-global-mode-change))
(defun diff-hl-global-mode-change ()
(unless global-diff-hl-mode
(dolist (buf (buffer-list))
(with-current-buffer buf
(when diff-hl-dir-mode
(diff-hl-dir-mode -1))))))
(provide 'diff-hl)
;;; diff-hl.el ends here

674
lisp/emacs-application-framework/LICENSE Normal file
View File

@@ -0,0 +1,674 @@
GNU GENERAL PUBLIC LICENSE
Version 3, 29 June 2007
Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The GNU General Public License is a free, copyleft license for
software and other kinds of works.
The licenses for most software and other practical works are designed
to take away your freedom to share and change the works. By contrast,
the GNU General Public License is intended to guarantee your freedom to
share and change all versions of a program--to make sure it remains free
software for all its users. We, the Free Software Foundation, use the
GNU General Public License for most of our software; it applies also to
any other work released this way by its authors. You can apply it to
your programs, too.
When we speak of free software, we are referring to freedom, not
price. Our General Public Licenses are designed to make sure that you
have the freedom to distribute copies of free software (and charge for
them if you wish), that you receive source code or can get it if you
want it, that you can change the software or use pieces of it in new
free programs, and that you know you can do these things.
To protect your rights, we need to prevent others from denying you
these rights or asking you to surrender the rights. Therefore, you have
certain responsibilities if you distribute copies of the software, or if
you modify it: responsibilities to respect the freedom of others.
For example, if you distribute copies of such a program, whether
gratis or for a fee, you must pass on to the recipients the same
freedoms that you received. You must make sure that they, too, receive
or can get the source code. And you must show them these terms so they
know their rights.
Developers that use the GNU GPL protect your rights with two steps:
(1) assert copyright on the software, and (2) offer you this License
giving you legal permission to copy, distribute and/or modify it.
For the developers' and authors' protection, the GPL clearly explains
that there is no warranty for this free software. For both users' and
authors' sake, the GPL requires that modified versions be marked as
changed, so that their problems will not be attributed erroneously to
authors of previous versions.
Some devices are designed to deny users access to install or run
modified versions of the software inside them, although the manufacturer
can do so. This is fundamentally incompatible with the aim of
protecting users' freedom to change the software. The systematic
pattern of such abuse occurs in the area of products for individuals to
use, which is precisely where it is most unacceptable. Therefore, we
have designed this version of the GPL to prohibit the practice for those
products. If such problems arise substantially in other domains, we
stand ready to extend this provision to those domains in future versions
of the GPL, as needed to protect the freedom of users.
Finally, every program is threatened constantly by software patents.
States should not allow patents to restrict development and use of
software on general-purpose computers, but in those that do, we wish to
avoid the special danger that patents applied to a free program could
make it effectively proprietary. To prevent this, the GPL assures that
patents cannot be used to render the program non-free.
The precise terms and conditions for copying, distribution and
modification follow.
TERMS AND CONDITIONS
0. Definitions.
"This License" refers to version 3 of the GNU General Public License.
"Copyright" also means copyright-like laws that apply to other kinds of
works, such as semiconductor masks.
"The Program" refers to any copyrightable work licensed under this
License. Each licensee is addressed as "you". "Licensees" and
"recipients" may be individuals or organizations.
To "modify" a work means to copy from or adapt all or part of the work
in a fashion requiring copyright permission, other than the making of an
exact copy. The resulting work is called a "modified version" of the
earlier work or a work "based on" the earlier work.
A "covered work" means either the unmodified Program or a work based
on the Program.
To "propagate" a work means to do anything with it that, without
permission, would make you directly or secondarily liable for
infringement under applicable copyright law, except executing it on a
computer or modifying a private copy. Propagation includes copying,
distribution (with or without modification), making available to the
public, and in some countries other activities as well.
To "convey" a work means any kind of propagation that enables other
parties to make or receive copies. Mere interaction with a user through
a computer network, with no transfer of a copy, is not conveying.
An interactive user interface displays "Appropriate Legal Notices"
to the extent that it includes a convenient and prominently visible
feature that (1) displays an appropriate copyright notice, and (2)
tells the user that there is no warranty for the work (except to the
extent that warranties are provided), that licensees may convey the
work under this License, and how to view a copy of this License. If
the interface presents a list of user commands or options, such as a
menu, a prominent item in the list meets this criterion.
1. Source Code.
The "source code" for a work means the preferred form of the work
for making modifications to it. "Object code" means any non-source
form of a work.
A "Standard Interface" means an interface that either is an official
standard defined by a recognized standards body, or, in the case of
interfaces specified for a particular programming language, one that
is widely used among developers working in that language.
The "System Libraries" of an executable work include anything, other
than the work as a whole, that (a) is included in the normal form of
packaging a Major Component, but which is not part of that Major
Component, and (b) serves only to enable use of the work with that
Major Component, or to implement a Standard Interface for which an
implementation is available to the public in source code form. A
"Major Component", in this context, means a major essential component
(kernel, window system, and so on) of the specific operating system
(if any) on which the executable work runs, or a compiler used to
produce the work, or an object code interpreter used to run it.
The "Corresponding Source" for a work in object code form means all
the source code needed to generate, install, and (for an executable
work) run the object code and to modify the work, including scripts to
control those activities. However, it does not include the work's
System Libraries, or general-purpose tools or generally available free
programs which are used unmodified in performing those activities but
which are not part of the work. For example, Corresponding Source
includes interface definition files associated with source files for
the work, and the source code for shared libraries and dynamically
linked subprograms that the work is specifically designed to require,
such as by intimate data communication or control flow between those
subprograms and other parts of the work.
The Corresponding Source need not include anything that users
can regenerate automatically from other parts of the Corresponding
Source.
The Corresponding Source for a work in source code form is that
same work.
2. Basic Permissions.
All rights granted under this License are granted for the term of
copyright on the Program, and are irrevocable provided the stated
conditions are met. This License explicitly affirms your unlimited
permission to run the unmodified Program. The output from running a
covered work is covered by this License only if the output, given its
content, constitutes a covered work. This License acknowledges your
rights of fair use or other equivalent, as provided by copyright law.
You may make, run and propagate covered works that you do not
convey, without conditions so long as your license otherwise remains
in force. You may convey covered works to others for the sole purpose
of having them make modifications exclusively for you, or provide you
with facilities for running those works, provided that you comply with
the terms of this License in conveying all material for which you do
not control copyright. Those thus making or running the covered works
for you must do so exclusively on your behalf, under your direction
and control, on terms that prohibit them from making any copies of
your copyrighted material outside their relationship with you.
Conveying under any other circumstances is permitted solely under
the conditions stated below. Sublicensing is not allowed; section 10
makes it unnecessary.
3. Protecting Users' Legal Rights From Anti-Circumvention Law.
No covered work shall be deemed part of an effective technological
measure under any applicable law fulfilling obligations under article
11 of the WIPO copyright treaty adopted on 20 December 1996, or
similar laws prohibiting or restricting circumvention of such
measures.
When you convey a covered work, you waive any legal power to forbid
circumvention of technological measures to the extent such circumvention
is effected by exercising rights under this License with respect to
the covered work, and you disclaim any intention to limit operation or
modification of the work as a means of enforcing, against the work's
users, your or third parties' legal rights to forbid circumvention of
technological measures.
4. Conveying Verbatim Copies.
You may convey verbatim copies of the Program's source code as you
receive it, in any medium, provided that you conspicuously and
appropriately publish on each copy an appropriate copyright notice;
keep intact all notices stating that this License and any
non-permissive terms added in accord with section 7 apply to the code;
keep intact all notices of the absence of any warranty; and give all
recipients a copy of this License along with the Program.
You may charge any price or no price for each copy that you convey,
and you may offer support or warranty protection for a fee.
5. Conveying Modified Source Versions.
You may convey a work based on the Program, or the modifications to
produce it from the Program, in the form of source code under the
terms of section 4, provided that you also meet all of these conditions:
a) The work must carry prominent notices stating that you modified
it, and giving a relevant date.
b) The work must carry prominent notices stating that it is
released under this License and any conditions added under section
7. This requirement modifies the requirement in section 4 to
"keep intact all notices".
c) You must license the entire work, as a whole, under this
License to anyone who comes into possession of a copy. This
License will therefore apply, along with any applicable section 7
additional terms, to the whole of the work, and all its parts,
regardless of how they are packaged. This License gives no
permission to license the work in any other way, but it does not
invalidate such permission if you have separately received it.
d) If the work has interactive user interfaces, each must display
Appropriate Legal Notices; however, if the Program has interactive
interfaces that do not display Appropriate Legal Notices, your
work need not make them do so.
A compilation of a covered work with other separate and independent
works, which are not by their nature extensions of the covered work,
and which are not combined with it such as to form a larger program,
in or on a volume of a storage or distribution medium, is called an
"aggregate" if the compilation and its resulting copyright are not
used to limit the access or legal rights of the compilation's users
beyond what the individual works permit. Inclusion of a covered work
in an aggregate does not cause this License to apply to the other
parts of the aggregate.
6. Conveying Non-Source Forms.
You may convey a covered work in object code form under the terms
of sections 4 and 5, provided that you also convey the
machine-readable Corresponding Source under the terms of this License,
in one of these ways:
a) Convey the object code in, or embodied in, a physical product
(including a physical distribution medium), accompanied by the
Corresponding Source fixed on a durable physical medium
customarily used for software interchange.
b) Convey the object code in, or embodied in, a physical product
(including a physical distribution medium), accompanied by a
written offer, valid for at least three years and valid for as
long as you offer spare parts or customer support for that product
model, to give anyone who possesses the object code either (1) a
copy of the Corresponding Source for all the software in the
product that is covered by this License, on a durable physical
medium customarily used for software interchange, for a price no
more than your reasonable cost of physically performing this
conveying of source, or (2) access to copy the
Corresponding Source from a network server at no charge.
c) Convey individual copies of the object code with a copy of the
written offer to provide the Corresponding Source. This
alternative is allowed only occasionally and noncommercially, and
only if you received the object code with such an offer, in accord
with subsection 6b.
d) Convey the object code by offering access from a designated
place (gratis or for a charge), and offer equivalent access to the
Corresponding Source in the same way through the same place at no
further charge. You need not require recipients to copy the
Corresponding Source along with the object code. If the place to
copy the object code is a network server, the Corresponding Source
may be on a different server (operated by you or a third party)
that supports equivalent copying facilities, provided you maintain
clear directions next to the object code saying where to find the
Corresponding Source. Regardless of what server hosts the
Corresponding Source, you remain obligated to ensure that it is
available for as long as needed to satisfy these requirements.
e) Convey the object code using peer-to-peer transmission, provided
you inform other peers where the object code and Corresponding
Source of the work are being offered to the general public at no
charge under subsection 6d.
A separable portion of the object code, whose source code is excluded
from the Corresponding Source as a System Library, need not be
included in conveying the object code work.
A "User Product" is either (1) a "consumer product", which means any
tangible personal property which is normally used for personal, family,
or household purposes, or (2) anything designed or sold for incorporation
into a dwelling. In determining whether a product is a consumer product,
doubtful cases shall be resolved in favor of coverage. For a particular
product received by a particular user, "normally used" refers to a
typical or common use of that class of product, regardless of the status
of the particular user or of the way in which the particular user
actually uses, or expects or is expected to use, the product. A product
is a consumer product regardless of whether the product has substantial
commercial, industrial or non-consumer uses, unless such uses represent
the only significant mode of use of the product.
"Installation Information" for a User Product means any methods,
procedures, authorization keys, or other information required to install
and execute modified versions of a covered work in that User Product from
a modified version of its Corresponding Source. The information must
suffice to ensure that the continued functioning of the modified object
code is in no case prevented or interfered with solely because
modification has been made.
If you convey an object code work under this section in, or with, or
specifically for use in, a User Product, and the conveying occurs as
part of a transaction in which the right of possession and use of the
User Product is transferred to the recipient in perpetuity or for a
fixed term (regardless of how the transaction is characterized), the
Corresponding Source conveyed under this section must be accompanied
by the Installation Information. But this requirement does not apply
if neither you nor any third party retains the ability to install
modified object code on the User Product (for example, the work has
been installed in ROM).
The requirement to provide Installation Information does not include a
requirement to continue to provide support service, warranty, or updates
for a work that has been modified or installed by the recipient, or for
the User Product in which it has been modified or installed. Access to a
network may be denied when the modification itself materially and
adversely affects the operation of the network or violates the rules and
protocols for communication across the network.
Corresponding Source conveyed, and Installation Information provided,
in accord with this section must be in a format that is publicly
documented (and with an implementation available to the public in
source code form), and must require no special password or key for
unpacking, reading or copying.
7. Additional Terms.
"Additional permissions" are terms that supplement the terms of this
License by making exceptions from one or more of its conditions.
Additional permissions that are applicable to the entire Program shall
be treated as though they were included in this License, to the extent
that they are valid under applicable law. If additional permissions
apply only to part of the Program, that part may be used separately
under those permissions, but the entire Program remains governed by
this License without regard to the additional permissions.
When you convey a copy of a covered work, you may at your option
remove any additional permissions from that copy, or from any part of
it. (Additional permissions may be written to require their own
removal in certain cases when you modify the work.) You may place
additional permissions on material, added by you to a covered work,
for which you have or can give appropriate copyright permission.
Notwithstanding any other provision of this License, for material you
add to a covered work, you may (if authorized by the copyright holders of
that material) supplement the terms of this License with terms:
a) Disclaiming warranty or limiting liability differently from the
terms of sections 15 and 16 of this License; or
b) Requiring preservation of specified reasonable legal notices or
author attributions in that material or in the Appropriate Legal
Notices displayed by works containing it; or
c) Prohibiting misrepresentation of the origin of that material, or
requiring that modified versions of such material be marked in
reasonable ways as different from the original version; or
d) Limiting the use for publicity purposes of names of licensors or
authors of the material; or
e) Declining to grant rights under trademark law for use of some
trade names, trademarks, or service marks; or
f) Requiring indemnification of licensors and authors of that
material by anyone who conveys the material (or modified versions of
it) with contractual assumptions of liability to the recipient, for
any liability that these contractual assumptions directly impose on
those licensors and authors.
All other non-permissive additional terms are considered "further
restrictions" within the meaning of section 10. If the Program as you
received it, or any part of it, contains a notice stating that it is
governed by this License along with a term that is a further
restriction, you may remove that term. If a license document contains
a further restriction but permits relicensing or conveying under this
License, you may add to a covered work material governed by the terms
of that license document, provided that the further restriction does
not survive such relicensing or conveying.
If you add terms to a covered work in accord with this section, you
must place, in the relevant source files, a statement of the
additional terms that apply to those files, or a notice indicating
where to find the applicable terms.
Additional terms, permissive or non-permissive, may be stated in the
form of a separately written license, or stated as exceptions;
the above requirements apply either way.
8. Termination.
You may not propagate or modify a covered work except as expressly
provided under this License. Any attempt otherwise to propagate or
modify it is void, and will automatically terminate your rights under
this License (including any patent licenses granted under the third
paragraph of section 11).
However, if you cease all violation of this License, then your
license from a particular copyright holder is reinstated (a)
provisionally, unless and until the copyright holder explicitly and
finally terminates your license, and (b) permanently, if the copyright
holder fails to notify you of the violation by some reasonable means
prior to 60 days after the cessation.
Moreover, your license from a particular copyright holder is
reinstated permanently if the copyright holder notifies you of the
violation by some reasonable means, this is the first time you have
received notice of violation of this License (for any work) from that
copyright holder, and you cure the violation prior to 30 days after
your receipt of the notice.
Termination of your rights under this section does not terminate the
licenses of parties who have received copies or rights from you under
this License. If your rights have been terminated and not permanently
reinstated, you do not qualify to receive new licenses for the same
material under section 10.
9. Acceptance Not Required for Having Copies.
You are not required to accept this License in order to receive or
run a copy of the Program. Ancillary propagation of a covered work
occurring solely as a consequence of using peer-to-peer transmission
to receive a copy likewise does not require acceptance. However,
nothing other than this License grants you permission to propagate or
modify any covered work. These actions infringe copyright if you do
not accept this License. Therefore, by modifying or propagating a
covered work, you indicate your acceptance of this License to do so.
10. Automatic Licensing of Downstream Recipients.
Each time you convey a covered work, the recipient automatically
receives a license from the original licensors, to run, modify and
propagate that work, subject to this License. You are not responsible
for enforcing compliance by third parties with this License.
An "entity transaction" is a transaction transferring control of an
organization, or substantially all assets of one, or subdividing an
organization, or merging organizations. If propagation of a covered
work results from an entity transaction, each party to that
transaction who receives a copy of the work also receives whatever
licenses to the work the party's predecessor in interest had or could
give under the previous paragraph, plus a right to possession of the
Corresponding Source of the work from the predecessor in interest, if
the predecessor has it or can get it with reasonable efforts.
You may not impose any further restrictions on the exercise of the
rights granted or affirmed under this License. For example, you may
not impose a license fee, royalty, or other charge for exercise of
rights granted under this License, and you may not initiate litigation
(including a cross-claim or counterclaim in a lawsuit) alleging that
any patent claim is infringed by making, using, selling, offering for
sale, or importing the Program or any portion of it.
11. Patents.
A "contributor" is a copyright holder who authorizes use under this
License of the Program or a work on which the Program is based. The
work thus licensed is called the contributor's "contributor version".
A contributor's "essential patent claims" are all patent claims
owned or controlled by the contributor, whether already acquired or
hereafter acquired, that would be infringed by some manner, permitted
by this License, of making, using, or selling its contributor version,
but do not include claims that would be infringed only as a
consequence of further modification of the contributor version. For
purposes of this definition, "control" includes the right to grant
patent sublicenses in a manner consistent with the requirements of
this License.
Each contributor grants you a non-exclusive, worldwide, royalty-free
patent license under the contributor's essential patent claims, to
make, use, sell, offer for sale, import and otherwise run, modify and
propagate the contents of its contributor version.
In the following three paragraphs, a "patent license" is any express
agreement or commitment, however denominated, not to enforce a patent
(such as an express permission to practice a patent or covenant not to
sue for patent infringement). To "grant" such a patent license to a
party means to make such an agreement or commitment not to enforce a
patent against the party.
If you convey a covered work, knowingly relying on a patent license,
and the Corresponding Source of the work is not available for anyone
to copy, free of charge and under the terms of this License, through a
publicly available network server or other readily accessible means,
then you must either (1) cause the Corresponding Source to be so
available, or (2) arrange to deprive yourself of the benefit of the
patent license for this particular work, or (3) arrange, in a manner
consistent with the requirements of this License, to extend the patent
license to downstream recipients. "Knowingly relying" means you have
actual knowledge that, but for the patent license, your conveying the
covered work in a country, or your recipient's use of the covered work
in a country, would infringe one or more identifiable patents in that
country that you have reason to believe are valid.
If, pursuant to or in connection with a single transaction or
arrangement, you convey, or propagate by procuring conveyance of, a
covered work, and grant a patent license to some of the parties
receiving the covered work authorizing them to use, propagate, modify
or convey a specific copy of the covered work, then the patent license
you grant is automatically extended to all recipients of the covered
work and works based on it.
A patent license is "discriminatory" if it does not include within
the scope of its coverage, prohibits the exercise of, or is
conditioned on the non-exercise of one or more of the rights that are
specifically granted under this License. You may not convey a covered
work if you are a party to an arrangement with a third party that is
in the business of distributing software, under which you make payment
to the third party based on the extent of your activity of conveying
the work, and under which the third party grants, to any of the
parties who would receive the covered work from you, a discriminatory
patent license (a) in connection with copies of the covered work
conveyed by you (or copies made from those copies), or (b) primarily
for and in connection with specific products or compilations that
contain the covered work, unless you entered into that arrangement,
or that patent license was granted, prior to 28 March 2007.
Nothing in this License shall be construed as excluding or limiting
any implied license or other defenses to infringement that may
otherwise be available to you under applicable patent law.
12. No Surrender of Others' Freedom.
If conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License. If you cannot convey a
covered work so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you may
not convey it at all. For example, if you agree to terms that obligate you
to collect a royalty for further conveying from those to whom you convey
the Program, the only way you could satisfy both those terms and this
License would be to refrain entirely from conveying the Program.
13. Use with the GNU Affero General Public License.
Notwithstanding any other provision of this License, you have
permission to link or combine any covered work with a work licensed
under version 3 of the GNU Affero General Public License into a single
combined work, and to convey the resulting work. The terms of this
License will continue to apply to the part which is the covered work,
but the special requirements of the GNU Affero General Public License,
section 13, concerning interaction through a network will apply to the
combination as such.
14. Revised Versions of this License.
The Free Software Foundation may publish revised and/or new versions of
the GNU General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the
Program specifies that a certain numbered version of the GNU General
Public License "or any later version" applies to it, you have the
option of following the terms and conditions either of that numbered
version or of any later version published by the Free Software
Foundation. If the Program does not specify a version number of the
GNU General Public License, you may choose any version ever published
by the Free Software Foundation.
If the Program specifies that a proxy can decide which future
versions of the GNU General Public License can be used, that proxy's
public statement of acceptance of a version permanently authorizes you
to choose that version for the Program.
Later license versions may give you additional or different
permissions. However, no additional obligations are imposed on any
author or copyright holder as a result of your choosing to follow a
later version.
15. Disclaimer of Warranty.
THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
16. Limitation of Liability.
IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
SUCH DAMAGES.
17. Interpretation of Sections 15 and 16.
If the disclaimer of warranty and limitation of liability provided
above cannot be given local legal effect according to their terms,
reviewing courts shall apply local law that most closely approximates
an absolute waiver of all civil liability in connection with the
Program, unless a warranty or assumption of liability accompanies a
copy of the Program in return for a fee.
END OF TERMS AND CONDITIONS
How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to the public, the best way to achieve this is to make it
free software which everyone can redistribute and change under these terms.
To do so, attach the following notices to the program. It is safest
to attach them to the start of each source file to most effectively
state the exclusion of warranty; and each file should have at least
the "copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) <year> <name of author>
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/>.
Also add information on how to contact you by electronic and paper mail.
If the program does terminal interaction, make it output a short
notice like this when it starts in an interactive mode:
<program> Copyright (C) <year> <name of author>
This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the appropriate
parts of the General Public License. Of course, your program's commands
might be different; for a GUI interface, you would use an "about box".
You should also get your employer (if you work as a programmer) or school,
if any, to sign a "copyright disclaimer" for the program, if necessary.
For more information on this, and how to apply and follow the GNU GPL, see
<http://www.gnu.org/licenses/>.
The GNU General Public License does not permit incorporating your program
into proprietary programs. If your program is a subroutine library, you
may consider it more useful to permit linking proprietary applications with
the library. If this is what you want to do, use the GNU Lesser General
Public License instead of this License. But first, please read
<http://www.gnu.org/philosophy/why-not-lgpl.html>.

257
lisp/emacs-application-framework/README.md Normal file
View File

@@ -0,0 +1,257 @@
English | [简体中文](./README.zh-CN.md)
# Emacs Application Framework (EAF)
EAF is a GUI application framework that revolutionizes Emacs graphical capabilities to ultimately *Live in Emacs*.
## EAF Application Overview
EAF is an extensible framework, one can develop any Qt5 application and integrate it into Emacs.
| Browser | Markdown Previewer |
| :--------: | :----: |
| <img src="./screenshot/browser.gif" width="400"> | <img src="./screenshot/markdown_previewer.gif" width="400"> |
| Image Viewer | Video Player |
| :--------: | :----: |
| <img src="./screenshot/image_viewer.gif" width="400"> | <img src="./screenshot/video_player.gif" width="400"> |
| | |
| PDF Viewer | Camera |
| :--------: | :----: |
| <img src="./screenshot/pdf_viewer.gif" width="400"> | <img src="./screenshot/camera.gif" width="400"> |
| | |
| File Sender | File Receiver |
| :--------: | :----: |
| <img src="./screenshot/file_transfer.png" width="400"> | <img src="./screenshot/file_browser.png" width="400"> |
| | |
| Air Share | Org Previewer |
| :--------: | :--------: |
| <img src="./screenshot/air_share.png" width="400"> | <img src="./screenshot/org_previewer.gif" width="400"> |
| | |
| Terminal Emulator | RSS Reader |
| :--------: | :------: |
| <img src="./screenshot/terminal.gif" width="400"> | <img src="./screenshot/rss_reader.gif" width="400"> |
| | |
| Aria2 Download Manager | Mind Map |
| :--------: | :-------: |
| <img src="./screenshot/aria2.gif" width="400"> | <img src="./screenshot/mindmap.gif" width="400"> |
| | |
| Mermaid | EAF Interleave |
| :--------: | :----------: |
| <img src="./screenshot/mermaid.gif" width="400"> | <img src="./screenshot/eaf-interleave.gif" width="400"> |
| | |
## Install
1. Install EAF dependencies, an explaination of each dependency can be found in [Dependency List](#dependency-list).
The following line is for *Archlinux*, same packages should be available to install on your particular distribution:
```Bash
yay -S python-pyqt5 python-pyqt5-sip python-pyqtwebengine python-qrcode python-feedparser python-dbus python-pyinotify python-markdown nodejs aria2 libreoffice python-pymupdf python-grip filebrowser-bin
```
2. Clone this repository.
```Bash
git clone https://github.com/manateelazycat/emacs-application-framework.git --depth=1
```
3. Add the full path to the EAF installation directory to your Emacs ```load-path```, then add the following to `init.el`:
```Elisp
(require 'eaf)
```
If you use [use-package](https://github.com/jwiegley/use-package), a sample configuration has been provided.
```Elisp
(use-package eaf
:load-path "~/.emacs.d/site-lisp/emacs-application-framework" ; Set to "/usr/share/emacs/site-lisp/eaf" if installed from AUR
:custom
(eaf-find-alternate-file-in-dired t)
:config
(eaf-bind-key scroll_up "C-n" eaf-pdf-viewer-keybinding)
(eaf-bind-key scroll_down "C-p" eaf-pdf-viewer-keybinding)
(eaf-bind-key take_photo "p" eaf-camera-keybinding))
```
---
If you use [Chemacs](https://github.com/plexus/chemacs), a sample `init.el` is provided as follows:
```Elisp
;; An example of init.el
(defun add-subdirs-to-load-path (dir)
"Recursive add directories to `load-path'."
(let ((default-directory (file-name-as-directory dir)))
(add-to-list 'load-path dir)
(normal-top-level-add-subdirs-to-load-path)))
(add-subdirs-to-load-path "~/.emacs.d/")
(require 'eaf)
```
During EAF installation, you only need to modify the parameter value when calling function `add-subdirs-to-load-path`, change it into your full path to the EAF installation directory. The sample gives a situation when you install EAF at `~/.emacs.d/`.
After EAF installation, let's assume your EAF installation directory is `~/eaf`, you only have Emacs configurations at `~/.emacs.d` and EAF installed on your computer, and you have installed Chemacs, then the `.emacs-profiles.el` should look like this:
```Elisp
(("default" . ((user-emacs-directory . "~/.emacs.d")))
("EAF" . ((user-emacs-directory . "~/eaf"))))
```
When you want to use EAF by chemacs, you can excute `emacs --with-profile EAF` in the terminal.
### Dependency List
Packages listed as **Core** are mandatory for EAF to work, whereas other packages are optional - install if you want to use corresponding EAF Application.
| Package | Dependent | Description |
| :-------- | :------ | :------ |
| python-pyqt5, python-pyqt5-sip | Core | Essential GUI library |
| python-dbus | Core | DBus IPC to connect Python with Elisp |
| python-pyqtwebengine | Core | Chromium based web rendering engine |
| python-pymupdf | PDF Viewer | PDF rendering engine |
| python-grip | Markdown Previewer | Markdown rendering server |
| python-qrcode | File Sender, File Receiver, Airshare | Render QR code pointing to local files |
| python-feedparser | RSS Reader | Parse RSS feeds |
| python-pyinotify | Mermaid | Monitor *.mmd file change status |
| python-markdown | Mermaid | Covert markdown format to mermaid html format |
| nodejs | Terminal | Communicate between browser and local TTY |
| aria2 | Browser | Download files from the web |
| libreoffice | Doc Viewer | Convert doc file to pdf |
| filebrowser-bin | File Browser | Share files between computer and smartphone |
## Launch EAF Applications
| Application Name | Launch |
| :-------- | :---- |
| Browser | `M-x eaf-open-browser` Search or Goto URL |
| | `M-x eaf-open-browser-with-history` Search or Goto URL or Goto History |
| HTML Email Renderer | `M-x eaf-open-mail-as-html` in `gnus`, `mu4e`, `notmuch` HTMl Mail |
| PDF Viewer | `M-x eaf-open` PDF File |
| Video Player | `M-x eaf-open` Video File |
| Image Viewer | `M-x eaf-open` Image File |
| Markdown Previewer | `M-x eaf-open` Markdown File |
| Org Previewer | `M-x eaf-open` Org File |
| Camera | `M-x eaf-open-camera` |
| Terminal | `M-x eaf-open-terminal` |
| File Sender | `M-x eaf-file-sender-qrcode` or `eaf-file-sender-qrcode-in-dired` |
| File Browser | `M-x eaf-file-browser-qrcode` |
| Airshare | `M-x eaf-open-airshare` |
| RSS Reader | `M-x eaf-open-rss-reader` |
| Mindmap | `M-x eaf-create-mindmap` or `M-x eaf-open-mindmap` |
| MS Office Viewer | `M-x eaf-open-office` |
| Mermaid | `M-x eaf-open` Mermaid file (*.mmd) |
| Demo | `M-x eaf-open-demo` to verify basic functionality |
- To open the file under the cursor in `dired` using appropriate EAF Application, use `eaf-open-this-from-dired` instead.
- EAF Browser and PDF Viewer support Emacs built-in bookmark operation, with `M-x bookmark-set` (defaulted to `C-x r m`) and `M-x bookmark-bmenu-list` (defaulted to `C-x r l`).
```
NOTE:
EAF use DBus' session bus, it must run by a general user.
Please don't use EAF when Emacs is started with sudo or root user, a root user can only access DBus's system bus.
```
## Wiki
It is **highly** suggested to read the [Wiki](https://github.com/manateelazycat/emacs-application-framework/wiki) first before using EAF.
Wiki consists of documentations on Keybinding, Customization, Design and TODOLIST. There also are some helpful tips to make EAF work with Docker, Helm, etc.
## FAQ
### How does EAF work?
EAF implements three major functionalities:
1. Integrate PyQt program window into Emacs frame using QWindow Reparent technology.
2. Listen to EAF buffer's keyboard event flow and control the keyboard input of PyQt program via DBus IPC.
3. Create a window compositer to make a PyQt program window adapt Emacs's Window/Buffer design.
### EAF vs EXWM?
1. EAF and EXWM share a common goal: enhance collaboration between the standard GNU Emacs with other GUI tools.
2. EXWM is an X11 Window Manager, it manages and controls other software using a keyboard, but it cannot modify, customize and extend the behavior of other software. For example, it cannot modify the behavior when you press a key in Chrome or a PDF viewer.
3. EAF is *not* a Window Manager, it utilizes the windows managing capabilities of Emacs to display its applications.
4. The intention of EAF is to provide a framework to write PyQt5 applications that extends the multimedia experience of Emacs. From the perspective of Emacs' buffer/mode design, EAF is not different from any other package, with the former uses Qt for drawing contents while the latter uses Emacs' built-in text libraries instead.
5. Through EAF's design, one can use Elisp to control Python and vice versa, and even able to use Elisp to control JavaScript in EAF Browser. EAF enables Emacs to the world of **multi-language scripting**.
Both projects are similar in terms of interface, but they are two completely different projects with different goals in mind. Sometimes one may find EAF is more suitable than EXWM, sometimes it's the other way around. Please do not meaninglessly compare them.
### EAF is (currently) Linux only. Why?
1. DBus is Linux-specific technology, it's difficult to support DBus in other operating systems.
2. Qt5's QGraphicsScene technology does not work on MacOS.
If you've figure them out, PRs are always welcome!
### `[EAF] *eaf* aborted (core dumped)` error
Please check the `*eaf*` buffer, something is wrong on the Python side. Usually due to Python dependencies are not installed correctly.
If you're sure Python dependences are installed correctly, please create an issue with the `*eaf*` buffer content, it contains many clues that can help us locate the problem faster.
### What is Github Personal Access Tokens?
If you use EAF Markdown Previewer, to get consistent previewing, you need to access [Github Personal access token site](https://github.com/settings/tokens/new?scopes=), fill something in "Token description" and click button "Generate token" to get your personal token. Then set the token:
```Elisp
(setq eaf-grip-token "yourtokencode")
```
Although Markdown Previewer works for the first few times by entering empty string when prompted, eventually it stops working and gives "GitHub Rate Limit Reached" error.
### Proxy
If you need to use proxy to access internet, one can configure the proxy settings.
```Elisp
(setq eaf-proxy-type "http")
(setq eaf-proxy-host "127.0.0.1")
(setq eaf-proxy-port "1080")
```
If you use Socks5 as local proxy, one can set proxy type with:
```Elisp
(setq eaf-proxy-type "socks5")
```
## EAF in the community
A list of other community packages that use EAF to enhance their graphical experiences!
If we missed your package, please make a PR to add it to the list.
* ***[obr-viz](https://github.com/swhalemwo/obr-viz)***: visualizing [org-brain](https://github.com/Kungsgeten/org-brain) relationships using EAF
## Report bug
For any installation and configuration assistance, please read the [Wiki](https://github.com/manateelazycat/emacs-application-framework/wiki) first!
If you encounter any problem with EAF, please use command `emacs -q` with a minimal setup that only contains EAF and verify the bug is reproducible. If `emacs -q` works fine, probably something is wrong with your Emacs config.
If the problem persists, please [report bug here](https://github.com/manateelazycat/emacs-application-framework/issues/new).
If you got segfault error, please use the following way to collect crash information:
1. Install gdb and turn on option `eaf-enable-debug`
2. Use command `eaf-stop-process` stop current process
3. Restart eaf, send issue with `*eaf*` buffer content when next crash
## Join Us
Do you want to make Emacs a real "operating system"?
Do you want to live in Emacs more comfortably?
Do you want to revolutionize the capabilities of Emacs?
[Let's hack together!](https://github.com/manateelazycat/emacs-application-framework/wiki/Hacking)
## 打赏
如果我的作品让你的生活充满快乐, 欢迎请我喝瓶啤酒, 哈哈哈哈
### ManateeLazyCat
<p float="left">
<img src="./screenshot/alipay.jpg" width="188">
<img src="./screenshot/wechat.jpg" width="200">
</p>

252
lisp/emacs-application-framework/README.zh-CN.md Normal file
View File

@@ -0,0 +1,252 @@
[English](./README.md) | 简体中文
# Emacs Application Framework (EAF)
EAF 是一个全新的图形应用框架，通过扩展Emacs的多媒体能力，最终达到 Live in Emacs 的终极目标。
## EAF 应用展示
EAF是一个可编程扩展的框架，你可以开发自己的Qt5应用并集成在Emacs中。
| 浏览器 | Markdown预览程序 |
| :--------: | :----: |
| <img src="./screenshot/browser.gif" width="400"> | <img src="./screenshot/markdown_previewer.gif" width="400"> |
| 图片浏览器 | 视频播放器 |
| :--------: | :----: |
| <img src="./screenshot/image_viewer.gif" width="400"> | <img src="./screenshot/video_player.gif" width="400"> |
| | |
| PDF阅读器 | 摄像头程序 |
| :--------: | :----: |
| <img src="./screenshot/pdf_viewer.gif" width="400"> | <img src="./screenshot/camera.gif" width="400"> |
| | |
| 二维码下载文件 (PC到手机) | 二维码上传文件 (手机到PC) |
| :--------: | :----: |
| <img src="./screenshot/file_transfer.png" width="400"> | <img src="./screenshot/file_browser.png" width="400"> |
| | |
| 无线文字传输程序 | Org预览 |
| :--------: | :--------: |
| <img src="./screenshot/air_share.png" width="400"> | <img src="./screenshot/org_previewer.gif" width="400"> |
| | |
| 终端模拟器 | RSS阅读器 |
| :--------: | :------: |
| <img src="./screenshot/terminal.gif" width="400"> | <img src="./screenshot/rss_reader.gif" width="400"> |
| | |
| Aria2 下载管理器 | 思维导图 |
| :--------: | :-------: |
| <img src="./screenshot/aria2.gif" width="400"> | <img src="./screenshot/mindmap.gif" width="400"> |
| | |
| 流程图 | 笔记管理系统 |
| :--------: | :--------: |
| <img src="./screenshot/mermaid.gif" width="400"> | <img src="./screenshot/eaf-interleave.gif" width="400"> |
| | |
## 安装
1. 安装EAF依赖，对于每个依赖的解释可以在[依赖列表](#依赖列表)找到。
以下这行是针对*Archlinux*，同样的包的安装方式在别的发行版略有不同，请善用搜索引擎：
```Bash
yay -S python-pyqt5 python-pyqt5-sip python-pyqtwebengine python-qrcode python-feedparser python-dbus python-pyinotify python-markdown nodejs aria2 libreoffice python-pymupdf python-grip filebrowser-bin
```
2. 使用 ```git clone``` 下载这个仓库.
```Bash
git clone https://github.com/manateelazycat/emacs-application-framework.git --depth=1
```
3. 把EAF加入Emacs的 ```load-path```，然后在 `init.el` 中写入:
```Elisp
(require 'eaf)
```
如果你使用[use-package](https://github.com/jwiegley/use-package)，下面有一个简单的配置文件供你参考:
```Elisp
(use-package eaf
:load-path "~/.emacs.d/site-lisp/emacs-application-framework" ; Set to "/usr/share/emacs/site-lisp/eaf" if installed from AUR
:custom
(eaf-find-alternate-file-in-dired t)
:config
(eaf-bind-key scroll_up "C-n" eaf-pdf-viewer-keybinding)
(eaf-bind-key scroll_down "C-p" eaf-pdf-viewer-keybinding)
(eaf-bind-key take_photo "p" eaf-camera-keybinding))
```
---
如果你使用[Chemacs](https://github.com/plexus/chemacs)， 下面是一份 `init.el`的配置示例：
```Elisp
;; An example of init.el
(defun add-subdirs-to-load-path (dir)
"Recursive add directories to `load-path'."
(let ((default-directory (file-name-as-directory dir)))
(add-to-list 'load-path dir)
(normal-top-level-add-subdirs-to-load-path)))
(add-subdirs-to-load-path "~/.emacs.d/")
(require 'eaf)
```
在安装EAF时，你仅需要修改此文件中调用函数`add-subdirs-to-load-path`的参数值，将其更改为你的EAF安装位置的绝对路径。 配置示例中的EAF是安装在`~/.emacs.d/`.
在EAF安装完成后，假设你将它安装到了`~/eaf`,你电脑中只有存放在`~/.emacs.d`的Emacs配置文件和安装的EAF，并且你电脑中安装了Chemacs，此时`.emacs-profiles.el`应该这样配置:
```Elisp
(("default" . ((user-emacs-directory . "~/.emacs.d")))
("EAF" . ((user-emacs-directory . "~/eaf"))))
```
当你想使用Chemacs打开EAF，只需在终端中执行`emacs --with-profile EAF`。
### 依赖列表
**核心** 分类代表必备依赖，这些包必须安装好EAF才能工作。其余依赖都可选，若想其使用对应的应用时，你才需要安装这些依赖。当然我们推荐先把所有依赖都安装好，等到真正使用的时候就不用再次折腾。
| 包名 | 依赖 | 解释 |
| :-------- | :------ | :------ |
| python-pyqt5, python-pyqt5-sip | 核心 | GUI图形库 |
| python-dbus | 核心 | DBus库，用于在Emacs和Python进程间通讯 |
| python-pyqtwebengine | 核心 | 基于Chromium的浏览器引擎 |
| python-pymupdf | PDF阅读器 | 解析PDF文件 |
| python-grip | Markdown预览 | 建立Markdown文件的HTML服务 |
| python-qrcode | 文件上传，文件下载，文字传输 | 根据文件信息生成二维码 |
| python-feedparser | RSS阅读器 | 解析RSS/Atom信息 |
| python-pyinotify | 流程图 | 监听 mmd 格式文件的变动 |
| python-markdown | 流程图 | 转换 mmd 格式为 mermaid 识别的 html 格式 |
| aria2 | 浏览器 | 下载网络文件 |
| nodejs | 终端模拟器 | 通过浏览器与本地TTY交互 |
| libreoffice | 办公文档阅读器 | 转换doc文件为pdf格式 |
| filebrowser-bin | 文件浏览器 | 在电脑和手机之间快速共享文件 |
## EAF应用启动命令
| 应用名称 | 启动命令 |
| :-------- | :---- |
| 浏览器 | `M-x eaf-open-browser` 在浏览器中打开或搜索 |
| | `M-x eaf-open-browser-with-history` 搜索历史或者打开URL |
| HTML邮件渲染 | `M-x eaf-open-mail-as-html` 在 `gnus`，`mu4e`，`notmuch` 等邮件客户端中执行 |
| PDF阅读器 | `M-x eaf-open` 输入PDF文件 |
| 视频播放器 | `M-x eaf-open` 输入视频文件 |
| 图片浏览器 | `M-x eaf-open` 输入图片文件 |
| Markdown预览 | `M-x eaf-open` 输入Markdown文件 |
| Org预览 | `M-x eaf-open` 输入Org文件 |
| 摄像头程序 | `M-x eaf-open-camera` |
| 终端模拟器 | `M-x eaf-open-terminal` |
| 二维码下载文件 | `M-x eaf-file-sender-qrcode` or `eaf-file-sender-qrcode-in-dired` |
| 二维码在线浏览器 | `M-x eaf-file-browser-qrcode` |
| 无线分享 | `M-x eaf-open-airshare` 输入要分享给手机的字符串 |
| RSS新闻阅读器 | `M-x eaf-open-rss-reader` |
| 思维导图 | `M-x eaf-create-mindmap` or `M-x eaf-open-mindmap` |
| 微软Office阅读器 | `M-x eaf-open-office` |
| 流程图 | `M-x eaf-open` 输入 mmd 格式文件 |
| 演示程序 | `M-x eaf-open-demo` |
- 在`dired`文件管理器中，建议绑定按键到命令 `eaf-open-this-from-dired` ，它会自动用合适的EAF应用来打开文件。
- EAF浏览器以及PDF浏览器支持Emacs内置书签操作，通过使用`M-x bookmark-set`（默认`C-x r m`）以及`M-x bookmark-bmenu-list`（默认`C-x r l`）。
```
注意：
EAF使用DBus的普通权限总线 (session bus)，请不要用 sudo 来启动EAF，root用户只能访问系统权限总线 (system bus)
```
## Wiki
强烈建议使用EAF之前浏览一遍[Wiki](https://github.com/manateelazycat/emacs-application-framework/wiki)。
Wiki包括架构设计，按键绑定，自定义选项和任务列表等文档。你还会在Wiki发现很多有用的技巧，比如Docker，Helm等，
## 常用问题
### EAF是怎么工作的？
EAF主要实现这几个功能：
1. 利用QWindow的Reparent技术来实现PyQt应用进程的窗口粘贴到Emacs对应的Buffer区域
2. 通过DBus IPC来实现Emacs进程和Python进程的控制指令和跨进程消息通讯
3. 通过Qt5的QGraphicsScene来实现镜像窗口，以对应Emacs的Buffer/Window模型
### EAF vs EXWM?
1. EAF和EXWM的共同点都是：“提升Emacs和别的程序的协作效率“
2. EXWM是一个X11窗口管理器，通过X11协议来控制Emacs和其他程序，但是EXWM只是管理其他程序，但是它并不会修改别的程序。比如它没法修改Chrome，PDF阅读器等GUI程序内在的行为
3. EAF不是一个窗口管理器，EAF只是依赖Emacs自身的窗口管理功能显示自己
4. EAF的目标是通过PyQt创造新的应用来扩展Emacs的多媒体能力。从Emacs本身的Buffer/Mode设计上看，它和你平常用的 `xx-mode` 插件没有啥区别，只是它用Qt来绘制内容，而不是Emacs自身的文本库来绘制内容
5. EAF通过造轮子的方式，把大多数程序员常用的应用写出来以后，达到Live in Emacs的最终目标
6. 基于EAF的架构设计，我们可以通过Elisp来控制Python，JavaScript和其他命令行工具，实现多语言扩展Emacs的编程模型。在坚持Emacs黑客文化和Elisp社区兼容性的前提下，让Emacs的多媒体能力能够跟上时代的发展
或许EAF和EXWM看起来有点相似，但它们在设计和理念上是两个完全不同的项目。所以请大家多多学习X11和Qt的区别，理解技术的本质，避免无意义的比较和争论。
### 为什么EAF只能在Linux下工作？
1. DBus是Linux下专用的进程间通讯技术，其他操作系统可能无法支持DBus
2. Qt5的QGraphicsScene技术无法在MacOS下正常工作，也就无法实现Qt5应用的镜像窗口以支持Emacs的Buffer/Window模型
欢迎操作系统级别黑客移植EAF，目前为止，我知道的主要的迁移障碍就只有两个：DBus，QGraphicsScene
### `[EAF] *eaf* aborted (core dumped)` 奔溃了怎么办？
请检查 `*eaf*` 这个窗口的内容。通常是EAF的Python依赖没有安装好，如果你确定依赖没有问题，请附带 `*eaf*` 窗口的内容给我们提交issue，那里面有很多线索可以帮助我们排查问题。
### Github 个人访问标记干什么用的？
Markdown预览程序依赖grip，你需要访问[Github Personal access token](https://github.com/settings/tokens/new?scopes=)去获取你个人的标记，然后通过下面的命令设置标记后，grip才能正常的工作：
```Elisp
(setq eaf-grip-token "yourtokencode")
```
尽管不设置访问标记一开始也能成功使用，但Github过段时间会弹出 "GitHub Rate Limit Reached" 的错误。
### 代理
可以通过下面设置来通过代理访问互联网：
```Elisp
(setq eaf-proxy-type "http")
(setq eaf-proxy-host "127.0.0.1")
(setq eaf-proxy-port "1080")
```
如果你使用Socks5代理，你可以设置代理类型为：
```Elisp
(setq eaf-proxy-type "socks5")
```
## EAF社区
下面列表列展示了EAF在Emacs社区的应用。如果我们遗漏你的应用，欢迎提交PR来加到下面列表中。
* ***[obr-viz](https://github.com/swhalemwo/obr-viz)***: visualizing [org-brain](https://github.com/Kungsgeten/org-brain) relationships using EAF
## 反馈问题
### 反馈安装和配置问题之前，请一定先阅读[Wiki](https://github.com/manateelazycat/emacs-application-framework/wiki)!!!
如果你遇到任何问题，请先用命令 `emacs -q` 并只添加EAF配置，做一个对比测试，如果 `emacs -q` 的时候可以工作，请检查你个人的配置文件。
如果```emacs -q```环境下问题依旧，请到[这里](https://github.com/manateelazycat/emacs-application-framework/issues/new)反馈。
如果你遇到崩溃的问题, 请用下面的方式来收集崩溃信息:
1. 先安装gdb并打开选项 `eaf-enable-debug`
2. 使用命令 `eaf-stop-process` 停止EAF进程
3. 重新打开EAF, 并在下次崩溃时发送 `*eaf*` 的内容
## 加入我们
你想把Emacs开发成一个操作系统吗？
想要在Emacs里面生活的更舒适吗？
想要创建下一个激动人心的Emacs插件吗？
[一起疯吧!](https://github.com/manateelazycat/emacs-application-framework/wiki/Hacking)
## 打赏
如果我的作品让你的生活充满快乐，欢迎请我喝瓶啤酒，哈哈哈哈
### ManateeLazyCat
<p float="left">
<img src="./screenshot/alipay.jpg" width="188">
<img src="./screenshot/wechat.jpg" width="200">
</p>

0
lisp/emacs-application-framework/app/__init__.py Normal file
View File

104
lisp/emacs-application-framework/app/airshare/buffer.py Normal file
View File

@@ -0,0 +1,104 @@
#!/usr/bin/env python3
# -*- coding: utf-8 -*-
# Copyright (C) 2018 Andy Stewart
#
# Author: Andy Stewart <lazycat.manatee@gmail.com>
# Maintainer: Andy Stewart <lazycat.manatee@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
# 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/>.
from PyQt5 import QtGui, QtCore
from PyQt5.QtCore import Qt
from PyQt5.QtGui import QColor, QFont
from PyQt5.QtWidgets import QWidget, QLabel, QVBoxLayout
from core.buffer import Buffer
import qrcode
class AppBuffer(Buffer):
def __init__(self, buffer_id, url, config_dir, arguments, emacs_var_dict, module_path):
Buffer.__init__(self, buffer_id, url, arguments, emacs_var_dict, module_path, False)
self.add_widget(AirShareWidget(url, QColor(0, 0, 0, 255)))
class Image(qrcode.image.base.BaseImage):
def __init__(self, border, width, box_size):
self.border = border
self.width = width
self.box_size = box_size
size = (width + border * 2) * box_size
self._image = QtGui.QImage(size, size, QtGui.QImage.Format_RGB16)
self._image.fill(QtCore.Qt.white)
def pixmap(self):
return QtGui.QPixmap.fromImage(self._image)
def drawrect(self, row, col):
painter = QtGui.QPainter(self._image)
painter.fillRect(
(col + self.border) * self.box_size,
(row + self.border) * self.box_size,
self.box_size, self.box_size,
QtCore.Qt.black)
def save(self, stream, kind=None):
pass
class AirShareWidget(QWidget):
def __init__(self, url, color):
QWidget.__init__(self)
self.setStyleSheet("background-color: black")
self.file_name_font = QFont()
self.file_name_font.setPointSize(24)
self.file_name_label = QLabel(self)
self.file_name_label.setText(url)
self.file_name_label.setFont(self.file_name_font)
self.file_name_label.setAlignment(Qt.AlignCenter)
self.file_name_label.setStyleSheet("color: #eee")
self.qrcode_label = QLabel(self)
self.notify_font = QFont()
self.notify_font.setPointSize(12)
self.notify_label = QLabel(self)
self.notify_label.setText("Scan QR code above to copy data.")
self.notify_label.setFont(self.notify_font)
self.notify_label.setAlignment(Qt.AlignCenter)
self.notify_label.setStyleSheet("color: #eee")
layout = QVBoxLayout(self)
layout.setContentsMargins(0, 0, 0, 0)
layout.addStretch()
layout.addWidget(self.qrcode_label, 0, Qt.AlignCenter)
layout.addSpacing(20)
layout.addWidget(self.file_name_label, 0, Qt.AlignCenter)
layout.addSpacing(40)
layout.addWidget(self.notify_label, 0, Qt.AlignCenter)
layout.addStretch()
self.qrcode_label.setPixmap(qrcode.make(url, image_factory=Image).pixmap())
if __name__ == "__main__":
from PyQt5.QtWidgets import QApplication
import sys
import signal
app = QApplication(sys.argv)
test = AirShareWidget("/home/andy/rms/1.jpg", QColor(0, 0, 0, 255))
test.show()
signal.signal(signal.SIGINT, signal.SIG_DFL)
sys.exit(app.exec_())

60
lisp/emacs-application-framework/app/browser/buffer.py Normal file
View File

@@ -0,0 +1,60 @@
#!/usr/bin/env python3
# -*- coding: utf-8 -*-
# Copyright (C) 2018 Andy Stewart
#
# Author: Andy Stewart <lazycat.manatee@gmail.com>
# Maintainer: Andy Stewart <lazycat.manatee@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
# 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/>.
from PyQt5.QtCore import QUrl
from PyQt5.QtGui import QColor
from core.browser import BrowserBuffer
from core.utils import touch
import os
class AppBuffer(BrowserBuffer):
def __init__(self, buffer_id, url, config_dir, arguments, emacs_var_dict, module_path):
BrowserBuffer.__init__(self, buffer_id, url, config_dir, arguments, emacs_var_dict, module_path, False)
self.config_dir = config_dir
# When arguments is "temp_html_file", browser will load content of html file, then delete temp file.
# Usually use for render html mail.
if arguments == "temp_html_file":
with open(url, "r") as html_file:
self.buffer_widget.setHtml(html_file.read())
if os.path.exists(url):
os.remove(url)
else:
self.buffer_widget.setUrl(QUrl(url))
self.close_page.connect(self.record_close_page)
self.buffer_widget.titleChanged.connect(self.record_history)
self.buffer_widget.titleChanged.connect(self.change_title)
self.buffer_widget.translate_selected_text.connect(self.translate_text)
self.buffer_widget.open_url_in_new_tab.connect(self.open_url_in_new_tab)
self.buffer_widget.open_url_in_background_tab.connect(self.open_url_in_background_tab)
# Reset to default zoom when page init or url changed.
self.reset_default_zoom()
self.buffer_widget.urlChanged.connect(self.update_url)
def update_url(self, url):
self.reset_default_zoom()
self.url = self.buffer_widget.url().toString()

113
lisp/emacs-application-framework/app/camera/buffer.py Normal file
View File

@@ -0,0 +1,113 @@
#!/usr/bin/env python3
# -*- coding: utf-8 -*-
# Copyright (C) 2018 Andy Stewart
#
# Author: Andy Stewart <lazycat.manatee@gmail.com>
# Maintainer: Andy Stewart <lazycat.manatee@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
# 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/>.
from PyQt5.QtCore import Qt, QSizeF
from PyQt5.QtGui import QBrush
from PyQt5.QtGui import QColor
from PyQt5.QtMultimedia import QCameraInfo, QCamera, QCameraImageCapture
from PyQt5.QtMultimediaWidgets import QGraphicsVideoItem
from PyQt5.QtWidgets import QGraphicsScene, QGraphicsView
from PyQt5.QtWidgets import QWidget, QVBoxLayout
from core.buffer import Buffer
from pathlib import Path
import time
import os
class AppBuffer(Buffer):
def __init__(self, buffer_id, url, config_dir, arguments, emacs_var_dict, module_path):
Buffer.__init__(self, buffer_id, url, arguments, emacs_var_dict, module_path, True)
self.add_widget(CameraWidget(QColor(0, 0, 0, 255)))
def all_views_hide(self):
# Need stop camera if all view will hide, otherwise camera will crash.
self.buffer_widget.camera.stop()
def some_view_show(self):
# Re-start camero after some view show.
self.buffer_widget.camera.start()
def take_photo(self):
if os.path.exists(os.path.expanduser(self.emacs_var_dict["eaf-camera-save-path"])):
self.buffer_widget.take_photo(self.emacs_var_dict["eaf-camera-save-path"])
else:
self.buffer_widget.take_photo("~/Downloads")
def destroy_buffer(self):
self.buffer_widget.stop_camera()
super().destroy_buffer()
class CameraWidget(QWidget):
def __init__(self, background_color):
QWidget.__init__(self)
self.scene = QGraphicsScene(self)
self.scene.setBackgroundBrush(QBrush(background_color))
self.graphics_view = QGraphicsView(self.scene)
self.graphics_view.setHorizontalScrollBarPolicy(Qt.ScrollBarAlwaysOff)
self.graphics_view.setVerticalScrollBarPolicy(Qt.ScrollBarAlwaysOff)
self.graphics_view.setFrameStyle(0)
self.graphics_view.setStyleSheet("QGraphicsView {background: transparent; border: 3px; outline: none;}")
self.graphics_view.scale(-1, 1) # this make live video from camero mirror.
self.video_item = QGraphicsVideoItem()
self.scene.addItem(self.video_item)
self.layout = QVBoxLayout(self)
self.layout.setContentsMargins(0, 0, 0, 0)
self.layout.addWidget(self.graphics_view)
self.available_cameras = QCameraInfo.availableCameras()
# Set the default camera.
self.select_camera(0)
def resizeEvent(self, event):
self.video_item.setSize(QSizeF(event.size().width(), event.size().height()))
QWidget.resizeEvent(self, event)
def select_camera(self, i):
self.camera = QCamera(self.available_cameras[i])
self.camera.setViewfinder(self.video_item)
self.camera.setCaptureMode(QCamera.CaptureStillImage)
self.camera.start()
def take_photo(self, camera_save_path):
image_capture = QCameraImageCapture(self.camera)
save_path = str(Path(os.path.expanduser(camera_save_path)))
photo_path = os.path.join(save_path, "EAF_Camera_Photo_" + time.strftime("%Y-%m-%d_%H:%M:%S", time.localtime(int(time.time()))))
image_capture.capture(photo_path)
self.message_to_emacs.emit("Captured Photo at " + photo_path)
def stop_camera(self):
self.camera.stop()
if __name__ == "__main__":
from PyQt5.QtWidgets import QApplication
import sys
import signal
app = QApplication(sys.argv)
test = CameraWidget(QColor(0, 0, 0, 255))
test.show()
signal.signal(signal.SIGINT, signal.SIG_DFL)
sys.exit(app.exec_())

31
lisp/emacs-application-framework/app/demo/buffer.py Normal file
View File

@@ -0,0 +1,31 @@
#!/usr/bin/env python3
# -*- coding: utf-8 -*-
# Copyright (C) 2018 Andy Stewart
#
# Author: Andy Stewart <lazycat.manatee@gmail.com>
# Maintainer: Andy Stewart <lazycat.manatee@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
# 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/>.
from PyQt5.QtGui import QColor
from PyQt5.QtWidgets import QPushButton
from core.buffer import Buffer
class AppBuffer(Buffer):
def __init__(self, buffer_id, url, config_dir, arguments, emacs_var_dict, module_path):
Buffer.__init__(self, buffer_id, url, arguments, emacs_var_dict, module_path, True)
self.add_widget(QPushButton("Hello, EAF hacker, it's working!!!"))
self.buffer_widget.setStyleSheet("font-size: 100px")

114
lisp/emacs-application-framework/app/file-browser/buffer.py Normal file
View File

@@ -0,0 +1,114 @@
#!/usr/bin/env python3
# -*- coding: utf-8 -*-
# Copyright (C) 2018 Andy Stewart
#
# Author: Andy Stewart <lazycat.manatee@gmail.com>
# Maintainer: Andy Stewart <lazycat.manatee@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
# 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/>.
from PyQt5 import QtGui, QtCore
from PyQt5.QtCore import Qt
from PyQt5.QtGui import QColor, QFont
from PyQt5.QtWidgets import QWidget, QLabel, QVBoxLayout
from core.utils import get_local_ip, get_free_port
import subprocess
import os
import qrcode
import signal
from core.buffer import Buffer
class AppBuffer(Buffer):
def __init__(self, buffer_id, url, config_dir, argument, emacs_var_dict, module_path):
Buffer.__init__(self, buffer_id, url, argument, emacs_var_dict, module_path, False)
self.add_widget(FileUploaderWidget(url, QColor(0, 0, 0, 255)))
def destroy_buffer(self):
os.kill(self.buffer_widget.background_process.pid, signal.SIGKILL)
super().destroy_buffer()
class Image(qrcode.image.base.BaseImage):
def __init__(self, border, width, box_size):
self.border = border
self.width = width
self.box_size = box_size
size = (width + border * 2) * box_size
self._image = QtGui.QImage(size, size, QtGui.QImage.Format_RGB16)
self._image.fill(QtCore.Qt.white)
def pixmap(self):
return QtGui.QPixmap.fromImage(self._image)
def drawrect(self, row, col):
painter = QtGui.QPainter(self._image)
painter.fillRect(
(col + self.border) * self.box_size,
(row + self.border) * self.box_size,
self.box_size, self.box_size,
QtCore.Qt.black)
def save(self, stream, kind=None):
pass
class FileUploaderWidget(QWidget):
def __init__(self, url, color):
QWidget.__init__(self)
url = os.path.expanduser(url)
self.setStyleSheet("background-color: black")
self.file_name_font = QFont()
self.file_name_font.setPointSize(24)
self.file_name_label = QLabel(self)
self.file_name_label.setText("Your file will be share at\n{0}".format(url))
self.file_name_label.setFont(self.file_name_font)
self.file_name_label.setAlignment(Qt.AlignCenter)
self.file_name_label.setStyleSheet("color: #eee")
self.qrcode_label = QLabel(self)
self.notify_font = QFont()
self.notify_font.setPointSize(12)
self.notify_label = QLabel(self)
self.notify_label.setText("Scan QR code above to upload a file from your smartphone.\nMake sure the smartphone is connected to the same WiFi network as this computer.")
self.notify_label.setFont(self.notify_font)
self.notify_label.setAlignment(Qt.AlignCenter)
self.notify_label.setStyleSheet("color: #eee")
layout = QVBoxLayout(self)
layout.setContentsMargins(0, 0, 0, 0)
layout.addStretch()
layout.addWidget(self.qrcode_label, 0, Qt.AlignCenter)
layout.addSpacing(20)
layout.addWidget(self.file_name_label, 0, Qt.AlignCenter)
layout.addSpacing(40)
layout.addWidget(self.notify_label, 0, Qt.AlignCenter)
layout.addStretch()
self.port = get_free_port()
self.local_ip = get_local_ip()
self.address = "http://{0}:{1}".format(self.local_ip, self.port)
self.qrcode_label.setPixmap(qrcode.make(self.address, image_factory=Image).pixmap())
self.background_process = subprocess.Popen(
"cd {0} && filebrowser --noauth -d /tmp/filebrowser.db --address {1} -p {2}".format(url, self.local_ip, self.port),
stdout=subprocess.PIPE,
stderr=subprocess.STDOUT,
shell=True)

147
lisp/emacs-application-framework/app/file-sender/buffer.py Normal file
View File

@@ -0,0 +1,147 @@
#!/usr/bin/env python3
# -*- coding: utf-8 -*-
# Copyright (C) 2018 Andy Stewart
#
# Author: Andy Stewart <lazycat.manatee@gmail.com>
# Maintainer: Andy Stewart <lazycat.manatee@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
# 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/>.
from PyQt5 import QtGui, QtCore
from PyQt5.QtCore import Qt
from PyQt5.QtGui import QColor, QFont
from PyQt5.QtWidgets import QWidget, QLabel, QVBoxLayout
from core.buffer import Buffer
from core.utils import get_free_port, get_local_ip
import http.server as BaseHTTPServer
import os
import qrcode
import shutil
import sys
import threading
import socket
class AppBuffer(Buffer):
def __init__(self, buffer_id, url, config_dir, arguments, emacs_var_dict, module_path):
Buffer.__init__(self, buffer_id, url, arguments, emacs_var_dict, module_path, False)
self.add_widget(FileTransferWidget(url, QColor(0, 0, 0, 255)))
class SimpleHTTPRequestHandler(BaseHTTPServer.BaseHTTPRequestHandler):
def do_GET(self):
global local_file_path
try:
with open(local_file_path, 'rb') as f:
self.send_response(200)
self.send_header("Content-Type", 'application/octet-stream')
self.send_header("Content-Disposition", 'attachment; filename="{}"'.format(os.path.basename(local_file_path)))
fs = os.fstat(f.fileno())
self.send_header("Content-Length", str(fs.st_size))
self.end_headers()
shutil.copyfileobj(f, self.wfile)
except socket.error:
# Don't need handle socket error.
pass
class Image(qrcode.image.base.BaseImage):
def __init__(self, border, width, box_size):
self.border = border
self.width = width
self.box_size = box_size
size = (width + border * 2) * box_size
self._image = QtGui.QImage(size, size, QtGui.QImage.Format_RGB16)
self._image.fill(QtCore.Qt.white)
def pixmap(self):
return QtGui.QPixmap.fromImage(self._image)
def drawrect(self, row, col):
painter = QtGui.QPainter(self._image)
painter.fillRect(
(col + self.border) * self.box_size,
(row + self.border) * self.box_size,
self.box_size, self.box_size,
QtCore.Qt.black)
def save(self, stream, kind=None):
pass
class FileTransferWidget(QWidget):
def __init__(self, url, color):
QWidget.__init__(self)
self.setStyleSheet("background-color: black")
file_path = os.path.expanduser(url)
self.file_name_font = QFont()
self.file_name_font.setPointSize(24)
self.file_name_label = QLabel(self)
self.file_name_label.setText(file_path)
self.file_name_label.setFont(self.file_name_font)
self.file_name_label.setAlignment(Qt.AlignCenter)
self.file_name_label.setStyleSheet("color: #eee")
self.qrcode_label = QLabel(self)
self.notify_font = QFont()
self.notify_font.setPointSize(12)
self.notify_label = QLabel(self)
self.notify_label.setText("Scan QR code above to download this file on your smartphone.\nMake sure the smartphone is connected to the same WiFi network as this computer.")
self.notify_label.setFont(self.notify_font)
self.notify_label.setAlignment(Qt.AlignCenter)
self.notify_label.setStyleSheet("color: #eee")
layout = QVBoxLayout(self)
layout.setContentsMargins(0, 0, 0, 0)
layout.addStretch()
layout.addWidget(self.qrcode_label, 0, Qt.AlignCenter)
layout.addSpacing(20)
layout.addWidget(self.file_name_label, 0, Qt.AlignCenter)
layout.addSpacing(40)
layout.addWidget(self.notify_label, 0, Qt.AlignCenter)
layout.addStretch()
self.start_server(file_path)
def set_address(self, address):
self.qrcode_label.setPixmap(qrcode.make(address, image_factory=Image).pixmap())
def start_server(self, filename):
global local_file_path
local_file_path = filename
self.port = get_free_port()
self.local_ip = get_local_ip()
self.set_address("http://{0}:{1}/{2}".format(self.local_ip, self.port, filename))
self.sender_thread = threading.Thread(target=self.run_http_server, name='LoopThread')
self.sender_thread.start()
def run_http_server(self):
httpd = BaseHTTPServer.HTTPServer(('', self.port), SimpleHTTPRequestHandler)
httpd.serve_forever()
def destroy_buffer(self):
global local_file_path
self.message_to_emacs.emit("Stop file sender server: http://{0}:{1}/{2}".format(self.local_ip, self.port, local_file_path))
self.sender_thread.stop()
super().destroy_buffer()

68
lisp/emacs-application-framework/app/image-viewer/buffer.py Normal file
View File

@@ -0,0 +1,68 @@
#!/usr/bin/env python3
# -*- coding: utf-8 -*-
# Copyright (C) 2018 Andy Stewart
#
# Author: Andy Stewart <lazycat.manatee@gmail.com>
# Maintainer: Andy Stewart <lazycat.manatee@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
# 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/>.
from PyQt5.QtCore import QUrl
from PyQt5.QtGui import QColor
from core.browser import BrowserBuffer
from core.utils import PostGui
from pathlib import Path
import os
class AppBuffer(BrowserBuffer):
def __init__(self, buffer_id, url, config_dir, arguments, emacs_var_dict, module_path):
BrowserBuffer.__init__(self, buffer_id, url, config_dir, arguments, emacs_var_dict, module_path, False)
self.load_image(url)
def load_image(self, url):
self.url = url
self.parent_dir = os.path.abspath(os.path.join(url, os.pardir))
self.image_name = os.path.basename(url)
self.buffer_widget.setUrl(QUrl("file://" + self.url))
def is_image_file(self, f):
return Path(f).suffix.lower() in ["jpg", "jpeg", "png", "bmp", "gif", "svg", "webp"]
def get_same_dir_images(self):
files = [f for f in os.listdir(self.parent_dir) if os.path.isfile(os.path.join(self.parent_dir, f))]
return list(filter(self.is_image_file, files))
def load_next_image(self):
images = self.get_same_dir_images()
if self.image_name in images:
image_index = images.index(self.image_name)
if image_index == len(images) - 1:
image_index = 0
else:
image_index += 1
self.load_image(os.path.join(self.parent_dir, images[image_index]))
def load_prev_image(self):
images = self.get_same_dir_images()
if self.image_name in images:
image_index = images.index(self.image_name)
if image_index == 0:
image_index = len(images) - 1
else:
image_index -= 1
self.load_image(os.path.join(self.parent_dir, images[image_index]))

511
lisp/emacs-application-framework/app/interleave/eaf-interleave.el Normal file
View File

@@ -0,0 +1,511 @@
;;; eaf-interleave.el --- Interleaving text books on EAF -*- lexical-binding: t -*-
;; Author: Sebastian Christ <rudolfo.christ@gmail.com>
;; URL: https://github.com/rudolfochrist/interleave
;; Version: 1.4.20161123-610
;; Fork: luhuaei <luhuaei@gmail.com>
;; This file is not part of GNU Emacs
;; 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, 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.
;; For a full copy of the GNU General Public License
;; see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; In the past, textbooks were sometimes published as 'interleaved'
;; editions. That meant, each page was followed by a blank page and
;; ambitious students/scholars had the ability to take their notes
;; directly in their copy of the textbook. Newton and Kant were
;; prominent representatives of this technique.
;; Nowadays textbooks (or lecture material) come in PDF format. Although almost
;; every PDF Reader has the ability to add some notes to the PDF itself, it is
;; not as powerful as it could be.
;; This is what this minor mode tries to accomplish. It presents your PDF side by
;; side to an [[http://orgmode.org][Org Mode]] buffer with your notes, narrowing
;; down to just those passages that are relevant to the particular page in the
;; document viewer.
;;; Usage:
;;; Code:
(require 'org)
(require 'org-element)
(defcustom eaf-interleave-org-notes-dir-list '("~/org/interleave_notes" ".")
"List of directories to look into when opening notes org from a pdf file.
The notes file is assumed to have the exact
same base name as the pdf file (just that the file extension is
.org instead of .pdf).
If the notes org file is not found, it is created in the
directory returned on doing `car' of this list (first element of
the list).
The notes file is searched in order from the first list element
till the last; the search is aborted once the file is found.
If a list element is \".\" or begins with \"./\", that portion is
replaced with the pdf directory name. e.g. \".\" is interpreted
as \"/pdf/file/dir/\", \"./notes\" is interpreted as
\"/pdf/file/dir/notes/\"."
:type '(repeat directory))
(defcustom eaf-interleave-split-direction 'vertical
"Specify how to split the notes buffer."
:type '(choice (const vertical)
(const horizontal)))
(defcustom eaf-interleave-split-lines nil
"Specify the number of lines the PDF buffer should be increased or decreased.
If nil both buffers are split equally. If the number is positive,
the window is enlarged. If the number is negative, the window is
shrunken.
If `eaf-interleave-split-direction' is 'vertical then the number is
taken as columns."
:type '(choice integer
(const nil)))
(defcustom eaf-interleave-disable-narrowing nil
"Disable narrowing in notes/org buffer."
:type 'boolean)
;; variables
(defvar eaf-interleave-org-buffer nil
"Org notes buffer name.")
(defvar eaf-interleave--window-configuration nil
"Variable to store the window configuration before interleave mode was enabled.")
(defconst eaf-interleave--page-note-prop "interleave_page_note"
"The page note property string.")
(defconst eaf-interleave--url-prop "interleave_url"
"The pdf property string.")
;; Minor mode for the org file buffer containing notes
(defvar eaf-interleave-mode-map (make-sparse-keymap)
"Keymap while command `eaf-interleave-mode' is active in the org file buffer.")
;;;###autoload
(define-minor-mode eaf-interleave-mode
"Interleaving your text books since 2015.
In the past, textbooks were sometimes published as 'interleaved' editions.
That meant, each page was followed by a blank page and the ambitious student/
scholar had the ability to take their notes directly in their copy of the
textbook. Newton and Kant were prominent representatives of this technique.
Nowadays textbooks (or lecture material) come in PDF format. Although almost
every PDF Reader has the ability to add some notes to the PDF itself, it is
not as powerful as it could be.
This is what this minor mode tries to accomplish. It presents your PDF side by
pppside to an [[http://orgmode.org][Org Mode]] buffer with your notes, narrowing
down to just those passages that are relevant to the particular page in the
document viewer.
The split direction is determined by the customizable variable
`eaf-interleave-split-direction'. When `eaf-interleave-mode' is invoked
with a prefix argument the inverse split direction is used
e.g. if `eaf-interleave-split-direction' is 'vertical the buffer is
split horizontally."
:keymap eaf-interleave-mode-map
(if eaf-interleave-mode
(setq eaf-interleave-org-buffer (current-buffer))
;; Disable the corresponding minor mode in the PDF file too.
(setq eaf-interleave-org-buffer nil)))
(defvar eaf-interleave-app-mode-map (make-sparse-keymap)
"Keymap while command `eaf-interleave-app-mode' is active.")
;;;###autoload
(define-minor-mode eaf-interleave-app-mode
"Interleave view for the EAF app."
:keymap eaf-interleave-app-mode-map)
;;; functions
;; interactive
(defun eaf-interleave-sync-current-note ()
"Sync EAF buffer on current note"
(interactive)
(let ((url (org-entry-get-with-inheritance eaf-interleave--url-prop)))
(cond ((and (string-prefix-p "/" url) (string-suffix-p "pdf" url t))
(eaf-interleave-sync-pdf-page-current))
((string-prefix-p "http" url)
(eaf-interleave-sync-browser-url-current))))
)
(defun eaf-interleave-sync-pdf-page-current ()
"Open PDF page for currently visible notes."
(interactive)
(let* ((pdf-page (org-entry-get-with-inheritance eaf-interleave--page-note-prop))
(pdf-url (org-entry-get-with-inheritance eaf-interleave--url-prop))
(buffer (eaf-interleave--find-buffer pdf-url)))
(if buffer
(progn
(eaf-interleave--display-buffer buffer)
(when pdf-page
(with-current-buffer buffer
(eaf-interleave--pdf-viewer-goto-page pdf-url pdf-page))))
(eaf-interleave--select-split-function)
(eaf-interleave--open-pdf pdf-url)
)))
(defun eaf-interleave-sync-next-note ()
"Move to the next set of notes.
This shows the next notes and synchronizes the PDF to the right page number."
(interactive)
(eaf-interleave--switch-to-org-buffer)
(widen)
(org-forward-heading-same-level 1)
(eaf-interleave--narrow-to-subtree)
(org-show-subtree)
(org-cycle-hide-drawers t)
(eaf-interleave-sync-current-note))
(defun eaf-interleave-add-note ()
"Add note for the EAF buffer.
If there are already notes for this url, jump to the notes
buffer."
(interactive)
(if (derived-mode-p 'eaf-mode)
(cond ((equal eaf--buffer-app-name "pdf-viewer")
(eaf-interleave--pdf-add-note))
((equal eaf--buffer-app-name "browser")
(eaf-interleave--browser-add-note)))
))
(defun eaf-interleave-add-file-url ()
"Add new url on note if property is none. else modify current url"
(interactive)
(let ((url (read-file-name "Please specify path: " nil nil t)))
(org-entry-put (point) eaf-interleave--url-prop url)))
(defun eaf-interleave-sync-previous-note ()
"Move to the previous set of notes.
This show the previous notes and synchronizes the PDF to the right page number."
(interactive)
(eaf-interleave--switch-to-org-buffer)
(widen)
(eaf-interleave--goto-parent-headline eaf-interleave--page-note-prop)
(org-backward-heading-same-level 1)
(eaf-interleave--narrow-to-subtree)
(org-show-subtree)
(org-cycle-hide-drawers t)
(eaf-interleave-sync-current-note))
(defun eaf-interleave-open-notes-file ()
"Find current EAF url corresponding note files if exists"
(interactive)
(if (derived-mode-p 'eaf-mode)
(cond ((equal eaf--buffer-app-name "pdf-viewer")
(eaf-interleave--open-notes-file-for-pdf))
((equal eaf--buffer-app-name "browser")
(eaf-interleave--open-notes-file-for-browser))))
)
(defun eaf-interleave-quit ()
"Quit interleave mode."
(interactive)
(with-current-buffer eaf-interleave-org-buffer
(widen)
(goto-char (point-min))
(when (eaf-interleave--headlines-available-p)
(org-overview))
(eaf-interleave-mode 0)))
;;;###autoload
(defun eaf-interleave--open-notes-file-for-pdf ()
"Open the notes org file for the current pdf file if it exists.
Else create it. It is assumed that the notes org file will have
the exact same base name as the pdf file (just that the notes
file will have a .org extension instead of .pdf)."
(let ((org-file (concat (file-name-base eaf--buffer-url) ".org")))
(eaf-interleave--open-notes-file-for-app org-file)))
(defun eaf-interleave--open-notes-file-for-browser ()
"Find current open interleave-mode org file, if exists, else
will create new org file with URL. It is assumed that the notes
org file will have the exact sam base name as the url domain."
(unless (buffer-live-p eaf-interleave-org-buffer)
(let* ((domain (url-domain (url-generic-parse-url eaf--buffer-url)))
(org-file (concat domain ".org")))
(eaf-interleave--open-notes-file-for-app org-file))))
(defun eaf-interleave--open-notes-file-for-app (org-file)
"Open the notes org file for the current url if it exists.
Else create it."
(let ((default-dir (nth 0 eaf-interleave-org-notes-dir-list))
(org-file-path (eaf-interleave--find-match-org eaf-interleave-org-notes-dir-list eaf--buffer-url))
(buffer (eaf-interleave--find-buffer eaf--buffer-url)))
;; Create the notes org file if it does not exist
(unless org-file-path
(setq org-file-path (eaf-interleave--ensure-org-file-exist eaf-interleave-org-notes-dir-list org-file)))
;; Open the notes org file and enable `eaf-interleave-mode'
(find-file org-file-path)
(eaf-interleave-mode)
(eaf-interleave--select-split-function)
(switch-to-buffer buffer)
))
(defun eaf-interleave--select-split-function ()
"Determine which split function to use.
This returns either `split-window-below' or `split-window-right'
based on a combination of `current-prefix-arg' and
`eaf-interleave-split-direction'."
(let ()
(delete-other-windows)
(if (string= eaf-interleave-split-direction "vertical")
(split-window-right)
(split-window-below))
(when (integerp eaf-interleave-split-lines)
(if (eql eaf-interleave-split-direction 'horizontal)
(enlarge-window eaf-interleave-split-lines)
(enlarge-window-horizontally eaf-interleave-split-lines)))
))
(defun eaf-interleave--go-to-page-note (url page)
"Look up the notes for the current pdf PAGE.
Effectively resolves the headline with the interleave_page_note
property set to PAGE and returns the point.
If `eaf-interleave-disable-narrowing' is non-nil then the buffer gets
re-centered to the page heading.
It (possibly) narrows the subtree when found."
(with-current-buffer eaf-interleave-org-buffer
(let ((window (get-buffer-window (current-buffer) 'visible))
(property-list (org-map-entries (lambda ()
(let ((url (org-entry-get-with-inheritance eaf-interleave--url-prop))
(page (org-entry-get-with-inheritance eaf-interleave--page-note-prop)))
(cons url page)))))
point)
(catch 'find-property
(dolist (property property-list)
(when (and (string= (car property) url)
(string= (cdr property) (number-to-string page)))
(widen)
(org-back-to-heading t)
(eaf-interleave--narrow-to-subtree)
(org-show-subtree)
(org-cycle-hide-drawers t)
(setq point (point))
(throw 'find-property nil))))
point)))
(defun eaf-interleave--narrow-to-subtree (&optional force)
"Narrow buffer to the current subtree.
If `eaf-interleave-disable-narrowing' is non-nil this
function does nothing.
When FORCE is non-nil `eaf-interleave-disable-narrowing' is
ignored."
(when (and (not (org-before-first-heading-p))
(or (not eaf-interleave-disable-narrowing)
force))
(org-narrow-to-subtree)))
(defun eaf-interleave--switch-to-org-buffer (&optional insert-newline-maybe position)
"Switch to the notes buffer.
Inserts a newline into the notes buffer if INSERT-NEWLINE-MAYBE
is non-nil.
If POSITION is non-nil move point to it."
(if (derived-mode-p 'eaf-mode)
(switch-to-buffer-other-window eaf-interleave-org-buffer)
(switch-to-buffer eaf-interleave-org-buffer))
(when (integerp position)
(goto-char position))
(when insert-newline-maybe
(save-restriction
(when eaf-interleave-disable-narrowing
(eaf-interleave--narrow-to-subtree t))
(goto-char (point-max)))
;; Expand again. Sometimes the new content is outside the narrowed
;; region.
(org-show-subtree)
(redisplay)
;; Insert a new line if not already on a new line
(when (not (looking-back "^ *" (line-beginning-position)))
(org-return))))
(defun eaf-interleave--insert-heading-respect-content (parent-headline)
"Create a new heading in the notes buffer.
Adjust the level of the new headline according to the
PARENT-HEADLINE.
Return the position of the newly inserted heading."
(org-insert-heading-respect-content)
(let* ((parent-level 0 )
(change-level (if (> (org-element-property :level (org-element-at-point))
(1+ parent-level))
#'org-promote
#'org-demote)))
(while (/= (org-element-property :level (org-element-at-point))
(1+ parent-level))
(funcall change-level)))
(point))
(defun eaf-interleave--create-new-note (url &optional title page)
"Create a new headline for current EAF url."
(let (new-note-position)
(with-current-buffer eaf-interleave-org-buffer
(save-excursion
(widen)
(let ((position (goto-char (point-max))))
(setq new-note-position (eaf-interleave--insert-heading-respect-content position)))
(org-set-property eaf-interleave--url-prop url)
(when title
(insert (format "Notes for %s" title)))
(when page
(org-set-property eaf-interleave--page-note-prop (number-to-string page)))
(eaf-interleave--narrow-to-subtree)
(org-cycle-hide-drawers t)))
(eaf-interleave--switch-to-org-buffer t new-note-position)))
(defun eaf-interleave-sync-browser-url-current ()
"Sync current note url for browser"
(let* ((web-url (org-entry-get-with-inheritance eaf-interleave--url-prop))
(buffer (eaf-interleave--find-buffer web-url)))
(if buffer
(eaf-interleave--display-buffer buffer)
(eaf-interleave--select-split-function)
(eaf-interleave--open-web-url web-url))))
(defun eaf-interleave--display-buffer (buffer)
"Use already used window display buffer"
(eaf-interleave--narrow-to-subtree)
(display-buffer-reuse-mode-window buffer '(("mode" . "eaf-interleave-app-mode")))
(eaf-interleave--ensure-buffer-window buffer))
(defun eaf-interleave--goto-parent-headline (property)
"Traverse the tree until the parent headline.
Consider a headline with property PROPERTY as parent headline."
(catch 'done
(if (and (eql (org-element-type (org-element-at-point)) 'headline)
(org-entry-get (point) property))
(org-element-at-point)
(condition-case nil
(org-up-element)
('error
(throw 'done nil)))
(eaf-interleave--goto-parent-headline property))))
(defun eaf-interleave--pdf-add-note ()
"EAF pdf-viewer-mode add note"
(let* ((page (eaf-interleave--pdf-viewer-current-page eaf--buffer-url))
(position (eaf-interleave--go-to-page-note eaf--buffer-url page)))
(if position
(eaf-interleave--switch-to-org-buffer t position)
(eaf-interleave--create-new-note eaf--buffer-url eaf--buffer-app-name page)))
)
(defun eaf-interleave--browser-add-note ()
"EAF browser add note"
(eaf-interleave--create-new-note eaf--buffer-url eaf--buffer-app-name))
(defun eaf-interleave--headlines-available-p ()
"True if there are headings in the notes buffer."
(save-excursion
(re-search-forward "^\* .*" nil t)))
;; utils
(defun eaf-interleave--open-pdf (pdf-file-name)
"Use EAF PdfViewer open this pdf-file-name document."
(eaf-open pdf-file-name)
(add-hook 'eaf-pdf-viewer-hook 'eaf-interleave-app-mode))
(defun eaf-interleave--open-web-url (url)
"Use EAF Browser open current note web address"
(eaf-open-browser url)
(add-hook 'eaf-browser-hook 'eaf-interleave-app-mode))
(defun eaf-interleave--find-buffer (url)
"find EAF buffer base url"
(let (current-buffer)
(catch 'find-buffer
(dolist (buffer (buffer-list))
(with-current-buffer buffer
(when (and
(derived-mode-p 'eaf-mode)
(equal eaf--buffer-url url))
(setq current-buffer buffer)
(throw 'find-buffer t)))))
current-buffer))
(defun eaf-interleave--kill-buffer (url)
"Kill the current converter process and buffer."
(let ((buffer (eaf-interleave--find-buffer url)))
(kill-buffer buffer)))
(defun eaf-interleave--pdf-viewer-current-page (url)
"get current page index."
(let ((id (buffer-local-value 'eaf--buffer-id (eaf-interleave--find-buffer url))))
(string-to-number (eaf-call "call_function" id "current_page"))))
(defun eaf-interleave--pdf-viewer-goto-page (url page)
"goto page"
(let ((id (buffer-local-value 'eaf--buffer-id (eaf-interleave--find-buffer url))))
(eaf-call "handle_input_message" id "jump_page" page)))
(defun eaf-interleave--ensure-buffer-window (buffer)
"If BUFFER don't display, will use other window display"
(if (get-buffer-window buffer)
nil
(eaf-interleave--select-split-function)
(switch-to-buffer buffer)))
(defun eaf-interleave--parse-current-dir (dir url)
"If dir is '.' or begins with './', replace the '.' or './' with the current url name"
(replace-regexp-in-string
"^\\(\\.$\\|\\./\\).*"
(file-name-directory url)
dir nil nil 1))
(defun eaf-interleave--find-match-org (dir-list url)
"Find corresponding org file base url on dir list"
(let ((org-file (concat (file-name-base url) ".org"))
path)
(catch 'break
(dolist (dir dir-list)
(setq dir (eaf-interleave--parse-current-dir dir url))
(setq path (locate-file org-file (list dir)))
(when path
;; return the first match
(throw 'break path))))
path))
(defun eaf-interleave--ensure-org-file-exist (dir-list file-name)
"If the org file directory exist return this path, else created directory."
(let ((default-dir (nth 0 dir-list)))
(if dir-list
(progn
(unless (file-exists-p default-dir)
(make-directory default-dir))
(expand-file-name file-name default-dir))
(read-file-name "Path for org file: " "~/"))))
(provide 'eaf-interleave)
;;; interleave.el ends here

63
lisp/emacs-application-framework/app/js-video-player/buffer.py Normal file
View File

@@ -0,0 +1,63 @@
#!/usr/bin/env python3
# -*- coding: utf-8 -*-
# Copyright (C) 2018 Andy Stewart
#
# Author: Andy Stewart <lazycat.manatee@gmail.com>
# Maintainer: Andy Stewart <lazycat.manatee@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
# 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/>.
from PyQt5 import QtCore
from PyQt5.QtCore import QUrl, QTimer
from PyQt5.QtWidgets import QApplication
from PyQt5.QtGui import QColor
from core.browser import BrowserBuffer
from core.utils import touch, string_to_base64
import os
import base64
class AppBuffer(BrowserBuffer):
export_org_json = QtCore.pyqtSignal(str, str)
def __init__(self, buffer_id, url, config_dir, arguments, emacs_var_dict, module_path):
BrowserBuffer.__init__(self, buffer_id, url, config_dir, arguments, emacs_var_dict, module_path, False)
self.url = url
index_file = "file://" + (os.path.join(os.path.dirname(__file__), "index.html"))
self.buffer_widget.setUrl(QUrl(index_file))
for method_name in ["toggle_play", "forward", "backward", "restart", "increase_volume", "decrease_volume"]:
self.build_js_method(method_name)
QTimer.singleShot(500, self.play_video)
def save_session_data(self):
return str(self.buffer_widget.execute_js("get_current_time();"))
def restore_session_data(self, session_data):
self.position = session_data
QTimer.singleShot(600, self.restore_seek_position)
def restore_seek_position(self):
self.buffer_widget.eval_js("set_current_time('{}');".format(self.position))
def play_video(self):
self.buffer_widget.eval_js("play('{}');".format("file://" + self.url))
def build_js_method(self, method_name):
def _do ():
self.buffer_widget.eval_js("{}();".format(method_name))
setattr(self, method_name, _do)

55
lisp/emacs-application-framework/app/js-video-player/index.html Normal file
View File

@@ -0,0 +1,55 @@
<head>
<link href="./node_modules/plyr/dist/plyr.css" rel="stylesheet" />
<link href="./style.css" rel="stylesheet" />
<script src="./node_modules/plyr/dist/plyr.min.js"></script>
</head>
<body>
<video
id="player"
autoplay
/>
<script type="text/javascript">
const player = new Plyr('#player', {
controls: ['play-large', 'play', 'progress', 'current-time', 'mute', 'volume', 'captions', 'settings', "fullscreen"],
});
function play(file) {
var video = document.getElementById('player');
video.setAttribute('src', file);
}
function toggle_play() {
player.togglePlay();
}
function get_current_time() {
return player.currentTime;
}
function set_current_time(time) {
player.currentTime = parseFloat(time);
}
function forward() {
player.forward(10);
}
function backward() {
player.forward(-10);
}
function restart() {
player.restart();
}
function increase_volume() {
player.increaseVolume(0.1);
}
function decrease_volume() {
player.decreaseVolume(0.1);
}
</script>
</body>

19
lisp/emacs-application-framework/app/js-video-player/node_modules/core-js/LICENSE generated vendored Normal file
View File

@@ -0,0 +1,19 @@
Copyright (c) 2014-2020 Denis Pushkarev
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
THE SOFTWARE.

58
lisp/emacs-application-framework/app/js-video-player/node_modules/core-js/README.md generated vendored Normal file
View File

@@ -0,0 +1,58 @@
# core-js
[![Sponsors on Open Collective](https://opencollective.com/core-js/sponsors/badge.svg)](#sponsors) [![Backers on Open Collective](https://opencollective.com/core-js/backers/badge.svg)](#backers) [![Gitter](https://badges.gitter.im/Join%20Chat.svg)](https://gitter.im/zloirock/core-js?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) [![version](https://img.shields.io/npm/v/core-js.svg)](https://www.npmjs.com/package/core-js) [![npm downloads](https://img.shields.io/npm/dm/core-js.svg)](http://npm-stat.com/charts.html?package=core-js&author=&from=2014-11-18) [![Build Status](https://travis-ci.org/zloirock/core-js.svg)](https://travis-ci.org/zloirock/core-js) [![devDependency status](https://david-dm.org/zloirock/core-js/dev-status.svg)](https://david-dm.org/zloirock/core-js?type=dev)
> Modular standard library for JavaScript. Includes polyfills for [ECMAScript up to 2019](https://github.com/zloirock/core-js#ecmascript): [promises](https://github.com/zloirock/core-js#ecmascript-promise), [symbols](https://github.com/zloirock/core-js#ecmascript-symbol), [collections](https://github.com/zloirock/core-js#ecmascript-collections), iterators, [typed arrays](https://github.com/zloirock/core-js#ecmascript-typed-arrays), many other features, [ECMAScript proposals](https://github.com/zloirock/core-js#ecmascript-proposals), [some cross-platform WHATWG / W3C features and proposals](#web-standards) like [`URL`](https://github.com/zloirock/core-js#url-and-urlsearchparams). You can load only required features or use it without global namespace pollution.
## As advertising: the author is looking for a good job -)
## [core-js@3, babel and a look into the future](https://github.com/zloirock/core-js/tree/master/docs/2019-03-19-core-js-3-babel-and-a-look-into-the-future.md)
## Raising funds
`core-js` isn't backed by a company, so the future of this project depends on you. Become a sponsor or a backer [**on Open Collective**](https://opencollective.com/core-js) or [**on Patreon**](https://www.patreon.com/zloirock) if you are interested in `core-js`.
---
<a href="https://opencollective.com/core-js/sponsor/0/website" target="_blank"><img src="https://opencollective.com/core-js/sponsor/0/avatar.svg"></a><a href="https://opencollective.com/core-js/sponsor/1/website" target="_blank"><img src="https://opencollective.com/core-js/sponsor/1/avatar.svg"></a><a href="https://opencollective.com/core-js/sponsor/2/website" target="_blank"><img src="https://opencollective.com/core-js/sponsor/2/avatar.svg"></a><a href="https://opencollective.com/core-js/sponsor/3/website" target="_blank"><img src="https://opencollective.com/core-js/sponsor/3/avatar.svg"></a><a href="https://opencollective.com/core-js/sponsor/4/website" target="_blank"><img src="https://opencollective.com/core-js/sponsor/4/avatar.svg"></a><a href="https://opencollective.com/core-js/sponsor/5/website" target="_blank"><img src="https://opencollective.com/core-js/sponsor/5/avatar.svg"></a><a href="https://opencollective.com/core-js/sponsor/6/website" target="_blank"><img src="https://opencollective.com/core-js/sponsor/6/avatar.svg"></a><a href="https://opencollective.com/core-js/sponsor/7/website" target="_blank"><img src="https://opencollective.com/core-js/sponsor/7/avatar.svg"></a><a href="https://opencollective.com/core-js/sponsor/8/website" target="_blank"><img src="https://opencollective.com/core-js/sponsor/8/avatar.svg"></a><a href="https://opencollective.com/core-js/sponsor/9/website" target="_blank"><img src="https://opencollective.com/core-js/sponsor/9/avatar.svg"></a><a href="https://opencollective.com/core-js/sponsor/10/website" target="_blank"><img src="https://opencollective.com/core-js/sponsor/10/avatar.svg"></a><a href="https://opencollective.com/core-js/sponsor/11/website" target="_blank"><img src="https://opencollective.com/core-js/sponsor/11/avatar.svg"></a>
---
<a href="https://opencollective.com/core-js#backers" target="_blank"><img src="https://opencollective.com/core-js/backers.svg?width=890"></a>
---
[*Example*](http://goo.gl/a2xexl):
```js
import 'core-js'; // <- at the top of your entry point
Array.from(new Set([1, 2, 3, 2, 1])); // => [1, 2, 3]
[1, [2, 3], [4, [5]]].flat(2); // => [1, 2, 3, 4, 5]
Promise.resolve(32).then(x => console.log(x)); // => 32
```
*You can load only required features*:
```js
import 'core-js/features/array/from'; // <- at the top of your entry point
import 'core-js/features/array/flat'; // <- at the top of your entry point
import 'core-js/features/set'; // <- at the top of your entry point
import 'core-js/features/promise'; // <- at the top of your entry point
Array.from(new Set([1, 2, 3, 2, 1])); // => [1, 2, 3]
[1, [2, 3], [4, [5]]].flat(2); // => [1, 2, 3, 4, 5]
Promise.resolve(32).then(x => console.log(x)); // => 32
```
*Or use it without global namespace pollution*:
```js
import from from 'core-js-pure/features/array/from';
import flat from 'core-js-pure/features/array/flat';
import Set from 'core-js-pure/features/set';
import Promise from 'core-js-pure/features/promise';
from(new Set([1, 2, 3, 2, 1])); // => [1, 2, 3]
flat([1, [2, 3], [4, [5]]], 2); // => [1, 2, 3, 4, 5]
Promise.resolve(32).then(x => console.log(x)); // => 32
```
**It's a global version (first 2 examples), for more info see [`core-js` documentation](https://github.com/zloirock/core-js/blob/master/README.md).**

23
lisp/emacs-application-framework/app/js-video-player/node_modules/core-js/configurator.js generated vendored Normal file
View File

@@ -0,0 +1,23 @@
var has = require('./internals/has');
var isArray = require('./internals/is-array');
var isForced = require('./internals/is-forced');
var shared = require('./internals/shared-store');
var data = isForced.data;
var normalize = isForced.normalize;
var USE_FUNCTION_CONSTRUCTOR = 'USE_FUNCTION_CONSTRUCTOR';
var ASYNC_ITERATOR_PROTOTYPE = 'AsyncIteratorPrototype';
var setAggressivenessLevel = function (object, constant) {
if (isArray(object)) for (var i = 0; i < object.length; i++) data[normalize(object[i])] = constant;
};
module.exports = function (options) {
if (typeof options == 'object') {
setAggressivenessLevel(options.useNative, isForced.NATIVE);
setAggressivenessLevel(options.usePolyfill, isForced.POLYFILL);
setAggressivenessLevel(options.useFeatureDetection, null);
if (has(options, USE_FUNCTION_CONSTRUCTOR)) shared[USE_FUNCTION_CONSTRUCTOR] = !!options[USE_FUNCTION_CONSTRUCTOR];
if (has(options, ASYNC_ITERATOR_PROTOTYPE)) shared[USE_FUNCTION_CONSTRUCTOR] = options[ASYNC_ITERATOR_PROTOTYPE];
}
};

1
lisp/emacs-application-framework/app/js-video-player/node_modules/core-js/es/README.md generated vendored Normal file
View File

@@ -0,0 +1 @@
This folder contains entry points for [stable ECMAScript features](https://github.com/zloirock/core-js/tree/v3#ecmascript) with dependencies.

5
lisp/emacs-application-framework/app/js-video-player/node_modules/core-js/es/array-buffer/constructor.js generated vendored Normal file
View File

@@ -0,0 +1,5 @@
require('../../modules/es.array-buffer.constructor');
require('../../modules/es.object.to-string');
var path = require('../../internals/path');
module.exports = path.ArrayBuffer;

7
lisp/emacs-application-framework/app/js-video-player/node_modules/core-js/es/array-buffer/index.js generated vendored Normal file
View File

@@ -0,0 +1,7 @@
require('../../modules/es.array-buffer.constructor');
require('../../modules/es.array-buffer.is-view');
require('../../modules/es.array-buffer.slice');
require('../../modules/es.object.to-string');
var path = require('../../internals/path');
module.exports = path.ArrayBuffer;

4
lisp/emacs-application-framework/app/js-video-player/node_modules/core-js/es/array-buffer/is-view.js generated vendored Normal file
View File

@@ -0,0 +1,4 @@
require('../../modules/es.array-buffer.is-view');
var path = require('../../internals/path');
module.exports = path.ArrayBuffer.isView;

1
lisp/emacs-application-framework/app/js-video-player/node_modules/core-js/es/array-buffer/slice.js generated vendored Normal file
View File

@@ -0,0 +1 @@
require('../../modules/es.array-buffer.slice');

4
lisp/emacs-application-framework/app/js-video-player/node_modules/core-js/es/array/concat.js generated vendored Normal file
View File

@@ -0,0 +1,4 @@
require('../../modules/es.array.concat');
var entryUnbind = require('../../internals/entry-unbind');
module.exports = entryUnbind('Array', 'concat');

4
lisp/emacs-application-framework/app/js-video-player/node_modules/core-js/es/array/copy-within.js generated vendored Normal file
View File

@@ -0,0 +1,4 @@
require('../../modules/es.array.copy-within');
var entryUnbind = require('../../internals/entry-unbind');
module.exports = entryUnbind('Array', 'copyWithin');

4
lisp/emacs-application-framework/app/js-video-player/node_modules/core-js/es/array/entries.js generated vendored Normal file
View File

@@ -0,0 +1,4 @@
require('../../modules/es.array.iterator');
var entryUnbind = require('../../internals/entry-unbind');
module.exports = entryUnbind('Array', 'entries');

4
lisp/emacs-application-framework/app/js-video-player/node_modules/core-js/es/array/every.js generated vendored Normal file
View File

@@ -0,0 +1,4 @@
require('../../modules/es.array.every');
var entryUnbind = require('../../internals/entry-unbind');
module.exports = entryUnbind('Array', 'every');

4
lisp/emacs-application-framework/app/js-video-player/node_modules/core-js/es/array/fill.js generated vendored Normal file
View File

@@ -0,0 +1,4 @@
require('../../modules/es.array.fill');
var entryUnbind = require('../../internals/entry-unbind');
module.exports = entryUnbind('Array', 'fill');

4
lisp/emacs-application-framework/app/js-video-player/node_modules/core-js/es/array/filter.js generated vendored Normal file
View File

@@ -0,0 +1,4 @@
require('../../modules/es.array.filter');
var entryUnbind = require('../../internals/entry-unbind');
module.exports = entryUnbind('Array', 'filter');

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