From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Max Mikhanosha Newsgroups: gmane.emacs.devel Subject: Patch/enhancement: highlight CL flet/label function names with font-lock-function-name-face Date: Thu, 22 Mar 2012 12:55:23 -0400 Message-ID: <87haxgh8xw.wl%max@openchat.com> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 (generated by SEMI 1.14.6 - "Maruoka") Content-Type: text/plain; charset=US-ASCII X-Trace: dough.gmane.org 1332435337 19092 80.91.229.3 (22 Mar 2012 16:55:37 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Thu, 22 Mar 2012 16:55:37 +0000 (UTC) To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Thu Mar 22 17:55:36 2012 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1SAlIV-0001mp-QM for ged-emacs-devel@m.gmane.org; Thu, 22 Mar 2012 17:55:35 +0100 Original-Received: from localhost ([::1]:42175 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1SAlIV-0000Kp-75 for ged-emacs-devel@m.gmane.org; Thu, 22 Mar 2012 12:55:35 -0400 Original-Received: from eggs.gnu.org ([208.118.235.92]:38048) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1SAlIO-0000Ju-Ct for emacs-devel@gnu.org; Thu, 22 Mar 2012 12:55:34 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1SAlIM-00006k-1O for emacs-devel@gnu.org; Thu, 22 Mar 2012 12:55:27 -0400 Original-Received: from openchat.com ([75.99.81.170]:39545 helo=momoland.openchat.com) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1SAlIL-00006X-TL for emacs-devel@gnu.org; Thu, 22 Mar 2012 12:55:25 -0400 Original-Received: from momoland.openchat.com (localhost [IPv6:::1]) by momoland.openchat.com (Postfix) with ESMTP id 97401E9FB3 for ; Thu, 22 Mar 2012 12:55:23 -0400 (EDT) User-Agent: Wanderlust/2.15.9 (Almost Unreal) SEMI/1.14.6 (Maruoka) FLIM/1.14.9 (=?UTF-8?B?R29qxY0=?=) APEL/10.6 Emacs/23.3.50 (x86_64-unknown-linux-gnu) MULE/6.0 (HANACHIRUSATO) X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 75.99.81.170 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:149170 Archived-At: This is not a formal patch to font-lock.el, as I don't think it will be accepted as is, but more of an idea. Here is how end result looks like (the local functions x, y and reduce-angle2 are in function name face): http://i.imgur.com/eDo2e.png Problems I see with it are: 1. Its limited to a hard-coded number of local functions. 2. There may be possible performance penalty, (although in my brief testing on large flet/labels forms I did not notice much slowdown). I'm not sure what is the best way to allow user to toggle it on/off, maybe "(> font-lock-maximum-decoration 3)" I had initially tried to accomplish the same task by using the multi-line highlighting method suggested in Emacs Lisp manual, and also by using anchored matches, but had to abandon it due to complexity. The proposed solution while suffering from above limitations seems to work reasonably well in practice. Code: ;; Highlighting of flet/labels/macrolet local functions/macros with ;; font-lock-function-name-face (defun mm/match-labels (bound) (when (re-search-forward "(\\<\\(labels\\|flet\\|macrolet\\)\\>" bound t) (let ((local-functions '()) (all-start (match-beginning 0)) (all-end (match-end 0)) (kw-start (match-beginning 1)) (kw-end (match-end 1)) (parse-sexp-ignore-comments t)) (catch 'done (condition-case e (progn ;; go inside the local functions list (goto-char (scan-lists all-end 1 -1)) (while t (save-excursion ;; down into local function definition (goto-char (scan-lists (point) 1 -1)) (let* ((name-end (scan-sexps (point) 1)) (name-start (scan-sexps name-end -1))) (push name-end local-functions) (push name-start local-functions))) ;; advance to the next local function (goto-char (scan-sexps (point) 1)))) (error ;; (message "got error %s" e) (throw 'done nil)))) (set-match-data (append (list all-start all-end kw-start kw-end) (nreverse local-functions) (list (current-buffer)))) (goto-char all-end) t))) (font-lock-add-keywords 'lisp-mode `((mm/match-labels (1 font-lock-keyword-face nil) (2 font-lock-function-name-face nil t) (3 font-lock-function-name-face nil t) (4 font-lock-function-name-face nil t) (5 font-lock-function-name-face nil t) (6 font-lock-function-name-face nil t) (7 font-lock-function-name-face nil t) (8 font-lock-function-name-face nil t))))