<commit_before>(uiop:define-package :nyxt/auto-mode
  (:use :common-lisp :nyxt)
  (:import-from #:serapeum #:export-always)
  (:documentation "Mode for automatic URL-based mode toggling."))
(in-package :nyxt/auto-mode)
(eval-when (:compile-toplevel :load-toplevel :execute)
  (trivial-package-local-nicknames:add-package-local-nickname :alex :alexandria))

(export-always '*prompt-on-mode-toggle*)
(defvar *prompt-on-mode-toggle* nil
  "Whether user will be asked about adding the mode to included/excluded modes
in auto-mode-list on mode activation/deactivation.")

(export-always '*non-rememberable-modes*)
(defvar *non-rememberable-modes*
  ;; Base mode conflicts with its Nyxt symbol if it's not prefixed
  '(help-mode web-mode auto-mode nyxt::base-mode)
  "Modes that AUTO-MODE won't even try to save.")

(declaim (ftype (function ((or symbol root-mode)) (values symbol &optional)) maybe-mode-name))
(defun maybe-mode-name (mode)
  (if (symbolp mode) mode (mode-name mode)))

(declaim (ftype (function ((or symbol root-mode) (or symbol root-mode)) boolean)
                mode-equal))
(defun mode-equal (mode1 mode2)
  (string-equal (symbol-name (maybe-mode-name mode1))
                (symbol-name (maybe-mode-name mode2))))

(defun non-rememberable-mode-p (mode)
  (member mode *non-rememberable-modes* :test #'mode-equal))

(defun rememberable-of (modes)
  (remove-if #'non-rememberable-mode-p modes))

(defclass-export auto-mode-rule ()
  ((test :initarg :test
         :accessor test
         :type list
         :initform (error "Slot `test' should be set."))
   (modes :initarg :modes
          :accessor modes
          :type list-of-symbols
          :initform '())))

(declaim (ftype (function (quri:uri) (or auto-mode-rule null))
                matching-auto-mode-rule))
(defun matching-auto-mode-rule (url)
  (flet ((priority (test1 test2)
           (let ((priority-list '(match-regex match-url match-host match-domain)))
             (< (or (position (first test1) priority-list) 4)
                (or (position (first test2) priority-list) 4)))))
    (first (sort (remove-if-not
                  #'(lambda (rule)
                      (funcall-safely
                       (apply (first (test rule)) (rest (test rule))) url))
                  (or (auto-mode-list *browser*) (restore-auto-mode-list)))
                 #'priority :key #'test))))

(declaim (ftype (function (quri:uri buffer)) enable-matching-modes))
(defun enable-matching-modes (url buffer)
  (let ((rule (matching-auto-mode-rule url)))
    (enable-modes (rememberable-of (set-difference
                                    (modes rule)
                                    (mapcar #'mode-name (modes buffer))
                                    :test #'mode-equal))
                  buffer)
    (disable-modes (rememberable-of (set-difference
                                     (mapcar #'mode-name (modes buffer))
                                     (modes rule) :test #'mode-equal))
                   buffer)))

(defun clean-up-auto-mode (mode)
  (dolist (handler-name '(auto-mode-request-handler
                          enable-mode-prompting-handler
                          disable-mode-prompting-handler))
    (hooks:remove-hook (request-resource-hook (buffer mode)) handler-name)))

(defun store-last-active-modes (auto-mode)
  (setf (last-active-modes auto-mode)
        (modes (buffer auto-mode))))

(defun restore-last-active-modes (auto-mode)
  (disable-modes
   (mapcar #'maybe-mode-name
           (set-difference (modes (buffer auto-mode))
                           (last-active-modes auto-mode)
                           :test #'mode-equal))
   (buffer auto-mode))
  (enable-modes
   (mapcar #'maybe-mode-name
           (set-difference (last-active-modes auto-mode)
                           (modes (buffer auto-mode))
                           :test #'mode-equal))
   (buffer auto-mode)))

(defun auto-mode-request-handler (request-data)
  (let* ((auto-mode (find-submode (buffer request-data) 'auto-mode))<commit_msg>auto-mode: fix dangling prompting handlers outside auto-mode<commit_after>(uiop:define-package :nyxt/auto-mode
  (:use :common-lisp :nyxt)
  (:import-from #:serapeum #:export-always)
  (:documentation "Mode for automatic URL-based mode toggling."))
(in-package :nyxt/auto-mode)
(eval-when (:compile-toplevel :load-toplevel :execute)
  (trivial-package-local-nicknames:add-package-local-nickname :alex :alexandria))

(export-always '*prompt-on-mode-toggle*)
(defvar *prompt-on-mode-toggle* nil
  "Whether user will be asked about adding the mode to included/excluded modes
in auto-mode-list on mode activation/deactivation.")

(export-always '*non-rememberable-modes*)
(defvar *non-rememberable-modes*
  ;; Base mode conflicts with its Nyxt symbol if it's not prefixed
  '(help-mode web-mode auto-mode nyxt::base-mode)
  "Modes that AUTO-MODE won't even try to save.")

(declaim (ftype (function ((or symbol root-mode)) (values symbol &optional)) maybe-mode-name))
(defun maybe-mode-name (mode)
  (if (symbolp mode) mode (mode-name mode)))

(declaim (ftype (function ((or symbol root-mode) (or symbol root-mode)) boolean)
                mode-equal))
(defun mode-equal (mode1 mode2)
  (string-equal (symbol-name (maybe-mode-name mode1))
                (symbol-name (maybe-mode-name mode2))))

(defun non-rememberable-mode-p (mode)
  (member mode *non-rememberable-modes* :test #'mode-equal))

(defun rememberable-of (modes)
  (remove-if #'non-rememberable-mode-p modes))

(defclass-export auto-mode-rule ()
  ((test :initarg :test
         :accessor test
         :type list
         :initform (error "Slot `test' should be set."))
   (modes :initarg :modes
          :accessor modes
          :type list-of-symbols
          :initform '())))

(declaim (ftype (function (quri:uri) (or auto-mode-rule null))
                matching-auto-mode-rule))
(defun matching-auto-mode-rule (url)
  (flet ((priority (test1 test2)
           (let ((priority-list '(match-regex match-url match-host match-domain)))
             (< (or (position (first test1) priority-list) 4)
                (or (position (first test2) priority-list) 4)))))
    (first (sort (remove-if-not
                  #'(lambda (rule)
                      (funcall-safely
                       (apply (first (test rule)) (rest (test rule))) url))
                  (or (auto-mode-list *browser*) (restore-auto-mode-list)))
                 #'priority :key #'test))))

(declaim (ftype (function (quri:uri buffer)) enable-matching-modes))
(defun enable-matching-modes (url buffer)
  (let ((rule (matching-auto-mode-rule url)))
    (enable-modes (rememberable-of (set-difference
                                    (modes rule)
                                    (mapcar #'mode-name (modes buffer))
                                    :test #'mode-equal))
                  buffer)
    (disable-modes (rememberable-of (set-difference
                                     (mapcar #'mode-name (modes buffer))
                                     (modes rule) :test #'mode-equal))
                   buffer)))

(defun clean-up-auto-mode (mode)
  (hooks:remove-hook (request-resource-hook (buffer mode))
                     'auto-mode-request-handler)
  (hooks:remove-hook (enable-mode-hook (buffer mode))
                     'enable-mode-auto-mode-handler)
  (hooks:remove-hook (disable-mode-hook (buffer mode))
                     'disable-mode-auto-mode-handler))

(defun store-last-active-modes (auto-mode)
  (setf (last-active-modes auto-mode)
        (modes (buffer auto-mode))))

(defun restore-last-active-modes (auto-mode)
  (disable-modes
   (mapcar #'maybe-mode-name
           (set-difference (modes (buffer auto-mode))
                           (last-active-modes auto-mode)
                           :test #'mode-equal))
   (buffer auto-mode))
  (enable-modes
   (mapcar #'maybe-mode-name
           (set-difference (last-active-modes auto-mode)
                           (modes (buffer auto-mode))
                           :test #'mode-equal))
   (buffer auto-mode)))

(defun auto-mode-request-handler (request-data)
  (let* ((auto-mode (find-submode (buffer request-data) 'auto-mode))
{'fraction_non_alphanumeric': 0.14005363237445148, 'fraction_numerical': 0.0024378352023403218, 'mean_word_length': 2.3286004056795133, 'pattern_counts': {'":': 0, '<': 5, '<?xml version=': 0, '>': 3, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 10, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '76946', 'n_tokens_mistral': 2626, 'n_tokens_neox': 2474, 'n_words': 618}