/semantic/semantic-idle.el

http://github.com/emacsmirror/cedet · Lisp · 1353 lines · 983 code · 128 blank · 242 comment · 46 complexity · e48d7c44bbdd6a1d50fe4c0534352e4b MD5 · raw file

  1. ;; semantic-idle.el --- Schedule parsing tasks in idle time
  2. ;;; Copyright (C) 2003, 2004, 2005, 2006, 2008, 2009, 2010 Eric M. Ludlam
  3. ;; Author: Eric M. Ludlam <zappo@gnu.org>
  4. ;; Keywords: syntax
  5. ;; X-RCS: $Id: semantic-idle.el,v 1.75 2010-05-21 23:05:13 scymtym Exp $
  6. ;; This file is not part of GNU Emacs.
  7. ;; Semantic is free software; you can redistribute it and/or modify
  8. ;; it under the terms of the GNU General Public License as published by
  9. ;; the Free Software Foundation; either version 2, or (at your option)
  10. ;; any later version.
  11. ;; This software is distributed in the hope that it will be useful,
  12. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14. ;; GNU General Public License for more details.
  15. ;; You should have received a copy of the GNU General Public License
  16. ;; along with GNU Emacs; see the file COPYING. If not, write to the
  17. ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  18. ;; Boston, MA 02110-1301, USA.
  19. ;;; Commentary:
  20. ;;
  21. ;; Originally, `semantic-auto-parse-mode' handled refreshing the
  22. ;; tags in a buffer in idle time. Other activities can be scheduled
  23. ;; in idle time, all of which require up-to-date tag tables.
  24. ;; Having a specialized idle time scheduler that first refreshes
  25. ;; the tags buffer, and then enables other idle time tasks reduces
  26. ;; the amount of work needed. Any specialized idle tasks need not
  27. ;; ask for a fresh tags list.
  28. ;;
  29. ;; NOTE ON SEMANTIC_ANALYZE
  30. ;;
  31. ;; Some of the idle modes use the semantic analyzer. The analyzer
  32. ;; automatically caches the created context, so it is shared amongst
  33. ;; all idle modes that will need it.
  34. (require 'semantic-ctxt)
  35. (require 'semantic-util-modes)
  36. (require 'timer)
  37. (require 'senator) ;; For `senator-menu-item'
  38. ;; @TODO - how to make this happen only if someone enables to summary mode?
  39. (require 'eldoc)
  40. ;;; Code:
  41. ;;; TIMER RELATED FUNCTIONS
  42. ;;
  43. (defvar semantic-idle-scheduler-timer nil
  44. "Timer used to schedule tasks in idle time.")
  45. (defvar semantic-idle-scheduler-work-timer nil
  46. "Timer used to schedule tasks in idle time that may take a while.")
  47. (defcustom semantic-idle-scheduler-verbose-flag nil
  48. "*Non-nil means that the idle scheduler should provide debug messages.
  49. Use this setting to debug idle activities."
  50. :group 'semantic
  51. :type 'boolean)
  52. (defcustom semantic-idle-scheduler-idle-time 2
  53. "*Time in seconds of idle before scheduling events.
  54. This time should be short enough to ensure that idle-scheduler will be
  55. run as soon as Emacs is idle."
  56. :group 'semantic
  57. :type 'number
  58. :set (lambda (sym val)
  59. (set-default sym val)
  60. (when (timerp semantic-idle-scheduler-timer)
  61. (cancel-timer semantic-idle-scheduler-timer)
  62. (setq semantic-idle-scheduler-timer nil)
  63. (semantic-idle-scheduler-setup-timers))))
  64. (defcustom semantic-idle-scheduler-work-idle-time 60
  65. "*Time in seconds of idle before scheduling big work.
  66. This time should be long enough that once any big work is started, it is
  67. unlikely the user would be ready to type again right away."
  68. :group 'semantic
  69. :type 'number
  70. :set (lambda (sym val)
  71. (set-default sym val)
  72. (when (timerp semantic-idle-scheduler-timer)
  73. (cancel-timer semantic-idle-scheduler-timer)
  74. (setq semantic-idle-scheduler-timer nil)
  75. (semantic-idle-scheduler-setup-timers))))
  76. (defun semantic-idle-scheduler-setup-timers ()
  77. "Lazy initialization of the auto parse idle timer."
  78. ;; REFRESH THIS FUNCTION for XEMACS FOIBLES
  79. (or (timerp semantic-idle-scheduler-timer)
  80. (setq semantic-idle-scheduler-timer
  81. (run-with-idle-timer
  82. semantic-idle-scheduler-idle-time t
  83. #'semantic-idle-scheduler-function)))
  84. (or (timerp semantic-idle-scheduler-work-timer)
  85. (setq semantic-idle-scheduler-work-timer
  86. (run-with-idle-timer
  87. semantic-idle-scheduler-work-idle-time t
  88. #'semantic-idle-scheduler-work-function)))
  89. )
  90. (defun semantic-idle-scheduler-kill-timer ()
  91. "Kill the auto parse idle timer."
  92. (if (timerp semantic-idle-scheduler-timer)
  93. (cancel-timer semantic-idle-scheduler-timer))
  94. (setq semantic-idle-scheduler-timer nil))
  95. ;;; MINOR MODE
  96. ;;
  97. ;; The minor mode portion of this code just sets up the minor mode
  98. ;; which does the initial scheduling of the idle timers.
  99. ;;
  100. ;;;###autoload
  101. (defcustom global-semantic-idle-scheduler-mode nil
  102. "*If non-nil, enable global use of idle-scheduler mode."
  103. :group 'semantic
  104. :group 'semantic-modes
  105. :type 'boolean
  106. :require 'semantic-idle
  107. :initialize 'custom-initialize-default
  108. :set (lambda (sym val)
  109. (global-semantic-idle-scheduler-mode (if val 1 -1))))
  110. (defcustom semantic-idle-scheduler-mode-hook nil
  111. "Hook run at the end of function `semantic-idle-scheduler-mode'."
  112. :group 'semantic
  113. :type 'hook)
  114. ;;;###autoload
  115. (defvar semantic-idle-scheduler-mode nil
  116. "Non-nil if idle-scheduler minor mode is enabled.
  117. Use the command `semantic-idle-scheduler-mode' to change this variable.")
  118. (make-variable-buffer-local 'semantic-idle-scheduler-mode)
  119. (defcustom semantic-idle-scheduler-max-buffer-size 0
  120. "*Maximum size in bytes of buffers where idle-scheduler is enabled.
  121. If this value is less than or equal to 0, idle-scheduler is enabled in
  122. all buffers regardless of their size."
  123. :group 'semantic
  124. :type 'number)
  125. (defsubst semantic-idle-scheduler-enabled-p ()
  126. "Return non-nil if idle-scheduler is enabled for this buffer.
  127. idle-scheduler is disabled when debugging or if the buffer size
  128. exceeds the `semantic-idle-scheduler-max-buffer-size' threshold."
  129. (let* ((remote-file? (when (stringp buffer-file-name) (file-remote-p buffer-file-name))))
  130. (and semantic-idle-scheduler-mode
  131. (not semantic-debug-enabled)
  132. (not semantic-lex-debug)
  133. ;; local file should exist on disk
  134. ;; remote file should have active connection
  135. (or (and (null remote-file?) (stringp buffer-file-name)
  136. (file-exists-p buffer-file-name))
  137. (and remote-file? (file-remote-p buffer-file-name nil t)))
  138. (or (<= semantic-idle-scheduler-max-buffer-size 0)
  139. (< (buffer-size) semantic-idle-scheduler-max-buffer-size)))))
  140. (defun semantic-idle-scheduler-mode-setup ()
  141. "Setup option `semantic-idle-scheduler-mode'.
  142. The minor mode can be turned on only if semantic feature is available
  143. and the current buffer was set up for parsing. When minor mode is
  144. enabled parse the current buffer if needed. Return non-nil if the
  145. minor mode is enabled."
  146. (if semantic-idle-scheduler-mode
  147. (if (not (and (featurep 'semantic) (semantic-active-p)))
  148. (progn
  149. ;; Disable minor mode if semantic stuff not available
  150. (setq semantic-idle-scheduler-mode nil)
  151. (error "Buffer %s was not set up idle time scheduling"
  152. (buffer-name)))
  153. (semantic-idle-scheduler-setup-timers)))
  154. semantic-idle-scheduler-mode)
  155. ;;;###autoload
  156. (defun semantic-idle-scheduler-mode (&optional arg)
  157. "Minor mode to auto parse buffer following a change.
  158. When this mode is off, a buffer is only rescanned for tokens when
  159. some command requests the list of available tokens. When idle-scheduler
  160. is enabled, Emacs periodically checks to see if the buffer is out of
  161. date, and reparses while the user is idle (not typing.)
  162. With prefix argument ARG, turn on if positive, otherwise off. The
  163. minor mode can be turned on only if semantic feature is available and
  164. the current buffer was set up for parsing. Return non-nil if the
  165. minor mode is enabled."
  166. (interactive
  167. (list (or current-prefix-arg
  168. (if semantic-idle-scheduler-mode 0 1))))
  169. (setq semantic-idle-scheduler-mode
  170. (if arg
  171. (>
  172. (prefix-numeric-value arg)
  173. 0)
  174. (not semantic-idle-scheduler-mode)))
  175. (semantic-idle-scheduler-mode-setup)
  176. (run-hooks 'semantic-idle-scheduler-mode-hook)
  177. (if (cedet-called-interactively-p 'interactive)
  178. (message "idle-scheduler minor mode %sabled"
  179. (if semantic-idle-scheduler-mode "en" "dis")))
  180. (semantic-mode-line-update)
  181. semantic-idle-scheduler-mode)
  182. (semantic-add-minor-mode 'semantic-idle-scheduler-mode
  183. "ARP"
  184. nil)
  185. (semantic-alias-obsolete 'semantic-auto-parse-mode
  186. 'semantic-idle-scheduler-mode)
  187. (semantic-alias-obsolete 'global-semantic-auto-parse-mode
  188. 'global-semantic-idle-scheduler-mode)
  189. ;;; SERVICES services
  190. ;;
  191. ;; These are services for managing idle services.
  192. ;;
  193. (defvar semantic-idle-scheduler-queue nil
  194. "List of functions to execute during idle time.
  195. These functions will be called in the current buffer after that
  196. buffer has had its tags made up to date. These functions
  197. will not be called if there are errors parsing the
  198. current buffer.")
  199. ;;;###autoload
  200. (defun semantic-idle-scheduler-add (function)
  201. "Schedule FUNCTION to occur during idle time."
  202. (add-to-list 'semantic-idle-scheduler-queue function))
  203. ;;;###autoload
  204. (defun semantic-idle-scheduler-remove (function)
  205. "Unschedule FUNCTION to occur during idle time."
  206. (setq semantic-idle-scheduler-queue
  207. (delete function semantic-idle-scheduler-queue)))
  208. ;;; IDLE Function
  209. ;;
  210. (defun semantic-idle-core-handler ()
  211. "Core idle function that handles reparsing.
  212. And also manages services that depend on tag values."
  213. (when semantic-idle-scheduler-verbose-flag
  214. (working-temp-message "IDLE: Core handler..."))
  215. (semantic-exit-on-input 'idle-timer
  216. (let* ((inhibit-quit nil)
  217. (buffers (delq (current-buffer)
  218. (delq nil
  219. (mapcar #'(lambda (b)
  220. (and (buffer-file-name b)
  221. b))
  222. (buffer-list)))))
  223. safe ;; This safe is not used, but could be.
  224. others
  225. mode)
  226. (when (semantic-idle-scheduler-enabled-p)
  227. (save-excursion
  228. ;; First, reparse the current buffer.
  229. (setq mode major-mode
  230. safe (semantic-safe "Idle Parse Error: %S"
  231. ;(error "Goofy error 1")
  232. (semantic-idle-scheduler-refresh-tags)
  233. )
  234. )
  235. ;; Now loop over other buffers with same major mode, trying to
  236. ;; update them as well. Stop on keypress.
  237. (dolist (b buffers)
  238. (semantic-throw-on-input 'parsing-mode-buffers)
  239. (with-current-buffer b
  240. (if (eq major-mode mode)
  241. (and (semantic-idle-scheduler-enabled-p)
  242. (semantic-safe "Idle Parse Error: %S"
  243. ;(error "Goofy error")
  244. (semantic-idle-scheduler-refresh-tags)))
  245. (push (current-buffer) others))))
  246. (setq buffers others))
  247. ;; If re-parse of current buffer completed, evaluate all other
  248. ;; services. Stop on keypress.
  249. ;; NOTE ON COMMENTED SAFE HERE
  250. ;; We used to not execute the services if the buffer was
  251. ;; unparseable. We now assume that they are lexically
  252. ;; safe to do, because we have marked the buffer unparseable
  253. ;; if there was a problem.
  254. ;;(when safe
  255. (dolist (service semantic-idle-scheduler-queue)
  256. (save-excursion
  257. (semantic-throw-on-input 'idle-queue)
  258. (when semantic-idle-scheduler-verbose-flag
  259. (working-temp-message "IDLE: execute service %s..." service))
  260. (semantic-safe (format "Idle Service Error %s: %%S" service)
  261. (funcall service))
  262. (when semantic-idle-scheduler-verbose-flag
  263. (working-temp-message "IDLE: execute service %s...done" service))
  264. )))
  265. ;;)
  266. ;; Finally loop over remaining buffers, trying to update them as
  267. ;; well. Stop on keypress.
  268. (save-excursion
  269. (dolist (b buffers)
  270. (semantic-throw-on-input 'parsing-other-buffers)
  271. (with-current-buffer b
  272. (and (semantic-idle-scheduler-enabled-p)
  273. (semantic-idle-scheduler-refresh-tags)))))
  274. ))
  275. (when semantic-idle-scheduler-verbose-flag
  276. (working-temp-message "IDLE: Core handler...done")))
  277. (defun semantic-debug-idle-function ()
  278. "Run the Semantic idle function with debugging turned on."
  279. (interactive)
  280. (let ((debug-on-error t))
  281. (semantic-idle-core-handler)
  282. ))
  283. (defun semantic-idle-scheduler-function ()
  284. "Function run when after `semantic-idle-scheduler-idle-time'.
  285. This function will reparse the current buffer, and if successful,
  286. call additional functions registered with the timer calls."
  287. (when (zerop (recursion-depth))
  288. (let ((debug-on-error nil))
  289. (save-match-data (semantic-idle-core-handler))
  290. )))
  291. ;;; WORK FUNCTION
  292. ;;
  293. ;; Unlike the shorter timer, the WORK timer will kick of tasks that
  294. ;; may take a long time to complete.
  295. (defcustom semantic-idle-work-parse-neighboring-files-flag nil
  296. "*Non-nil means to parse files in the same dir as the current buffer.
  297. Disable to prevent lots of excessive parsing in idle time."
  298. :group 'semantic
  299. :type 'boolean)
  300. (defcustom semantic-idle-work-update-headers-flag nil
  301. "*Non-nil means to parse through header files in idle time.
  302. Disable to prevent idle time parsing of many files. If completion
  303. is called that work will be done then instead."
  304. :group 'semantic
  305. :type 'boolean)
  306. (defun semantic-idle-work-for-one-buffer (buffer)
  307. "Do long-processing work for BUFFER.
  308. Uses `semantic-safe' and returns the output.
  309. Returns t if all processing succeeded."
  310. (with-current-buffer buffer
  311. (not (and
  312. ;; Just in case
  313. (semantic-safe "Idle Work Parse Error: %S"
  314. (semantic-idle-scheduler-refresh-tags)
  315. t)
  316. ;; Option to disable this work.
  317. semantic-idle-work-update-headers-flag
  318. ;; Force all our include files to get read in so we
  319. ;; are ready to provide good smart completion and idle
  320. ;; summary information
  321. (semantic-safe "Idle Work Including Error: %S"
  322. ;; Get the include related path.
  323. (when (and (featurep 'semanticdb)
  324. (semanticdb-minor-mode-p))
  325. (require 'semanticdb-find)
  326. (semanticdb-find-translate-path buffer nil)
  327. )
  328. t)
  329. ;; Pre-build the typecaches as needed.
  330. (semantic-safe "Idle Work Typecaching Error: %S"
  331. (when (featurep 'semanticdb-typecache)
  332. (semanticdb-typecache-refresh-for-buffer buffer))
  333. t)
  334. ))
  335. ))
  336. (defun semantic-idle-work-core-handler ()
  337. "Core handler for idle work processing of long running tasks.
  338. Visits Semantic controlled buffers, and makes sure all needed
  339. include files have been parsed, and that the typecache is up to date.
  340. Uses `semantic-idle-work-for-on-buffer' to do the work."
  341. (let ((errbuf nil)
  342. (interrupted
  343. (semantic-exit-on-input 'idle-work-timer
  344. (let* ((inhibit-quit nil)
  345. (cb (current-buffer))
  346. (buffers (delq (current-buffer)
  347. (delq nil
  348. (mapcar #'(lambda (b)
  349. (and (buffer-file-name b)
  350. b))
  351. (buffer-list)))))
  352. safe errbuf)
  353. ;; First, handle long tasks in the current buffer.
  354. (when (semantic-idle-scheduler-enabled-p)
  355. (save-excursion
  356. (setq safe (semantic-idle-work-for-one-buffer (current-buffer))
  357. )))
  358. (when (not safe) (push (current-buffer) errbuf))
  359. ;; Now loop over other buffers with same major mode, trying to
  360. ;; update them as well. Stop on keypress.
  361. (dolist (b buffers)
  362. (semantic-throw-on-input 'parsing-mode-buffers)
  363. (with-current-buffer b
  364. (when (semantic-idle-scheduler-enabled-p)
  365. (and (semantic-idle-scheduler-enabled-p)
  366. (unless (semantic-idle-work-for-one-buffer (current-buffer))
  367. (push (current-buffer) errbuf)))
  368. ))
  369. )
  370. (when (and (featurep 'semanticdb)
  371. (semanticdb-minor-mode-p))
  372. ;; Save everything.
  373. (semanticdb-save-all-db-idle)
  374. ;; Parse up files near our active buffer
  375. (when semantic-idle-work-parse-neighboring-files-flag
  376. (semantic-safe "Idle Work Parse Neighboring Files: %S"
  377. (set-buffer cb)
  378. (semantic-idle-scheduler-work-parse-neighboring-files))
  379. t)
  380. ;; Save everything... again
  381. (semanticdb-save-all-db-idle)
  382. )
  383. ;; Done w/ processing
  384. nil))))
  385. ;; Done
  386. (if interrupted
  387. "Interrupted"
  388. (cond ((not errbuf)
  389. "done")
  390. ((not (cdr errbuf))
  391. (format "done with 1 error in %s" (car errbuf)))
  392. (t
  393. (format "done with errors in %d buffers."
  394. (length errbuf)))))))
  395. (defun semantic-debug-idle-work-function ()
  396. "Run the Semantic idle work function with debugging turned on."
  397. (interactive)
  398. (let ((debug-on-error t))
  399. (semantic-idle-work-core-handler)
  400. ))
  401. (defun semantic-idle-scheduler-work-function ()
  402. "Function run when after `semantic-idle-scheduler-work-idle-time'.
  403. This routine handles difficult tasks that require a lot of parsing, such as
  404. parsing all the header files used by our active sources, or building up complex
  405. datasets."
  406. (when semantic-idle-scheduler-verbose-flag
  407. (message "Long Work Idle Timer..."))
  408. (let ((exit-type (save-match-data
  409. (semantic-idle-work-core-handler))))
  410. (when semantic-idle-scheduler-verbose-flag
  411. (message "Long Work Idle Timer...%s" exit-type)))
  412. )
  413. (defun semantic-idle-scheduler-work-parse-neighboring-files ()
  414. "Parse all the files in similar directories to buffers being edited."
  415. ;; Lets check to see if EDE matters.
  416. (let ((ede-auto-add-method 'never))
  417. (dolist (a auto-mode-alist)
  418. (when (eq (cdr a) major-mode)
  419. (dolist (file (directory-files default-directory t (car a) t))
  420. (semantic-throw-on-input 'parsing-mode-buffers)
  421. (save-excursion
  422. (semanticdb-file-table-object file)
  423. ))))
  424. ))
  425. (defun semantic-idle-pnf-test ()
  426. "Test `semantic-idle-scheduler-work-parse-neighboring-files' and time it."
  427. (interactive)
  428. (let ((start (current-time))
  429. (junk (semantic-idle-scheduler-work-parse-neighboring-files))
  430. (end (current-time)))
  431. (message "Work took %.2f seconds." (semantic-elapsed-time start end)))
  432. )
  433. ;;; REPARSING
  434. ;;
  435. ;; Reparsing is installed as semantic idle service.
  436. ;; This part ALWAYS happens, and other services occur
  437. ;; afterwards.
  438. (defcustom semantic-idle-scheduler-no-working-message t
  439. "*If non-nil, disable display of working messages during parse."
  440. :group 'semantic
  441. :type 'boolean)
  442. (defcustom semantic-idle-scheduler-working-in-modeline-flag nil
  443. "*Non-nil means show working messages in the mode line.
  444. Typically, parsing will show messages in the minibuffer.
  445. This will move the parse message into the modeline."
  446. :group 'semantic
  447. :type 'boolean)
  448. (defvar semantic-before-idle-scheduler-reparse-hook nil
  449. "Hook run before option `semantic-idle-scheduler' begins parsing.
  450. If any hook throws an error, this variable is reset to nil.
  451. This hook is not protected from lexical errors.")
  452. (defvar semantic-after-idle-scheduler-reparse-hook nil
  453. "Hook run after option `semantic-idle-scheduler' has parsed.
  454. If any hook throws an error, this variable is reset to nil.
  455. This hook is not protected from lexical errors.")
  456. (semantic-varalias-obsolete 'semantic-before-idle-scheduler-reparse-hooks
  457. 'semantic-before-idle-scheduler-reparse-hook)
  458. (semantic-varalias-obsolete 'semantic-after-idle-scheduler-reparse-hooks
  459. 'semantic-after-idle-scheduler-reparse-hook)
  460. (defun semantic-idle-scheduler-refresh-tags ()
  461. "Refreshes the current buffer's tags.
  462. This is called by `semantic-idle-scheduler-function' to update the
  463. tags in the current buffer.
  464. Return non-nil if the refresh was successful.
  465. Return nil if there is some sort of syntax error preventing a full
  466. reparse.
  467. Does nothing if the current buffer doesn't need reparsing."
  468. (prog1
  469. ;; These checks actually occur in `semantic-fetch-tags', but if we
  470. ;; do them here, then all the bovination hooks are not run, and
  471. ;; we save lots of time.
  472. (cond
  473. ;; If the buffer was previously marked unparseable,
  474. ;; then don't waste our time.
  475. ((semantic-parse-tree-unparseable-p)
  476. nil)
  477. ;; The parse tree is already ok.
  478. ((semantic-parse-tree-up-to-date-p)
  479. t)
  480. (t
  481. ;; If the buffer might need a reparse and it is safe to do so,
  482. ;; give it a try.
  483. (let* ((semantic-working-type nil)
  484. (inhibit-quit nil)
  485. (working-use-echo-area-p
  486. (not semantic-idle-scheduler-working-in-modeline-flag))
  487. (working-status-dynamic-type
  488. (if semantic-idle-scheduler-no-working-message
  489. nil
  490. working-status-dynamic-type))
  491. (working-status-percentage-type
  492. (if semantic-idle-scheduler-no-working-message
  493. nil
  494. working-status-percentage-type))
  495. (lexically-safe t)
  496. )
  497. ;; Let people hook into this, but don't let them hose
  498. ;; us over!
  499. (condition-case nil
  500. (run-hooks 'semantic-before-idle-scheduler-reparse-hook)
  501. (error (setq semantic-before-idle-scheduler-reparse-hook nil)))
  502. (unwind-protect
  503. ;; Perform the parsing.
  504. (progn
  505. (when semantic-idle-scheduler-verbose-flag
  506. (working-temp-message "IDLE: reparse %s..." (buffer-name)))
  507. (when (semantic-lex-catch-errors idle-scheduler
  508. (save-excursion (semantic-fetch-tags))
  509. nil)
  510. ;; If we are here, it is because the lexical step failed,
  511. ;; proably due to unterminated lists or something like that.
  512. ;; We do nothing, and just wait for the next idle timer
  513. ;; to go off. In the meantime, remember this, and make sure
  514. ;; no other idle services can get executed.
  515. (setq lexically-safe nil))
  516. (when semantic-idle-scheduler-verbose-flag
  517. (working-temp-message "IDLE: reparse %s...done" (buffer-name))))
  518. ;; Let people hook into this, but don't let them hose
  519. ;; us over!
  520. (condition-case nil
  521. (run-hooks 'semantic-after-idle-scheduler-reparse-hook)
  522. (error (setq semantic-after-idle-scheduler-reparse-hook nil))))
  523. ;; Return if we are lexically safe (from prog1)
  524. lexically-safe)))
  525. ;; After updating the tags, handle any pending decorations for this
  526. ;; buffer.
  527. (semantic-decorate-flush-pending-decorations (current-buffer))
  528. ))
  529. ;;; IDLE SERVICES
  530. ;;
  531. ;; Idle Services are minor modes which enable or disable a services in
  532. ;; the idle scheduler. Creating a new services only requires calling
  533. ;; `semantic-create-idle-services' which does all the setup
  534. ;; needed to create the minor mode that will enable or disable
  535. ;; a services. The services must provide a single function.
  536. ;; FIXME doc is incomplete.
  537. (defmacro define-semantic-idle-service (name doc &rest forms)
  538. "Create a new idle services with NAME.
  539. DOC will be a documentation string describing FORMS.
  540. FORMS will be called during idle time after the current buffer's
  541. semantic tag information has been updated.
  542. This routine creates the following functions and variables:"
  543. (let ((global (intern (concat "global-" (symbol-name name) "-mode")))
  544. (mode (intern (concat (symbol-name name) "-mode")))
  545. (hook (intern (concat (symbol-name name) "-mode-hook")))
  546. (map (intern (concat (symbol-name name) "-mode-map")))
  547. (setup (intern (concat (symbol-name name) "-mode-setup")))
  548. (func (intern (concat (symbol-name name) "-idle-function"))))
  549. `(eval-and-compile
  550. (defun ,global (&optional arg)
  551. ,(concat "Toggle `" (symbol-name mode) "'.
  552. With ARG, turn the minor mode on if ARG is positive, off otherwise.
  553. When this minor mode is enabled, `" (symbol-name mode) "' is
  554. turned on in every Semantic-supported buffer.")
  555. (interactive "P")
  556. (setq ,global
  557. (semantic-toggle-minor-mode-globally
  558. ',mode arg)))
  559. (defcustom ,global nil
  560. ,(concat "Non-nil if `" (symbol-name mode) "' is enabled.")
  561. :group 'semantic
  562. :group 'semantic-modes
  563. :type 'boolean
  564. :require 'semantic-idle
  565. :initialize 'custom-initialize-default
  566. :set (lambda (sym val)
  567. (,global (if val 1 -1))))
  568. (defcustom ,hook nil
  569. ,(concat "Hook run at the end of function `" (symbol-name mode) "'.")
  570. :group 'semantic
  571. :type 'hook)
  572. (defvar ,map
  573. (let ((km (make-sparse-keymap)))
  574. km)
  575. ,(concat "Keymap for `" (symbol-name mode) "'."))
  576. (defvar ,mode nil
  577. ,(concat "Non-nil if the minor mode `" (symbol-name mode) "' is enabled.
  578. Use the command `" (symbol-name mode) "' to change this variable."))
  579. (make-variable-buffer-local ',mode)
  580. (defun ,setup ()
  581. ,(concat "Set up `" (symbol-name mode) "'.
  582. Return non-nil if the minor mode is enabled.")
  583. (if ,mode
  584. (if (not (and (featurep 'semantic) (semantic-active-p)))
  585. (progn
  586. ;; Disable minor mode if semantic stuff not available
  587. (setq ,mode nil)
  588. (error "Buffer %s was not set up for parsing"
  589. (buffer-name)))
  590. ;; Enable the mode mode
  591. (semantic-idle-scheduler-add #',func)
  592. )
  593. ;; Disable the mode mode
  594. (semantic-idle-scheduler-remove #',func)
  595. )
  596. ,mode)
  597. ;;;###autoload
  598. (defun ,mode (&optional arg)
  599. ,doc
  600. (interactive
  601. (list (or current-prefix-arg
  602. (if ,mode 0 1))))
  603. (setq ,mode
  604. (if arg
  605. (>
  606. (prefix-numeric-value arg)
  607. 0)
  608. (not ,mode)))
  609. (,setup)
  610. (run-hooks ,hook)
  611. (if (cedet-called-interactively-p 'interactive)
  612. (message "%s %sabled"
  613. (symbol-name ',mode)
  614. (if ,mode "en" "dis")))
  615. (semantic-mode-line-update)
  616. ,mode)
  617. (semantic-add-minor-mode ',mode
  618. "" ; idle schedulers are quiet?
  619. ,map)
  620. (defun ,func ()
  621. ,(concat "Perform idle activity for the minor mode `"
  622. (symbol-name mode) "'.")
  623. ,@forms))))
  624. (put 'define-semantic-idle-service 'lisp-indent-function 1)
  625. (add-hook 'edebug-setup-hook
  626. (lambda ()
  627. (def-edebug-spec define-semantic-idle-service
  628. (&define name stringp def-body))))
  629. ;;; SUMMARY MODE
  630. ;;
  631. ;; A mode similar to eldoc using semantic
  632. (defcustom semantic-idle-truncate-long-summaries t
  633. "Truncate summaries that are too long to fit in the minibuffer.
  634. This can prevent minibuffer resizing in idle time."
  635. :group 'semantic
  636. :type 'boolean)
  637. (defcustom semantic-idle-summary-function
  638. 'semantic-format-tag-summarize-with-file
  639. "Function to call when displaying tag information during idle time.
  640. This function should take a single argument, a Semantic tag, and
  641. return a string to display.
  642. Some useful functions are found in `semantic-format-tag-functions'."
  643. :group 'semantic
  644. :type semantic-format-tag-custom-list)
  645. (defsubst semantic-idle-summary-find-current-symbol-tag (sym)
  646. "Search for a semantic tag with name SYM in database tables.
  647. Return the tag found or nil if not found.
  648. If semanticdb is not in use, use the current buffer only."
  649. (car (if (and (featurep 'semanticdb) semanticdb-current-database)
  650. (cdar (semanticdb-deep-find-tags-by-name sym))
  651. (semantic-deep-find-tags-by-name sym (current-buffer)))))
  652. (defun semantic-idle-summary-current-symbol-info-brutish ()
  653. "Return a string message describing the current context.
  654. Gets a symbol with `semantic-ctxt-current-thing' and then
  655. tries to find it with a deep targeted search."
  656. ;; Try the current "thing".
  657. (let ((sym (car (semantic-ctxt-current-thing))))
  658. (when sym
  659. (semantic-idle-summary-find-current-symbol-tag sym))))
  660. (defun semantic-idle-summary-current-symbol-keyword ()
  661. "Return a string message describing the current symbol.
  662. Returns a value only if it is a keyword."
  663. ;; Try the current "thing".
  664. (let ((sym (car (semantic-ctxt-current-thing))))
  665. (if (and sym (semantic-lex-keyword-p sym))
  666. (semantic-lex-keyword-get sym 'summary))))
  667. (defun semantic-idle-summary-current-symbol-info-context ()
  668. "Return a string message describing the current context.
  669. Use the semantic analyzer to find the symbol information."
  670. (let ((analysis (condition-case nil
  671. (semantic-analyze-current-context (point))
  672. (error nil))))
  673. (when analysis
  674. (semantic-analyze-interesting-tag analysis))))
  675. (defun semantic-idle-summary-current-symbol-info-default ()
  676. "Return a string message describing the current context.
  677. This function will disable loading of previously unloaded files
  678. by semanticdb as a time-saving measure."
  679. (semanticdb-without-unloaded-file-searches
  680. (save-excursion
  681. ;; use whichever has success first.
  682. (or
  683. (semantic-idle-summary-current-symbol-keyword)
  684. (semantic-idle-summary-current-symbol-info-context)
  685. (semantic-idle-summary-current-symbol-info-brutish)
  686. ))))
  687. (defvar semantic-idle-summary-out-of-context-faces
  688. '(
  689. font-lock-comment-face
  690. font-lock-string-face
  691. font-lock-doc-string-face ; XEmacs.
  692. font-lock-doc-face ; Emacs 21 and later.
  693. )
  694. "List of font-lock faces that indicate a useless summary context.
  695. Those are generally faces used to highlight comments.
  696. It might be useful to override this variable to add comment faces
  697. specific to a major mode. For example, in jde mode:
  698. \(defvar-mode-local jde-mode semantic-idle-summary-out-of-context-faces
  699. (append (default-value 'semantic-idle-summary-out-of-context-faces)
  700. '(jde-java-font-lock-doc-tag-face
  701. jde-java-font-lock-link-face
  702. jde-java-font-lock-bold-face
  703. jde-java-font-lock-underline-face
  704. jde-java-font-lock-pre-face
  705. jde-java-font-lock-code-face)))")
  706. (defun semantic-idle-summary-useful-context-p ()
  707. "Non-nil if we should show a summary based on context."
  708. (if (and (boundp 'font-lock-mode)
  709. font-lock-mode
  710. (memq (get-text-property (point) 'face)
  711. semantic-idle-summary-out-of-context-faces))
  712. ;; The best I can think of at the moment is to disable
  713. ;; in comments by detecting with font-lock.
  714. nil
  715. t))
  716. (define-overloadable-function semantic-idle-summary-current-symbol-info ()
  717. "Return a string message describing the current context.")
  718. (make-obsolete-overload 'semantic-eldoc-current-symbol-info
  719. 'semantic-idle-summary-current-symbol-info)
  720. (define-semantic-idle-service semantic-idle-summary
  721. "Display a tag summary of the lexical token under the cursor.
  722. Call `semantic-idle-summary-current-symbol-info' for getting the
  723. current tag to display information."
  724. (or (eq major-mode 'emacs-lisp-mode)
  725. (not (semantic-idle-summary-useful-context-p))
  726. (let* ((found (semantic-idle-summary-current-symbol-info))
  727. (str (cond ((stringp found) found)
  728. ((semantic-tag-p found)
  729. (funcall semantic-idle-summary-function
  730. found nil t)))))
  731. ;; Show the message with eldoc functions
  732. (unless (and str (boundp 'eldoc-echo-area-use-multiline-p)
  733. eldoc-echo-area-use-multiline-p)
  734. (let ((w (1- (window-width (minibuffer-window)))))
  735. (if (> (length str) w)
  736. (setq str (substring str 0 w)))))
  737. ;; I borrowed some bits from eldoc to shorten the
  738. ;; message.
  739. (when semantic-idle-truncate-long-summaries
  740. (let ((ea-width (1- (window-width (minibuffer-window))))
  741. (strlen (length str)))
  742. (when (> strlen ea-width)
  743. (setq str (substring str 0 ea-width)))))
  744. ;; Display it
  745. (eldoc-message str))))
  746. (semantic-alias-obsolete 'semantic-summary-mode
  747. 'semantic-idle-summary-mode)
  748. (semantic-alias-obsolete 'global-semantic-summary-mode
  749. 'global-semantic-idle-summary-mode)
  750. ;;; Current symbol highlight
  751. ;;
  752. ;; This mode will use context analysis to perform highlighting
  753. ;; of all uses of the symbol that is under the cursor.
  754. ;;
  755. ;; This is to mimic the Eclipse tool of a similar nature.
  756. (defvar semantic-idle-symbol-highlight-face 'region
  757. "Face used for the highlighting local symbols.")
  758. (defun semantic-idle-symbol-maybe-highlight (tag)
  759. "Perhaps add highlighting onto the symbol represented by TAG.
  760. TAG was found as the symbol under point. If it happens to be
  761. visible, then highlight it."
  762. (let* ((region (when (and (semantic-tag-p tag)
  763. (semantic-tag-with-position-p tag))
  764. (semantic-tag-overlay tag)))
  765. (file (when (and (semantic-tag-p tag)
  766. (semantic-tag-with-position-p tag))
  767. (semantic-tag-file-name tag)))
  768. (buffer (when file (get-file-buffer file)))
  769. ;; We use pulse, but we don't want the flashy version,
  770. ;; just the stable version.
  771. (pulse-flag nil)
  772. )
  773. (cond ((semantic-overlay-p region)
  774. (with-current-buffer (semantic-overlay-buffer region)
  775. (goto-char (semantic-overlay-start region))
  776. (when (pos-visible-in-window-p
  777. (point) (get-buffer-window (current-buffer) 'visible))
  778. (if (< (semantic-overlay-end region) (point-at-eol))
  779. (pulse-momentary-highlight-overlay
  780. region semantic-idle-symbol-highlight-face)
  781. ;; Not the same
  782. (pulse-momentary-highlight-region
  783. (semantic-overlay-start region)
  784. (point-at-eol)
  785. semantic-idle-symbol-highlight-face)))
  786. ))
  787. ((vectorp region)
  788. (let ((start (aref region 0))
  789. (end (aref region 1)))
  790. (save-excursion
  791. (when buffer (set-buffer buffer))
  792. ;; As a vector, we have no filename. Perhaps it is a
  793. ;; local variable?
  794. (when (and (<= end (point-max))
  795. (pos-visible-in-window-p
  796. start (get-buffer-window (current-buffer) 'visible)))
  797. (goto-char start)
  798. (when (re-search-forward
  799. (regexp-quote (semantic-tag-name tag))
  800. end t)
  801. ;; This is likely it, give it a try.
  802. (pulse-momentary-highlight-region
  803. start (if (<= end (point-at-eol)) end
  804. (point-at-eol))
  805. semantic-idle-symbol-highlight-face)))
  806. ))))
  807. nil))
  808. (define-semantic-idle-service semantic-idle-local-symbol-highlight
  809. "Highlight the tag and symbol references of the symbol under point.
  810. Call `semantic-analyze-current-context' to find the reference tag.
  811. Call `semantic-symref-hits-in-region' to identify local references."
  812. (when (semantic-idle-summary-useful-context-p)
  813. (let* ((ctxt
  814. (semanticdb-without-unloaded-file-searches
  815. (semantic-analyze-current-context)))
  816. (Hbounds (when ctxt (oref ctxt bounds)))
  817. (target (when ctxt (car (reverse (oref ctxt prefix)))))
  818. (tag (semantic-current-tag))
  819. ;; We use pulse, but we don't want the flashy version,
  820. ;; just the stable version.
  821. (pulse-flag nil))
  822. (when (and ctxt tag)
  823. ;; Highlight the original tag? Protect against problems.
  824. (condition-case nil
  825. (semantic-idle-symbol-maybe-highlight target)
  826. (error nil))
  827. ;; Identify all hits in this current tag.
  828. (when (semantic-tag-p target)
  829. (semantic-symref-hits-in-region
  830. target (lambda (start end prefix)
  831. (when (/= start (car Hbounds))
  832. (pulse-momentary-highlight-region
  833. start end semantic-idle-symbol-highlight-face))
  834. (semantic-throw-on-input 'symref-highlight)
  835. )
  836. (semantic-tag-start tag)
  837. (semantic-tag-end tag)))
  838. ))))
  839. ;;;###autoload
  840. (defun global-semantic-idle-scheduler-mode (&optional arg)
  841. "Toggle global use of option `semantic-idle-scheduler-mode'.
  842. The idle scheduler will automatically reparse buffers in idle time,
  843. and then schedule other jobs setup with `semantic-idle-scheduler-add'.
  844. If ARG is positive, enable, if it is negative, disable.
  845. If ARG is nil, then toggle."
  846. (interactive "P")
  847. (setq global-semantic-idle-scheduler-mode
  848. (semantic-toggle-minor-mode-globally
  849. 'semantic-idle-scheduler-mode arg)))
  850. ;;; Completion Popup Mode
  851. ;;
  852. ;; This mode uses tooltips to display a (hopefully) short list of possible
  853. ;; completions available for the text under point. It provides
  854. ;; NO provision for actually filling in the values from those completions.
  855. (defun semantic-idle-completions-end-of-symbol-p ()
  856. "Return non-nil if the cursor is at the END of a symbol.
  857. If the cursor is in the middle of a symbol, then we shouldn't be
  858. doing fancy completions."
  859. (not (looking-at "\\w\\|\\s_")))
  860. (defun semantic-idle-completion-list-default ()
  861. "Calculate and display a list of completions."
  862. (when (and (semantic-idle-summary-useful-context-p)
  863. (semantic-idle-completions-end-of-symbol-p))
  864. ;; This mode can be fragile, hence don't raise errors, and only
  865. ;; report problems if semantic-idle-scheduler-verbose-flag is
  866. ;; non-nil. If something doesn't do what you expect, run the
  867. ;; below command by hand instead.
  868. (condition-case err
  869. (semanticdb-without-unloaded-file-searches
  870. ;; Use idle version.
  871. (semantic-complete-analyze-inline-idle)
  872. )
  873. (error
  874. (when semantic-idle-scheduler-verbose-flag
  875. (message " %s" (error-message-string err)))))
  876. ))
  877. (define-semantic-idle-service semantic-idle-completions
  878. "Toggle Semantic Idle Completions mode.
  879. With ARG, turn Semantic Idle Completions mode on if ARG is
  880. positive, off otherwise.
  881. This minor mode only takes effect if Semantic is active and
  882. `semantic-idle-scheduler-mode' is enabled.
  883. When enabled, Emacs displays a list of possible completions at
  884. idle time. The method for displaying completions is given by
  885. `semantic-complete-inline-analyzer-idle-displayor-class'; the
  886. default is to show completions inline.
  887. While a completion is displayed, RET accepts the completion; M-n
  888. and M-p cycle through completion alternatives; TAB attempts to
  889. complete as far as possible, and cycles if no additional
  890. completion is possible; and any other command cancels the
  891. completion.
  892. \\{semantic-complete-inline-map}"
  893. ;; Add the ability to override sometime.
  894. (semantic-idle-completion-list-default))
  895. ;;; Breadcrumbs for tag under point
  896. ;;
  897. ;; Service that displays a breadcrumbs indication of the tag under
  898. ;; point and its parents in the header or mode line.
  899. ;;
  900. (defcustom semantic-idle-breadcrumbs-display-function
  901. #'semantic-idle-breadcrumbs--display-in-header-line
  902. "Specify how to display the tag under point in idle time.
  903. This function should take a list of Semantic tags as its only
  904. argument. The tags are sorted according to their nesting order,
  905. starting with the outermost tag. The function should call
  906. `semantic-idle-breadcrumbs-format-tag-list-function' to convert
  907. the tag list into a string."
  908. :group 'semantic
  909. :type '(choice
  910. (const :tag "Display in header line"
  911. semantic-idle-breadcrumbs--display-in-header-line)
  912. (const :tag "Display in mode line"
  913. semantic-idle-breadcrumbs--display-in-mode-line)
  914. (function :tag "Other function")))
  915. (defcustom semantic-idle-breadcrumbs-format-tag-list-function
  916. #'semantic-idle-breadcrumbs--format-linear
  917. "Specify how to format the list of tags containing point.
  918. This function should take a list of Semantic tags and an optional
  919. maximum length of the produced string as its arguments. The
  920. maximum length is a hint and can be ignored. When the maximum
  921. length is omitted, an unconstrained string should be
  922. produced. The tags are sorted according to their nesting order,
  923. starting with the outermost tag. Single tags should be formatted
  924. using `semantic-idle-breadcrumbs-format-tag-function' unless
  925. special formatting is required."
  926. :group 'semantic
  927. :type '(choice
  928. (const :tag "Format tags as list, innermost last"
  929. semantic-idle-breadcrumbs--format-linear)
  930. (const :tag "Innermost tag with details, followed by remaining tags"
  931. semantic-idle-breadcrumbs--format-innermost-first)
  932. (function :tag "Other function")))
  933. (defcustom semantic-idle-breadcrumbs-format-tag-function
  934. #'semantic-format-tag-abbreviate
  935. "Function to call to format information about tags.
  936. This function should take a single argument, a Semantic tag, and
  937. return a string to display.
  938. Some useful functions are found in `semantic-format-tag-functions'."
  939. :group 'semantic
  940. :type semantic-format-tag-custom-list)
  941. (defcustom semantic-idle-breadcrumbs-separator 'mode-specific
  942. "Specify how to separate tags in the breadcrumbs string.
  943. An arbitrary string or a mode-specific scope nesting
  944. string (like, for example, \"::\" in C++, or \".\" in Java) can
  945. be used."
  946. :group 'semantic
  947. :type '(choice
  948. (const :tag "Use mode specific separator"
  949. mode-specific)
  950. (string :tag "Specify separator string")))
  951. (defcustom semantic-idle-breadcrumbs-header-line-prefix
  952. semantic-stickyfunc-indent-string ;; TODO not optimal
  953. "String used to indent the breadcrumbs string.
  954. Customize this string to match the space used by scrollbars and
  955. fringe."
  956. :group 'semantic
  957. :type 'string)
  958. (defun semantic-idle-breadcrumbs--popup-menu (event)
  959. "Popup a menu that displays things to do to the clicked tag.
  960. Argument EVENT describes the event that caused this function to
  961. be called."
  962. (interactive "e")
  963. (let ((old-window (selected-window))
  964. (window (semantic-event-window event)))
  965. (select-window window t)
  966. (semantic-popup-menu semantic-idle-breadcrumbs-popup-menu)
  967. (select-window old-window)))
  968. (defmacro semantic-idle-breadcrumbs--tag-function (function)
  969. "Return lambda expression calling FUNCTION when called from a popup."
  970. `(lambda (event)
  971. (interactive "e")
  972. (let* ((old-window (selected-window))
  973. (window (semantic-event-window event))
  974. (column (car (nth 6 (nth 1 event)))) ;; TODO semantic-event-column?
  975. (tag (progn
  976. (select-window window t)
  977. (plist-get
  978. (text-properties-at column header-line-format)
  979. 'tag))))
  980. (,function tag)
  981. (select-window old-window)))
  982. )
  983. ;; TODO does this work for mode-line case?
  984. (defvar semantic-idle-breadcrumbs-popup-map
  985. (let ((map (make-sparse-keymap)))
  986. ;; mouse-1 goes to clicked tag
  987. (define-key map
  988. [ header-line mouse-1 ]
  989. (semantic-idle-breadcrumbs--tag-function
  990. semantic-go-to-tag))
  991. ;; mouse-3 pops up a context menu
  992. (define-key map
  993. [ header-line mouse-3 ]
  994. 'semantic-idle-breadcrumbs--popup-menu)
  995. map)
  996. "Keymap for semantic idle breadcrumbs minor mode.")
  997. (defvar semantic-idle-breadcrumbs-popup-menu nil
  998. "Menu used when a tag displayed by `semantic-idle-breadcrumbs-mode' is clicked.")
  999. (easy-menu-define
  1000. semantic-idle-breadcrumbs-popup-menu
  1001. semantic-idle-breadcrumbs-popup-map
  1002. "Semantic Breadcrumbs Mode Menu"
  1003. (list
  1004. "Breadcrumb Tag"
  1005. (senator-menu-item
  1006. (vector
  1007. "Go to Tag"
  1008. (semantic-idle-breadcrumbs--tag-function
  1009. semantic-go-to-tag)
  1010. :active t
  1011. :help "Jump to this tag"))
  1012. ;; TODO these entries need minor changes (optional tag argument) in
  1013. ;; senator-copy-tag etc
  1014. ;; (senator-menu-item
  1015. ;; (vector
  1016. ;; "Copy Tag"
  1017. ;; (semantic-idle-breadcrumbs--tag-function
  1018. ;; senator-copy-tag)
  1019. ;; :active t
  1020. ;; :help "Copy this tag"))
  1021. ;; (senator-menu-item
  1022. ;; (vector
  1023. ;; "Kill Tag"
  1024. ;; (semantic-idle-breadcrumbs--tag-function
  1025. ;; senator-kill-tag)
  1026. ;; :active t
  1027. ;; :help "Kill tag text to the kill ring, and copy the tag to
  1028. ;; the tag ring"))
  1029. ;; (senator-menu-item
  1030. ;; (vector
  1031. ;; "Copy Tag to Register"
  1032. ;; (semantic-idle-breadcrumbs--tag-function
  1033. ;; senator-copy-tag-to-register)
  1034. ;; :active t
  1035. ;; :help "Copy this tag"))
  1036. ;; (senator-menu-item
  1037. ;; (vector
  1038. ;; "Narrow to Tag"
  1039. ;; (semantic-idle-breadcrumbs--tag-function
  1040. ;; senator-narrow-to-defun)
  1041. ;; :active t
  1042. ;; :help "Narrow to the bounds of the current tag"))
  1043. ;; (senator-menu-item
  1044. ;; (vector
  1045. ;; "Fold Tag"
  1046. ;; (semantic-idle-breadcrumbs--tag-function
  1047. ;; senator-fold-tag-toggle)
  1048. ;; :active t
  1049. ;; :style 'toggle
  1050. ;; :selected '(let ((tag (semantic-current-tag)))
  1051. ;; (and tag (semantic-tag-folded-p tag)))
  1052. ;; :help "Fold the current tag to one line"))
  1053. "---"
  1054. (senator-menu-item
  1055. (vector
  1056. "About this Header Line"
  1057. (lambda ()
  1058. (interactive)
  1059. (describe-function 'semantic-idle-breadcrumbs-mode))
  1060. :active t
  1061. :help "Display help about this header line."))
  1062. )
  1063. )
  1064. (define-semantic-idle-service semantic-idle-breadcrumbs
  1065. "Display breadcrumbs for the tag under point and its parents."
  1066. (let* ((scope (semantic-calculate-scope))
  1067. (tag-list (if scope
  1068. ;; If there is a scope, extract the tag and its
  1069. ;; parents.
  1070. (append (oref scope parents)
  1071. (when (oref scope tag)
  1072. (list (oref scope tag))))
  1073. ;; Fall back to tags by overlay
  1074. (semantic-find-tag-by-overlay))))
  1075. ;; Display the tags.
  1076. (funcall semantic-idle-breadcrumbs-display-function tag-list)))
  1077. (defun semantic-idle-breadcrumbs--display-in-header-line (tag-list)
  1078. "Display the tags in TAG-LIST in the header line of their buffer."
  1079. (let ((width (- (nth 2 (window-edges))
  1080. (nth 0 (window-edges)))))
  1081. ;; Format TAG-LIST and put the formatted string into the header
  1082. ;; line.
  1083. (setq header-line-format
  1084. (replace-regexp-in-string ;; Since % is interpreted in the
  1085. "\\(%\\)" "%\\1" ;; mode/header line format, we
  1086. (concat ;; have to escape all occurrences.
  1087. semantic-idle-breadcrumbs-header-line-prefix
  1088. (if tag-list
  1089. (semantic-idle-breadcrumbs--format-tag-list
  1090. tag-list
  1091. (- width
  1092. (length semantic-idle-breadcrumbs-header-line-prefix)))
  1093. (propertize
  1094. "<not on tags>"
  1095. 'face
  1096. 'font-lock-comment-face))))))
  1097. ;; Update the header line.
  1098. (force-mode-line-update))
  1099. (defun semantic-idle-breadcrumbs--display-in-mode-line (tag-list)
  1100. "Display the tags in TAG-LIST in the mode line of their buffer.
  1101. TODO THIS FUNCTION DOES NOT WORK YET."
  1102. (error "This function does not work yet")
  1103. (let ((width (- (nth 2 (window-edges))
  1104. (nth 0 (window-edges)))))
  1105. (setq mode-line-format
  1106. (replace-regexp-in-string ;; see comment in
  1107. "\\(%\\)" "%\\1" ;; `semantic-idle-breadcrumbs--display-in-header-line'
  1108. (semantic-idle-breadcrumbs--format-tag-list tag-list width))))
  1109. (force-mode-line-update))
  1110. (defun semantic-idle-breadcrumbs--format-tag-list (tag-list max-length)
  1111. "Format TAG-LIST using configured functions respecting MAX-LENGTH.
  1112. If the initial formatting result is longer than MAX-LENGTH, it is
  1113. shortened at the beginning."
  1114. ;; Format TAG-LIST using the configured formatting function.
  1115. (let* ((complete-format (funcall
  1116. semantic-idle-breadcrumbs-format-tag-list-function
  1117. tag-list max-length))
  1118. ;; Determine length of complete format.
  1119. (complete-length (length complete-format)))
  1120. ;; Shorten string if necessary.
  1121. (if (<= complete-length max-length)
  1122. complete-format
  1123. (concat "... "
  1124. (substring
  1125. complete-format
  1126. (- complete-length (- max-length 4))))))
  1127. )
  1128. (defun semantic-idle-breadcrumbs--format-linear
  1129. (tag-list &optional max-length)
  1130. "Format TAG-LIST as a linear list, starting with the outermost tag.
  1131. MAX-LENGTH is not used."
  1132. (let* ((format-pieces (mapcar
  1133. #'semantic-idle-breadcrumbs--format-tag
  1134. tag-list))
  1135. ;; Format tag list, putting configured separators between the
  1136. ;; tags.
  1137. (complete-format (cond
  1138. ;; Mode specific separator.
  1139. ((eq semantic-idle-breadcrumbs-separator
  1140. 'mode-specific)
  1141. (semantic-analyze-unsplit-name format-pieces))
  1142. ;; Custom separator.
  1143. ((stringp semantic-idle-breadcrumbs-separator)
  1144. (mapconcat
  1145. #'identity
  1146. format-pieces
  1147. semantic-idle-breadcrumbs-separator)))))
  1148. complete-format)
  1149. )
  1150. (defun semantic-idle-breadcrumbs--format-innermost-first
  1151. (tag-list &optional max-length)
  1152. "Format TAG-LIST placing the innermost tag first, separated from its parents.
  1153. If MAX-LENGTH is non-nil, the innermost tag is shortened."
  1154. (let* (;; Separate and format remaining tags. Calculate length of
  1155. ;; resulting string.
  1156. (rest-tags (butlast tag-list))
  1157. (rest-format (if rest-tags
  1158. (concat
  1159. " | "
  1160. (semantic-idle-breadcrumbs--format-linear
  1161. rest-tags))
  1162. ""))
  1163. (rest-length (length rest-format))
  1164. ;; Format innermost tag and calculate length of resulting
  1165. ;; string.
  1166. (inner-format (semantic-idle-breadcrumbs--format-tag
  1167. (car (last tag-list))
  1168. #'semantic-format-tag-prototype))
  1169. (inner-length (length inner-format))
  1170. ;; Calculate complete length and shorten string for innermost
  1171. ;; tag if MAX-LENGTH is non-nil and the complete string is
  1172. ;; too long.
  1173. (complete-length (+ inner-length rest-length))
  1174. (inner-short (if (and max-length
  1175. (<= complete-length max-length))
  1176. inner-format
  1177. (concat (substring
  1178. inner-format
  1179. 0
  1180. (- inner-length
  1181. (- complete-length max-length)
  1182. 4))
  1183. " ..."))))
  1184. ;; Concat both parts.
  1185. (concat inner-short rest-format))
  1186. )
  1187. (defun semantic-idle-breadcrumbs--format-tag (tag &optional format-function)
  1188. "Format TAG using the configured function or FORMAT-FUNCTION.
  1189. This function also adds text properties for help-echo, mouse
  1190. highlighting and a keymap."
  1191. (let ((formatted (funcall
  1192. (or format-function
  1193. semantic-idle-breadcrumbs-format-tag-function)
  1194. tag nil t)))
  1195. (add-text-properties
  1196. 0 (length formatted)
  1197. (list
  1198. 'tag
  1199. tag
  1200. 'help-echo
  1201. (format
  1202. "Tag %s
  1203. Type: %s
  1204. mouse-1: jump to tag
  1205. mouse-3: popup context menu"
  1206. (semantic-tag-name tag)
  1207. (semantic-tag-class tag))
  1208. 'mouse-face
  1209. 'highlight
  1210. 'keymap
  1211. semantic-idle-breadcrumbs-popup-map)
  1212. formatted)
  1213. formatted))
  1214. (provide 'semantic-idle)
  1215. ;;; semantic-idle.el ends here