| 1 | ;;; srecode/texi.el --- Srecode texinfo support. |
| 2 | |
| 3 | ;; Copyright (C) 2008-2011 Free Software Foundation, Inc. |
| 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 FOREIGN-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 | (srecode-texi-insert-tag-as-doc foreign-tag)) |
| 182 | |
| 183 | (defun srecode-texi-insert-tag-as-doc (tag) |
| 184 | "Insert TAG into the current buffer with SRecode." |
| 185 | (when (not (eq major-mode 'texinfo-mode)) |
| 186 | (error "Can only insert tags into texinfo in texinfo mode")) |
| 187 | (let ((srecode-semantic-selected-tag tag)) |
| 188 | (srecode-load-tables-for-mode major-mode) |
| 189 | ;; @todo - choose of the many types of tags to insert, |
| 190 | ;; or put all that logic into srecode. |
| 191 | (srecode-insert "declaration:function"))) |
| 192 | |
| 193 | |
| 194 | \f |
| 195 | ;;; Texinfo mangling. |
| 196 | |
| 197 | (define-overloadable-function srecode-texi-texify-docstring |
| 198 | (docstring) |
| 199 | "Texify the doc string DOCSTRING. |
| 200 | Takes plain text formatting that may exist, and converts it to |
| 201 | using TeXinfo formatting.") |
| 202 | |
| 203 | (defun srecode-texi-texify-docstring-default (docstring) |
| 204 | "Texify the doc string DOCSTRING. |
| 205 | Takes a few very generic guesses as to what the formatting is." |
| 206 | (let ((case-fold-search nil) |
| 207 | (start 0)) |
| 208 | (while (string-match |
| 209 | "\\(^\\|[^{]\\)\\<\\([A-Z0-9_-]+\\)\\>\\($\\|[^}]\\)" |
| 210 | docstring start) |
| 211 | (let ((ms (match-string 2 docstring))) |
| 212 | ;(when (eq mode 'emacs-lisp-mode) |
| 213 | ; (setq ms (downcase ms))) |
| 214 | |
| 215 | (when (not (or (string= ms "A") |
| 216 | (string= ms "a") |
| 217 | )) |
| 218 | (setq docstring (concat (substring docstring 0 (match-beginning 2)) |
| 219 | "@var{" |
| 220 | ms |
| 221 | "}" |
| 222 | (substring docstring (match-end 2)))))) |
| 223 | (setq start (match-end 2))) |
| 224 | ;; Return our modified doc string. |
| 225 | docstring)) |
| 226 | |
| 227 | (defun srecode-texi-massage-to-texinfo (tag buffer string) |
| 228 | "Massage TAG's documentation from BUFFER as STRING. |
| 229 | This is to take advantage of TeXinfo's markup symbols." |
| 230 | (save-excursion |
| 231 | (if buffer |
| 232 | (progn (set-buffer buffer) |
| 233 | (srecode-texi-texify-docstring string)) |
| 234 | ;; Else, no buffer, so let's do something else |
| 235 | (with-mode-local texinfo-mode |
| 236 | (srecode-texi-texify-docstring string))))) |
| 237 | |
| 238 | (define-mode-local-override srecode-texi-texify-docstring emacs-lisp-mode |
| 239 | (string) |
| 240 | "Take STRING, (a normal doc string), and convert it into a texinfo string. |
| 241 | For instances where CLASS is the class being referenced, do not Xref |
| 242 | that class. |
| 243 | |
| 244 | `function' => @dfn{function} |
| 245 | `variable' => @code{variable} |
| 246 | `class' => @code{class} @xref{class} |
| 247 | `unknown' => @code{unknonwn} |
| 248 | \"text\" => ``text'' |
| 249 | 'quoteme => @code{quoteme} |
| 250 | non-nil => non-@code{nil} |
| 251 | t => @code{t} |
| 252 | :tag => @code{:tag} |
| 253 | [ stuff ] => @code{[ stuff ]} |
| 254 | Key => @kbd{Key} (key is C\\-h, M\\-h, SPC, RET, TAB and the like) |
| 255 | ... => @dots{}" |
| 256 | (while (string-match "`\\([-a-zA-Z0-9<>.]+\\)'" string) |
| 257 | (let* ((vs (substring string (match-beginning 1) (match-end 1))) |
| 258 | (v (intern-soft vs))) |
| 259 | (setq string |
| 260 | (concat |
| 261 | (replace-match (concat |
| 262 | (if (fboundp v) |
| 263 | "@dfn{" "@code{") |
| 264 | vs "}") |
| 265 | nil t string))))) |
| 266 | (while (string-match "\\( \\|^\\)\\(nil\\|t\\|'[-a-zA-Z0-9]+\\|:[-a-zA-Z0-9]+\\)\\([. ,]\\|$\\)" string) |
| 267 | (setq string (replace-match "@code{\\2}" t nil string 2))) |
| 268 | (while (string-match "\\( \\|^\\)\\(\\(non-\\)\\(nil\\)\\)\\([. ,]\\|$\\)" string) |
| 269 | (setq string (replace-match "\\3@code{\\4}" t nil string 2))) |
| 270 | (while (string-match "\\( \\|^\\)\\(\\[[^]]+\\]\\)\\( \\|$\\)" string) |
| 271 | (setq string (replace-match "@code{\\2}" t nil string 2))) |
| 272 | (while (string-match "\\( \\|^\\)\\(\\(\\(C-\\|M-\\|S-\\)+\\([^ \t\n]\\|RET\\|SPC\\|TAB\\)\\)\\|\\(RET\\|SPC\\|TAB\\)\\)\\( \\|\\s.\\|$\\)" string) |
| 273 | (setq string (replace-match "@kbd{\\2}" t nil string 2))) |
| 274 | (while (string-match "\"\\(.+\\)\"" string) |
| 275 | (setq string (replace-match "``\\1''" t nil string 0))) |
| 276 | (while (string-match "\\.\\.\\." string) |
| 277 | (setq string (replace-match "@dots{}" t nil string 0))) |
| 278 | ;; Also do base docstring type. |
| 279 | (srecode-texi-texify-docstring-default string)) |
| 280 | |
| 281 | (provide 'srecode/texi) |
| 282 | |
| 283 | ;; Local variables: |
| 284 | ;; generated-autoload-file: "loaddefs.el" |
| 285 | ;; generated-autoload-load-name: "srecode/texi" |
| 286 | ;; End: |
| 287 | |
| 288 | ;;; srecode/texi.el ends here |