diff options
| -rw-r--r-- | .gitignore | 5 | ||||
| -rw-r--r-- | README | 381 | ||||
| -rw-r--r-- | assets/custom.jpg | bin | 134004 -> 0 bytes | |||
| -rw-r--r-- | assets/stylist-dark.jpg | bin | 124282 -> 0 bytes | |||
| -rw-r--r-- | assets/stylist-light.jpg | bin | 55948 -> 0 bytes | |||
| -rw-r--r-- | nx-mapper.asd | 13 | ||||
| -rw-r--r-- | nx-router.asd | 9 | ||||
| -rw-r--r-- | package.lisp | 12 | ||||
| -rw-r--r-- | router.lisp (renamed from src/rural.lisp) | 309 | ||||
| -rw-r--r-- | src/mapper.lisp | 40 | ||||
| -rw-r--r-- | src/package.lisp | 34 | ||||
| -rw-r--r-- | src/settings.lisp | 374 | ||||
| -rw-r--r-- | src/stylor.lisp | 332 |
13 files changed, 234 insertions, 1275 deletions
diff --git a/.gitignore b/.gitignore deleted file mode 100644 index 95d1a33..0000000 --- a/.gitignore +++ /dev/null @@ -1,5 +0,0 @@ -.dir-locals.el -docs/** -styles/** -assets/** -index.html
\ No newline at end of file @@ -1,370 +1,107 @@ # -*- mode: org; -*- -#+title: nx-mapper -=nx-mapper= is an extension for the [[https://nyxt.atlas.engineer/][Nyxt]] browser which aims at reducing the complexity associated with defining common browsing behaviors desired by power users in the form of two modes: [[#stylor-mode][stylor-mode]], which offers fine-grained control over Nyxt's themes and [[#rural-mode][rural-mode]], which allows you to build composable URL associations. +#+title: nx-router +=nx-router= is a URL routing extension for [[https://nyxt.atlas.engineer/][Nyxt]]. It lets you define fine-grained routes so you can enhance the browsing experience without get your attention sucked away. You can set up URL redirects, block lists, open resources with external applications, all in a cohesive configuration language. * Installation -To install the extension, you should download the source and place it in Nyxt's extensions path, by default given by the value of =nyxt-source-registry= (=~/.local/share/nyxt/extensions=). +To install the extension, you need to download the source and place it in Nyxt's extensions path, given by the value of =(nyxt-source-registry)= (by default =~/.local/share/nyxt/extensions=). #+begin_src sh -git clone https://github.com/efimerspan/nx-mapper ~/.local/share/nyxt/nx-mapper +git clone https://github.com/efimerspan/nx-router ~/.local/share/nyxt/nx-router #+end_src -It's worth noting that the extension works with Nyxt 3 onward, so you should probably use it with the latest version of Nyxt master for the time being. +The extension works with *Nyxt 3 onward*, so ensure to use it with the latest version of Nyxt master for the time being. -However, if you want to place the extension elsewhere in the system, such as for development purposes, you can configure so via the ASDF source registry mechanism. For this, you'll need to create a file in the source registry directory, =~/.config/common-lisp/source-registry.conf.d/=, and then put the following contents into it, replacing the path with the desired system path. +If you want to place the extension elsewhere in the system, such as for development purposes, you can configure so via the ASDF source registry mechanism. For this, you'll need to create a file in the source registry directory, =~/.config/common-lisp/source-registry.conf.d/=, and then put the following contents into it, replacing the path with the desired system path. #+name: 10-personal-lisp.conf #+begin_src lisp (:tree "/path/to/user/location") #+end_src -Then, make sure to refresh the ASDF cache via =asdf:clear-source-registry=. Now, ASDF will be able to find the extension on the custom path. For more information on this utility, please refer to the [[https://asdf.common-lisp.dev/asdf.html][ASDF manual]]. +Then, make sure to refresh the ASDF cache via =asdf:clear-source-registry=. ASDF will now be able to find the extension on the custom path. For more information on this utility, please refer to the [[https://asdf.common-lisp.dev/asdf.html][ASDF manual]]. However, by default Nyxt won't read the custom source registry path we provided, so ensure to include a =reset-asdf-registries= invocation in the Nyxt's initialization file too. -Then, in the init file, ensure to include the following. +In your Nyxt initialization file, place the following. #+begin_src lisp -(load-after-system :nx-mapper (nyxt-init-file "/path/to/mapper.lisp")) +(load-after-system :nx-router (nyxt-init-file "/path/to/router.lisp")) (define-configuration buffer - ((default-modes - (append - ;; Either of them or both, depending on what functionality you want - '(stylor:stylor-mode - rural:rural-mode) - %slot-default%))) + ((default-modes `(router:router-mode ,@%slot-default%)))) #+end_src -Where =/path/to/mapper.lisp= is a custom file that should be created to provide the extension settings after the =nx-mapper= system has been successfully loaded. Inside this file, you can take two approaches when it comes to supplying the extension options, as described by the following. - -#+name: mapper.lisp -#+begin_src lisp -(define-configuration mapper:settings - ;; provide all the mapping types -) -#+end_src - -As you might notice from the above, you can bundle everything into the global =nx-mapper:settings= class, but optionally you can configure everything per sub-extension too, which is useful if you want to split the configuration of each mode per file, such as by having a =style.lisp= for =stylor-mode= and a =url.lisp= for =rural-mode=. The next section gives examples of how to structure and configure each. - -#+name: stylor.lisp -#+begin_src lisp -(define-configuration stylor:stylor-mode - ((stylor:auto-p t))) ;; Whether to set the browser theme according to system settings - -(define-configuration nx-mapper/stylor-mode:settings - ((stylor:scripts - ;; user script mappings - ) - (stylor:external-themes - ;; user styles mappings - ) - (stylor:internal-themes - ;; browser theme mappings - ))) -#+end_src - -#+name: rural.lisp -#+begin_src lisp -(define-configuration rural:rural-mode - ((rural:banner-p nil) ;; Whether to show a banner when encountering a block rule - (rural:media-enabled-p nil))) ;; Whether to allow media in all sites - -(define-configuration rural:settings - ((rural:url-mappings - ;; URL associations mappings - ))) -#+end_src +Where =/path/to/router.lisp= is a custom file that should be created to provide the extension settings after the =nx-router= system has been successfully loaded. Inside this file, you should provide the extension options, explained in the following section. * Configuration - -** stylor-mode -:PROPERTIES: -:CUSTOM_ID: stylor-mode -:END: -/stylor-mode/ acts like a userscript and userstyle manager, as well as an easy way to manage Nyxt's themes. Its functionality is split into three core parts: - -- Internal themes :: these tweak the overall browser's interface elements and allow you to change the browser's appearance on the fly. -- External themes :: these map sources that act like triggers for which to apply CSS styles. These triggers are in the form of URL predicates and styles can be supplied as CSS strings, local path names, URLs where remote style sheets are hosted, or a function which takes the current internal theme and uses it to style the CSS. The latter is a nifty feature which allows you to share internal and external themes, achieving a more consistent look if that's something the user is interested in for a given site. -- Scripts :: these also map sources which act like triggers for which an arbitrary JavaScript snippet will be executed. This is slightly more powerful than just altering the look via themes, as it also enables you to tweak the behavior of sites. - -Therefore, using these three concepts, you can include something along the following lines in your Nyxt init file. +To get familiar with the format of URL rules in =nx-router=, see the following sample configuration along with the description of what each slot does. #+begin_src lisp -(import 'mapper:make-mapping) +(import 'router:make-route) -(define-configuration stylor:settings - ((stylor:scripts +(define-configuration router:router-mode + ((router:enforce-p t) ; Set this to non-nil to prevent you from disabling the mode + (router:media-enabled-p t) ; Show media in sites + (router:banner-p t) ; Show a banner upon visiting blocked sites + (router:routes (list - (make-mapping "FSF" '(match-domain "fsf.org") - :script (ps:ps (setf (ps:@ document body |innerHTML|) - "This was invoked by some sample JavaScript."))))) - (stylor:external-themes - (list - (make-mapping "GitHub" '(match-domain "github.com") - :style (cl-css:css '(("a[href*=watchers]" - :display "none !important")))) - (make-mapping "Lisp Documentation" '(match-domain "lisp.se" "lispworks.com") - :style (lambda (theme) - (theme:themed-css theme - (* - :background-color theme:background - :color theme:text)))) - (make-mapping "Medium" '(match-domain "medium.com") - :style (asdf:system-relative-pathname :nx-mapper "styles/medium.css")) - (make-mapping "Nord Startpage" '(match-domain "startpage.com") - :style (quri:uri "https://bpa.st/raw/4WYA")))) - (stylor:internal-themes - (list - (make-mapping "Modus Operandi" nil - :background-color "white" - :text-color "black" - :primary-color "#093060" - :secondary-color "#f0f0f0" - :tertiary-color "#dfdfdf" - :quaternary-color "#005a5f" - :accent-color "#8f0075" - :font-family "Iosevka" - :stylist (make-instance 'nx-mapper/stylor-mode:user-stylist)) - (make-mapping "Modus Vivendi" nil - :dark-p t - :background-color "black" - :text-color "white" - :primary-color "#c6eaff" - :secondary-color "#323232" - :tertiary-color "#323232" - :quaternary-color "#a8a8a8" - :accent-color "#afafef" - :font-family "Iosevka" - :stylist (make-instance 'nx-mapper/stylor-mode:user-stylist)))))) -#+end_src - -The above configuration initially defines a script mapping called =FSF= which matches on the =fsf.org= domain, thereby triggering the script provided by the =script= slot, which in this case will simply change the page's internal contents to effectively just show the string "/This was invoked by some sample JavaScript/". - -The next set of rules involve external themes, which carry the same principle as scripts in that they map a set of predicates to external styles specified by the =style= slot. As previously outlined, this style can be in the form of a CSS string, such as the one specified by the =GitHub= mapping (which uses the library =cl-css= that compiles Common Lisp into a CSS string). This first mapping, for instance, gets rid of the number specifying how many people are watching a repository. The =style= slot can also take a function that has the current active internal theme as its argument, such the one given by the =Lisp Documentation= mapping, which will essentially provide the same background and text color as the current internal theme for the whole site. If the style sheet becomes too big or you would like to use your favorite editor to tweak it, you can optionally also provide a pathname pointing to the CSS file. Finally, if you have your styles remotely backed up or stumble across one you like in a user-style or user-script platform like [[https://userstyles.world/][UserStyles.world]], you can simply point to their URL and they will be automatically applied. - -Finally, there's the internal themes rules, where as we can see from the above we have to issue a name for the mapping, and then a set of theme attributes which are built into the =nyxt/theme= library that ships with the browser as of version =2.2.4=. In addition to these, each internal theme can take a "/stylist/", a custom style crafter that allows you to style specific elements of the browser's interface if you aren't satisfied with the default layout of a certain element, such as the mode line, as well as allowing for dynamic theme change without having to restart the browser. A stylist effectively aims at reducing the complexity associated with having to manually define the =style= slot of many user classes, and can be defined as follows. - -#+begin_src lisp -(define-configuration stylor:stylist - ((stylor:name "Minimal UI") - (stylor:prompt-style - (lambda (theme) - (theme:themed-css theme - (* :font-family theme:font-family) - ("#prompt-modes" - :display "none") - ("#prompt-area" - :background-color theme:tertiary - :color theme:quaternary - :border "1px solid" - :border-color (if (theme:dark-p theme:theme) theme:quaternary theme:text)) - ("#input" - :background-color theme:tertiary - :color theme:text) - (".source-content" - :border "none" - :border-collapse collapse) - (".source-name" - :background-color theme:background - :color theme:text - :font-style "italic") - (".source-content th" - :padding-left "0" - :background-color theme:background - :font-weight "bold") - (".source-content td" - :padding "0 2px") - ("#selection" - :font-weight "bold" - :background-color theme:secondary - :color theme:text)))) - (stylor:buffer-style - (lambda (theme) - (theme:themed-css theme - (body - :font-family theme:font-family - :background-color theme:background - :color theme:text) - ("h1,h2,h3,h4,h5,h6" - :font-family "IBM Plex Sans" - :color theme:primary) - ("p,pre,td" - :font-family "IBM Plex Sans" - :color theme:text) - (pre - :background-color theme:tertiary) - ("button,a:link" - :color theme:text - :font-family "IBM Plex Sans") - (".button, .button:hover , .button:visited, .button:active" - :background-color theme:secondary - :border "1px solid" - :border-color (if (theme:dark-p theme:theme) theme:quaternary theme:text) - :color theme:text) - (code - :font-family "Iosevka" - :background-color theme:tertiary)))) - (stylor:status-style - (lambda (theme) - (theme:themed-css theme - (body - :font-family theme:font-family - :height "100%" - :width "100%" - :border "1px solid" - :border-color (if (theme:dark-p theme:theme) theme:quaternary theme:text) - :box-sizing "border-box" - :line-height "20px" - :display "flex" - :flex-direction "column" - :background theme:tertiary - :flex-wrap "wrap") - ("#container" - :display "flex" - :height "100%" - :width "100%" - :line-height "20px" - :justify-content "space-between" - :align-items "center") - ("#buttons" - :display "flex" - :align-items "center" - :justify-content "center" - :line-height "20px" - :height "100%") - ("#url" - :font-weight "bold" - :max-width "60%" - :padding-right "0" - :padding-left "5px" - :background-color theme:tertiary - :color theme:text - :box-sizing "border-box" - :z-index "auto") - ("#tabs, #controls" :display "none") - ("#modes" - :padding-right "2px" - :background-color theme:tertiary - :box-sizing "border-box" - :color theme:text - :display "flex" - :justify-contents "flex-end" - :z-index "auto") - (.button - :color theme:text)))) - (stylor:message-style - (lambda (theme) - (theme:themed-css theme - (body - :color theme:text - :background-color theme:background - :font-family theme:font-family)))) - (stylor:hint-style - (lambda (theme) - (theme:themed-css theme - (".nyxt-hint" - :background-color theme:primary - :color theme:background - :font-weight "bold" - :padding "0px 3px" - :border-radius "2px" - :z-index #.(1- (expt 2 31)))))))) -#+end_src - -This is an example stylist which I use in my configuration for a more compact and minimal interface to the browser, which looks like the following, but the user is welcome to change each style slot as they see fit. Also, it's worth noting this is the default stylist, but you can pass any stylist object to an internal theme, to tweak the layout appearance per theme too. - -[[file:assets/stylist-dark.jpg]] - -[[file:assets/stylist-light.jpg]] - -** rural-mode -:PROPERTIES: -:CUSTOM_ID: rural-mode -:END: -=rural-mode= is an extension which enables fine-grained control over URL associations. Even though the Nyxt team is already working on a solution via =no-procrastinate-mode= which prevents the access to certain hosts as per [[https://github.com/atlas-engineer/nyxt/pull/1771][#1771]], as well as =blocker-mode=, which can also be leveraged to block the access to arbitrary hosts, I find that declaratively specifying these mappings in a consistent syntax and without having to rely on multiple external files is more cohesive. Also, even though there's already a Nyxt extension which provides redirections in the form of [[https://github.com/kssytsrk/nx-freestance-handler][nx-freestance-handler]], I quickly felt its limitation in the number of sites it provides support for, as I found myself adding more request resource handlers to my own configuration. As such, I decided to roll out a more general-purpose solution, so the user is not limited to a predefined number of URL associations and can mold flexible mappings as they please. - -Therefore, you can set up a configuration for some URL mappings such as what follows in your Nyxt initialization file. - -#+begin_src lisp -(import 'mapper:make-mapping) - -(define-configuration rural:settings - ((rural:url-mappings - (list - ;; 1 - (make-mapping "Instagram" '((match-domain "instagram.com") - (match-regex "https://bibliogram.*") - :redirect '("insta.trom.tf" (:path ("/u" (not "/" "/p/" "/tv")))) - :instances (lambda () - (delete - nil - (mapcar - (lambda (instance) - (unless (str:emptyp - (alex:assoc-value instance :url)) - (alex:assoc-value instance :url))) - (json:with-decoder-simple-list-semantics - (json:decode-json-from-string - (dex:get - "https://bibliogram.art/api/instances")))))))) - ;; 2 - (make-mapping "Reddit" '(match-domain "reddit.com") - :redirect "teddit.namazso.eu" - :blocklist '(:path (:contains (not "/comments")))) - ;; 3 - (make-mapping "Audio" '((match-regex ".*/watch\\?v=.*") - (match-file-extension "mp3") + (make-route '((match-domain "instagram.com") + (match-regex "https://bibliogram.*")) + :redirect '("insta.trom.tf" (:path ("/u" (not "/" "/p/" "/tv")))) + :instances (lambda () + (delete + nil + (mapcar + (lambda (instance) + (unless (str:emptyp + (alex:assoc-value instance :url)) + (alex:assoc-value instance :url))) + (json:with-decoder-simple-list-semantics + (json:decode-json-from-string + (dex:get + "https://bibliogram.art/api/instances"))))))) + (make-route (match-domain "reddit.com") + :redirect "teddit.namazso.eu" + :blocklist '(:path (:contains (not "/comments")))) + (make-route '((match-regex ".*/watch\\?v=.*") + (match-file-extension "mp3") :redirect "youtube.com" :external (lambda (data) (eval-in-emacs `(init-multimedia-mpv-start ,(quri:render-uri (url data)) :audio-only t :repeat t))))) - ;; 4 - (make-mapping "Amazon" '(match-domain "amazon.com") - :blocklist '(:host (:starts (not "smile")))) - ;; 5 - (make-mapping "Lemmy" '(match-domain "lemmy.ml") - :blocklist '(:path (:contains ("post") :starts ("/u")))) - ;; 6 - (make-mapping "GitHub" '(match-domain "github.com") - :blocklist '(:path (or 1 (:contains (not "pulls" "search"))))) - ;; 7 - (make-mapping "Blocked" '((match-domain "timewastingsite1.com" - "timewastingsite2.com")) - :blocklist t))))) + (make-route (match-domain "amazon.com") + :blocklist '(:host (:starts (not "smile")))) + (make-route (match-domain "lemmy.ml") + :blocklist '(:path (:contains ("post") :starts ("/u")))) + (make-route (match-domain "github.com") + :blocklist '(:path (or 1 (:contains (not "pulls" "search"))))) + (make-route (match-domain "timewastingsite1.com" + "timewastingsite2.com") + :blocklist t))))) #+end_src -=rural-mode= mapping slots can hold the following values: +=route= slots include a mini-DSL that specifies what URL part to block as well as the comparison type. Personally, I believe this is a bit more straightforward than having to fiddle around with complex regular expressions. The following is a detailed description of all the available slots: -- =:redirect= :: this can take a redirect URL as a string, or a single pair of the form =(REPLACEMENT-PATH ORIGINAL-PATHS)=, where =ORIGINAL-PATHS= is a list of paths of the original URL which will be redirected to =REPLACEMENT-PATH=. If you want to redirect all paths except =ORIGINAL-PATHS= to =REPLACEMENT-PATH=, prefix this list with =not=. -- =:blocklist= :: this is a property list of blocking conditions in the form of =(TYPE VALUE)=, where =TYPE= can be one of =:path= or =:host=, and =VALUE= is either another property list of the form =(TYPE PATHNAMES)=, where =TYPE= is either =:starts=, =:ends=, or =:contains= to denote the URL comparison and =PATHNAMES= is a list of URL pathnames to draw the comparison against, or an integer to indicate the number of URL /sections/ (e.g. =https://example.com/section_1/section_2=) to block in case the blocking condition value is not known. If =PATHNAMES= is prefixed with =not=, all sites will be blocked except for the specified list. Also, a blocklist can be given the value =t= to block the whole URL for the defined sources. +- =:redirect= :: can take a redirect URL as a string, or a single pair of the form =(REPLACEMENT-PATH ORIGINAL-PATHS)=, where =ORIGINAL-PATHS= is a list of paths of the original URL which will be redirected to =REPLACEMENT-PATH=. If you want to redirect all paths except =ORIGINAL-PATHS= to =REPLACEMENT-PATH=, prefix this list with =not=. +- =:blocklist= :: a property list of blocking conditions in the form of =(TYPE VALUE)=, where =TYPE= can be one of =:path= or =:host=, and =VALUE= is either another property list of the form =(TYPE PATHNAMES)=, where =TYPE= is either =:starts=, =:ends=, or =:contains= to denote the URL comparison and =PATHNAMES= is a list of URL pathnames to draw the comparison against, or an integer to indicate the number of URL /sections/ (e.g. =https://example.com/section_1/section_2=) to block in case the blocking condition value is not known. If =PATHNAMES= is prefixed with =not=, all sites will be blocked except for the specified list. Also, a blocklist can be given the value =t= to block the whole URL for the defined sources. - =:external= :: used to open resources externally. If it's a function, it takes a single parameter =REQUEST-DATA= and can invoke arbitrary Lisp forms within it. If provided as a string, it will run the specified command via =uiop:run-program= with the current URL as its argument in a =format=-like syntax. -- =:media-p= :: whether to show media in the resource or not. This is useful if you want to block all media via the =nx-mapper/rural-mode:media-enabled-p= slot in =nx-mapper/rural-mode:settings=, but only override it for certain resources. +- =:media-p= :: whether to show media in the resource or not. This is useful if you want to block all media via the =router:media-enabled-p= slot, but only override it for certain resources. - =:instances= :: provides a list of instances to add to the default sources automatically computed via a custom function, which is useful if a service provides an official endpoint where these are stored. -The following describes the above examples: - -1. Set up all Instagram requests to redirect to the host =insta.trom.tf= and additionally redirect all its paths which don't start with =/=, =/p/=, or =/tv= to =/u= paths, as this is what the [[https://bibliogram.art/][Bibliogram]] alternative Instagram front-end uses for its URL structure. Do note this mapping also takes an =instances= slot, which can be either a list or a function that will compute a list of instances. This is useful if the service used to redirect the predicates offers a list of predefined instances, and these will also be added to the mapping's predicates on mapping instantiation. Indeed, mapping sources can also consist of lists of predicates for which to match URLs, which means on the =Instagram= mapping above, it will match either domains that contain =instagram.com= or URLs that contain the regexp starting with =https://bibliogram.*=. This was added to allow for more granularity, so that mappings can get applied on more triggers. - -2. Redirect all Reddit requests to the =teddit.namazso.eu= host and additionally block all of the paths pertaining to such trigger except the ones that contain the =/comments= path. This would essentially limit the user to only being able to access Reddit publications instead of sections like its main feed. - -3. Matches on YouTube video URLs, videos hosted on its alternative front-ends such as [[https://invidious.io/][Invidious]], as well as MP3 files, redirecting all of these requests to =youtube.com=, and dispatching a rule which invokes an external program with the current request data, in this case launching an [[https://mpv.io/][mpv]] player IPC client process to control the player from Emacs. Do note this is a custom function from my configuration, but we could also pass a one-placeholder format string such as =mpv --video=no ~a= to the =:external= slot if we'd rather not use a Lisp form, where =~a= represents the current mapping URL. - -4. Showcases the use of a hostname blocklist, in this case preventing the user from accessing Amazon URLs unless they contain the =smile= hostname. +The following describes the above routers as per their order. -5. Consists of a blocklist for certain paths of the =lemmy.ml= domain; namely, the blocked paths would be those that contain =post= on them or the ones that start with =/u=, which would block all publications and user profiles on the site. +- Set up all Instagram requests to redirect to the host =insta.trom.tf= and additionally redirect all its paths which don't start with =/=, =/p/=, or =/tv= to =/u= paths, as this is what the [[https://bibliogram.art/][Bibliogram]] alternative Instagram front-end uses for its URL structure. Do note this route also takes an =instances= slot, which can be either a list or a function that will compute a list of instances. This is useful if the service used to redirect the predicates offers a list of predefined instances, and these will also be added to the route's predicates on route instantiation. Indeed, triggers can also consist of lists of predicates for which to match URLs, which means on the =Instagram= route above, it will match either domains that contain =instagram.com= or URLs that contain the regexp starting with =https://bibliogram.*=. -6. Provides a combined path rule for =github.com= requests. Combined rules (specified via =or=) in paths allow you to specify two or more predicates that you wish to draw the path comparison against. In this combination, the integer will first indicate that we want to block those paths that consist of a single sub-section (e.g. =https://github.com/profile_name=), /or/ block all paths except the ones which contain =pulls= or =search=. This essentially allows you to specify a more general block rule and bypass it for certain scenarios. In this case, it would block all single-sub-section paths on =github.com= (such as profiles, the marketplace and so on) but at the same time allow you to use GitHub's search engine and see your listed pull requests. +- Redirect all Reddit requests to the =teddit.namazso.eu= host and additionally block all of the paths belonging to this trigger except those that contain the =/comments= path. This would essentially limit the user to only being able to access Reddit publications instead of sections like its main feed. -7. Serves as a general blocklist trigger. To block an entire URL predicate or list of predicates, you can simply pass =t= to the =blocklist= slot. +- Matches on YouTube video URLs, videos hosted on its alternative front-ends such as [[https://invidious.io/][Invidious]], as well as MP3 files, redirecting all of these requests to =youtube.com=, and dispatching a rule which invokes an external program with the current request data, in this case launching an [[https://mpv.io/][mpv]] player IPC client process to control the player from Emacs. Do note this is a custom function from my configuration, but we could also pass a one-placeholder format string such as =mpv --video=no ~a= to the =:external= slot if we'd rather not use a Lisp form, where =~a= represents the current route URL. -** Customization Interface -For those who aren't well versed with Lisp yet or don't like to tweak around with configuration files, a customization interface is provided through the =customize-mappings= command, which will show a two-paned settings page consisting of an automatically generated code snippet to be pasted in the user's Nyxt initialization file on the left pane and the actual extension settings on the right pane. +- Showcases the use of a hostname blocklist, in this case preventing the user from accessing Amazon URLs unless they contain the =smile= hostname. -Thus, the user can tweak the configuration on the right pane, being able to add, delete, and edit mappings as well as seeing their information in a more user-friendly interface, which is especially useful if they aren't used to a language with lots parentheses. Changes will see themselves reflected on the left pane as the user changes them, but it's important to note these will only persist for the current Nyxt session and it's thereby crucial one copies them over to their configuration so they get persisted. +- Consists of a blocklist for certain paths of the =lemmy.ml= domain; namely, the blocked paths would be those that contain =post= on them or the ones that start with =/u=, which would block all publications and user profiles on the site. -Moreover, there are some interactive commands like =select-internal-theme= which also allow the user to change the current theme on the fly without having to tweak their configuration. +- Provides a combined path rule for =github.com= requests. Combined rules (specified via =or=) in paths allow you to specify two or more predicates that you wish to draw the path comparison against. In this combination, the integer will first indicate that we want to block those paths that consist of a single sub-section (e.g. =https://github.com/profile_name=), /or/ block all paths except the ones which contain =pulls= or =search=. This essentially allows you to specify a more general block rule and bypass it for certain scenarios. In this case, it would block all single-sub-section paths on =github.com= (such as profiles, the marketplace and so on) but at the same time allow you to use GitHub's search engine and see your listed pull requests. -[[file:assets/custom.jpg]] +- Serves as a general blocklist trigger. To block an entire URL predicate or list of predicates, you can simply pass =t= to the =blocklist= slot. diff --git a/assets/custom.jpg b/assets/custom.jpg Binary files differdeleted file mode 100644 index 160778a..0000000 --- a/assets/custom.jpg +++ /dev/null diff --git a/assets/stylist-dark.jpg b/assets/stylist-dark.jpg Binary files differdeleted file mode 100644 index 58d1edc..0000000 --- a/assets/stylist-dark.jpg +++ /dev/null diff --git a/assets/stylist-light.jpg b/assets/stylist-light.jpg Binary files differdeleted file mode 100644 index 37667b2..0000000 --- a/assets/stylist-light.jpg +++ /dev/null diff --git a/nx-mapper.asd b/nx-mapper.asd deleted file mode 100644 index 3d66e6f..0000000 --- a/nx-mapper.asd +++ /dev/null @@ -1,13 +0,0 @@ -(asdf:defsystem #:nx-mapper - :description "nx-mapper provides easy-to-define mappings for the Nyxt browser." - :author "efimerspan" - :license "BSD 3-Clause" - :version "0.0.1" - :serial t - :depends-on (#:nyxt) - :pathname "src/" - :components ((:file "package") - (:file "stylor") - (:file "rural") - (:file "settings") - (:file "mapper"))) diff --git a/nx-router.asd b/nx-router.asd new file mode 100644 index 0000000..4754d57 --- /dev/null +++ b/nx-router.asd @@ -0,0 +1,9 @@ +(defsystem #:nx-router + :description "nx-router allows you to define composable and flexible routes for Nyxt." + :author "efimerspan" + :license "BSD 3-Clause" + :version "0.0.1" + :serial t + :depends-on (#:nyxt) + :components ((:file "package") + (:file "router"))) diff --git a/package.lisp b/package.lisp new file mode 100644 index 0000000..24579bf --- /dev/null +++ b/package.lisp @@ -0,0 +1,12 @@ +(uiop:define-package #:nx-router + (:nicknames #:router) + (:use #:cl) + (:import-from #:nyxt + #:define-class + #:user-class + #:define-mode + #:define-command-global + #:current-buffer + #:url + #:buffer) + (:documentation "nx-router allows you to define composable and flexible routes for Nyxt.")) diff --git a/src/rural.lisp b/router.lisp index fa13f64..ce76c30 100644 --- a/src/rural.lisp +++ b/router.lisp @@ -1,51 +1,26 @@ -(uiop:define-package #:nx-mapper/rural-mode - (:nicknames #:rural) - (:use #:cl) - (:import-from #:nyxt - #:define-class - #:define-user-class - #:define-mode - #:define-command-global - #:current-buffer - #:url - #:buffer) - (:documentation "Provides composable, easy-to-define, and flexible URL mappings for Nyxt.")) - -(in-package #:nx-mapper/rural-mode) +(in-package #:nx-router) (nyxt:use-nyxt-package-nicknames) -(define-class settings () - ((active-url-mapping - nil - :type (or null url-mapping) - :documentation "`url-mapping' currently active in the browser.") - (url-mappings - '() - :type list - :documentation "List of URL mappings that predicates are to be matched against the user's buffers.") - (media-enabled-p - t - :type boolean - :documentation "Whether to allow media in sites. This can be overridden per `url-mapping'.")) - (:export-class-name-p t) - (:export-accessor-names-p t) - (:accessor-name-transformer (class*:make-name-transformer name))) -(define-user-class settings) +(sera:export-always 'make-route) +(defun make-route (trigger &rest extra-slots &key &allow-other-keys) + "Constructs a route. TRIGGER is required and EXTRA-SLOTS can vary +depending on the complexity of the rule." + (apply #'make-instance 'route :trigger trigger extra-slots)) +(defun list-of-lists-p (object) + "Returns non-nil of OBJECT consists of a list of lists." + (and (listp object) + (every #'listp object))) -;; TODO: If instances is provided as a function, it can be too computing expensive -;; on initial Nyxt launch and it sometimes might not even get run at the right time -;; to be added to the URL mapping sources, needing for the mode to be re-invoked. -;; Look into using threads. -(define-class url-mapping (nx-mapper:mapping) - ((source +(define-class route () + ((trigger '() - :type (list function) - :documentation "Source where this mapping should be applied to.") + :type (or list function) + :documentation "Trigger(s) for this route to be followed.") (redirect nil :type (or list quri:uri string null) - :documentation "Main redirect URL to be used or, when :path is given, a single-pair + :documentation "Main redirect URL to be used for this route or, when :path is given, a single-pair of the form REPLACEMENT-PATH ORIGINAL-PATHS where ORIGINAL-PATHS is a list of paths of the original URL which will be redirected to REPLACEMENT-PATH. To redirect all paths except ORIGINAL-PATHS to REPLACEMENT-PATH, prefix this list with `not'.") @@ -56,7 +31,7 @@ prefix this list with `not'.") is one of :path or :host, and VALUE is another plist of the form TYPE PATHNAMES where TYPE is either :start, :end, or :contain and PATHNAMES is a list of URL pathnames to draw the comparison against. If PATHNAMES is prefixed with `not', all sites will be blocked except for the specified list. Also, if this is `t', it -will block the whole URL for the defined sources.") +will block the whole URL for the defined triggers.") (external nil :type (or null function string) @@ -69,53 +44,96 @@ it runs the specified command via `uiop:run-program' with the current URL as arg (instances nil :type (or null function) - :documentation "This provides a function to compute a list of instances to add to the default sources, + :documentation "This provides a function to compute a list of instances to add to the default triggers, useful if a service provides an official endpoint where these are stored.")) (:export-class-name-p t) (:export-slot-names-p t) (:export-accessor-names-p t) (:accessor-name-transformer (class*:make-name-transformer name)) - (:documentation "A `url-mapping' is that of a service which often times needs to be + (:documentation "A `route' is that of a service which often times needs to be redirected to a privacy-friendly alternative. Additionally, it can be used to enforce good habits by setting block lists to mold you the way you access sites.")) -(defmethod initialize-instance :after ((mapping url-mapping) &key) - (nyxt:run-thread "Build list of instances" - (with-slots (instances source) mapping - (flet ((construct-predicates () - (mapcar (lambda (instance) - (if (quri:uri-http-p (quri:uri instance)) - `(nyxt:match-url ,instance) - `(nyxt:match-host ,instance))) - (delete nil (funcall instances))))) - (alex:when-let ((instances (funcall instances))) - (if (nx-mapper::list-of-lists-p source) - (setf (source mapping) (append source (construct-predicates))) - (setf (source mapping) (cons source (construct-predicates))))))))) +(define-mode router-mode () + "Applies a set of routes on the current browsing session." + ((banner-p + :type (or null boolean) + :documentation "Whether to show a block banner when the route is blocked.") + (enforce-p + :type (or null boolean) + :documentation "Set this to non-nil to prevent you from disabling the mode.") + (current-route + nil + :type (or null route) + :documentation "Currently active `route'.") + (routes + '() + :type list + :documentation "List of provided routes to be matched against current buffer.") + (media-enabled-p + t + :type boolean + :documentation "Whether to allow media in routes. This can be overridden per `route'."))) + +(defmethod nyxt:enable ((mode router-mode) &key) + "Initializes `route-mode' to enable routes." + (when (nyxt:web-buffer-p (buffer mode)) + (hooks:add-hook (nyxt:request-resource-hook (buffer mode)) + (make-instance + 'hooks:handler + :fn (lambda (request-data) + (route-handler request-data mode)) + :name 'handle-routing)))) + +(defmethod nyxt:disable ((mode router-mode) &key) + "Cleans up `router-mode', removing the existing routes." + (when (and (nyxt:web-buffer-p (buffer mode)) + (not (enforce-p mode))) + (hooks:remove-hook (nyxt:request-resource-hook (buffer mode)) 'handle-routing))) + +(define-class source-type (prompter:source) + ((prompter:name "Source type") + (prompter:constructor (list "Domain" "Host" "Regex" "URL")))) + +;; (defmethod initialize-instance :after ((route route) &key) +;; (nyxt:run-thread "Builds list of instances" +;; (with-slots (instances trigger) route +;; (flet ((construct-predicates () +;; (mapcar (lambda (instance) +;; (if (quri:uri-http-p (quri:uri instance)) +;; `(nyxt:match-url ,instance) +;; `(nyxt:match-host ,instance))) +;; (delete nil (funcall instances))))) +;; (alex:when-let ((instances (funcall instances))) +;; (cond +;; ((list-of-lists-p trigger) +;; (setf (trigger route) (append trigger (construct-predicates)))) +;; ((listp trigger) +;; (setf (trigger route) (cons trigger (construct-predicates)))) +;; ((functionp trigger) +;; (setf (trigger route) (cons trigger (mapcar #'eval (construct-predicates))))))))))) -(defun perform-redirect (mapping url) - "Performs the redirect of URL as provided by `redirect' in MAPPING." - (if (typep (redirect mapping) 'list) +(defun perform-redirect (route url) + "Performs the redirect of URL as provided by `redirect' in ROUTE." + (if (typep (redirect route) 'list) (progn - (loop for (original rules) on (redirect mapping) + (loop for (original rules) on (redirect route) by #'cddr while rules do (handle-redirect-rule rules url)) - (setf (quri:uri-host url) (first (redirect mapping)))) - (setf (quri:uri-host url) (redirect mapping)))) + (setf (quri:uri-host url) (first (redirect route)))) + (setf (quri:uri-host url) (redirect route)))) -;; TODO: For same page requests, it sometimes won't perform the redirect so look -;; into using `buffer-loaded-hook' or `buffer-load-hook' -(defun redirect-handler (request-data mapping) - "Redirects REQUEST-DATA to the redirect of MAPPING." +(defun redirect-handler (request-data route) + "Redirects REQUEST-DATA to the redirect of ROUTE." (let ((url (url request-data))) - (perform-redirect mapping url) + (perform-redirect route url) (setf (url request-data) url)) request-data) -(defmethod block-handler (request-data mapping) - "Specifies rules for which to block REQUEST-DATA from loading in MAPPING." +(defun block-handler (request-data route) + "Specifies rules for which to block REQUEST-DATA from loading in ROUTE." (let ((url (url request-data)) - (blocklist (blocklist mapping)) + (blocklist (blocklist route)) block-p) (typecase blocklist (list (loop for (type rules) on blocklist @@ -126,40 +144,23 @@ redirected to a privacy-friendly alternative. Additionally, it can be used to en (progn ;; TODO: see if I can invoke `buffer-load' on the internal block page ;; to avoid having to delete the current buffer - (when (banner-p (nyxt:current-mode 'rural)) + (when (banner-p (current-router-mode)) (nyxt:delete-current-buffer) (display-blocked-page :url (nyxt:render-url url))) nil) request-data))) -(nyxt::define-internal-page-command-global display-blocked-page (&key (url nil)) - (buffer "*Blocked Site*" 'nyxt:base-mode) - "Shows blocked warning for URL." - (spinneret:with-html-string - (let ((mapping (nx-mapper/rural-mode:active-url-mapping nx-mapper:*user-settings*))) - (:style (nyxt:style buffer)) - (:div :style (cl-css:inline-css - '(:display "flex" :width "100%" - :justify-content "center" - :align-items "center" - :flex-direction "column" - :height "100%")) - (:img :src "https://nyxt.atlas.engineer/image/nyxt_128x128.png") - (:h1 "The page you're trying to access has been blocked by nx-mapper.") - (when url - (:a :style (cl-css:inline-css '(:text-decoration "underline")) url)))))) - -(defun external-handler (request-data mapping) - "Runs the MAPPING's specified external command with REQUEST-DATA." - (let ((rule (eval (external mapping))) +(defun external-handler (request-data route) + "Runs the ROUTE's specified external command with REQUEST-DATA." + (let ((external-rule (external route)) (url (url request-data))) - (etypecase rule + (etypecase external-rule (function - (when (redirect mapping) - (perform-redirect mapping url)) - (funcall rule request-data)) + (when (redirect route) + (perform-redirect route url)) + (funcall external-rule request-data)) (string - (uiop:run-program (format rule (quri:render-uri url))))) + (uiop:run-program (format external-rule (quri:render-uri url))))) nil)) (defun handle-redirect-rule (rules url) @@ -178,11 +179,11 @@ redirected to a privacy-friendly alternative. Additionally, it can be used to en (setf (quri:uri-path url) (str:replace-first old-prefix replacement (quri:uri-path url))))))))) - url) (defun handle-block-rules (rules url type) - "Evaluates if resource blocking should take place in URL according to RULES and TYPE." + "Evaluates if resource blocking should take place in URL according to blocking +RULES and TYPE." (let (block-p) (flet ((assess-rules (type test rules) (setf block-p @@ -217,7 +218,7 @@ redirected to a privacy-friendly alternative. Additionally, it can be used to en (:contains (assess-rules :path :contains paths)) (:starts (assess-rules :path :starts paths)) (:ends (assess-rules :path :ends paths)))))) - ;; TODO: allow to block user-provided predicate that takes the URL mapping path + ;; TODO: allow to block user-provided predicate that takes the URL rule path (integer (when (= (length (str:split-omit-nulls "/" (quri:uri-path url))) rules) (setf block-p t))))) @@ -259,70 +260,68 @@ TYPE can be one of :host, :path or :domain, while EQ-FN can be one of :starts, : (funcall predicate prefix uri-part))) url-parts)))) -(define-mode rural-mode () - "Apply a set of rules on a site." - ((nyxt:glyph "🖇") - (nyxt:constructor #'initialize) - (nyxt:destructor #'cleanup) - (banner-p t :type boolean - :documentation "Whether to show a block banner when the current site is blocked.") - (enforce-p nil :type boolean - :documentation "Set this to non-nil to prevent you from disabling the mode."))) - (defun set-media-state (state request-data) - "Sets the value of `url-media-p' to STATE for the current REQUEST-DATA." + "Sets the value of `media-p' to STATE for the current REQUEST-DATA." (nyxt:ffi-buffer-auto-load-image (buffer request-data) state) (nyxt:ffi-buffer-enable-media (buffer request-data) state)) -;; TODO: third party requests, such as embedded frames, are still being triggered -;; as per https://github.com/atlas-engineer/nyxt/issues/980 -(defun url-mapping-handler (request-data) - "Handles buffer and the `rural-mode' URL mapping associations -to dispatch the corresponding request-data." - (alex:if-let ((mapping (find-if (lambda (mapping) - (let ((source (source mapping))) - (if (nx-mapper::list-of-lists-p source) - (some (lambda (predicate) - (funcall (eval predicate) (url request-data))) - source) - (funcall (eval source) (url request-data))))) - (url-mappings nx-mapper:*user-settings*)))) - ;; TODO: external handler for certain URL parts - ;; TODO: block or redirect per page title +(defun current-router-mode () + "Returns `router-mode' if it's active in the current buffer." + (nyxt:find-submode + (nyxt:resolve-symbol :router-mode :mode '(:nx-router)))) + +(defun route-handler (request-data mode) + "Handles routes to dispatch with REQUEST-DATA from MODE's buffer." + (alex:if-let ((route (find-if (lambda (route) + (let ((source (trigger route))) + (cond + ((list-of-lists-p source) + (some (lambda (predicate) + (funcall (eval predicate) (url request-data))) + source)) + ((listp source) + (funcall (eval source) (url request-data))) + ((functionp source) + (funcall source (url request-data)))))) + (routes mode)))) (progn - (if (media-p mapping) - (set-media-state (not (media-enabled-p nx-mapper:*user-settings*)) request-data) - (set-media-state (media-enabled-p nx-mapper:*user-settings*) request-data)) - (setf (active-url-mapping nx-mapper:*user-settings*) mapping) + (setf (current-route mode) route) + (if (media-p route) + (set-media-state (not (media-enabled-p mode)) request-data) + (set-media-state (media-enabled-p mode) request-data)) (if (nyxt:request-resource-hook (current-buffer)) (cond - ((external mapping) - (external-handler request-data mapping)) - ((and (redirect mapping) - (blocklist mapping)) + ((external route) + (external-handler request-data route)) + ((and (redirect route) + (blocklist route)) (progn - (redirect-handler request-data mapping) - (block-handler request-data mapping))) - ((and (redirect mapping) - (null (external mapping))) - (redirect-handler request-data mapping)) - ((blocklist mapping) - (block-handler request-data mapping)) + (redirect-handler request-data route) + (block-handler request-data route))) + ((and (redirect route) + (null (external route))) + (redirect-handler request-data route)) + ((blocklist route) + (block-handler request-data route)) (t request-data)) - request-data)) + request-data))) (progn - (setf (active-url-mapping nx-mapper:*user-settings*) nil) - (set-media-state (media-enabled-p nx-mapper:*user-settings*) request-data) - request-data))) - -(defmethod initialize ((mode rural-mode)) - "Initializes `url-mapping-mode' to enable URL associations." - (when (nyxt:web-buffer-p (buffer mode)) - (hooks:add-hook (nyxt:request-resource-hook (buffer mode)) #'url-mapping-handler))) + (setf (current-route mode) nil) + (set-media-state (media-enabled-p mode) request-data) + request-data)) -(defmethod cleanup ((mode rural-mode)) - "Cleans up `url-mapping-mode'." - (when (and (nyxt:web-buffer-p (buffer mode)) - (not (enforce-p mode))) - (hooks:remove-hook (nyxt:request-resource-hook (buffer mode)) - #'url-mapping-handler))) +(nyxt::define-internal-page-command-global display-blocked-page (&key (url nil)) + (buffer "*Blocked Site*" 'nyxt:base-mode) + "Shows blocked warning for URL." + (spinneret:with-html-string + (:style (nyxt:style buffer)) + (:div :style (cl-css:inline-css + '(:display "flex" :width "100%" + :justify-content "center" + :align-items "center" + :flex-direction "column" + :height "100%")) + (:img :src "https://nyxt.atlas.engineer/image/nyxt_128x128.png") + (:h1 "The page you're trying to access has been blocked by nx-router.") + (when url + (:a :style (cl-css:inline-css '(:text-decoration "underline")) url))))) diff --git a/src/mapper.lisp b/src/mapper.lisp deleted file mode 100644 index 78bb3a0..0000000 --- a/src/mapper.lisp +++ /dev/null @@ -1,40 +0,0 @@ -(in-package #:nx-mapper) - -(hooks:add-hook nyxt:*after-init-hook* - (make-instance - 'hooks:handler - :fn (lambda () - (setf nx-mapper:*user-settings* - (make-instance 'nx-mapper:user-settings))) - :name 'apply-user-settings)) - -(sera:export-always 'delete-mapping) -(define-command-global delete-mapping (type name mapping-name) - "Deletes the mapping of class TYPE with MAPPING-NAME from the - global extension settings' slot NAME." - (let* ((settings-slot (funcall - (sb-mop:slot-definition-name - (find name (sb-mop:class-slots (find-class 'nx-mapper:user-settings)) - :key #'sb-mop:slot-definition-name)) - nx-mapper:*user-settings*)) - (mapping (find mapping-name - (nx-mapper/stylor-mode:internal-themes nx-mapper:*user-settings*) - :key #'nx-mapper:name :test #'string=))) - (when (nyxt:prompt1 :prompt (format nil "Are you sure you want to delete ~s?" - (nx-mapper:name mapping)) - :sources (make-instance 'prompter:yes-no-source)) - (setf settings-slot (delete mapping settings-slot)) - (nyxt:reload-current-buffer)))) - -(define-command-global reset-configuration () - "Resets user settings to the default values. This is useful to re-evaluate -your user settings in your init file and then reload them in the current Nyxt session." - (let ((active-theme (nx-mapper/stylor-mode:active-internal-theme - nx-mapper:*user-settings*))) - (setf nx-mapper:*user-settings* - (make-instance 'nx-mapper:user-settings)) - (setf (nx-mapper/stylor-mode:active-internal-theme - nx-mapper:*user-settings*) - active-theme) - (nyxt:reload-current-buffer) - (nyxt:echo "Settings reset."))) diff --git a/src/package.lisp b/src/package.lisp deleted file mode 100644 index 6ce2057..0000000 --- a/src/package.lisp +++ /dev/null @@ -1,34 +0,0 @@ -(uiop:define-package #:nx-mapper - (:nicknames #:mapper) - (:use #:cl) - (:import-from #:nyxt - #:define-mode - #:define-class - #:define-user-class - #:define-command-global) - (:documentation "nx-mapper provides a general mode to map entities into triggers which will invoke them. -Currently, supported entities include themes and URL associations.")) - -(in-package #:nx-mapper) -(nyxt:use-nyxt-package-nicknames) - -(define-class mapping () - ((name - "" - :type string - :documentation "The name of the mapping.")) - (:export-class-name-p t) - (:export-accessor-names-p t) - (:accessor-name-transformer (class*:make-name-transformer name))) - -;; WIP: Add a global settings class that smaller extensions can inherit from to define -;; their own settings or the other way round, i.e. a global settings class which inherits from all other classes? - -(sera:export-always '*user-settings*) -(defparameter *user-settings* nil - "The global user `nx-mapper' user settings.") - -(defun list-of-lists-p (object) - "Returns non-nil of OBJECT consists of a list of lists." - (and (listp object) - (every #'listp object))) diff --git a/src/settings.lisp b/src/settings.lisp deleted file mode 100644 index b57a52d..0000000 --- a/src/settings.lisp +++ /dev/null @@ -1,374 +0,0 @@ -(in-package #:nx-mapper) - -(define-class settings (nx-mapper/stylor-mode:user-settings - nx-mapper/rural-mode:user-settings) - () - (:export-class-name-p t)) -(define-user-class settings) - -(sera:export-always 'make-mapping) -(defun make-mapping (name source &rest extra-slots &key &allow-other-keys) - "Constructs a `nx-mapper' mapping. NAME and SOURCE are required and EXTRA-SLOTS -can vary depending on how modular one wants their mapping to be." - (cond - ((some (lambda (slot) - (member slot (list :redirect :blocklist :external :media-p))) - extra-slots) - (apply #'make-instance 'nx-mapper/rural-mode:url-mapping :name name :source source extra-slots)) - ((member :style extra-slots) - (apply #'make-instance 'nx-mapper/stylor-mode:external-theme :name name :source source extra-slots)) - ((member :script extra-slots) - (apply #'make-instance 'nx-mapper/stylor-mode:user-script :name name :source source extra-slots)) - (t - (apply #'make-instance 'nx-mapper/stylor-mode:internal-theme :name name extra-slots)))) - -(sera:export-always 'add-mapping) -(defun add-mapping (type name &key (filter-fn nil) (direct-p nil)) - "Interactively adds a new mapping of class TYPE to the extension's user settings slot NAME. -Optionally, specify how to filter out each of the class slots with FILTER-FN, and specify -DIRECT-P to only get prompted for the direct slots." - (let* ((computed-slots - (if filter-fn - (remove-if-not filter-fn - (if direct-p - (sb-mop:class-direct-slots (find-class type)) - (sb-mop:class-slots (find-class type)))) - (if direct-p - (sb-mop:class-direct-slots (find-class type)) - (sb-mop:class-slots (find-class type))))) - (slots (mapcar (lambda (slot) - (let* ((slot-name (sb-mop:slot-definition-name slot)) - (formatted-name (intern (symbol-name slot-name)))) - ;; When adding a source slot, prompt the user for the type of predicate, and then - ;; construct the source with it and the url, use data-path-source - ;; When the slot has type boolean or ends in -p, prompt for yes or no sources - (etypecase (sb-mop:slot-definition-type slot) - (boolean - (cons (intern (symbol-name slot-name) "KEYWORD") - (nyxt:prompt1 :prompt formatted-name - :sources (make-instance 'prompter:yes-no-source)))) - (t - (cons (intern (symbol-name slot-name) "KEYWORD") - (nyxt:prompt1 :prompt formatted-name - :sources (make-instance 'prompter:raw-source))))))) - computed-slots))) - (nconc - (funcall - (sb-mop:slot-definition-name - (find name (sb-mop:class-slots (find-class 'nx-mapper:settings)) - :key #'sb-mop:slot-definition-name)) - nx-mapper:*user-settings*) - (list - (eval - `(make-instance ',type - ,@(alex:flatten slots))))))) - -(defun retrieve-instance-slots (class instance &key (direct-p nil)) - "Returns the slot information as it was provided to create the INSTANCE from CLASS. -If DIRECT-P, only return the direct slots from CLASS." - (let ((slots - (mapcar - (lambda (slot) - (let ((slot-initarg - (intern - (symbol-name (sb-mop:slot-definition-name slot)) "KEYWORD")) - (computed-slot (funcall (sb-mop:slot-definition-name slot) instance))) - (if (typep (class-of computed-slot) 'standard-class) - (cons slot-initarg - (intern - (format nil "(make-instance '~(~s~))" - (type-of computed-slot)))) - (when computed-slot - (typecase computed-slot - (list - (list slot-initarg (intern (format nil "'~s" computed-slot)))) - (function - (cons slot-initarg (funcall computed-slot instance))) - (quri:uri - (cons slot-initarg (nyxt:render-url computed-slot))) - (t - (cons slot-initarg computed-slot))))))) - (sb-mop:class-slots (find-class class))))) - (loop for (head . tail) in (delete nil slots) - nconc (list head (if (listp tail) - (car tail) - tail))))) - -(defun print-configuration (slots) - (when slots - (format - nil " (~(~a~) ~& (list~&~{~a~^~&~}))" - (format nil "~ss"(type-of (car slots))) - (loop for slot in slots - collect - (format nil " (make-instance '~(~s~) ~& ~{~(~s~)~* ~:*~s~^~& ~})" - (type-of slot) - (retrieve-instance-slots (type-of slot) slot)))))) - -(defun print-init-snippet () - "Prints the resulting code snippet to be placed in the user's -Nyxt initialization file." - (let* ((internal-themes (nx-mapper/stylor-mode:internal-themes nx-mapper:*user-settings*)) - (external-themes (nx-mapper/stylor-mode:external-themes nx-mapper:*user-settings*)) - (url-assocs (nx-mapper/rural-mode:url-mappings nx-mapper:*user-settings*)) - (generated-code (format nil "(define-configuration nx-mapper:settings ~&~@{~a~^~&~})" - (print-configuration internal-themes) - (print-configuration external-themes) - (print-configuration url-assocs)))) - (spinneret:with-html-string - (:aside - :style (cl-css:inline-css - '(:width "50%" :padding "0 2 rem" - :overflow-y "scroll")) - (:h1 (:code "nx-mapper") " initialization snippet") - (:p - "After customizing, one is to put this code snippet into their Nyxt init file at " - (:code (format nil "~a" (nfiles:expand nyxt:*init-file*))) ".") - (:div (:button :class "button" - :onclick (ps:ps (nyxt/ps:lisp-eval - `(progn - (nyxt:copy-to-clipboard ,generated-code) - (nyxt:echo "Copied to clipboard!")))) - "+ Copy ") - (:button :class "button" - :onclick (ps:ps (nyxt/ps:lisp-eval - `(reset-configuration))) - "🔁 Reset configuration")) - (:pre (:code generated-code)))))) - -(defun show-internal-themes-configuration () - "Shows the section about Internal Themes." - (spinneret:with-html-string - (:h2 "Internal themes") - (:p "The following themes tweak the appearance of the browser interface.") - ;; TODO: Add sun or moon icon depending if the theme is dark or not - (:div - (:button :class "button" - :onclick (ps:ps (nyxt/ps:lisp-eval '(nx-mapper:add-mapping - 'nx-mapper/stylor-mode:internal-theme - 'nx-mapper/stylor-mode:internal-themes))) - "+ Add theme")) - (alex:if-let ((internal-themes (nx-mapper/stylor-mode:internal-themes - nx-mapper:*user-settings*))) - (dolist (theme internal-themes) - (let ((theme-name (nx-mapper:name theme)) - (global-theme (nyxt:theme nyxt:*browser*)) - (color-slots (remove-if-not - (lambda (slot) - (str:containsp "color" (str:downcase slot))) - (mapcar (lambda (slot) - (sb-mop:slot-definition-name slot)) - (sb-mop:class-direct-slots (find-class 'theme:theme)))))) - (:div - (:h2 (str:concat theme-name - (when (eq global-theme theme) - " *") - (if (theme:dark-p theme) - " 🌚" " 🌞"))) - (:table :style (format - nil - "table-layout: fixed; width: 100%; margin: 10px 0; border: 1px solid ~a" - (if (theme:dark-p global-theme) - (theme:tertiary-color global-theme) - (theme:text-color global-theme))) - (loop for slot in color-slots - collect (:tr - (:td :style (cl-css:inline-css '(:padding "10px")) - (car (str:split "-" (str:capitalize (string slot))))) - ;; Once the color picker is chosen, add a button which lets us - ;; edit the color from this table data - (:td :style (cl-css:inline-css - `(:background ,(funcall slot theme) - :padding "25px" :width "50%")))))) - (:button :class "button" - :onclick (ps:ps (nyxt/ps:lisp-eval - `(nx-mapper/stylor-mode:select-internal-theme ,theme-name))) - "💾 Load theme") - (:button :class "button" - :onclick (ps:ps (nyxt/ps:lisp-eval - `(delete-mapping - 'nx-mapper/stylor-mode:internal-theme - 'nx-mapper/stylor-mode:internal-themes - ,theme-name))) - "- Delete theme"))))) - (:p "No browser themes specified."))) - -(defun show-external-themes-configuration (buffer) - "Displays the section to do with external themes in BUFFER." - (spinneret:with-html-string - (:h2 "External Themes") - (:p "These allow you to set rules for which to apply CSS styles to arbitrary sources.") - (:div - (:button :class "button" - :onclick (ps:ps (nyxt/ps:lisp-eval '(nx-mapper:add-mapping - 'nx-mapper/stylor-mode:external-theme - 'nx-mapper/stylor-mode:external-themes))) - "+ Add theme")) - (alex:if-let ((external-themes (nx-mapper/stylor-mode:external-themes - nx-mapper:*user-settings*))) - (dolist (theme external-themes) - (let ((name (nx-mapper:name theme)) - (style-mapping (nx-mapper/stylor-mode:style theme)) - (sources (nx-mapper/stylor-mode:source theme))) - (:div - (:h3 name) - (:raw (nx-mapper::show-mapping-sources sources)) - (typecase style-mapping - (quri:uri - (:pre (:code (nyxt/style-mode::open-or-cache-url (nyxt:find-mode buffer 'stylor-mode) - (nyxt:render-url style-mapping))))) - (pathname - (:pre (:code (uiop:read-file-string style-mapping)))) - (function (:pre - (:code - (if (nx-mapper/stylor-mode:active-internal-theme - nx-mapper:*user-settings*) - (funcall style-mapping (nx-mapper/stylor-mode:active-internal-theme - nx-mapper:*user-settings*)) - (funcall style-mapping (nyxt:theme nyxt:*browser*)))))) - (t (:pre (:code style-mapping)))) - (:div - (:button - :class "button" - :onclick (ps:ps (nyxt/ps:lisp-eval - '(progn - (setf sources - (nyxt:prompt1 - :prompt "Source type:" - :source (make-instance - nx-mapper/stylor-mode::source-type)))))) - "Change sources") - (typecase style-mapping - (quri:uri - (:button - :class "button" - :onclick (ps:ps (nyxt/ps:lisp-eval - ;; Provide the value to be updated (i.e. the URL) - `(nx-mapper/stylor-mode::update-style - ,name - :external-p t))) - "Change CSS URI")) - (string (:button :class "button" - :onclick (ps:ps (nyxt/ps:lisp-eval - `(nyxt::%edit-with-external-editor ,style-mapping))) - "Edit CSS")) - (function (:button :class "button" - :onclick (ps:ps (nyxt/ps:lisp-eval - `(nx-mapper/stylor-mode::update-style - ,name - :external-p t))) - "Edit CSS")) - (t (:button :class "button" - :onclick (ps:ps (nyxt/ps:lisp-eval - `(nyxt::%edit-with-external-editor ,style-mapping))) - "Edit CSS"))))))) - (:p "No external themes specified.")))) - -(defun show-scripts-configuration () - "Shows the section relevant to user scripts." - (spinneret:with-html-string - (:h2 "User Scripts") - (:p "The following allow one to tweak the behavior of a site via JavaScript.") - (:div - (:button :class "button" - :onclick (ps:ps (nyxt/ps:lisp-eval '(nx-mapper:add-mapping - 'nx-mapper/stylor-mode:script - 'nx-mapper/stylor-mode:scripts))) - "+ Add script")) - (alex:if-let ((scripts (nx-mapper/stylor-mode:scripts nx-mapper:*user-settings*))) - (dolist (script scripts) - (let ((name (nx-mapper:name script)) - (script-mapping (nx-mapper/stylor-mode:script script)) - (sources (delete nil (nx-mapper/stylor-mode:source script)))) - (:div - (:h3 name) - (:raw (nx-mapper::show-mapping-sources sources)) - (typecase script-mapping - ;; (quri:uri - ;; (:pre (:code (nyxt/style-mode::open-or-cache-url (nyxt:find-mode buffer 'stylor-mode) - ;; (nyxt:render-url style-mapping)))) - ;; ;; (:p "The style is located at " (:a :href (nyxt:render-url style-mapping) - ;; ;; (nyxt:render-url style-mapping))) - ;; ) - ;; (pathname - ;; (:pre (:code (uiop:read-file-string style-mapping)))) - ;; (function (:pre - ;; (:code - ;; (funcall style-mapping (nx-mapper/stylor-mode:active-internal-theme - ;; nx-mapper:*user-settings*))))) - (t (:pre (:code script-mapping))))))) - (:p "No user scripts specified.")))) - -;; TODO: add buttons to edit all fields of a mapping and send these per value -(defun show-url-assocs-configuration () - "Shows the section to do with URL mappings." - (spinneret:with-html-string - (:h2 "URL Associations") - (:p "The following allow you to provide behavior for certain sources, such as redirect or block.") - (:div - (:button :class "button" - :onclick (ps:ps (nyxt/ps:lisp-eval '(nx-mapper:add-mapping - 'nx-mapper/rural-mode:url-mapping - 'nx-mapper/rural-mode:url-mappings))) - "+ Add URL mapping")) - (alex:if-let ((url-assocs (nx-mapper/rural-mode:url-mappings nx-mapper:*user-settings*))) - (dolist (url-mapping url-assocs) - (let ((name (nx-mapper:name url-mapping)) - (sources (delete nil (nx-mapper/rural-mode:source url-mapping)))) - (:div - (:h3 name) - (:p "Invoked with one of these triggers, and type of matching.") - (:raw (nx-mapper::show-mapping-sources sources))))) - (:p "No URL mappings specified.")))) - -(defun show-mapping-sources (sources) - "Styles SOURCES to be displayed on the customization page." - (spinneret:with-html-string - (if (nx-mapper::list-of-lists-p sources) - (loop for (predicate . urls) in sources - collect - (:div - (:ul - (loop for url in urls - collect - (:li - (:p (:a :style "text-decoration: underline" url) - (:span (format nil " (~a)" - (cadr (str:split "-" (symbol-name predicate))))))))))) - (:ul - (:li - (:p (:a :style "text-decoration:underline" (cadr sources)) - (:span (format nil " (~a)" - (cadr (str:split "-" (symbol-name (car sources)))))))))))) - -(nyxt::define-internal-page-command-global customize-mappings () - (buffer "*nx-mapper settings*" 'nyxt:base-mode) - "Displays an extension customization page." - (spinneret:with-html-string - (:style (str:concat - (nyxt:style buffer) - (cl-css:css - '(("#settings-container" - :display "flex" - :width "100%" - :height "100%" - :overflow "hidden" - :flex-direction "row" - :justify-content "center") - ("#settings-pane" - :width "50%" - :overflow-y "scroll" - :padding "0 2rem"))))) - (:div :id "settings-container" - (:raw (nx-mapper::print-init-snippet)) - (:div :id "settings-pane" - (:h1 "Settings") - (:p (format nil "Welcome back, ~:(~a~), these are your nx-mapper settings." - (uiop:getenv "USER"))) - (:raw (nx-mapper::show-internal-themes-configuration)) - (:hr) - (:raw (nx-mapper::show-external-themes-configuration buffer)) - (:hr) - (:raw (nx-mapper::show-scripts-configuration)) - (:hr) - (:raw (nx-mapper::show-url-assocs-configuration)))))) diff --git a/src/stylor.lisp b/src/stylor.lisp deleted file mode 100644 index 000c8ca..0000000 --- a/src/stylor.lisp +++ /dev/null @@ -1,332 +0,0 @@ -(uiop:define-package #:nx-mapper/stylor-mode - (:nicknames #:stylor) - (:use #:cl) - (:import-from #:nyxt - #:define-class - #:define-user-class - #:define-mode - #:define-command - #:define-command-global - #:*browser* - #:theme - #:current-buffer - #:current-window - #:current-mode - #:buffer - #:url) - (:documentation "An interface to manage user custom style-sheets and scripts in Nyxt.")) - -(in-package #:nx-mapper/stylor-mode) -(nyxt:use-nyxt-package-nicknames) - -(define-class settings () - ((external-themes - '() - :type list - :documentation "`external-theme' objects for which to apply styles mapped to sources.") - (internal-themes - '() - :type list - :documentation "`internal-theme' objects among which to select the main internal interface theme.") - (active-internal-theme - nil - :type (or null internal-theme) - :documentation "`internal-theme' currently active in the browser.") - (active-external-theme - nil - :type (or null external-theme) - :documentation "`external-theme' currently active in the browser.") - (scripts - '() - :type list - :documentation "`user-script' objects for which to map sources to pieces of JavaScript to run in them.")) - (:export-class-name-p t) - (:export-accessor-names-p t) - (:accessor-name-transformer (class*:make-name-transformer name)) - (:documentation "User style and script configurations for both internal and external use to be leveraged -by `stylor-mode'.")) -(define-user-class settings) - -(define-class external-theme (theme:theme nx-mapper:mapping) - ((source - :documentation "Source where this theme is to be applied to.") - (style nil - :type (or null quri:uri string function) - :documentation "Style provided either as a CSS string, a function which takes a theme and returns a -CSS string (useful to share the same look between internal and external themes, can also be specified via :internal), a URL pointing to a CSS file, or a local pathname to a CSS file to apply to the specified SOURCE.")) - (:export-class-name-p t) - (:export-accessor-names-p t) - (:accessor-name-transformer (class*:make-name-transformer name))) - -(define-class stylist () - ((name - nil - :type (or null string) - :documentation "Stylist name.") - (buffer-style nil - :type (or null function) - :documentation "A function which takes an `internal-theme' and styles the `buffer' appearance.") - (prompt-style nil - :type (or null function) - :documentation "A function which takes an `internal-theme' and styles the `prompt-buffer' appearance.") - (status-style nil - :type (or null function) - :documentation "A function which takes an `internal-theme' and styles the `status-buffer' appearance.") - (message-style nil - :type (or null function) - :documentation "A function which takes an `internal-theme' and styles the `message-buffer' appearance.") - (hint-style nil - :type (or null function) - :documentation "A function which takes an `internal-theme' and styles the `box-style' appearance.")) - (:export-class-name-p t) - (:export-accessor-names-p t) - (:export-slot-names-p t) - (:accessor-name-transformer (class*:make-name-transformer name)) - (:documentation "A stylist is a custom style crafter filled with functions to style specific elements of the -internal interface of the browser.")) -(define-user-class stylist) - -(define-class internal-theme (theme:theme nx-mapper:mapping) - ((stylist - nil - :type (or null stylist) - :documentation "`stylist' object to allow for dynamic theme change.")) - (:export-class-name-p t) - (:export-accessor-names-p t) - (:accessor-name-transformer (class*:make-name-transformer name))) - -(define-class user-script (nx-mapper:mapping) - ((source - '() - :type list - :documentation "Source where this script is to be applied to.") - (script - nil - :type (or function null) - :documentation "Script provided as a JavaScript string to apply to the specified SOURCE.")) - (:export-class-name-p t) - (:export-accessor-names-p t) - (:accessor-name-transformer (class*:make-name-transformer name))) - -(define-class theme-source (prompter:source) - ((prompter:name "User themes") - (prompter:constructor (internal-themes nx-mapper:*user-settings*)) - (prompter:active-attributes-keys '("Name")))) - -(define-class source-type (prompter:source) - ((prompter:name "Source type") - (prompter:constructor (list "Domain" "Host" "Regex" "URL")))) - -(defun get-original-interface-style (element &optional style-slot parent-class) - "Finds the original STYLE-SLOT slot value of ELEMENT. If PARENT-CLASS, -looks through all the children class slots." - (sb-mop:slot-definition-initform - (find (or style-slot 'nyxt:style) (if parent-class - (sb-mop:class-slots - (find-class element)) - (sb-mop:class-direct-slots - (find-class element))) - :key (lambda (el) (slot-value el 'sb-pcl::name))))) - -;; TODO: take value to update various fields in a mapping -;; TODO: can this be abstracted away to `update-mapping'? -(defun update-style (name &key (external-p nil)) - "Updates style NAME. If EXTERNAL-P, it updates the external theme NAME." - (let ((mapping (find name (if external-p - (external-themes nx-mapper:*user-settings*) - (internal-themes nx-mapper:*user-settings*)) - :key #'nx-mapper:name :test #'string=))) - (setf (style mapping) - (etypecase (style mapping) - (function - (nyxt::%edit-with-external-editor - (funcall - (style mapping) - (nx-mapper/stylor-mode:active-internal-theme - nx-mapper:*user-settings*)))) - (string - (nyxt::%edit-with-external-editor - (style mapping))))))) - -(define-mode stylor-mode (nyxt/style-mode:style-mode) - "Mode that applies custom external themes." - ((nyxt:glyph "🖌") - (auto-p - nil - :type boolean - :documentation "Whether to automatically apply an `internal-theme' -variant based on the system environment.") - (nyxt:destructor #'cleanup) - (nyxt:constructor #'initialize))) - -(defun internal-style-handler (buffer) - "Handler function to re-calculate some styles in every new buffer." - (setf (nyxt::style buffer) (compute-buffer-style - (active-internal-theme nx-mapper:*user-settings*))) - (when (nyxt:find-submode buffer 'web-mode) - (setf (nyxt/web-mode:box-style (nyxt:find-submode buffer 'web-mode)) - (compute-hint-style - (active-internal-theme nx-mapper:*user-settings*))))) - -(defun external-style-handler (buffer) - "Handles setting external styles if the user-defined rules match BUFFER, and applies -the styles depending on the type of mapping provided." - (alex:when-let* ((mapping (find-if (lambda (mapping) - (let ((source (source mapping))) - (if (nx-mapper::list-of-lists-p source) - (some (lambda (predicate) - (funcall (eval predicate) buffer)) - source) - (funcall (eval source) buffer)))) - (external-themes nx-mapper:*user-settings*))) - (style (style mapping))) - (setf (active-external-theme nx-mapper:*user-settings*) mapping) - (nyxt::html-set-style - (etypecase style - (pathname (ignore-errors (uiop:read-file-string - (style mapping)))) - (quri:uri (nyxt/style-mode::open-or-cache-url (current-mode 'stylor) (style mapping))) - (string - (if (quri:uri-http-p (quri:uri style)) - (nyxt/style-mode::open-or-cache-url (current-mode 'stylor) (style mapping)) - (style mapping))) - (function (funcall style - (active-internal-theme nx-mapper:*user-settings*)))) - buffer)) - (alex:when-let* ((mapping (find-if (lambda (mapping) - (funcall (eval (source mapping)) buffer)) - (scripts nx-mapper:*user-settings*))) - (script (script mapping))) - (nyxt:ffi-buffer-evaluate-javascript-async - buffer - script))) - -(defmethod initialize ((mode stylor-mode)) - (with-slots (auto-p) mode - (unless (or (not (internal-themes nx-mapper:*user-settings*)) - (find (theme *browser*) - (internal-themes nx-mapper:*user-settings*) :test #'equal) - (active-internal-theme nx-mapper:*user-settings*)) - (or (and auto-p - (if (string= (uiop:getenv "GTK_THEME") ":light") - (select-internal-theme (nx-mapper:name (find-internal-variant)) mode) - (setf (nyxt::style (buffer mode)) - (compute-buffer-style - (select-internal-theme - (nx-mapper:name (find-internal-variant :dark t)) mode))))) - (select-internal-theme - (nx-mapper:name (car (internal-themes nx-mapper:*user-settings*))) mode)) - (hooks:add-hook (nyxt:buffer-before-make-hook *browser*) #'internal-style-handler)) - (when (internal-themes nx-mapper:*user-settings*) - (hooks:add-hook (nyxt:buffer-loaded-hook (buffer mode)) #'external-style-handler)))) - -(defmethod cleanup ((mode stylor-mode)) - (hooks:remove-hook (nyxt:buffer-loaded-hook (buffer mode)) #'external-style-handler) - (hooks:remove-hook (nyxt:buffer-before-make-hook *browser*) #'internal-style-handler) - (hooks:remove-hook (nyxt:prompt-buffer-make-hook *browser*) 'style-prompt-buffer)) - -(defmethod find-internal-variant (&key dark) - "Finds the first light theme variant from MODE. If DARK, it finds the first dark theme." - (if dark - (find-if #'theme:dark-p (internal-themes nx-mapper:*user-settings*)) - (find-if-not #'theme:dark-p (internal-themes nx-mapper:*user-settings*)))) - -(defun compute-buffer-style (theme) - (str:concat - (eval (get-original-interface-style 'nyxt:user-buffer nil t)) - (and (stylist theme) (funcall (buffer-style (stylist theme)) theme)))) - -(defun compute-hint-style (theme) - (str:concat - (eval (get-original-interface-style 'nyxt/web-mode:web-mode 'nyxt/web-mode:box-style)) - (and (stylist theme) (funcall (hint-style (stylist theme)) theme)))) - -(define-command-global select-internal-theme (&optional name (mode (current-mode 'stylor))) - "Selects an `internal-theme' with NAME from MODE and applies it." - (let* ((theme (or (and name - (find name (internal-themes nx-mapper:*user-settings*) - :key #'nx-mapper:name :test #'string=)) - (nyxt:prompt1 - :prompt "Select theme" - :sources (make-instance 'theme-source)))) - (stylist (stylist theme))) - (flet ((compute-prompt-style (theme) - (str:concat - (eval (get-original-interface-style - 'nyxt:prompt-buffer)) - (and stylist (funcall (prompt-style stylist) theme)))) - (compute-status-style (theme) - (str:concat - (eval (get-original-interface-style 'nyxt:status-buffer)) - (and stylist (funcall (status-style stylist) theme)))) - (compute-message-style (theme) - (str:concat - (eval (get-original-interface-style - 'nyxt:window 'nyxt:message-buffer-style)) - (and stylist (funcall (message-style stylist) theme))))) - (setf (active-internal-theme nx-mapper:*user-settings*) theme - (theme *browser*) theme) - (if (not (stylist theme)) - (progn - (hooks:remove-hook (nyxt:prompt-buffer-make-hook *browser*) - 'style-prompt-buffer) - (hooks:add-hook (nyxt:prompt-buffer-make-hook *browser*) - (make-instance - 'hooks:handler - :fn (lambda (prompt) - (setf (nyxt:style prompt) - (compute-prompt-style - (active-internal-theme nx-mapper:*user-settings*)))) - :name 'style-prompt-buffer-sans-stylist))) - (progn - (hooks:remove-hook (nyxt:prompt-buffer-make-hook *browser*) - 'style-prompt-buffer-sans-stylist) - (hooks:add-hook (nyxt:prompt-buffer-make-hook *browser*) - (make-instance - 'hooks:handler - :fn (lambda (prompt) - (setf (nyxt:style prompt) - (compute-prompt-style - (active-internal-theme nx-mapper:*user-settings*)))) - :name 'style-prompt-buffer)))) - (if (not (current-window)) - (hooks:add-hook (nyxt:window-make-hook *browser*) - (make-instance - 'hooks:handler - :fn (lambda (window) - (setf (nyxt::style (nyxt::status-buffer window)) - (compute-status-style (active-internal-theme - nx-mapper:*user-settings*)) - (nyxt:message-buffer-style window) - (compute-message-style (active-internal-theme - nx-mapper:*user-settings*))) - (hooks:remove-hook (nyxt:window-make-hook *browser*) - 'style-window-on-startup)) - :name 'style-window-on-startup)) - (setf (nyxt::style (nyxt::status-buffer (current-window))) - (compute-status-style (active-internal-theme nx-mapper:*user-settings*)) - (nyxt:message-buffer-style (current-window)) - (compute-message-style (active-internal-theme nx-mapper:*user-settings*)))) - (loop for buffer in (nyxt:buffer-list) - do (progn - (setf (nyxt::style buffer) (compute-buffer-style - (active-internal-theme nx-mapper:*user-settings*))) - ;; (unless name - ;; (nyxt:buffer-load (nyxt:url buffer) :buffer buffer)) - (nyxt:buffer-load (nyxt:url buffer) :buffer buffer))) - (when (nyxt:find-submode (buffer mode) 'web-mode) - (setf (nyxt/web-mode:box-style (nyxt:find-submode (buffer mode) 'web-mode)) - (compute-hint-style - (active-internal-theme nx-mapper:*user-settings*)))) - (nyxt::print-status) - (nyxt::echo "") - theme))) - -(define-command-global apply-current-theme () - "Apply the `active-internal-theme''s color scheme to the current page." - (nyxt::html-set-style - (funcall (buffer-style - (stylist - (active-internal-theme nx-mapper:*user-settings*))) - (active-internal-theme nx-mapper:*user-settings*)) - (current-buffer))) |
