From 54495fbb097661f9ca0836f1a08ed86f562cbbea Mon Sep 17 00:00:00 2001 From: "Andre A. Gomes" Date: Mon, 18 Dec 2023 16:26:07 +0200 Subject: [PATCH 1/2] Deprecate no-procrastinate mode. --- nyxt.asd | 1 - source/mode/no-procrastinate.lisp | 334 ----------------------- tests/offline/mode/no-procrastinate.lisp | 12 - 3 files changed, 347 deletions(-) delete mode 100644 source/mode/no-procrastinate.lisp delete mode 100644 tests/offline/mode/no-procrastinate.lisp diff --git a/nyxt.asd b/nyxt.asd index 2961c06eebb..faf983b4414 100644 --- a/nyxt.asd +++ b/nyxt.asd @@ -211,7 +211,6 @@ (:file "history-migration") (:file "macro-edit") (:file "no-image") - (:file "no-procrastinate" :depends-on ("blocker")) (:file "no-script") (:file "no-sound") (:file "no-webgl") diff --git a/source/mode/no-procrastinate.lisp b/source/mode/no-procrastinate.lisp deleted file mode 100644 index f11d0c52c74..00000000000 --- a/source/mode/no-procrastinate.lisp +++ /dev/null @@ -1,334 +0,0 @@ -;;;; SPDX-FileCopyrightText: Atlas Engineer LLC -;;;; SPDX-License-Identifier: BSD-3-Clause - -(nyxt:define-package :nyxt/mode/no-procrastinate - (:use :nyxt/mode/blocker) - (:documentation "Package for `no-procrastinate-mode' to lock requests for listed hosts. - -`no-procrastinate-entry' is the main class encapsulating the logic of -entries. `no-procrastinate-add' is the wrapper around it to add new entries. - -`serialize-object' is the method to print these hosts to the Lisp file -`read'ably. - -The mode itself inherits from `nyxt/mode/blocker:blocker-mode' and reuses its APIs.")) -(in-package :nyxt/mode/no-procrastinate) - -;;; TODO: Remove? It's mostly poorly duplicating the blocker-mode logic and is -;;; poorly written, rotting in the dark. - -(export-always '*default-hostlist-no-procrastinate*) -(defparameter *default-hostlist-no-procrastinate* - (make-instance 'hostlist - ;; FIXME: Use a local file instead of the absolutely - ;; unnecessary network round-trip. - :url (quri:uri "https://raw.githubusercontent.com/atlas-engineer/default-hosts-no-procrastinate/main/hosts") - :base-path #p"hostlist-no-procrastinate.txt") - "Default hostlist for `no-procrastinate-mode'.") - -(define-class no-procrastinate-hosts-file (files:data-file nyxt-lisp-file) - ((files:base-path #p"no-procrastinate-hosts") - (files:name "no-procrastinate-hosts")) - (:export-class-name-p t)) - -(define-mode no-procrastinate-mode (nyxt/mode/blocker:blocker-mode) - "Mode to block access to hosts associated with procrastination. - -Hostlists belong to hostlist-no-procrastinate.txt file in data directory. - -`*default-hostlist-no-procrastinate*' is a simple way to set things up for your -hostlists. See `nyxt/mode/blocker:blocker-mode' documentation for how to -configure such a hostlist variable. - -See `nyxt/mode/no-procrastinate' package documentation for implementation -details and internal programming APIs." - ((rememberable-p nil) - (no-procrastinate-hosts-file - (make-instance 'no-procrastinate-hosts-file) - :type no-procrastinate-hosts-file - :documentation "File where hosts associated to procrastination are saved.") - (style (theme:themed-css (theme *browser*) - `("summary" - :background-color ,theme:secondary - :color ,theme:on-secondary - :font-size "14px" - :padding "16px" - :margin "6px" - :width "100%" - :border "none" - :outline "none" - :text-align "left"))) - (nyxt/mode/blocker:hostlists - (list (nyxt/mode/blocker:make-hostlist - :hosts (mapcar #'(lambda (y) (hostname y)) - (when (current-buffer) - (files:content (no-procrastinate-hosts-file (current-buffer)))))) - *default-hostlist-no-procrastinate*)))) - -(defmethod no-procrastinate-hosts-file ((buffer buffer)) - (no-procrastinate-hosts-file (find-submode 'no-procrastinate-mode buffer))) - -(defun group-no-procrastinate-hosts (buffer) - (let ((no-procrastinate-hosts-table (make-hash-table :test #'equalp)) - (no-procrastinate-hosts (files:content (no-procrastinate-hosts-file buffer)))) - (dolist (no-procrastinate-host no-procrastinate-hosts) - (let ((tags (tags no-procrastinate-host))) - (if tags - (dolist (tag tags) - (push no-procrastinate-host (gethash tag no-procrastinate-hosts-table nil))) - (push no-procrastinate-host (gethash tags no-procrastinate-hosts-table nil))))) - no-procrastinate-hosts-table)) - -(define-internal-page-command-global list-no-procrastinate-hosts () - (no-procrastinate-hosts-buffer "*No Procrastinate Hosts*") - "List all hosts to avoid procrastination in a new buffer." - (let ((no-procrastinate-hosts (group-no-procrastinate-hosts no-procrastinate-hosts-buffer)) - (mode (find-submode 'nyxt/mode/no-procrastinate:no-procrastinate-mode - no-procrastinate-hosts-buffer))) - (spinneret:with-html-string - (:nstyle (style mode)) - (:h1 "Hosts to avoid procrastination") - (:body - (if (zerop (hash-table-count no-procrastinate-hosts)) - (format nil "No hosts to avoid procrastination in ~s." - (files:expand (no-procrastinate-hosts-file mode))) - (maphash - (lambda (tag no-procrastinate-hosts) - (:details - (:summary (or tag "Unsorted")) - (dolist (host no-procrastinate-hosts) - (let ((url-display (render-url (url host))) - (url-href (render-url (url host)))) - (:div :class "host-entry" - (:p (:b "Host: ") (hostname host)) - (:p (:b "Homepage's Title: ") (title host)) - (:p (:b "Homepage's URL: ") (:a :href url-href - url-display)) - (:p (:b "Tags: ") - (when (tags host) - (format nil " (~{~a~^, ~})" (tags host)))) - (:p (:button :class "button" - :onclick - (ps:ps - (let ((section (ps:chain (nyxt/ps:active-element document) - (closest ".host-entry")))) - (ps:chain section parent-node (remove-child section)) - (nyxt/ps:lisp-eval - (:title "delete-host") - (delete-no-procrastinate-host url-href)))) - "Delete")) - (:hr "")))))) - no-procrastinate-hosts)))))) - -(define-class no-procrastinate-entry () - ((url (quri:uri "")) - (hostname "") - (title "") - (date (time:now)) - (tags - '() - :type (list-of string))) - (:export-class-name-p t) - (:export-accessor-names-p t) - (:documentation "A singular `no-procrastinate-mode' entry. -Represents the `hostname' to block.")) - -(defmethod equals ((e1 no-procrastinate-entry) (e2 no-procrastinate-entry)) - "Entries are equal if the hosts and the paths are equal. -In particular, we ignore the protocol (e.g. HTTP or HTTPS does not matter)." - (url-equal (url e1) (url e2))) - -(-> no-procrastinate-add - (quri:uri &key (:title string) - (:date (or time:timestamp null)) - (:tags t) - (:hostname string)) - t) -(defun no-procrastinate-add (url &key date title tags hostname) - (files:with-file-content (no-procrastinate-hosts-list (no-procrastinate-hosts-file (current-buffer))) - (unless (or (url-empty-p url) - (string= "about:blank" (render-url url))) - (multiple-value-bind (entries no-procrastinate-hosts-without-url) - (sera:partition (sera:partial #'url-equal url) no-procrastinate-hosts-list :key #'url) - (let ((entry (if entries - (first entries) - (make-instance 'no-procrastinate-entry - :url url)))) - (unless (str:emptyp title) - (setf (title entry) title)) - (unless (str:emptyp hostname) - (setf (hostname entry) hostname)) - (setf tags (delete "" tags :test #'string=)) - (setf tags (delete-duplicates tags :test #'string=)) - (setf (tags entry) (sort tags #'string<)) - (when date - (setf (date entry) date)) - (push entry no-procrastinate-hosts-without-url) - (setf no-procrastinate-hosts-list no-procrastinate-hosts-without-url)))))) - -(define-class no-procrastinate-source (prompter:source) - ((prompter:name "Hosts to avoid procrastination") - (prompter:constructor (files:content (no-procrastinate-hosts-file (current-buffer)))) - (prompter:enable-marks-p t) - (prompter:active-attributes-keys - '("URL" "Title" "Tags") - :accessor nil))) - -(defmethod prompter:object-attributes ((entry no-procrastinate-entry) (source no-procrastinate-source)) - (declare (ignore source)) - `(("URL" ,(render-url (url entry))) - ("Hostname" ,(quri:uri-host (url entry))) - ("Title" ,(title entry)) - ("Tags" ,(format nil "~{~a ~}" (tags entry))) - ("Date" ,(date entry)))) - -(defun url-no-procrastinate-host-tags (url) - "Return the list of tags of the host corresponding to URL." - (let ((no-procrastinate-hosts-entry-list (files:content (no-procrastinate-hosts-file (current-buffer))))) - (alex:when-let ((existing (find url no-procrastinate-hosts-entry-list :key #'url :test #'url-equal))) - (tags existing)))) - -(define-command no-procrastinate-current-host (&optional (buffer (current-buffer))) - "Block procrastination on current hostname of BUFFER's URL." - (if (url-empty-p (url buffer)) - (echo "Buffer has no URL.") - (let* ((tags (prompt - :prompt (format nil "Tag(s) for ~a " (render-url (url buffer))) - :sources (list - (make-instance 'prompter:word-source - :name "New tags" - ;; On no input, suggest the empty tag which effectively acts as "no tag". - ;; Without it, we would be force to specify a tag. - :filter-postprocessor - (lambda (suggestions source input) - (declare (ignore source input)) - (or suggestions - (list ""))) - :enable-marks-p t) - (make-instance 'keyword-source - :buffer buffer) - (make-instance 'tag-source - :marks (url-no-procrastinate-host-tags (url buffer)))))) - (homepage-url-string (render-host-and-scheme (url buffer))) - (homepage-title (fetch-url-title (url buffer))) - (homepage-url-object (quri:uri homepage-url-string)) - (hostname (quri:uri-host homepage-url-object))) - (no-procrastinate-add homepage-url-object - :title homepage-title - :tags tags - :hostname hostname) - (echo "Associated as a host to avoid procrastination ~a." hostname)))) - -(define-command no-procrastinate-buffer-host () - "Add to the list of hostnames to avoid procrastination the currently opened -page(s) in the active buffer." - (prompt - :prompt "Avoid procrastination on HOSTS from buffer(s)" - :sources (make-instance 'buffer-source - :enable-marks-p t - :actions-on-return (lambda-mapped-command no-procrastinate-current-host)))) - - - -(define-command no-procrastinate-host (&key url) - "Allow the user to avoid procrastination on a HOST via prompt buffer input." - (let* ((url (or url - (ignore-errors (quri:uri - (prompt1 :prompt "Avoid procrastination the URL's host" - :sources (make-instance 'prompter:raw-source - :name "New URL")))))) - (homepage-url-string (render-host-and-scheme url)) - (homepage-title (fetch-url-title url)) - (homepage-url-object (quri:uri homepage-url-string)) - (hostname (quri:uri-host homepage-url-object))) - (if (not (valid-url-p url)) - (echo "Invalid URL '~a'" url) - (let* ((url (quri:uri url)) - (tags (prompt - :prompt "Tag(s)" - :sources (list - (make-instance 'prompter:word-source - :name "New tags" - :enable-marks-p t) - (make-instance 'tag-source - :marks (url-no-procrastinate-host-tags url)))))) - (no-procrastinate-add homepage-url-object - :title homepage-title - :hostname hostname - :tags tags))))) - -(define-command delete-no-procrastinate-host (&optional urls-or-no-procrastinate-host-entries) - "Delete host(s) matching URLS-OR-NO-PROCRASTINATE-HOST-ENTRIES -URLS is either a list or a single element." - (if urls-or-no-procrastinate-host-entries - (files:with-file-content (no-procrastinate-hosts (no-procrastinate-hosts-file (current-buffer))) - (setf no-procrastinate-hosts - (set-difference - no-procrastinate-hosts - (mapcar (lambda (url) - (if (no-procrastinate-entry-p url) - url - (make-instance 'no-procrastinate-entry :url (quri:uri url)))) - (uiop:ensure-list urls-or-no-procrastinate-host-entries)) - :test #'equals))) - (let ((entries (prompt - :prompt "Delete host(s)" - :sources (make-instance 'no-procrastinate-source - :enable-marks-p t)))) - (delete-no-procrastinate-host entries)))) - -(defmethod serialize-object ((entry no-procrastinate-entry) stream) - (unless (url-empty-p (url entry)) - (flet ((write-slot (slot) - (let ((entry-slot (funcall slot entry))) - (unless (str:emptyp entry-slot) - (format t " :~a ~s" - (str:downcase slot) - entry-slot))))) - (let ((*standard-output* stream)) - (write-string "(:url ") - (format t "~s" (render-url (url entry))) - (write-slot 'title) - (write-slot 'hostname) - (when (date entry) - (write-string " :date ") - ;; If we don't force the timezone, the timestamp could be serialized - ;; differently depending on the local timezone, e.g. - ;; 2020-12-10T11:46:02.500515+01:00 - ;; instead of - ;; 2020-12-10T10:46:02.500515Z - (format t "~s" (time:format-timestring nil (date entry) - :timezone time:+utc-zone+))) - (when (tags entry) - (write-string " :tags (") - (format t "~s" (first (tags entry))) - (dolist (tag (rest (tags entry))) - (write-string " ") - (write tag)) - (write-string ")")) - (write-string ")"))))) - -(defmethod files:serialize ((profile nyxt-profile) (file no-procrastinate-hosts-file) stream &key) - (let ((content - (files:content file))) - (write-string "(" stream) - (dolist (entry content) - (write-string +newline+ stream) - (serialize-object entry stream)) - (format stream "~%)~%") - (echo "Saved ~a host to avoid procrastination to ~s." - (length content) - (files:expand file)))) - -(defmethod files:deserialize ((profile nyxt-profile) (path no-procrastinate-hosts-file) raw-content &key) - (let ((entries (safe-read raw-content))) - (mapcar (lambda (entry) - (when (getf entry :url) - (setf (getf entry :url) - (quri:uri (getf entry :url)))) - (when (getf entry :date) - (setf (getf entry :date) - (time:parse-timestring (getf entry :date)))) - (apply #'make-instance 'no-procrastinate-entry - entry)) - entries))) diff --git a/tests/offline/mode/no-procrastinate.lisp b/tests/offline/mode/no-procrastinate.lisp deleted file mode 100644 index 0b750886f50..00000000000 --- a/tests/offline/mode/no-procrastinate.lisp +++ /dev/null @@ -1,12 +0,0 @@ -;;;; SPDX-FileCopyrightText: Atlas Engineer LLC -;;;; SPDX-License-Identifier: BSD-3-Clause - -(in-package :nyxt/tests) - -(define-test toggle-no-procrastinate-mode () - (let ((buffer (make-instance 'modable-buffer))) - (with-current-buffer buffer - (assert-true (enable-modes* 'nyxt/mode/no-procrastinate:no-procrastinate-mode - buffer)) - (assert-true (disable-modes* 'nyxt/mode/no-procrastinate:no-procrastinate-mode - buffer))))) From f71c5d8fd0031ba3a972f5773ba4b7ea75bcc07b Mon Sep 17 00:00:00 2001 From: "Andre A. Gomes" Date: Mon, 18 Dec 2023 16:26:13 +0200 Subject: [PATCH 2/2] migration: Mention deprecation of no-procrastinate-mode. --- source/migration.lisp | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/source/migration.lisp b/source/migration.lisp index a41603bcf02..8b851fb33f0 100644 --- a/source/migration.lisp +++ b/source/migration.lisp @@ -130,7 +130,10 @@ major versions." (:p "Deprecated support for lists as a value. Strings are the only valid values.") (conservative-history-movement-p) - (:p "Deprecated in favor of " (:nxref :slot 'global-history-p :class-name 'buffer) ".")) + (:p "Deprecated in favor of " (:nxref :slot 'global-history-p :class-name 'buffer) ".") + + nyxt/mode/no-procrastinate + (:p "Deprecated mode.")) (define-migration "3" (%slot-default)