Skip to content

Commit 7cf81aa

Browse files
author
Mitsuo Saito
committedNov 21, 2010
font lock again
1 parent d1f932f commit 7cf81aa

File tree

1 file changed

+125
-47
lines changed

1 file changed

+125
-47
lines changed
 

‎auto-highlight-symbol.el

+125-47
Original file line numberDiff line numberDiff line change
@@ -41,6 +41,8 @@
4141
;; (@> "Screencast") Screencast
4242
;; (@> "Mode map") Key binding
4343
;;
44+
;; (@> "Note") Performance note
45+
;;
4446
;; (@> "Custom variable") Customizable varible
4547
;; (@> "Face") Face used in auto-highlight-symbol-mode
4648
;; (@> "Highlight Rules") Whether to highlight the symbol.
@@ -171,11 +173,11 @@
171173

172174
;;; SCM Log
173175
;;
174-
;; $Revision: 241:c70529cd7f01 tip $
176+
;; $Revision: 243:6aa59061b1df tip $
175177
;; $Commiter: Mitso Saito <arch320@NOSPAM.gmail.com> $
176-
;; $LastModified: Sun, 21 Nov 2010 07:50:34 +0900 $
178+
;; $LastModified: Sun, 21 Nov 2010 14:42:11 +0900 $
177179
;;
178-
;; $Lastlog: font lock orz... $
180+
;; $Lastlog: font lock again $
179181
;;
180182

181183
;;; (@* "Changelog" )
@@ -251,7 +253,7 @@
251253
'(called-interactively-p))))
252254

253255
(defconst ahs-mode-vers
254-
"$Id: auto-highlight-symbol.el,v 241:c70529cd7f01 2010-11-21 07:50 +0900 arch320 $"
256+
"$Id: auto-highlight-symbol.el,v 243:6aa59061b1df 2010-11-21 14:42 +0900 arch320 $"
255257
"auto-highlight-symbol-mode version.")
256258

257259
;;
@@ -591,7 +593,10 @@ You can do these operations at One Key!
591593
(defvar ahs-range-plugin-list nil
592594
"List of installed plugin.")
593595

594-
;; buffer local variable
596+
(defvar ahs-search-work nil)
597+
(defvar ahs-need-fontify nil)
598+
599+
;; Buffer local variable
595600
(defvar ahs-current-overlay nil)
596601
(defvar ahs-current-range nil)
597602
(defvar ahs-edit-mode-enable nil)
@@ -987,48 +992,121 @@ You can do these operations at One Key!
987992
;;
988993
;; (@* "Highlight" )
989994
;;
995+
(defun ahs-prepare-highlight (symbol)
996+
"Prepare for highlight."
997+
(let ((before (ahs-current-plugin-prop 'before-search symbol))
998+
(beg (ahs-current-plugin-prop 'start))
999+
(end (ahs-current-plugin-prop 'end)))
1000+
(cond ((equal before 'abort) nil)
1001+
((not (numberp beg)) nil)
1002+
((not (numberp end)) nil)
1003+
((> beg end) nil)
1004+
(t (cons beg end)))))
1005+
1006+
(defun ahs-search-symbol (symbol search-range)
1007+
"Search `SYMBOL' in `SEARCH-RANGE'."
1008+
(save-excursion
1009+
(let ((case-fold-search ahs-case-fold-search)
1010+
(regexp (concat "\\_<\\(" (regexp-quote symbol) "\\)\\_>" ))
1011+
(beg (car search-range))
1012+
(end (cdr search-range)))
1013+
(goto-char end)
1014+
(while (re-search-backward regexp beg t)
1015+
(let* ((symbol-beg (match-beginning 1))
1016+
(symbol-end (match-end 1))
1017+
(tprop (text-properties-at symbol-beg))
1018+
(face (cadr (memq 'face tprop)))
1019+
(fontified (cadr (memq 'fontified tprop))))
1020+
(unless (or face fontified)
1021+
(setq ahs-need-fontify t))
1022+
(push (list symbol-beg
1023+
symbol-end
1024+
face fontified) ahs-search-work))))))
1025+
1026+
(defun ahs-fontify ()
1027+
"Fontify symbols for strict check."
1028+
;;;;
1029+
;;
1030+
;; (@* "Note" )
1031+
;;
1032+
;; If symbol has no text properties, will be called `jit-lock-fontify-now'
1033+
;; to strict check.
1034+
;;
1035+
;; Some old PCs performance may be degraded when:
1036+
;; * Editing large file.
1037+
;; * So many matched symbols exists outside the display area.
1038+
;;
1039+
;; Tested on my old pentium4 pc (bought in 2002 xD)
1040+
;; So dirty `font-lock-keywords' and use `whole buffer' plugin.
1041+
;; Result:
1042+
;; +---------------+-----------+----------------+----------+
1043+
;; | filename | filesize | matched symbol | result |
1044+
;; +---------------+-----------+----------------+----------+
1045+
;; | `loaddefs.el' | 1,207,715 | `autoload' | so slow |
1046+
;; | `org.el' | 753,991 | `if' | slow |
1047+
;; +---------------+-----------+----------------+----------+
1048+
;;
1049+
;; If you feel slow, please use `display area' plugin instead of `whole buffer' plugin.
1050+
;; And use `ahs-onekey-edit' to use `whole buffer' plugin.
1051+
;;
1052+
(loop with beg = nil
1053+
with end = nil
1054+
1055+
for symbol in ahs-search-work
1056+
for fontified = (or (nth 2 symbol)
1057+
(nth 3 symbol))
1058+
1059+
unless (or beg fontified) do (setq beg (nth 0 symbol))
1060+
unless fontified do (setq end (nth 1 symbol))
1061+
1062+
when (and beg end fontified)
1063+
do (progn
1064+
(jit-lock-fontify-now beg end)
1065+
(setq beg nil
1066+
end nil))
1067+
1068+
finally
1069+
do (when (and beg end)
1070+
(jit-lock-fontify-now beg end))))
1071+
1072+
(defun ahs-light-up ()
1073+
"Light up symbols."
1074+
(loop for symbol in ahs-search-work
1075+
1076+
for beg = (nth 0 symbol)
1077+
for end = (nth 1 symbol)
1078+
for face = (or (nth 2 symbol)
1079+
(get-text-property beg 'face))
1080+
for face = (ahs-add-overlay-face beg face)
1081+
1082+
unless (ahs-face-p face 'ahs-inhibit-face-list)
1083+
do (let ((overlay (make-overlay beg end nil nil t)))
1084+
(overlay-put overlay 'ahs-symbol t)
1085+
(overlay-put overlay 'face
1086+
(if (ahs-face-p face 'ahs-definition-face-list)
1087+
ahs-definition-face
1088+
ahs-face))
1089+
(push overlay ahs-overlay-list))))
1090+
9901091
(defun ahs-highlight (symbol beg end)
991-
"Highlight Core"
992-
(if (equal 'abort (ahs-current-plugin-prop 'before-search symbol))
993-
nil
994-
(save-excursion
995-
(let ((case-fold-search ahs-case-fold-search)
996-
(regexp (concat "\\_<\\(" (regexp-quote symbol) "\\)\\_>" ))
997-
(range-start (ahs-current-plugin-prop 'start))
998-
(range-end (ahs-current-plugin-prop 'end)))
999-
(when (and (numberp range-start)
1000-
(numberp range-end))
1001-
(goto-char range-start)
1002-
(while (re-search-forward regexp range-end t)
1003-
(let* ((symbol-start (match-beginning 1))
1004-
(symbol-end (match-end 1))
1005-
(tprop (text-properties-at symbol-start))
1006-
(face (cadr (memq 'face tprop)))
1007-
(fontified (cadr (memq 'fontified tprop)))
1008-
(overlay))
1009-
1010-
;; If symbol has no text properties, will be called `jit-lock-fontify-now'
1011-
(unless (or face fontified)
1012-
(jit-lock-fontify-now)
1013-
(setq face (get-text-property symbol-start 'face)))
1014-
1015-
;; Overlay check
1016-
(setq face (ahs-add-overlay-face symbol-start face))
1017-
1018-
;; Light up!!
1019-
(unless (ahs-face-p face 'ahs-inhibit-face-list)
1020-
(setq overlay (make-overlay symbol-start symbol-end nil nil t))
1021-
(overlay-put overlay 'ahs-symbol t)
1022-
(overlay-put overlay 'face
1023-
(if (ahs-face-p face 'ahs-definition-face-list)
1024-
ahs-definition-face
1025-
ahs-face))
1026-
(push overlay ahs-overlay-list)))))))
1027-
(when ahs-overlay-list
1028-
(ahs-highlight-current-symbol beg end)
1029-
(setq ahs-start-point beg)
1030-
(setq ahs-highlighted t)
1031-
(add-hook 'pre-command-hook 'ahs-unhighlight nil t) t)))
1092+
"Highlight"
1093+
(setq ahs-search-work nil
1094+
ahs-need-fontify nil)
1095+
(let ((search-range (ahs-prepare-highlight symbol)))
1096+
(when (consp search-range)
1097+
;;(msell-bench
1098+
(ahs-search-symbol symbol search-range)
1099+
(when ahs-need-fontify
1100+
(ahs-fontify))
1101+
(ahs-light-up)
1102+
;;)
1103+
(when ahs-overlay-list
1104+
(ahs-highlight-current-symbol beg end)
1105+
(setq ahs-highlighted t
1106+
ahs-start-point beg
1107+
ahs-search-work nil
1108+
ahs-need-fontify nil)
1109+
(add-hook 'pre-command-hook 'ahs-unhighlight nil t) t))))
10321110

10331111
(defun ahs-unhighlight (&optional force)
10341112
"Unhighlight"
@@ -1548,6 +1626,6 @@ That's all."
15481626
;;; End:
15491627

15501628
;;
1551-
;; $Id: auto-highlight-symbol.el,v 241:c70529cd7f01 2010-11-21 07:50 +0900 arch320 $
1629+
;; $Id: auto-highlight-symbol.el,v 243:6aa59061b1df 2010-11-21 14:42 +0900 arch320 $
15521630
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15531631
;;; auto-highlight-symbol.el ends here

0 commit comments

Comments
 (0)
Please sign in to comment.