Lines Matching defs:cpp
0 ;;; cpp.el --- highlight or hide text according to cpp conditionals
51 (defgroup cpp nil
52 "Highlight or hide text according to cpp conditionals."
55 :prefix "cpp-")
57 (defcustom cpp-config-file (convert-standard-filename ".cpp.el")
58 "*File name to save cpp configuration."
60 :group 'cpp)
62 (define-widget 'cpp-face 'lazy
66 (defcustom cpp-known-face 'invisible
67 "*Face used for known cpp symbols."
68 :type 'cpp-face
69 :group 'cpp)
71 (defcustom cpp-unknown-face 'highlight
72 "*Face used for unknown cpp symbols."
73 :type 'cpp-face
74 :group 'cpp)
76 (defcustom cpp-face-type 'light
83 :group 'cpp)
85 (defcustom cpp-known-writable t
88 :group 'cpp)
90 (defcustom cpp-unknown-writable t
93 :group 'cpp)
95 (defcustom cpp-edit-list nil
96 "Alist of cpp macros and information about how they should be displayed.
103 (cpp-face :tag "True")
104 (cpp-face :tag "False")
108 :group 'cpp)
110 (defvar cpp-overlay-list nil)
111 ;; List of cpp overlays active in the current buffer.
112 (make-variable-buffer-local 'cpp-overlay-list)
114 (defvar cpp-callback-data)
115 (defvar cpp-state-stack)
117 (defconst cpp-face-type-list
124 (defconst cpp-writable-list
129 (defvar cpp-button-event nil)
130 ;; This will be t in the callback for `cpp-make-button'.
132 (defvar cpp-edit-buffer nil)
133 ;; Real buffer whose cpp display information we are editing.
134 (make-variable-buffer-local 'cpp-edit-buffer)
136 (defconst cpp-branch-list
142 (defcustom cpp-face-default-list nil
143 "Alist of faces you can choose from for cpp conditionals.
145 serves as a name (for `cpp-highlight-buffer' only)
149 :group 'cpp)
151 (defcustom cpp-face-light-name-list
157 :group 'cpp)
159 (defcustom cpp-face-dark-name-list
165 :group 'cpp)
167 (defcustom cpp-face-light-list nil
171 :group 'cpp)
173 (defcustom cpp-face-dark-list nil
177 :group 'cpp)
179 (defcustom cpp-face-mono-list
186 :group 'cpp)
188 (defcustom cpp-face-none-list
192 :type '(repeat (cons string cpp-face))
193 :group 'cpp)
195 (defvar cpp-face-all-list
196 (append cpp-face-light-list
197 cpp-face-dark-list
198 cpp-face-mono-list
199 cpp-face-none-list)
200 "All faces used for highlighting text inside cpp conditionals.")
204 (defvar cpp-parse-symbols nil
205 "List of cpp macros used in the local buffer.")
206 (make-variable-buffer-local 'cpp-parse-symbols)
208 (defconst cpp-parse-regexp
216 (defun cpp-highlight-buffer (arg)
223 (memq 'cpp buffer-invisibility-spec))
224 (add-to-invisibility-spec 'cpp))
225 (setq cpp-parse-symbols nil)
226 (cpp-parse-reset)
227 (if (null cpp-edit-list)
228 (cpp-edit-load))
229 (let (cpp-state-stack)
232 (cpp-progress-message "Parsing...")
233 (while (re-search-forward cpp-parse-regexp nil t)
234 (cpp-progress-message "Parsing...%d%%"
242 (error (cpp-parse-error
257 (cpp-parse-open t expr from to))
259 (cpp-parse-open nil expr from to))
261 (cpp-parse-open t expr from to))
263 (let (cpp-known-face cpp-unknown-face)
264 (cpp-parse-close from to))
265 (cpp-parse-open t expr from to))
267 (or cpp-state-stack
268 (cpp-parse-error "Top level #else"))
269 (let ((entry (list (not (nth 0 (car cpp-state-stack)))
270 (nth 1 (car cpp-state-stack))
272 (cpp-parse-close from to)
273 (setq cpp-state-stack (cons entry cpp-state-stack))))
275 (cpp-parse-close from to))
277 (cpp-parse-error "Parser error"))))))))
279 (if cpp-state-stack
281 (goto-char (nth 3 (car cpp-state-stack)))
282 (cpp-parse-error "Unclosed conditional"))))
284 (null cpp-parse-symbols)
285 (cpp-parse-edit)))
287 (defun cpp-parse-open (branch expr begin end)
288 "Push information about conditional-beginning onto `cpp-state-stack'."
302 (setq cpp-state-stack (cons (list branch expr begin end) cpp-state-stack))
303 (or (member expr cpp-parse-symbols)
304 (setq cpp-parse-symbols
305 (cons expr cpp-parse-symbols)))
306 (if (assoc expr cpp-edit-list)
307 (cpp-make-known-overlay begin end)
308 (cpp-make-unknown-overlay begin end)))
310 (defun cpp-parse-close (from to)
311 ;; Pop top of cpp-state-stack and create overlay.
312 (let ((entry (assoc (nth 1 (car cpp-state-stack)) cpp-edit-list))
313 (branch (nth 0 (car cpp-state-stack)))
314 (begin (nth 2 (car cpp-state-stack)))
315 (end (nth 3 (car cpp-state-stack))))
316 (setq cpp-state-stack (cdr cpp-state-stack))
320 (priority (length cpp-state-stack))
322 (cpp-make-known-overlay from to)
323 (setq cpp-overlay-list (cons overlay cpp-overlay-list))
326 (cpp-make-overlay-hidden overlay))
331 (cpp-make-overlay-read-only overlay)
332 (cpp-make-overlay-sticky overlay)))
333 (cpp-make-unknown-overlay from to))))
335 (defun cpp-parse-error (error)
336 ;; Error message issued by the cpp parser.
339 (defun cpp-parse-reset ()
340 "Reset display of cpp conditionals to normal."
342 (while cpp-overlay-list
343 (delete-overlay (car cpp-overlay-list))
344 (setq cpp-overlay-list (cdr cpp-overlay-list))))
347 (defun cpp-parse-edit ()
348 "Edit display information for cpp conditionals."
350 (or cpp-parse-symbols
351 (cpp-highlight-buffer t))
354 (cpp-edit-mode)
355 (setq cpp-edit-buffer buffer)
356 (cpp-edit-reset)))
360 (defun cpp-make-known-overlay (start end)
361 ;; Create an overlay for a known cpp command from START to END.
363 (if (eq cpp-known-face 'invisible)
364 (cpp-make-overlay-hidden overlay)
365 (or (eq cpp-known-face 'default)
366 (overlay-put overlay 'face cpp-known-face))
367 (if cpp-known-writable
369 (overlay-put overlay 'modification-hooks '(cpp-signal-read-only))
370 (overlay-put overlay 'insert-in-front-hooks '(cpp-signal-read-only))))
371 (setq cpp-overlay-list (cons overlay cpp-overlay-list))))
373 (defun cpp-make-unknown-overlay (start end)
374 ;; Create an overlay for an unknown cpp command from START to END.
376 (cond ((eq cpp-unknown-face 'invisible)
377 (cpp-make-overlay-hidden overlay))
378 ((eq cpp-unknown-face 'default))
380 (overlay-put overlay 'face cpp-unknown-face)))
381 (if cpp-unknown-writable
383 (overlay-put overlay 'modification-hooks '(cpp-signal-read-only))
384 (overlay-put overlay 'insert-in-front-hooks '(cpp-signal-read-only)))
385 (setq cpp-overlay-list (cons overlay cpp-overlay-list))))
387 (defun cpp-make-overlay-hidden (overlay)
389 (overlay-put overlay 'invisible 'cpp)
390 (overlay-put overlay 'modification-hooks '(cpp-signal-read-only))
391 (overlay-put overlay 'insert-in-front-hooks '(cpp-signal-read-only)))
393 (defun cpp-make-overlay-read-only (overlay)
395 (overlay-put overlay 'modification-hooks '(cpp-signal-read-only))
396 (overlay-put overlay 'insert-in-front-hooks '(cpp-signal-read-only))
397 (overlay-put overlay 'insert-behind-hooks '(cpp-signal-read-only)))
399 (defun cpp-make-overlay-sticky (overlay)
401 (overlay-put overlay 'insert-in-front-hooks '(cpp-grow-overlay))
402 (overlay-put overlay 'insert-behind-hooks '(cpp-grow-overlay)))
404 (defun cpp-signal-read-only (overlay after start end &optional len)
412 (defun cpp-grow-overlay (overlay after start end &optional len)
421 (defvar cpp-edit-map nil)
422 ;; Keymap for `cpp-edit-mode'.
424 (if cpp-edit-map
426 (setq cpp-edit-map (make-keymap))
427 (suppress-keymap cpp-edit-map)
428 (define-key cpp-edit-map [ down-mouse-2 ] 'cpp-push-button)
429 (define-key cpp-edit-map [ mouse-2 ] 'ignore)
430 (define-key cpp-edit-map " " 'scroll-up)
431 (define-key cpp-edit-map "\C-?" 'scroll-down)
432 (define-key cpp-edit-map [ delete ] 'scroll-down)
433 (define-key cpp-edit-map "\C-c\C-c" 'cpp-edit-apply)
434 (define-key cpp-edit-map "a" 'cpp-edit-apply)
435 (define-key cpp-edit-map "A" 'cpp-edit-apply)
436 (define-key cpp-edit-map "r" 'cpp-edit-reset)
437 (define-key cpp-edit-map "R" 'cpp-edit-reset)
438 (define-key cpp-edit-map "s" 'cpp-edit-save)
439 (define-key cpp-edit-map "S" 'cpp-edit-save)
440 (define-key cpp-edit-map "l" 'cpp-edit-load)
441 (define-key cpp-edit-map "L" 'cpp-edit-load)
442 (define-key cpp-edit-map "h" 'cpp-edit-home)
443 (define-key cpp-edit-map "H" 'cpp-edit-home)
444 (define-key cpp-edit-map "b" 'cpp-edit-background)
445 (define-key cpp-edit-map "B" 'cpp-edit-background)
446 (define-key cpp-edit-map "k" 'cpp-edit-known)
447 (define-key cpp-edit-map "K" 'cpp-edit-known)
448 (define-key cpp-edit-map "u" 'cpp-edit-unknown)
449 (define-key cpp-edit-map "u" 'cpp-edit-unknown)
450 (define-key cpp-edit-map "t" 'cpp-edit-true)
451 (define-key cpp-edit-map "T" 'cpp-edit-true)
452 (define-key cpp-edit-map "f" 'cpp-edit-false)
453 (define-key cpp-edit-map "F" 'cpp-edit-false)
454 (define-key cpp-edit-map "w" 'cpp-edit-write)
455 (define-key cpp-edit-map "W" 'cpp-edit-write)
456 (define-key cpp-edit-map "X" 'cpp-edit-toggle-known)
457 (define-key cpp-edit-map "x" 'cpp-edit-toggle-known)
458 (define-key cpp-edit-map "Y" 'cpp-edit-toggle-unknown)
459 (define-key cpp-edit-map "y" 'cpp-edit-toggle-unknown)
460 (define-key cpp-edit-map "q" 'bury-buffer)
461 (define-key cpp-edit-map "Q" 'bury-buffer))
463 (defvar cpp-edit-symbols nil)
465 (make-variable-buffer-local 'cpp-edit-symbols)
467 (defun cpp-edit-mode ()
468 "Major mode for editing the criteria for highlighting cpp conditionals.
475 (setq major-mode 'cpp-edit-mode)
477 (use-local-map cpp-edit-map))
479 (defun cpp-edit-apply ()
482 (cpp-edit-home)
483 (cpp-highlight-buffer t))
485 (defun cpp-edit-reset ()
493 (set-buffer cpp-edit-buffer)
494 (setq symbols cpp-parse-symbols)
496 (setq cpp-edit-symbols symbols)
499 (cpp-make-button (buffer-name cpp-edit-buffer) 'cpp-edit-home)
503 (cpp-make-button "[H]ome (display the C file)" 'cpp-edit-home)
505 (cpp-make-button "[A]pply new settings" 'cpp-edit-apply)
507 (cpp-make-button "[S]ave settings" 'cpp-edit-save)
509 (cpp-make-button "[L]oad settings" 'cpp-edit-load)
513 (cpp-make-button (car (rassq cpp-face-type cpp-face-type-list))
514 'cpp-edit-background)
516 (cpp-make-button (cpp-face-name cpp-known-face)
517 'cpp-edit-known nil t)
519 (cpp-make-button (car (rassq cpp-known-writable cpp-writable-list))
520 'cpp-edit-toggle-known)
522 (cpp-make-button (cpp-face-name cpp-unknown-face)
523 'cpp-edit-unknown nil t)
525 (cpp-make-button (car (rassq cpp-unknown-writable cpp-writable-list))
526 'cpp-edit-toggle-unknown)
533 (entry (assoc symbol cpp-edit-list))
543 (setq cpp-edit-list (delq entry cpp-edit-list)
550 (cpp-make-button (cpp-face-name true)
551 'cpp-edit-true symbol t 14)
553 (cpp-make-button (cpp-face-name false)
554 'cpp-edit-false symbol t 14)
556 (cpp-make-button (car (rassq write cpp-branch-list))
557 'cpp-edit-write symbol nil 6)
563 (defun cpp-edit-load ()
564 "Load cpp configuration."
569 ((file-readable-p cpp-config-file)
570 (load-file cpp-config-file))
571 ((file-readable-p (concat "~/" cpp-config-file))
572 (load-file cpp-config-file)))
573 (if (eq major-mode 'cpp-edit-mode)
574 (cpp-edit-reset)))
576 (defun cpp-edit-save ()
577 "Save the current cpp configuration in a file."
581 (set-buffer cpp-edit-buffer)
582 (let ((buffer (find-file-noselect cpp-config-file)))
585 (pp (list 'setq 'cpp-known-face
586 (list 'quote cpp-known-face)) buffer)
587 (pp (list 'setq 'cpp-unknown-face
588 (list 'quote cpp-unknown-face)) buffer)
589 (pp (list 'setq 'cpp-face-type
590 (list 'quote cpp-face-type)) buffer)
591 (pp (list 'setq 'cpp-known-writable
592 (list 'quote cpp-known-writable)) buffer)
593 (pp (list 'setq 'cpp-unknown-writable
594 (list 'quote cpp-unknown-writable)) buffer)
595 (pp (list 'setq 'cpp-edit-list
596 (list 'quote cpp-edit-list)) buffer)
597 (write-file cpp-config-file))))
599 (defun cpp-edit-home ()
602 (if cpp-button-event
604 (pop-to-buffer cpp-edit-buffer))
606 (defun cpp-edit-background ()
609 (call-interactively 'cpp-choose-default-face)
610 (cpp-edit-reset))
612 (defun cpp-edit-known ()
615 (setq cpp-known-face (cpp-choose-face "Known face" cpp-known-face))
616 (cpp-edit-reset))
618 (defun cpp-edit-unknown ()
621 (setq cpp-unknown-face (cpp-choose-face "Unknown face" cpp-unknown-face))
622 (cpp-edit-reset))
624 (defun cpp-edit-toggle-known (arg)
628 (if (or (and (null arg) cpp-known-writable)
630 (setq cpp-known-writable nil)
631 (setq cpp-known-writable t))
632 (cpp-edit-reset))
634 (defun cpp-edit-toggle-unknown (arg)
638 (if (or (and (null arg) cpp-unknown-writable)
640 (setq cpp-unknown-writable nil)
641 (setq cpp-unknown-writable t))
642 (cpp-edit-reset))
644 (defun cpp-edit-true (symbol face)
647 (let ((symbol (cpp-choose-symbol)))
649 (cpp-choose-face "True face"
650 (nth 1 (assoc symbol cpp-edit-list))))))
651 (setcar (nthcdr 1 (cpp-edit-list-entry-get-or-create symbol)) face)
652 (cpp-edit-reset))
654 (defun cpp-edit-false (symbol face)
657 (let ((symbol (cpp-choose-symbol)))
659 (cpp-choose-face "False face"
660 (nth 2 (assoc symbol cpp-edit-list))))))
661 (setcar (nthcdr 2 (cpp-edit-list-entry-get-or-create symbol)) face)
662 (cpp-edit-reset))
664 (defun cpp-edit-write (symbol branch)
667 (interactive (list (cpp-choose-symbol) (cpp-choose-branch)))
668 (setcar (nthcdr 3 (cpp-edit-list-entry-get-or-create symbol)) branch)
669 (cpp-edit-reset))
671 (defun cpp-edit-list-entry-get-or-create (symbol)
672 ;; Return the entry for SYMBOL in `cpp-edit-list'.
674 (let ((entry (assoc symbol cpp-edit-list)))
677 cpp-edit-list (cons entry cpp-edit-list)))
682 (defun cpp-choose-symbol ()
684 (if cpp-button-event
685 cpp-callback-data
686 (completing-read "Symbol: " cpp-edit-symbols nil t)))
688 (defun cpp-choose-branch ()
690 (if cpp-button-event
691 (x-popup-menu cpp-button-event
692 (list "Branch" (cons "Branch" cpp-branch-list)))
693 (cdr (assoc (completing-read "Branch: " cpp-branch-list nil t)
694 cpp-branch-list))))
696 (defun cpp-choose-face (prompt default)
697 ;; Choose a face from cpp-face-default-list.
700 (or (if cpp-button-event
701 (x-popup-menu cpp-button-event
702 (list prompt (cons prompt cpp-face-default-list)))
703 (let ((name (car (rassq default cpp-face-default-list))))
708 cpp-face-default-list nil t)
709 cpp-face-all-list))))
712 (defun cpp-choose-default-face (type)
714 ;; Type must be one of the types defined in `cpp-face-type-list'.
715 (interactive (list (if cpp-button-event
716 (x-popup-menu cpp-button-event
719 cpp-face-type-list)))
721 cpp-face-type-list
723 cpp-face-type-list)))))
726 (if cpp-face-light-list
728 (setq cpp-face-light-list
729 (mapcar 'cpp-create-bg-face cpp-face-light-name-list))
730 (setq cpp-face-all-list
731 (append cpp-face-all-list cpp-face-light-list)))
732 (setq cpp-face-type 'light)
733 (setq cpp-face-default-list
734 (append cpp-face-light-list cpp-face-none-list)))
736 (if cpp-face-dark-list
738 (setq cpp-face-dark-list
739 (mapcar 'cpp-create-bg-face cpp-face-dark-name-list))
740 (setq cpp-face-all-list
741 (append cpp-face-all-list cpp-face-dark-list)))
742 (setq cpp-face-type 'dark)
743 (setq cpp-face-default-list
744 (append cpp-face-dark-list cpp-face-none-list)))
746 (setq cpp-face-type 'mono)
747 (setq cpp-face-default-list
748 (append cpp-face-mono-list cpp-face-none-list)))
750 (setq cpp-face-type 'none)
751 (setq cpp-face-default-list cpp-face-none-list))))
755 (defun cpp-make-button (name callback &optional data face padding)
760 ;;in the free variable cpp-callback-data.
761 ;; FACE means that NAME is the name of a face in `cpp-face-all-list'.
778 (let ((check (cdr (assoc name cpp-face-all-list))))
787 (list 'cpp-callback callback)
788 (if data (list 'cpp-data data))))))
790 (defun cpp-push-button (event)
795 (let ((cpp-callback-data (get-text-property pos 'cpp-data))
796 (fun (get-text-property pos 'cpp-callback))
797 (cpp-button-event event))
799 (call-interactively (get-text-property pos 'cpp-callback)))
805 (defun cpp-create-bg-face (color)
809 (cpp-choose-default-face
810 (if (or window-system (display-color-p)) cpp-face-type 'none))
812 (defun cpp-face-name (face)
813 ;; Return the name of FACE from `cpp-face-all-list'.
814 (let ((entry (rassq (if face face 'default) cpp-face-all-list)))
821 (defvar cpp-progress-time 0)
824 (defun cpp-progress-message (&rest args)
827 (if (= time cpp-progress-time)
829 (setq cpp-progress-time time)
832 (provide 'cpp)
835 ;;; cpp.el ends here