Changeset 16446


Ignore:
Timestamp:
Jul 1, 2015, 10:06:02 PM (4 years ago)
Author:
svspire
Message:

Don't do syntax highlighting in text mode (except paren highlighting,
which is still useful there).
Fixes ticket:1138.

Location:
trunk/source/cocoa-ide/hemlock/src
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/cocoa-ide/hemlock/src/display.lisp

    r16343 r16446  
    8181(defun hemlock:selection-for-click (mark paragraph-mode-p)
    8282  ;; Handle lisp mode specially, otherwise just go with default Cocoa behavior
    83   (when (string= (buffer-major-mode (mark-buffer mark)) "Lisp")
     83  (when (lisp-mode? mark)
    8484    (unless paragraph-mode-p
    8585      (let ((region (word-region-at-mark mark)))
     
    109109
    110110(defun hemlock:update-current-package (&optional pkg (buffer (current-buffer)))
    111   (when (equalp (buffer-major-mode buffer) "Lisp")
     111  (when (lisp-mode? buffer)
    112112    (unless pkg
    113113      (setq pkg (or (package-at-mark (current-point))
     
    265265                    (eq sym 'setq))))))
    266266
    267 
    268267(defun compute-string/comment-coloring-in-region (region-start region-end)
    269   (let* ((lisp-code-colors (cached-lisp-code-colors))
    270          (start-line (mark-line region-start))
    271          (end-line (line-next (mark-line region-end)))
    272          (start-charpos (mark-charpos region-start)))
    273     (assert (not (eq start-line end-line)))
    274     (loop
    275       for line = start-line then (line-next line) until (eq line end-line)
    276       for info = (getf (line-plist line) 'lisp-info)
    277       when info
    278       nconc (loop with origin = (hi::line-origin line)
    279               for last-end = 0 then end-offset
    280               for (start-offset . end-offset) in (lisp-info-ranges-to-ignore info)
    281               for syntax = (if (eql start-offset 0)
    282                              (lisp-info-begins-quoted info)
    283                              (if (< last-end start-offset)
    284                                (character-attribute :lisp-syntax (line-character line (1- start-offset)))
    285                                :comment))
    286               do (when (member syntax '(:symbol-quote :string-quote))
    287                    (when (< 0 start-offset)
    288                      (decf start-offset))
    289                    (when (< end-offset (line-length line))
    290                      (incf end-offset)))
    291               unless (and (eq line start-line) (<= end-offset start-charpos))
    292               nconc (let* ((type (case syntax
    293                                    ((:char-quote :symbol-quote) nil)
    294                                    (:string-quote :string)
    295                                    (t (loop for i from start-offset as nsemi upfrom 0
    296                                         until (or (eql nsemi 3)
    297                                                   (eql i end-offset)
    298                                                   (not (test-char (line-character line i) :lisp-syntax :comment)))
    299                                         finally (return (case nsemi
    300                                                           (2 :double-comment)
    301                                                           (3 :triple-comment)
    302                                                           (t :comment)))))))
    303                            (color (and type (cdr (assq type lisp-code-colors)))))
    304                       (when color
    305                         (list (list* (+ origin start-offset) (- end-offset start-offset) color))))))))
     268  (when (lisp-mode? region-start)
     269    (let* ((lisp-code-colors (cached-lisp-code-colors))
     270           (start-line (mark-line region-start))
     271           (end-line (line-next (mark-line region-end)))
     272           (start-charpos (mark-charpos region-start)))
     273      (assert (not (eq start-line end-line)))
     274      (loop
     275        for line = start-line then (line-next line) until (eq line end-line)
     276        for info = (getf (line-plist line) 'lisp-info)
     277        when info
     278        nconc (loop with origin = (hi::line-origin line)
     279                for last-end = 0 then end-offset
     280                for (start-offset . end-offset) in (lisp-info-ranges-to-ignore info)
     281                for syntax = (if (eql start-offset 0)
     282                                 (lisp-info-begins-quoted info)
     283                                 (if (< last-end start-offset)
     284                                     (character-attribute :lisp-syntax (line-character line (1- start-offset)))
     285                                     :comment))
     286                do (when (member syntax '(:symbol-quote :string-quote))
     287                     (when (< 0 start-offset)
     288                       (decf start-offset))
     289                     (when (< end-offset (line-length line))
     290                       (incf end-offset)))
     291                unless (and (eq line start-line) (<= end-offset start-charpos))
     292                nconc (let* ((type (case syntax
     293                                     ((:char-quote :symbol-quote) nil)
     294                                     (:string-quote :string)
     295                                     (t (loop for i from start-offset as nsemi upfrom 0
     296                                          until (or (eql nsemi 3)
     297                                                    (eql i end-offset)
     298                                                    (not (test-char (line-character line i) :lisp-syntax :comment)))
     299                                          finally (return (case nsemi
     300                                                            (2 :double-comment)
     301                                                            (3 :triple-comment)
     302                                                            (t :comment)))))))
     303                             (color (and type (cdr (assq type lisp-code-colors)))))
     304                        (when color
     305                          (list (list* (+ origin start-offset) (- end-offset start-offset) color)))))))))
    306306
    307307(defun coloring-region (start-mark end-mark color)
     
    314314
    315315(defun compute-symbol-coloring-in-region (region-start region-end)
    316   (let* ((sym-vec (make-sym-vec))
    317          (pkg nil)
    318          (lisp-colors (cached-lisp-code-colors))
    319          (defn-color (cdr (assq :definition lisp-colors))))
    320     (with-mark ((start-mark region-start)
    321                 (end-mark region-start))
    322       (let ((pkgname (package-at-mark region-end end-mark)))
    323         (when pkgname
    324           (when (mark< region-start end-mark)
    325             ;; Argh, more than one package in region.  KLUDGE!!
    326             (return-from compute-symbol-coloring-in-region
    327               (nconc (compute-symbol-coloring-in-region region-start (mark-before end-mark))
    328                      (compute-symbol-coloring-in-region (mark-after end-mark) region-end))))
    329           (setq pkg (find-package pkgname))))
    330       (loop
    331         while (and (%scan-to-symbol start-mark) (mark< start-mark region-end))
    332         for sym = (progn
    333                     (move-mark end-mark start-mark)
    334                     (unless (forward-form end-mark) (move-mark end-mark region-end))
    335                     (case-insensitive-string-to-symbol (displace-to-region sym-vec start-mark end-mark) pkg))
    336         for type = (compute-symbol-category start-mark sym)
    337         for reg = (when type
    338                     (let ((color (cdr (assq type lisp-colors))))
    339                       (when color
    340                         (coloring-region start-mark end-mark color))))
    341         when reg collect reg
    342         ;; if we're at start of a defining form, color the thing being defined.
    343         when (and defn-color
    344                   (defining-symbol-p start-mark sym)
    345                   (form-offset (move-mark start-mark end-mark) 1)
    346                   (%scan-down-to-atom end-mark)
    347                   (mark< end-mark region-end))
    348         collect (progn
    349                   (move-mark start-mark end-mark)
    350                   (unless (and (forward-form end-mark)
    351                                (mark<= end-mark region-end))
    352                     (move-mark end-mark region-end))
    353                   (unless (mark< start-mark end-mark)
    354                     (warn "definition got start ~s end ~s region-end ~s" start-mark end-mark
    355                           region-end)
    356                     (move-mark end-mark start-mark))
    357                   (coloring-region start-mark end-mark defn-color))
    358         do (rotatef start-mark end-mark)))))
     316  (when (lisp-mode? region-start)
     317    (let* ((sym-vec (make-sym-vec))
     318           (pkg nil)
     319           (lisp-colors (cached-lisp-code-colors))
     320           (defn-color (cdr (assq :definition lisp-colors))))
     321      (with-mark ((start-mark region-start)
     322                  (end-mark region-start))
     323        (let ((pkgname (package-at-mark region-end end-mark)))
     324          (when pkgname
     325            (when (mark< region-start end-mark)
     326              ;; Argh, more than one package in region.  KLUDGE!!
     327              (return-from compute-symbol-coloring-in-region
     328                (nconc (compute-symbol-coloring-in-region region-start (mark-before end-mark))
     329                       (compute-symbol-coloring-in-region (mark-after end-mark) region-end))))
     330            (setq pkg (find-package pkgname))))
     331        (loop
     332          while (and (%scan-to-symbol start-mark) (mark< start-mark region-end))
     333          for sym = (progn
     334                      (move-mark end-mark start-mark)
     335                      (unless (forward-form end-mark) (move-mark end-mark region-end))
     336                      (case-insensitive-string-to-symbol (displace-to-region sym-vec start-mark end-mark) pkg))
     337          for type = (compute-symbol-category start-mark sym)
     338          for reg = (when type
     339                      (let ((color (cdr (assq type lisp-colors))))
     340                        (when color
     341                          (coloring-region start-mark end-mark color))))
     342          when reg collect reg
     343          ;; if we're at start of a defining form, color the thing being defined.
     344          when (and defn-color
     345                    (defining-symbol-p start-mark sym)
     346                    (form-offset (move-mark start-mark end-mark) 1)
     347                    (%scan-down-to-atom end-mark)
     348                    (mark< end-mark region-end))
     349          collect (progn
     350                    (move-mark start-mark end-mark)
     351                    (unless (and (forward-form end-mark)
     352                                 (mark<= end-mark region-end))
     353                      (move-mark end-mark region-end))
     354                    (unless (mark< start-mark end-mark)
     355                      (warn "definition got start ~s end ~s region-end ~s" start-mark end-mark
     356                            region-end)
     357                      (move-mark end-mark start-mark))
     358                    (coloring-region start-mark end-mark defn-color))
     359          do (rotatef start-mark end-mark))))))
    359360
    360361(defun compute-unmatched-parens-coloring-in-region (start-mark end-mark)
     362  ; not checking for lisp mode here because this is still useful even in text mode
    361363  (macrolet ((scan-loop (forwardp open-key buffer-start-mark start-line end-line close-key)
    362364               `(loop with paren-count = 0 with limit-line = (neighbor-line ,end-line ,forwardp) with in-region-p = nil
  • trunk/source/cocoa-ide/hemlock/src/lispmode.lisp

    r16109 r16446  
    14101410  :value '("LABELS" "MACROLET" "FLET"))
    14111411
     1412(defgeneric lisp-mode? (thing)
     1413  (:documentation "Returns true if thing is in Lisp mode"))
     1414
     1415(defmethod lisp-mode? ((mark mark))
     1416  (lisp-mode? (mark-buffer mark)))
     1417
     1418(defmethod lisp-mode? ((buffer buffer))
     1419  (string-equal "Lisp" (buffer-major-mode buffer)))
     1420
     1421(defmethod lisp-mode? ((thing t))
     1422  nil)
     1423
    14121424;;; LISP-INDENTATION-CHECK-FOR-LOCAL-DEF -- Internal.
    14131425;;;
Note: See TracChangeset for help on using the changeset viewer.