;;; semantic/fw.el --- Framework for Semantic
-;;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
-;;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
(load "semantic/loaddefs" nil 'nomessage)
;;; Compatibility
-
-(defalias 'semantic-buffer-local-value 'buffer-local-value)
-(defalias 'semantic-overlay-live-p 'overlay-buffer)
-(defalias 'semantic-make-overlay 'make-overlay)
-(defalias 'semantic-overlay-put 'overlay-put)
-(defalias 'semantic-overlay-get 'overlay-get)
-(defalias 'semantic-overlay-properties 'overlay-properties)
-(defalias 'semantic-overlay-move 'move-overlay)
-(defalias 'semantic-overlay-delete 'delete-overlay)
-(defalias 'semantic-overlays-at 'overlays-at)
-(defalias 'semantic-overlays-in 'overlays-in)
-(defalias 'semantic-overlay-buffer 'overlay-buffer)
-(defalias 'semantic-overlay-start 'overlay-start)
-(defalias 'semantic-overlay-end 'overlay-end)
-(defalias 'semantic-overlay-size 'overlay-size)
-(defalias 'semantic-overlay-next-change 'next-overlay-change)
-(defalias 'semantic-overlay-previous-change 'previous-overlay-change)
-(defalias 'semantic-overlay-lists 'overlay-lists)
-(defalias 'semantic-overlay-p 'overlayp)
-(defalias 'semantic-read-event 'read-event)
-(defalias 'semantic-popup-menu 'popup-menu)
-(defalias 'semantic-make-local-hook 'identity)
-(defalias 'semantic-mode-line-update 'force-mode-line-update)
-(defalias 'semantic-run-mode-hooks 'run-mode-hooks)
-(defalias 'semantic-compile-warn 'byte-compile-warn)
-(defalias 'semantic-menu-item 'identity)
-
-(defun semantic-event-window (event)
- "Extract the window from EVENT."
- (car (car (cdr event))))
+;;
+(eval-and-compile
+ (if (featurep 'xemacs)
+ (progn
+ (defalias 'semantic-buffer-local-value 'symbol-value-in-buffer)
+ (defalias 'semantic-overlay-live-p
+ (lambda (o)
+ (and (extent-live-p o)
+ (not (extent-detached-p o))
+ (bufferp (extent-buffer o)))))
+ (defalias 'semantic-make-overlay
+ (lambda (beg end &optional buffer &rest rest)
+ "Xemacs `make-extent', supporting the front/rear advance options."
+ (let ((ol (make-extent beg end buffer)))
+ (when rest
+ (set-extent-property ol 'start-open (car rest))
+ (setq rest (cdr rest)))
+ (when rest
+ (set-extent-property ol 'end-open (car rest)))
+ ol)))
+ (defalias 'semantic-overlay-put 'set-extent-property)
+ (defalias 'semantic-overlay-get 'extent-property)
+ (defalias 'semantic-overlay-properties 'extent-properties)
+ (defalias 'semantic-overlay-move 'set-extent-endpoints)
+ (defalias 'semantic-overlay-delete 'delete-extent)
+ (defalias 'semantic-overlays-at
+ (lambda (pos)
+ (condition-case nil
+ (extent-list nil pos pos)
+ (error nil))
+ ))
+ (defalias 'semantic-overlays-in
+ (lambda (beg end) (extent-list nil beg end)))
+ (defalias 'semantic-overlay-buffer 'extent-buffer)
+ (defalias 'semantic-overlay-start 'extent-start-position)
+ (defalias 'semantic-overlay-end 'extent-end-position)
+ (defalias 'semantic-overlay-size 'extent-length)
+ (defalias 'semantic-overlay-next-change 'next-extent-change)
+ (defalias 'semantic-overlay-previous-change 'previous-extent-change)
+ (defalias 'semantic-overlay-lists
+ (lambda () (list (extent-list))))
+ (defalias 'semantic-overlay-p 'extentp)
+ (defalias 'semantic-event-window 'event-window)
+ (defun semantic-read-event ()
+ (let ((event (next-command-event)))
+ (if (key-press-event-p event)
+ (let ((c (event-to-character event)))
+ (if (char-equal c (quit-char))
+ (keyboard-quit)
+ c)))
+ event))
+ (defun semantic-popup-menu (menu)
+ "Blocking version of `popup-menu'"
+ (popup-menu menu)
+ ;; Wait...
+ (while (popup-up-p) (dispatch-event (next-event))))
+ )
+ ;; Emacs Bindings
+ (defalias 'semantic-overlay-live-p 'overlay-buffer)
+ (defalias 'semantic-make-overlay 'make-overlay)
+ (defalias 'semantic-overlay-put 'overlay-put)
+ (defalias 'semantic-overlay-get 'overlay-get)
+ (defalias 'semantic-overlay-properties 'overlay-properties)
+ (defalias 'semantic-overlay-move 'move-overlay)
+ (defalias 'semantic-overlay-delete 'delete-overlay)
+ (defalias 'semantic-overlays-at 'overlays-at)
+ (defalias 'semantic-overlays-in 'overlays-in)
+ (defalias 'semantic-overlay-buffer 'overlay-buffer)
+ (defalias 'semantic-overlay-start 'overlay-start)
+ (defalias 'semantic-overlay-end 'overlay-end)
+ (defalias 'semantic-overlay-next-change 'next-overlay-change)
+ (defalias 'semantic-overlay-previous-change 'previous-overlay-change)
+ (defalias 'semantic-overlay-lists 'overlay-lists)
+ (defalias 'semantic-overlay-p 'overlayp)
+ (defalias 'semantic-read-event 'read-event)
+ (defalias 'semantic-popup-menu 'popup-menu)
+ (defun semantic-event-window (event)
+ "Extract the window from EVENT."
+ (car (car (cdr event))))
+
+ (if (> emacs-major-version 21)
+ (defalias 'semantic-buffer-local-value 'buffer-local-value)
+
+ (defun semantic-buffer-local-value (sym &optional buf)
+ "Get the value of SYM from buffer local variable in BUF."
+ (cdr (assoc sym (buffer-local-variables buf)))))
+ )
+
+
+ (defalias 'semantic-make-local-hook
+ (if (and (not (featurep 'xemacs))
+ (>= emacs-major-version 21))
+ #'identity #'make-local-hook))
+
+ (defalias 'semantic-mode-line-update
+ (if (featurep 'xemacs) #'redraw-modeline #'force-mode-line-update))
+
+ ;; Since Emacs 22 major mode functions should use `run-mode-hooks' to
+ ;; run major mode hooks.
+ (defalias 'semantic-run-mode-hooks
+ (if (fboundp 'run-mode-hooks)
+ 'run-mode-hooks
+ 'run-hooks))
+
+ ;; Fancy compat usage now handled in cedet-compat
+ (defalias 'semantic-subst-char-in-string 'subst-char-in-string)
+ )
(defun semantic-delete-overlay-maybe (overlay)
"Delete OVERLAY if it is a semantic token overlay."
(if (semantic-overlay-get overlay 'semantic)
(semantic-overlay-delete overlay)))
+;;; Menu Item compatibility
+;;
+(defun semantic-menu-item (item)
+ "Build an XEmacs compatible menu item from vector ITEM.
+That is remove the unsupported :help stuff."
+ (if (featurep 'xemacs)
+ (let ((n (length item))
+ (i 0)
+ slot l)
+ (while (< i n)
+ (setq slot (aref item i))
+ (if (and (keywordp slot)
+ (eq slot :help))
+ (setq i (1+ i))
+ (setq l (cons slot l)))
+ (setq i (1+ i)))
+ (apply #'vector (nreverse l)))
+ item))
+
;;; Positional Data Cache
;;
(defvar semantic-cache-data-overlays nil
(when ans
(semantic-overlay-get ans 'cached-value)))))
+(defun semantic-test-data-cache ()
+ "Test the data cache."
+ (interactive)
+ (let ((data '(a b c)))
+ (save-current-buffer
+ (set-buffer (get-buffer-create " *semantic-test-data-cache*"))
+ (save-excursion
+ (erase-buffer)
+ (insert "The Moose is Loose")
+ (goto-char (point-min))
+ (semantic-cache-data-to-buffer (current-buffer) (point) (+ (point) 5)
+ data 'moose 'exit-cache-zone)
+ (if (equal (semantic-get-cache-data 'moose) data)
+ (message "Successfully retrieved cached data.")
+ (error "Failed to retrieve cached data"))
+ ))))
+
;;; Obsoleting various functions & variables
;;
(defun semantic-overload-symbol-from-function (name)
(not (string-match "cedet" byte-compile-current-file))
)
(make-obsolete-overload oldfnalias newfn when)
- (semantic-compile-warn
+ (byte-compile-warn
"%s: `%s' obsoletes overload `%s'"
byte-compile-current-file
newfn
;; Only throw this warning when byte compiling things.
(when (and (boundp 'byte-compile-current-file)
byte-compile-current-file)
- (semantic-compile-warn
+ (byte-compile-warn
"variable `%s' obsoletes, but isn't alias of `%s'"
newvar oldvaralias)
))))
(defmacro semantic-exit-on-input (symbol &rest forms)
"Using SYMBOL as an argument to `throw', execute FORMS.
-If FORMS includes a call to `semantic-thow-on-input', then
+If FORMS includes a call to `semantic-throw-on-input', then
if a user presses any key during execution, this form macro
will exit with the value passed to `semantic-throw-on-input'.
If FORMS completes, then the return value is the same as `progn'."
"Call `find-file-noselect' with various features turned off.
Use this when referencing a file that will be soon deleted.
FILE, NOWARN, RAWFILE, and WILDCARDS are passed into `find-file-noselect'"
+ ;; Hack -
+ ;; Check if we are in set-auto-mode, and if so, warn about this.
+ (when (or (and (featurep 'emacs) (boundp 'keep-mode-if-same))
+ (and (featurep 'xemacs) (boundp 'just-from-file-name)))
+ (let ((filename (or (and (boundp 'filename) filename)
+ "(unknown)")))
+ (message "WARNING: semantic-find-file-noselect called for \
+%s while in set-auto-mode for %s. You should call the responsible function \
+into `mode-local-init-hook'." file filename)
+ (sit-for 1)))
+
(let* ((recentf-exclude '( (lambda (f) t) ))
;; This is a brave statement. Don't waste time loading in
;; lots of modes. Especially decoration mode can waste a lot
(ede-auto-add-method 'never)
;; Ask font-lock to not colorize these buffers, nor to
;; whine about it either.
- (font-lock-maximum-size 0)
+ (global-font-lock-mode nil)
(font-lock-verbose nil)
+ ;; This forces flymake to ignore this buffer on find-file, and
+ ;; prevents flymake processes from being started.
+ (flymake-start-syntax-check-on-find-file nil)
;; Disable revision control
(vc-handled-backends nil)
;; Don't prompt to insert a template if we visit an empty file
(auto-insert nil)
;; We don't want emacs to query about unsafe local variables
- (enable-local-variables
- (if (featurep 'xemacs)
- ;; XEmacs only has nil as an option?
- nil
- ;; Emacs 23 has the spiffy :safe option, nil otherwise.
- (if (>= emacs-major-version 22)
- nil
- :safe)))
+ (enable-local-variables :safe)
;; ... or eval variables
(enable-local-eval nil)
)
(find-file-noselect file nowarn rawfile wildcards)))
))
+;;; Database restriction settings
+;;
+(defmacro semanticdb-without-unloaded-file-searches (forms)
+ "Execute FORMS with `unloaded' removed from the current throttle."
+ `(let ((semanticdb-find-default-throttle
+ (if (featurep 'semantic/db-find)
+ (remq 'unloaded semanticdb-find-default-throttle)
+ nil)))
+ ,forms))
+(put 'semanticdb-without-unloaded-file-searches 'lisp-indent-function 1)
+
\f
;; ;;; Editor goodies ;-)
;; ;;
(provide 'semantic/fw)
-;; arch-tag: e7eeffbf-112b-4665-92fc-5f69479ca2c4
;;; semantic/fw.el ends here