~eshel/sweep

349a7a133cf86c8832da6866850b3444fee9cb68 — Eshel Yaron 6 months ago 58f6bd0 + e87b6f9
Merge branch 'master'
3 files changed, 107 insertions(+), 66 deletions(-)

M sweep.pl
M sweeprolog-tests.el
M sweeprolog.el
M sweep.pl => sweep.pl +14 -5
@@ 236,9 236,12 @@ sweep_handle_fragment_(Offset, Col, Beg, Len) :-
    user:sweep_funcall("sweeprolog-analyze-fragment", [Start,Len|Nom], _).

sweep_short_documentation([ClauseString,Point,FileName0], [PIString,Doc,ArgSpan]) :-
    atom_string(FileName, FileName0),
    xref_source(FileName),
    sweep_module_path_(Mod, FileName),
    (   FileName0 == []
    ->  Mod = user
    ;   atom_string(FileName, FileName0),
        xref_source(FileName),
        sweep_module_path_(Mod, FileName)
    ),
    term_string(Clause, ClauseString, [subterm_positions(Pos), module(Mod), syntax_errors(quiet)]),
    callable(Clause),
    sweep_short_documentation_clause(Pos, Clause, Point, FileName, Mod, PIString, Doc, ArgSpan).


@@ 276,6 279,9 @@ sweep_short_documentation_clause_((Head --> Body), _Pos, [HeadPos, BodyPos], Poi
sweep_short_documentation_clause_((:- Directive), _Pos, [Pos], Point, FileName, Mod, PIString, Doc, ArgSpan) :-
    !,
    sweep_short_documentation_body(Pos, Directive, 0, Point, FileName, Mod, PIString, Doc, ArgSpan).
sweep_short_documentation_clause_((?- Directive), _Pos, [Pos], Point, FileName, Mod, PIString, Doc, ArgSpan) :-
    !,
    sweep_short_documentation_body(Pos, Directive, 0, Point, FileName, Mod, PIString, Doc, ArgSpan).
sweep_short_documentation_clause_(Head, Pos, _, Point, FileName, Mod, PIString, Doc, ArgSpan) :-
    sweep_short_documentation_head(Pos, Head, 0, Point, FileName, Mod, PIString, Doc, ArgSpan).



@@ 426,11 432,14 @@ explicit_args(N, G0, G) :-
    !,
    explicit_args_(N, G0, G).

explicit_args_(0, G, G) :-
    atom(G),
    !.
explicit_args_(N, G0, G) :-
    G0 =.. [F|A0],
    compound_name_arguments(G0, F, A0),
    length(A1, N),
    append(A0, A1, A),
    G =.. [F|A].
    compound_name_arguments(G, F, A).

sweep_short_documentation_finalize(M, PI, Index, PIString, Doc, ArgSpan) :-
    doc_comment(M:PI, Pos, OneLiner, Comment),

M sweeprolog-tests.el => sweeprolog-tests.el +25 -0
@@ 1379,6 1379,23 @@ html_program_section(Section, Dict) -->
  (sweeprolog-end-of-top-term)
  (should (= (point) 466)))

(sweeprolog-deftest end-of-top-term-with-dot-char-literal ()
  "Tests detecting the fullstop in presence of `0\'.'."
  "
full_stop_after(Index, String, [H|T]) :-
    string_code(Index, String, H),
    Index2 is Index+1,
    (   code_type(H, space)
    ->  !, full_stop_after(Index2, String, T)
    ;   H == 0'.
    ->  !, layout_after(Index2, String, T)
    ).
full_stop_after(_, _, []).
"
  (goto-char (point-min))
  (sweeprolog-end-of-top-term)
  (should (= (point) 242)))

(sweeprolog-deftest fullstop-detection ()
  "Tests detecting the fullstop in presence of confusing comments."
  "


@@ 1873,6 1890,14 @@ head,
  (forward-sexp)
  (should (= (point) 21)))

(ert-deftest top-level-thread-id ()
  "Test obtaining the thread id of a top-level on startup."
  (let ((buf-name (generate-new-buffer-name "*test top-level*")))
    (sweeprolog-top-level buf-name)
    (should sweeprolog-top-level-thread-id)
    (sweeprolog-top-level-delete-process buf-name)
    (kill-buffer buf-name)))

(sweeprolog-deftest usage-example-comment ()
  "Tests adding usage example comments."
  "\nfoo."

M sweeprolog.el => sweeprolog.el +68 -61
@@ 301,9 301,9 @@ predicate (e.g. \":-\" for regular clauses and \"-->\" for DCG
non-terminals)."
  :package-version '((sweeprolog "0.8.11"))
  :type '(choice (const    :tag "Below Current Predicate"
                        sweeprolog-default-new-predicate-location)
                           sweeprolog-default-new-predicate-location)
                 (const    :tag "Above Current Predicate"
                        sweeprolog-new-predicate-location-above-current)
                           sweeprolog-new-predicate-location-above-current)
                 (function :tag "Custom Function")))

(defcustom sweeprolog-top-level-signal-default-goal "sweep_interrupt"


@@ 1384,6 1384,7 @@ Prolog buffers."
                    (ppre (sweeprolog-op-prefix-precedence op)))
               (cond
                ((and (string= "." op)
                      (equal 1 (sweeprolog-syntax-class-at obeg))
                      (let ((sa (sweeprolog-syntax-class-at (1+ obeg))))
                        (or (null sa) (member sa '(0 12)))))
                 nil)


@@ 2058,8 2059,8 @@ inside a comment, string or quoted atom."

(defface sweeprolog-functor
  '((t :inherit font-lock-function-name-face))
 "Face for highlighting Prolog functors."
 :group 'sweeprolog-faces)
  "Face for highlighting Prolog functors."
  :group 'sweeprolog-faces)

(defface sweeprolog-arity
  '((t :inherit font-lock-function-name-face))


@@ 3308,26 3309,26 @@ modified."

(defun sweeprolog-analyze-some-terms (beg end &optional verbose)
  (let ((sweeprolog--analyze-point (point)))
   (save-match-data
     (save-mark-and-excursion
       (goto-char beg)
       (sweeprolog-beginning-of-top-term)
       (unless (bobp)
         (sweeprolog-beginning-of-top-term))
       (let ((start (point))
             (cur (point)))
         (while (and (not (eobp))
                     (< (point) end))
           (setq cur (point))
           (sweeprolog-end-of-top-term)
           (sweeprolog-analyze-term cur (point)))
         (setq cur (point))
         (sweeprolog-end-of-top-term)
         (skip-chars-forward " \t\n")
         (sweeprolog-analyze-term cur (point))
         (when font-lock-keywords
           (font-lock-fontify-keywords-region start (point) verbose))
         `(jit-lock-bounds ,start . ,(point)))))))
    (save-match-data
      (save-mark-and-excursion
        (goto-char beg)
        (sweeprolog-beginning-of-top-term)
        (unless (bobp)
          (sweeprolog-beginning-of-top-term))
        (let ((start (point))
              (cur (point)))
          (while (and (not (eobp))
                      (< (point) end))
            (setq cur (point))
            (sweeprolog-end-of-top-term)
            (sweeprolog-analyze-term cur (point)))
          (setq cur (point))
          (sweeprolog-end-of-top-term)
          (skip-chars-forward " \t\n")
          (sweeprolog-analyze-term cur (point))
          (when font-lock-keywords
            (font-lock-fontify-keywords-region start (point) verbose))
          `(jit-lock-bounds ,start . ,(point)))))))

(defconst sweeprolog-syntax-propertize-function
  (syntax-propertize-rules


@@ 3371,11 3372,11 @@ variable at point, if any."
          (let ((cur (buffer-substring-no-properties beg end)))
            (when (and var (string= cur var))
              (with-silent-modifications
               (font-lock--add-text-property beg
                                             end
                                             'font-lock-face
                                             'sweeprolog-variable-at-point
                                             (current-buffer) nil))))))))))
                (font-lock--add-text-property beg
                                              end
                                              'font-lock-face
                                              'sweeprolog-variable-at-point
                                              (current-buffer) nil))))))))))

(defun sweeprolog-cursor-sensor-functions (var)
  (list


@@ 3509,11 3510,13 @@ top-level."
                    (let* ((proc (get-buffer-process buf))
                           (tty (process-tty-name proc)))
                      (process-send-eof proc)
                      (sweeprolog--query-once "sweep" "sweep_top_level_start_pty" tty)
                      (unless comint-last-prompt buf (accept-process-output proc 1))
                      (when (eq system-type 'gnu/linux)
                        ;; make sure the pty does not echo input
                        (call-process "stty" nil nil nil "-F" tty "-echo"))))
                      (prog1 (sweeprolog--query-once
                              "sweep" "sweep_top_level_start_pty" tty)
                        (unless comint-last-prompt buf
                                (accept-process-output proc 1))
                        (when (eq system-type 'gnu/linux)
                          ;; make sure the pty does not echo input
                          (call-process "stty" nil nil nil "-F" tty "-echo")))))
                (unless sweeprolog-prolog-server-port
                  (sweeprolog-start-prolog-server))
                (make-comint-in-buffer "sweeprolog-top-level"


@@ 3661,6 3664,9 @@ GOAL.  Otherwise, GOAL is set to a default value specified by
  (add-hook 'after-change-functions #'sweeprolog-colourise-query nil t)
  (add-hook 'xref-backend-functions #'sweeprolog--xref-backend nil t)
  (add-hook 'comint-input-filter-functions #'sweeprolog--fill-query-holes nil t)
  (when (fboundp 'eldoc-documentation-default)
    (setq-local eldoc-documentation-strategy #'eldoc-documentation-default))
  (add-hook 'eldoc-documentation-functions #'sweeprolog-predicate-modes-doc nil t)
  (unless (member 'sweeprolog-hole yank-excluded-properties)
    (setq-local yank-excluded-properties
                (cons 'sweeprolog-hole yank-excluded-properties)))


@@ 3673,8 3679,8 @@ GOAL.  Otherwise, GOAL is set to a default value specified by
  (setq buffer (or buffer (current-buffer)))
  (sweeprolog--query-once "sweep" "sweep_source_file_load_time"
                          (with-current-buffer buffer
                           (or (buffer-file-name)
                               (expand-file-name (buffer-name))))))
                            (or (buffer-file-name)
                                (expand-file-name (buffer-name))))))

(defun sweeprolog-buffer-loaded-since-last-modification-p ()
  (when-let ((mtime (or sweeprolog--buffer-last-modified-time


@@ 3868,6 3874,7 @@ The command `beginning-of-defun' calls this function in
      (or (re-search-forward (rx "." (or white "\n")) nil t)
          (goto-char (point-max)))
      (while (and (or (nth 8 (syntax-ppss))
                      (equal 0 (sweeprolog-syntax-class-at (point)))
                      (save-excursion
                        (nth 8 (syntax-ppss (max (point-min)
                                                 (1- (point))))))


@@ 5002,12 5009,12 @@ if-then-else constructs and other common layouts in SWI-Prolog."
          (delete-horizontal-space)
          (let* ((lend (point))
                 (lbeg (save-excursion
                        (while (and (< bol (point))
                                    (not
                                     (= (sweeprolog-syntax-class-at (1- (point)))
                                        0)))
                          (forward-char -1))
                        (point)))
                         (while (and (< bol (point))
                                     (not
                                      (= (sweeprolog-syntax-class-at (1- (point)))
                                         0)))
                           (forward-char -1))
                         (point)))
                 (num (- 4 (% (- lend lbeg) 4))))
            (insert (make-string (if (< 0 num)
                                     num


@@ 5292,7 5299,7 @@ accordingly."
          (_ (setq go nil))))
      (let ((col (current-column)))
        (if (= col 0)
             (/ sweeprolog-indent-offset 2)
            (/ sweeprolog-indent-offset 2)
          col)))))

(defun sweeprolog-indent-line ()


@@ 5563,9 5570,9 @@ accordingly."
                              (one-or-more digit) eos)
                          target)
        (buttonize-region start
                                      (point)
                                      #'sweeprolog-describe-predicate
                                      target)))
                          (point)
                          #'sweeprolog-describe-predicate
                          target)))
     (t (let* ((path-and-query (url-path-and-query parsed))
               (path (car path-and-query))
               (query (cdr path-and-query)))


@@ 5575,16 5582,16 @@ accordingly."
                  (base (file-name-base path)))
              (when (string= dir "/pldoc/doc/_SWI_/library/")
                (buttonize-region start
                                              (point)
                                              #'find-file
                                              (concat "library(" base ")")))))
                                  (point)
                                  #'find-file
                                  (concat "library(" base ")")))))
           ((string= path "/pldoc/man")
            (pcase (url-parse-query-string query)
              (`(("predicate" ,pred))
               (buttonize-region start
                                             (point)
                                             #'sweeprolog-describe-predicate
                                             pred))))))))))
                                 (point)
                                 #'sweeprolog-describe-predicate
                                 pred))))))))))

(defun sweeprolog-render-html (html)
  (with-temp-buffer


@@ 5598,9 5605,9 @@ accordingly."
      (goto-char (point-max))
      (when sweeprolog--html-footnotes
        (insert "\n\nFootnotes:")
       (dolist (footnote sweeprolog--html-footnotes)
         (insert "\n\n")
         (shr-tag-span footnote))))
        (dolist (footnote sweeprolog--html-footnotes)
          (insert "\n\n")
          (shr-tag-span footnote))))
    (buffer-string)))

(defun sweeprolog--describe-module (mod)


@@ 6470,8 6477,8 @@ prompt for CLASS as well."
  (dolist (id sweeprolog-context-menu-breakpoints-at-click)
    (sweeprolog-delete-breakpoint id))
  (let ((n (length sweeprolog-context-menu-breakpoints-at-click)))
   (message "Deleted %d %s" n
            (ngettext "breakpoint" "breakpoints" n))))
    (message "Deleted %d %s" n
             (ngettext "breakpoint" "breakpoints" n))))

(defun sweeprolog-breakpoint-context-menu-set-condition ()
  "Set condition goal for the breakpoint at click."


@@ 7511,10 7518,10 @@ where in the buffer to insert the newly created predicate."
                                  "scope may change as a result of this "
                                  "operation.  Continue?"))))
             (and in-use
              (not (y-or-n-p (concat
                              (format "Predicate %s/%d is already defined.  "
                                      functor arity)
                              "Continue?")))))
                  (not (y-or-n-p (concat
                                  (format "Predicate %s/%d is already defined.  "
                                          functor arity)
                                  "Continue?")))))
         (message "Canceled."))
        (t
         (goto-char beg)