Commit | Line | Data |
---|---|---|
4d902e6f CY |
1 | ;;; srecode-texi.el --- Srecode texinfo support. |
2 | ||
114f9c96 | 3 | ;; Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc. |
4d902e6f CY |
4 | |
5 | ;; Author: Eric M. Ludlam <eric@siege-engine.com> | |
6 | ||
7 | ;; This file is part of GNU Emacs. | |
8 | ||
9 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
10 | ;; it under the terms of the GNU General Public License as published by | |
11 | ;; the Free Software Foundation, either version 3 of the License, or | |
12 | ;; (at your option) any later version. | |
13 | ||
14 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 | ;; GNU General Public License for more details. | |
18 | ||
19 | ;; You should have received a copy of the GNU General Public License | |
20 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
21 | ||
22 | ;;; Commentary: | |
23 | ;; | |
24 | ;; Texinfo semantic recoder support. | |
25 | ;; | |
26 | ;; Contains some handlers, and a few simple texinfo srecoder applications. | |
27 | ||
28 | (require 'semantic) | |
29 | (require 'semantic/texi) | |
30 | (require 'srecode/semantic) | |
31 | ||
32 | ;;; Code: | |
33 | ||
34 | (defun srecode-texi-add-menu (newnode) | |
35 | "Add an item into the current menu. Add @node statements as well. | |
36 | Argument NEWNODE is the name of the new node." | |
37 | (interactive "sName of new node: ") | |
38 | (srecode-load-tables-for-mode major-mode) | |
39 | (semantic-fetch-tags) | |
40 | (let ((currnode (reverse (semantic-find-tag-by-overlay))) | |
41 | (nodebounds nil)) | |
42 | (when (not currnode) | |
43 | (error "Cannot find node to put menu item into")) | |
44 | (setq currnode (car currnode)) | |
45 | (setq nodebounds (semantic-tag-texi-section-text-bounds currnode)) | |
46 | ;; Step 1: | |
47 | ;; Limit search within this node. | |
48 | ;; Step 2: | |
49 | ;; Find the menu. If there isn't one, add one to the end. | |
50 | ;; Step 3: | |
51 | ;; Add new item to end of menu list. | |
52 | ;; Step 4: | |
53 | ;; Find correct node new item should show up after, and stick | |
54 | ;; the new node there. | |
55 | (if (string= (semantic-texi-current-environment) "menu") | |
56 | ;; We are already in a menu, so insert the new item right here. | |
57 | (beginning-of-line) | |
58 | ;; Else, try to find a menu item to append to. | |
59 | (goto-char (car nodebounds)) | |
60 | (if (not (re-search-forward "^@menu" (car (cdr nodebounds)) t)) | |
61 | (progn | |
62 | (goto-char (car (cdr nodebounds))) | |
63 | (if (not (y-or-n-p "Add menu here? ")) | |
64 | (error "Abort")) | |
65 | (srecode-insert "declaration:menu")) | |
66 | ;; Else, find the end | |
67 | (re-search-forward "@end menu") | |
68 | (beginning-of-line))) | |
69 | ;; At this point, we are in a menu... or not. | |
70 | ;; If we are, do stuff, else error. | |
71 | (when (string= (semantic-texi-current-environment) "menu") | |
72 | (let ((menuname newnode) | |
73 | (returnpoint nil)) | |
74 | (srecode-insert "declaration:menuitem" "NAME" menuname) | |
75 | (set-mark (point)) | |
76 | (setq returnpoint (make-marker)) | |
77 | ;; Update the bound since we added text | |
78 | (setq nodebounds (semantic-tag-texi-section-text-bounds currnode)) | |
79 | (beginning-of-line) | |
80 | (forward-char -1) | |
81 | (beginning-of-line) | |
82 | (let ((end nil)) | |
83 | (if (not (looking-at "\\* \\([^:]+\\):")) | |
84 | (setq end (car (cdr nodebounds))) | |
85 | (let* ((nname (match-string 1)) | |
86 | (tag | |
87 | (semantic-deep-find-tags-by-name nname (current-buffer)))) | |
88 | (when tag | |
89 | (setq end (semantic-tag-end (car tag)))) | |
90 | )) | |
91 | (when (not end) | |
92 | (goto-char returnpoint) | |
93 | (error "Could not find location for new node" )) | |
94 | (when end | |
95 | (goto-char end) | |
96 | (when (bolp) (forward-char -1)) | |
97 | (insert "\n") | |
98 | (if (eq (semantic-current-tag) currnode) | |
99 | (srecode-insert "declaration:subnode" "NAME" menuname) | |
100 | (srecode-insert "declaration:node" "NAME" menuname)) | |
101 | ) | |
102 | ))) | |
103 | )) | |
104 | ||
105 | ;;;###autoload | |
106 | (defun srecode-semantic-handle-:texi (dict) | |
107 | "Add macros into the dictionary DICT based on the current texinfo file. | |
108 | Adds the following: | |
109 | LEVEL - chapter, section, subsection, etc | |
110 | NEXTLEVEL - One below level" | |
111 | ||
112 | ;; LEVEL and NEXTLEVEL calculation | |
113 | (semantic-fetch-tags) | |
114 | (let ((tags (reverse (semantic-find-tag-by-overlay))) | |
115 | (level nil)) | |
116 | (while (and tags (not (semantic-tag-of-class-p (car tags) 'section))) | |
117 | (setq tags (cdr tags))) | |
118 | (when tags | |
119 | (save-excursion | |
120 | (goto-char (semantic-tag-start (car tags))) | |
121 | (when (looking-at "@node") | |
122 | (forward-line 1) | |
123 | (beginning-of-line)) | |
124 | (when (looking-at "@\\(\\w+\\)") | |
125 | (setq level (match-string 1)) | |
126 | ))) | |
127 | (srecode-dictionary-set-value dict "LEVEL" (or level "chapter")) | |
128 | (let ((nl (assoc level '( ( nil . "top" ) | |
129 | ("top" . "chapter") | |
130 | ("chapter" . "section") | |
131 | ("section" . "subsection") | |
132 | ("subsection" . "subsubsection") | |
133 | ("subsubsection" . "subsubsection") | |
134 | )))) | |
135 | (srecode-dictionary-set-value dict "NEXTLEVEL" (cdr nl)))) | |
136 | ) | |
137 | ||
138 | ;;;###autoload | |
139 | (defun srecode-semantic-handle-:texitag (dict) | |
140 | "Add macros into the dictionary DICT based on the current :tag file. | |
141 | Adds the following: | |
142 | TAGDOC - Texinfo formatted doc string for :tag." | |
143 | ||
144 | ;; If we also have a TAG, what is the doc? | |
145 | (let ((tag (srecode-dictionary-lookup-name dict "TAG")) | |
146 | (doc nil) | |
147 | ) | |
148 | ||
149 | ;; If the user didn't apply :tag, then do so now. | |
150 | (when (not tag) | |
151 | (srecode-semantic-handle-:tag dict)) | |
152 | ||
153 | (setq tag (srecode-dictionary-lookup-name dict "TAG")) | |
154 | ||
155 | (when (not tag) | |
156 | (error "No tag to insert for :texitag template argument")) | |
157 | ||
158 | ;; Extract the tag out of the compound object. | |
159 | (setq tag (oref tag :prime)) | |
160 | ||
161 | ;; Extract the doc string | |
162 | (setq doc (semantic-documentation-for-tag tag)) | |
163 | ||
164 | (when doc | |
165 | (srecode-dictionary-set-value dict "TAGDOC" | |
166 | (srecode-texi-massage-to-texinfo | |
167 | tag (semantic-tag-buffer tag) | |
168 | doc))) | |
169 | )) | |
170 | ||
171 | ;;; OVERRIDES | |
172 | ;; | |
173 | ;; Override some semantic and srecode features with texi specific | |
174 | ;; versions. | |
175 | ||
176 | (define-mode-local-override semantic-insert-foreign-tag | |
177 | texinfo-mode (foreign-tag) | |
178 | "Insert TAG from a foreign buffer in TAGFILE. | |
179 | Assume TAGFILE is a source buffer, and create a documentation | |
180 | thingy from it using the `document' tool." | |
181 | (let ((srecode-semantic-selected-tag foreign-tag)) | |
182 | ;; @todo - choose of the many types of tags to insert, | |
183 | ;; or put all that logic into srecode. | |
184 | (srecode-insert "declaration:function"))) | |
185 | ||
186 | ||
187 | \f | |
188 | ;;; Texinfo mangling. | |
189 | ||
190 | (define-overloadable-function srecode-texi-texify-docstring | |
191 | (docstring) | |
192 | "Texify the doc string DOCSTRING. | |
193 | Takes plain text formatting that may exist, and converts it to | |
194 | using TeXinfo formatting.") | |
195 | ||
196 | (defun srecode-texi-texify-docstring-default (docstring) | |
197 | "Texify the doc string DOCSTRING. | |
198 | Takes a few very generic guesses as to what the formatting is." | |
199 | (let ((case-fold-search nil) | |
200 | (start 0)) | |
201 | (while (string-match | |
202 | "\\(^\\|[^{]\\)\\<\\([A-Z0-9_-]+\\)\\>\\($\\|[^}]\\)" | |
203 | docstring start) | |
204 | (let ((ms (match-string 2 docstring))) | |
205 | ;(when (eq mode 'emacs-lisp-mode) | |
206 | ; (setq ms (downcase ms))) | |
207 | ||
208 | (when (not (or (string= ms "A") | |
209 | (string= ms "a") | |
210 | )) | |
211 | (setq docstring (concat (substring docstring 0 (match-beginning 2)) | |
212 | "@var{" | |
213 | ms | |
214 | "}" | |
215 | (substring docstring (match-end 2)))))) | |
216 | (setq start (match-end 2))) | |
217 | ;; Return our modified doc string. | |
218 | docstring)) | |
219 | ||
220 | (defun srecode-texi-massage-to-texinfo (tag buffer string) | |
221 | "Massage TAG's documentation from BUFFER as STRING. | |
222 | This is to take advantage of TeXinfo's markup symbols." | |
223 | (save-excursion | |
224 | (if buffer | |
225 | (progn (set-buffer buffer) | |
226 | (srecode-texi-texify-docstring string)) | |
227 | ;; Else, no buffer, so lets do something else | |
228 | (with-mode-local texinfo-mode | |
229 | (srecode-texi-texify-docstring string))))) | |
230 | ||
231 | (define-mode-local-override srecode-texi-texify-docstring emacs-lisp-mode | |
232 | (string) | |
233 | "Take STRING, (a normal doc string), and convert it into a texinfo string. | |
234 | For instances where CLASS is the class being referenced, do not Xref | |
235 | that class. | |
236 | ||
237 | `function' => @dfn{function} | |
238 | `variable' => @code{variable} | |
239 | `class' => @code{class} @xref{class} | |
240 | `unknown' => @code{unknonwn} | |
241 | \"text\" => ``text'' | |
242 | 'quoteme => @code{quoteme} | |
243 | non-nil => non-@code{nil} | |
244 | t => @code{t} | |
245 | :tag => @code{:tag} | |
246 | [ stuff ] => @code{[ stuff ]} | |
247 | Key => @kbd{Key} (key is C\\-h, M\\-h, SPC, RET, TAB and the like) | |
248 | ... => @dots{}" | |
249 | (while (string-match "`\\([-a-zA-Z0-9<>.]+\\)'" string) | |
250 | (let* ((vs (substring string (match-beginning 1) (match-end 1))) | |
251 | (v (intern-soft vs))) | |
252 | (setq string | |
253 | (concat | |
254 | (replace-match (concat | |
255 | (if (fboundp v) | |
256 | "@dfn{" "@code{") | |
257 | vs "}") | |
258 | nil t string))))) | |
259 | (while (string-match "\\( \\|^\\)\\(nil\\|t\\|'[-a-zA-Z0-9]+\\|:[-a-zA-Z0-9]+\\)\\([. ,]\\|$\\)" string) | |
260 | (setq string (replace-match "@code{\\2}" t nil string 2))) | |
261 | (while (string-match "\\( \\|^\\)\\(\\(non-\\)\\(nil\\)\\)\\([. ,]\\|$\\)" string) | |
262 | (setq string (replace-match "\\3@code{\\4}" t nil string 2))) | |
263 | (while (string-match "\\( \\|^\\)\\(\\[[^]]+\\]\\)\\( \\|$\\)" string) | |
264 | (setq string (replace-match "@code{\\2}" t nil string 2))) | |
265 | (while (string-match "\\( \\|^\\)\\(\\(\\(C-\\|M-\\|S-\\)+\\([^ \t\n]\\|RET\\|SPC\\|TAB\\)\\)\\|\\(RET\\|SPC\\|TAB\\)\\)\\( \\|\\s.\\|$\\)" string) | |
266 | (setq string (replace-match "@kbd{\\2}" t nil string 2))) | |
267 | (while (string-match "\"\\(.+\\)\"" string) | |
268 | (setq string (replace-match "``\\1''" t nil string 0))) | |
269 | (while (string-match "\\.\\.\\." string) | |
270 | (setq string (replace-match "@dots{}" t nil string 0))) | |
271 | ;; Also do base docstring type. | |
272 | (srecode-texi-texify-docstring-default string)) | |
273 | ||
274 | (provide 'srecode/texi) | |
275 | ||
276 | ;; Local variables: | |
277 | ;; generated-autoload-file: "loaddefs.el" | |
4d902e6f CY |
278 | ;; generated-autoload-load-name: "srecode/texi" |
279 | ;; End: | |
280 | ||
3999968a | 281 | ;; arch-tag: 6f0e7f45-2281-49e4-b73c-680cba477094 |
4d902e6f | 282 | ;;; srecode/texi.el ends here |