; Copyright (C) 1990 Mark B. Motl ; ; This program is free software; you can redistribute it and/or modify ; it under the terms of the GNU General Publich License as published by ; the Free Software Foundation. ; ; This program is distributed in the hope that it will be useful, ; but WITHOUT ANY WARRANTY; without even the implied warranty of ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ; GNU General Public License for more details. ; ; To obtain a copy of the GNU General Public License, write to: ; Free Software Foundation, Inc. ; 675 Mass Ave. ; Cambridge, MA 02139 ; USA ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; AUTHOR: Mark B. Motl ; Department of Computer Science ; Texas A&M University ; College Station, TX 77843-3112 ; ; PURPOSE: The following functions are a set of GNU Emacs Lisp functions ; to extend Emacs so that it is sensitive to the WEB style of ; programming. ; ; DATE: The preliminary version of these functions was written in ; Summer/Fall 1989. ; ; ADVISOR: Dr. S. Bart Childs ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; ; This program is still under development. The author accepts no ; responsibility to anyone for the consequences of using it, for whether ; it serves any particular purpose, or even works at all. ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; Any bugs or comments should be mailed to the author at the above address. ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; REVISION HISTORY ; ; Late November 1989 ; ; Made a significant change to the type of list maintained for the module ; names. It now looks like ; ; (("Module Name 1" (Defined in Module #'s) (Used in Module #'s)) ; ("Module Name 2" (Defined in Module #'s) (Used in Module #'s)) ; ... ; ("Module Name n" (Defined in Module #'s) (Used in Module #'s)) ; ) ; ; As a consequence of this reorganization, the following functions had to ; be modified: any-modules-undefined-initially, collect-module-names, ; display-module-names, module-lookup, options-for-module-name-insertion, ; and view-module-names. ; ; Two functions were deleted: print-module-names and replace-nth-element. ; ; The function "append-a-stub-module" was modified so that a stub module ; is now added at the end of the section in which it is first used ; instead of at the end of the buffer. ; ; Some new functions have been added: ; 1) "collect-section-names" -- constructs a list of the major sections ; and the module in which each section starts ; 2) "view-section-names" -- prints the list of section names to another ; buffer ; 3) "switch-to-module" -- this function is useful when one is switched ; to another buffer (e.g., running "view-section-names") and wants to ; return to the buffer where the WEB document is. It prompts for a ; module number to return to in the WEB; or, alternatively, one can ; provide a prefix argument. ; 4) "insert-new-module-name-in-list-of-module-names" -- this replaces ; the old function "replace-nth-element". ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; Early December 1989 ; ; Added several functions so that traversal of the Defined In and Used In ; lists in the list of module names could be accomplished. These are: ; ; first-use and first-define -- these can be executed from either the buffer ; containing the WEB document or the buffer where the module names are ; displayed. The only way to select a module is in the buffer containing ; the list of module names (position the cursor on the line containing ; the module name of interest). Once a module name has been selected, ; first-use switches back to the buffer containing the WEB document at ; the module where the selected module name was first used. If the ; command is issued from the buffer containing the WEB document, point ; is positioned at the beginning of the module where the most recently ; selected module name was first used. The function first-define is analogous ; to the operation of first-use except that it works on the Defined In ; list instead of the Used In list. ; ; next-use, previous-use, next-define, and previous-define -- These functions ; work as one would expect. These functions can only be used in the buffer ; containing the WEB document. ; ; An internal support function, convert-list-to-string, was added so that ; the lists Defined In and Used In (lists of integers) could be inserted ; in the buffer where the module names are displayed. ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; Late December 1989 ; ; Added some new functions to aid in communication with the index that ; Weave creates. These are: eliminate-control-sequences, first-index-use, ; next-index-use, previous-index-use, reformat-the-index, and view-index. ; The second, third, fourth, and last of these are interactive; the remaining ; ones are support functions. When the command view-index is invoked, it ; first checks to see if the file INDEX.tex is present (we have modified the ; output generated by Weave so that in addition to the TeX file, it also ; creates two other files: INDEX.tex which contains the index and ; MODULE_NAMES.tex which contains the list of section names). If not present, ; it creates another process and Weaves the current buffer. The file ; INDEX.tex is then read in and some reformatting is done so that it is more ; readable. The user selects an index entry of interest by placing the ; cursor anywhere on the line(s) where the index entry is located. An index ; entry is selected then by issuing the command first-index-use. This command ; can be issued from the buffer where the index is displayed or it can be ; issued from the buffer containing the WEB document. If invoked from the ; former, it switches back to the buffer containing the WEB document at the ; beginning of the module where the selected index entry was first referenced. ; If invoked from the latter, point is positioned at the beginning of the ; module where the most recently selected index entry was first referenced. ; ; Once an index entry has been selected, the functions next-index-use and ; previous-index-use can be used to traverse the list of references for the ; most recently selected index entry. ; ; Also added functions count-sections (provides a count of the total number ; of sections in the WEB), goto-section (which goes to the beginning of the ; n-th section), and what-section (which informs the user of the section ; that point is currently positioned in). ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; ACCOMMODATIONS FOR A CHANGE FILE ; ; In late December 1989, I added five new functions that deal with CHange ; files. These are: ; ; 1) change-module --- Used in the buffer that contains the Web ; document. The user positions point in the module that he wishes to ; change and then invokes the function. It copies the entire module ; contents from the Web buffer to the buffer containing the CHange file ; twice---once between an @x @y and once between an @y @z. The text ; is inserted in the proper position in the CHange file. ; ; 2) collect-list-of-changed-module-numbers --- collects and returns a list ; of module numbers that have been changed in the CHange file. ; ; 3) escape-special-characters-in-regexp --- used when determining what ; module in the Web a particular change corresponds to. Because the ; text between the @x and @y may contain special characters Emacs uses ; in regular expression searches, it is necessary to turn them into ; ordinary characters. ; ; 4) view-list-of-changed-modules --- available in both the buffer ; containing the Web document and the buffer containing the CHange file. ; It displays a list of which modules in the Web have been changed in the ; CHange file. ; ; 5) what-change --- available only in the buffer containing the CHange ; file. Based on the position of point, it displays a descriptive message ; in the minibufer indicating which module in the Web is being changed. ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; January 3, 1990 ; ; Changed the names of some functions: ; FROM Name: TO Name: ; module-count count-modules ; section-count count-sections ; show-index view-index ; show-list-of-changed-modules view-list-of-changed-modules ; show-module-names view-module-names ; show-section-names view-section-names ; statistics determine-statistics ; what-module-does-this-change-correspond-to what-change ; ; Also added key-bindings which are accomplished at load time. I used the ; convention: Each command takes the form ; ESC (or META) ; CTRL first-letter-of-function-name ; CTRL first-letter-of-second-word-in-function-name ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; January 8, 1990 ; ; Added two new functions change-file and web-file. When invoked they ; set the current buffer to the CHange or Web file, respectively. ; Eliminated the function switch-to-module. ; ; Changed some function names: ; FROM TO ; change-this-module edit-module ; check-balance-of-module-delimiters delimiter-match-check ; determine-statistics determine-characteristics ; first-index-use first-index ; next-index-use next-index ; previous-index-use previous-index ; view-list-of-changed-modules view-changed-modules-list ; view-module-names view-module-names-list ; view-section-names view-section-names-list ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; January 10, 1990 ; ; Added four new functions: ; 1) count-changes -- counts the number of changes in the CHange file. ; 2) goto-change -- goes to the n-th change in the CHange file. The ; changes are numbered sequentially beginning with 1. ; 3) next-change -- positions point at the beginning of the next change. ; 4) previous-change -- positions point at the beginning of the previous ; change. ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; January 13, 1990 ; ; Added two new functions: ; 1) initialize-module-names-list -- this function is invoked by web-mode ; if two conditions prevail: ; a) the file .mods exists for the WEB beging edited and ; b) the file .mods is newer than the WEB ; If both of these conditions are true, the information to initialize ; the module-names list is read in from the file .mods. This saves ; a considerable amount of time when the WEB is quite large, such as ; initex.web. Thus, if the file initex.mods exists and it is newer ; than initex.web, a lot of time can be saved in the initial startup. ; 2) write-module-names-to-a-file -- this is also an internal support function. ; Every time the module-names must be collected, this function is invoked ; so that the new information can be written to the file .mods. ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; January 16, 1990 ; ; Completely changed the function collect-list-of-changed-module-numbers. ; The method the function now uses closely resembles the method used by ; Knuth in TANGLE and WEAVE. See modules 128 through 137 in TANGLE.WEB. ; As a result of this change, I was able to delete the function escape- ; special-characters-in-regexp. ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; January 27, 1990 ; ; Reworked the function collect-module-names so that it works considerably ; faster. ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; April 7, 1990 ; ; Eliminated the functions first-index, first-define, and first-use. Made ; the functions next-define, next-use, next-index, previous-define, ; previous-use, and previous-index more logical. They work in either the ; buffer displaying the index or module names or in the buffer containing ; the Web document. If in one of the special buffers and one of these ; commands is issued, the user is switched back to the Web document at the ; next or previous occurrence based on point's position in the Web document ; before the switch over to the special buffer. ; ; Added a global variable web-module-changed-then-goto-change. Its purpose ; is to indicate where point is to be positioned when going to a module that ; has been changed. If the variable's value is true, then point is positioned ; in the CHange file at the change that corresponds to the module that the ; user wants to go to. If the variables value is not true, then point is ; positioned in the Web document with a message in the minibuffer that says ; that the module has been changed. ; ; Renamed all functions and global variables so that web- precedes their name. ; This was done in an effort to avoid any collisions when web-mode is used in ; conjunction with other modes. ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; July 30, 1990 ; ; After looking at some journal files, I realized that when web-mode-save- ; buffers-kill-emacs is invoked, the web-journal function doesn't write out ; the proper count for web-mode-save-buffers-kill-emacs because the file ; is written before the vector containing the counts gets updated. ; ; 1. Extend reformat or rewrite it to produce statistics. ; These should include the usual things but for webs ; it should also read a config file and produce things ; like counts of @<*@>, @, and all other index ; things, ... ; ; 2. The environment of Mark does not need this but a WEB ; user does. Each library should have a corresponding ; library whose elements are WEB sources for documenting ; calls. For example: calling LEQT1F from IMSL should ; be complemented by emacs including /usr/local/doc/imsl/leqt1f.web ; and editing for the local use. ; ; 3. Major sections need a complementary command of the type ; of @*subprogram-name@*. This string could be passed ; to the index for scoping variables and comments that ; may be entered into the index. Global vs local variables. ; ; 4. C prototypes and Pascal forward references: display of ; these kinds of items could be handy for a programmer. ; This is somewhat related to 2. above. ; ; 5. Integration with other tools such as Marcus' LPT or ; Kevin Borden's work with X. Two particular items that ; would yield the most benefit would be a tex previewer ; and source level debugger. These may be possible now, ; just not yet documented. ; ; 6. Also need to set up a default directory for Emacs to ; search when @i's are encountered. ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; GLOBAL variables and constants used in web-mode. ; (defvar web-buffer-name "" "Name of Web document being edited.") (defvar web-change-buffer-name nil "Name of the buffer containing the CHange file") (defvar web-default-directory nil "The default-directory that the Web is located in.") (defvar web-defined-in-occurrence -1 "Used as a pointer into the (Defined In) list of the most recently selected module name.") (defvar web-defined-in-used-in-location -1 "Used as a pointer into the list of module names. Used to take the (web-defined-in-used-in-location)-th car of module-names.") (defvar web-files nil "A list of the files used in the WEB. The general form of the list is: (\"CHange file name\" \"WEB file name\" \"include file 1\" \"include file 2\" ... \"include file n\")") (defvar web-index-buffer-name "" "Name of the buffer where the index is displayed.") (defvar web-index-entry "" "The selected index entry.") (defvar web-interactive-function-usage nil "A vector containing the number of times that the interactive functions were executed. The i-th element corresponds to the i-th car of web-interactive-functions") (defvar web-interactive-functions nil "List of the interactive functions available in web-mode.") ; initialize web-interactive-functions (setq web-interactive-functions '("web-change-file" "web-collect-module-names" "web-count-changes" "web-count-modules" "web-count-sections" "web-delimiter-match-check" "web-determine-characteristics" "web-edit-module" "web-file" "web-goto-change-corresponding-to-module" "web-goto-module" "web-goto-section" "web-include-file" "web-insert-index-entry" "web-insert-module-name" "web-is-this-a-new-module-beginning" "web-mode" "web-mode-save-buffers-kill-emacs" "web-newline" "web-next-change" "web-next-define" "web-next-index" "web-next-module" "web-next-section" "web-next-use" "web-previous-change" "web-previous-define" "web-previous-index" "web-previous-module" "web-previous-section" "web-previous-use" "web-rename-module" "web-view-changed-modules-list" "web-view-index" "web-view-module-names-list" "web-view-section-names-list" "web-what-change" "web-what-module" "web-what-section" ) ; end list ) ; end setq (defvar web-location-in-selected-index-entry-occurrences -1 "Used as a pointer into the list selected-web-index-entry-occurrences.") (defvar web-location-of-module nil "A vector of vectors. The i-th element contains information about the i-th module. Each element is a vector of 4 parts: the first part is an index into the list web-files indicative of which file the i-th module is located; the second part is the module number relative to the file that it is located in; the third part tells the major section that the i-th mdoule is located in; the fourth part indicates if the i-th module has been changed (0=no, 1=yes); and the fifth indicates the position of the CHange in the CHange file.") (defconst web-max-number-of-modules 2000 "The maximum number of modules in the WEB and its associated include files.") (defvar web-mode-map nil "Keymap used in Web Mode.") (defvar web-module-begins "^@\\( \\|\t\\|\n\\|\\*\\)" "Regular expression used for determining the beginning of a module.") (defvar web-module-changed-then-goto-change nil "Boolean variable. When going to a module and it is true, point is positioned in the CHange buffer at the CHange corresponding to the module number; otherwise, point is positioned at the module in the Web file.") (defvar web-module-name "\\(@@\\)*@<\\(@'\\|@\"\\|@@\\|[^@]\\)+@>" "Regular expression used for isolating a valid module name.") (defvar web-module-name-defined-in-used-in nil "A list of the Web's module names. The list takes the form ((\"Module Name 1\" (Defined in Module #'s) (Used in Module #'s)) (\"Module Name 2\" (Defined in Module #'s) (Used in Module #'s)) ... (\"Module Name n\" (Defined in Module #'s) (Used in Module #'s)) )") (defvar web-module-names nil "List of Web document's module names.") (defvar web-number-of-lines-in-window 0 "Total number of lines in window where Emacs is used.") (defvar web-number-of-module-names 0 "Total number of module names in the Web.") (defvar web-number-of-modules-in-file nil "A vector that contains number of modules in each of the WEB files. The elements are interpretted as follows: 0 - # of modules in the CHange file; 1 - # of modules in the WEB file; 2 - # of modules in include file 1; 3 - # of modules in include file 2; etc.") (defvar web-selected-index-entry-occurrences nil "A list comprised of the module numbers where the most recently selected index entry was referenced.") (defvar web-selected-module-name "" "Represents the name of the most recently selected module name.") (defvar web-used-in-occurrence -1 "Used as a pointer into the (Used In) list of the most recently selected module name.") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; Initialize the key-map used in web-mode. This is done at load-time. ; (if web-mode-map ; then the user has defined one () ; else (let ((map (make-sparse-keymap))) (define-key map "\e\C-c\C-f" 'web-change-file) (define-key map "\e\C-c\C-c" 'web-count-changes) (define-key map "\e\C-c\C-m" 'web-count-modules) (define-key map "\e\C-c\C-s" 'web-count-sections) (define-key map "\e\C-d\C-m" 'web-delimiter-match-check) (define-key map "\e\C-d\C-c" 'web-determine-characteristics) (define-key map "\e\C-e\C-m" 'web-edit-module) (define-key map "\e\C-w\C-f" 'web-file) (define-key map "\e\C-g\C-c" 'web-goto-change-corresponding-to-module) (define-key map "\e\C-g\C-m" 'web-goto-module) (define-key map "\e\C-g\C-s" 'web-goto-section) (define-key map "\e\C-i\C-f" 'web-include-file) (define-key map "\e\C-i\C-i" 'web-insert-index-entry) (define-key map "<" 'web-insert-module-name) (define-key map "@" 'web-is-this-a-new-module-beginning) (define-key map "\015" 'web-newline) (define-key map "\e\C-n\C-c" 'web-next-change) (define-key map "\e\C-n\C-d" 'web-next-define) (define-key map "\e\C-n\C-i" 'web-next-index) (define-key map "\e\C-n\C-m" 'web-next-module) (define-key map "\e\C-n\C-s" 'web-next-section) (define-key map "\e\C-n\C-u" 'web-next-use) (define-key map "\e\C-p\C-c" 'web-previous-change) (define-key map "\e\C-p\C-d" 'web-previous-define) (define-key map "\e\C-p\C-i" 'web-previous-index) (define-key map "\e\C-p\C-m" 'web-previous-module) (define-key map "\e\C-p\C-s" 'web-previous-section) (define-key map "\e\C-p\C-u" 'web-previous-use) (define-key map "\e\C-r\C-m" 'web-rename-module) (define-key map "\e\C-v\C-c" 'web-view-changed-modules-list) (define-key map "\e\C-v\C-i" 'web-view-index) (define-key map "\e\C-v\C-m" 'web-view-module-names-list) (define-key map "\e\C-v\C-s" 'web-view-section-names-list) (define-key map "\e\C-w\C-c" 'web-what-change) (define-key map "\e\C-w\C-m" 'web-what-module) (define-key map "\e\C-w\C-s" 'web-what-section) (setq web-mode-map map) ) ; end let ) ; end if ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; ; Here are the functions that comprise web-mode.el ; (defun web-any-modules-undefined-initially () "This function is invoked by \\[web-mode]. It checks to make sure that all modules are defined. If a module is undefined, a stub module is appended. ARGUMENTS : None GLOBAL Variables : web-module-name-defined-in-used-in and web-module-names LOCAL Variable : ctr and ptr RETURNS : Nothing USES : web-append-a-stub-module and web-goto-module" (let ((ctr 0) (ptr 0) ) (while (nth ctr web-module-names) (setq ptr (string-to-int (substring (nth ctr web-module-names) (+ (string-match " " (nth ctr web-module-names)) 2)))) (if (null (car (car (cdr (nth ptr web-module-name-defined-in-used-in))))) ; then (progn (ding) (message "Appending a module for %s" (substring (car (nth ptr web-module-name-defined-in-used-in)) 0 (length (car (nth ptr web-module-name-defined-in-used-in))))) (sit-for 2) (web-goto-module (car (car (cdr (cdr (nth ptr web-module-name-defined-in-used-in)))))) (setq module-number-of-stub (web-append-a-stub-module (substring (car (nth ptr web-module-name-defined-in-used-in)) 0 (length (car (nth ptr web-module-name-defined-in-used-in)))))) (setcdr (nth ptr web-module-name-defined-in-used-in) (append (list (list module-number-of-stub)) (list (car (cdr (cdr (nth ptr web-module-name-defined-in-used-in))))))) ) ; end then ) ; end if (setq ctr (1+ ctr)) ) ; end while ) ; end let ) (defun web-append-a-stub-module (module-name) "This function is invoked when a new stub module needs to be inserted. It appends a module with no commentary, an index entry indicating that this module is a stub, and the named module MODULE-NAME with no code. ARGUMENT : module-name (required) GLOBAL Variables : None LOCAL Variables : module-number-of-stub RETURNS : module-number-of-stub USES : web-insert-index-entry, web-update-the-location-of-module-vector, web-update-the-module-name-defined-in-used-in-list, and web-what-module" (save-excursion (let ((module-number-of-stub)) (if (re-search-forward "^@\\*" nil t) ; then position point at the end of the current section (forward-line -1) ; else position point at the end of the buffer ; (i.e., there is no next section) (goto-char (point-max)) (newline) ) ; end if (newline) (insert-string "@ ") (web-update-the-location-of-module-vector ? ) (web-insert-index-entry "R" "Stub") (insert-string (concat "@<" module-name "@>=\n")) (setq module-number-of-stub (web-what-module)) (web-update-the-module-name-defined-in-used-in-list module-number-of-stub) module-number-of-stub ) ; end let ) ; end excursion ) (defun web-binary-search-of-names (names num-elements-in-names search-key len) "This is an internal support function that performs a binary search on the list NAMES with NUM-ELEMENTS-IN-NAMES elements to find SEARCH-KEY of length LEN. ARGUMENTS : names, num-elements-in-names, search-key, and len (all required) LOCAL Variables : bottom, found, location, mid, and top GLOBAL Variables : None RETURNS : location USES : Nothing" (let ((bottom (1- num-elements-in-names)) found (location -1) (mid 0) (top 0) ) (while (and (not (null names)) (not found) (<= top bottom) ) (setq mid (/ (+ top bottom) 2)) (cond ((string= (substring search-key 0 len) (substring (nth mid names) 0 (min len (length (nth mid names))))) ; then we have a match (setq found t location mid) ) ; end case ((string< (substring search-key 0 len) (substring (nth mid names) 0 (min len (length (nth mid names))))) (setq bottom (1- mid)) ) ; end case (t (setq top (1+ mid)) ) ; end case ) ; end cond ) ; end while location ; return the location ) ; end let ) (defun web-change-file () "Makes the buffer that contains the CHange file the current buffer. ARGUMENTS : None LOCAL Variables : None GLOBAL Variable : web-change-buffer-name RETURNS : Nothing USES : web-check-if-buffer-is-one-of-the-web-files and web-journal" (interactive) (web-journal "web-change-file") (web-check-if-buffer-is-one-of-the-web-files) (switch-to-buffer web-change-buffer-name) ) (defun web-check-if-buffer-is-one-of-the-web-files () "This function checks if the current buffer is one of the files included in web-files. If the current buffer is not one of the files include in web-files, an error is signaled indicating that a user has attempted to use one of the functions in web-mode in a buffer that \\[web-mode] was not used on. ARGUMENTS : None GLOBAL Variables : web-default-directory and web-files LOCAL Variable : ctr RETURNS : pointer into the web-files list USES : Nothing" (let ((ctr 0) current-buffer-is-one-of-the-web-files ) (while (and (not current-buffer-is-one-of-the-web-files) (nth ctr web-files)) (if (string-equal (expand-file-name (nth ctr web-files) web-default-directory) (buffer-file-name)) ; then (setq current-buffer-is-one-of-the-web-files t) ; else (setq ctr (1+ ctr)) ) ; end if ) ; end while (if (not current-buffer-is-one-of-the-web-files) ; then (if (not (or (string= (buffer-name (current-buffer)) (concat "STATISTICS for " web-buffer-name "*")) (string= (buffer-name (current-buffer)) "*Module Names*") (string= (buffer-name (current-buffer)) web-index-buffer-name) (string= (buffer-name (current-buffer)) "*CHanged Modules*") (string= (buffer-name (current-buffer)) "*Module Name (Defined In) (Used In)*") (string= (buffer-name (current-buffer)) "*Section Names*") (string= (buffer-name (current-buffer)) "web-mode.jou") ) ; end or ) ; end not ; then (error "Attempting to use a function in a non-Web buffer.") ) ; end if ; else ctr ; return the location of the current-buffer in web-files ) ; end if ) ; end let ) (defun web-collect-list-of-changed-module-numbers () "This is an internal support function used by \\[web-edit-module], \\[web-view-changed-modules-list], and \\[web-what-change]. It returns a list of the module numbers in the Web being edited that have been changed in the CHange file. ARGUMENTS : None GLOBAL Variables : web-change-buffer-name and web-buffer-name LOCAL Variables : change-begins-at, changed-module, discrepancies, discrepancies-begin-at, line-in-change-file, and line-no-in-web RETURNS : Nothing USES : web-what-module" (let ((change-begins-at 0) (changed-module 0) (ctr 0) (discrepancies 0) (discrepancies-begin-at 0) line-in-change-file (line-no-in-web 1) ) (message "Determining which modules have been CHanged...") (save-excursion (set-buffer web-change-buffer-name) (save-excursion (goto-char (point-min)) (while (re-search-forward "^@\\(x\\|y\\|z\\)" nil t) (if (or (char-equal (downcase (string-to-char (buffer-substring (match-beginning 1) (match-end 1)))) ?y) (char-equal (downcase (string-to-char (buffer-substring (match-beginning 1) (match-end 1)))) ?z) ) ; end condition ; then (error "CHange beginning on line %d in %s is missing an @x." (count-lines (point-min) (point)) web-change-buffer-name) ; else (setq change-begins-at (count-lines (point-min) (point))) (forward-line 1) (if (eobp) (error "CHange file ended before @y.")) (setq line-in-change-file (buffer-substring (point) (save-excursion (end-of-line) (point)))) (save-excursion ; find this line's position in the WEB file (set-buffer web-buffer-name) (save-excursion (goto-line line-no-in-web) (if (not (search-forward line-in-change-file nil t)) ; then couldn't find line from the change file (error "WEB file ended during CHange.") ; else did find the line from the change file (setq line-no-in-web (count-lines (point-min) (point)) changed-module (web-what-module)) ) ; end if ) ; end excursion ) ; end excursion (setq line-no-in-web (1+ line-no-in-web) discrepancies 0) (forward-line 1) (if (eobp) (error "CHange file ended before @y.")) (while (not (looking-at "^@\\(x\\|y\\|z\\)")) (if (not (string-equal (buffer-substring (point) (save-excursion (end-of-line) (point))) (save-excursion (set-buffer web-buffer-name) (save-excursion (goto-line line-no-in-web) (if (eobp) (error "WEB ended during CHange.")) (buffer-substring (point) (save-excursion (end-of-line) (point))) ) ; end excursion ) ; end excursion ) ; end string-equal ) ; end not ; then (progn (if (zerop discrepancies) ; then (setq discrepancies-begin-at line-no-in-web) ) ; end if (setq discrepancies (1+ discrepancies)) ) ; end then ) ; end if (setq line-no-in-web (1+ line-no-in-web)) (forward-line 1) (if (eobp) (error "CHange file ended during CHange.")) ) ; end while (if (or (char-equal (downcase (string-to-char (buffer-substring (match-beginning 1) (match-end 1)))) ?x) (char-equal (downcase (string-to-char (buffer-substring (match-beginning 1) (match-end 1)))) ?z) ) ; end condition ; then (error "The @x located on line %d in %s has no matching @y." change-begins-at web-change-buffer-name) ; else scan forward to the next @ (if (not (zerop discrepancies)) ; then (if (= discrepancies 1) ; then (error "Hmm... %d line beginning at line %d in %s failed to match." discrepancies discrepancies-begin-at web-buffer-name) ; else (error "Hmm... %d lines beginning at line %d in %s failed to match." discrepancies discrepancies-begin-at web-buffer-name) ) ; end if ) ; end if (forward-line 1) (if (eobp) (error "CHange file ended before @z.")) (while (not (looking-at "^@\\(x\\|y\\|z\\)")) (forward-line 1) (if (eobp) (error "CHange file ended before @z.")) ) ; end while (if (or (char-equal (downcase (string-to-char (buffer-substring (match-beginning 1) (match-end 1)))) ?x) (char-equal (downcase (string-to-char (buffer-substring (match-beginning 1) (match-end 1)))) ?y) ) ; end condition ; then (error "The @x located on line %d in %s has no matching @z." change-begins-at web-change-buffer-name) ; else (end-of-line) ) ; end if (aset (aref web-location-of-module changed-module) 3 1) (if (zerop (aref (aref web-location-of-module changed-module) 4)) ; then (save-excursion (goto-line change-begins-at) (forward-char 2) (setq change-begins-at (point)) (goto-char (point-min)) (setq ctr 0) (while (re-search-forward "^@x" change-begins-at t) (setq ctr (1+ ctr)) ) ; end while (aset (aref web-location-of-module changed-module) 4 ctr) ) ; end excursion ) ; end if ) ; end if ) ; end while ) ; end while ) ; end excursion ) ; end excursion (message "Determining which modules have been CHanged...done") ) ; end let ) (defun web-collect-location-of-modules () "This function actually initializes the vector web-location-of-module. The vector consists of vectors. The i-th vector gives information about the i-th module in the Web. Each of these vectors has three elements: the first is a index into the list web-files which is indicative of the file that the i-th module is located; the secend the i-th module's position relative to the beginning of the file that it is located in; and the third element is indicative of the section that the i-th module is in. ARGUMENTS : NONE GLOBAL Variables : web-location-of-module, web-number-of-modules-in-file, web-files, and web-mode-map LOCAL Variables : file-number, include-file-name, module-number, and section-number RETURNS : Nothing USES : web-collect-location-of-modules and web-eliminate-white-space" (save-excursion (goto-char (point-min)) (while (re-search-forward "^@\\(i\\| \\|\n\\|\t\\|\\*\\)" nil t) (if (char-equal ?i (string-to-char (buffer-substring (match-beginning 1) (match-end 1)))) ; then (progn (setq include-file-name (buffer-substring (point) (save-excursion (end-of-line) (point)))) (setq include-file-name (substring include-file-name 0 (string-match " " include-file-name 1))) (setq web-files (append web-files (list (web-eliminate-white-space include-file-name)))) (setq file-number (cons (1- (length web-files)) file-number)) (save-excursion (find-file-noselect (expand-file-name (nth (car file-number) web-files) web-default-directory)) (set-buffer (get-file-buffer (expand-file-name (nth (car file-number) web-files) web-default-directory))) (setq major-mode 'Web-mode mode-name "Web") (use-local-map web-mode-map) (web-collect-location-of-modules) ) ; end excursion ) ; end then ; else (if (char-equal ?* (string-to-char (buffer-substring (match-beginning 1) (match-end 1)))) ; then (setq section-number (1+ section-number)) ) ; end if (aset web-number-of-modules-in-file (car file-number) (1+ (aref web-number-of-modules-in-file (car file-number)))) (aset web-location-of-module module-number (vector (car file-number) (aref web-number-of-modules-in-file (car file-number)) section-number 0 ; has it changed 0 ; if changed, the relative position in the CHange file ) ; end vector ) ; end aset (setq module-number (1+ module-number)) ) ; end if ) ; end while (setq file-number (cdr file-number)) ) ; end excursion ) (defun web-collect-module-names () "This function is invoked by \\[web-mode]. It collects the list module-name-defined-i9n-used-in list. This function can be invoked by the user if the list is in error (e.g., if a module name has been added but then the user deletes it--\\[web-mode] has no way of knowing when a module name or a module has been deleted ARGUMENTS : None GLOBAL Variables : web-module-name-defined-in-used-in, web-module-names, web-number-of-module-names, web-default-directory, and web-files LOCAL Variable : module-number RETURNS : Nothing USES : web-collect-module-names-in-buffer, web-journal, and web-write-module-names-to-a-file" (interactive) (web-journal "web-collect-module-names") (let ((module-number 1)) (setq web-module-name-defined-in-used-in () web-module-names () web-number-of-module-names 0) (save-excursion (set-buffer (get-file-buffer (expand-file-name (nth 1 web-files) web-default-directory))) (web-collect-module-names-in-buffer) ) ; end excursion (web-write-module-names-to-a-file) ) ; end let ) (defun web-collect-module-names-in-buffer () "This function is used to collect a list of all valid module names. The list takes the form ((\"Module Name 1\" (Defined in Module #'s) (Used in Module #'s)) (\"Module Name 2\" (Defined in Module #'s) (Used in Module #'s)) ... (\"Module Name n\" (Defined in Module #'s) (Used in Module #'s)) ) First it must determine the beginning and ending points of where a module name begins and ends. Once it has the name isolated, it checks the last three characters. If the last three characters are an ellipsis the length of the module name is set to the number of characters between the starting and ending positions less 3; otherwise the length is set to the number of characters between the starting and ending positons of the module name. The list as mentioned above is not kept in alphabetical order. The module names themselves are maintained in a separate list in alphabetical order. Each module name has an integer appended to it which is used as a pointer into the list as mentioned above. This module name is then compared with the module names already in the list that contains only module names. If no match is found, the new module name is inserted into both lists. If a match is found, update either the Defined In or Used In list that accompanies the module name in the big list. ARGUMENTS : None GLOBAL Variables : web-module-name-defined-in-used-in, web-module-names, web-number-of-module-names, web-default-directory, and web-module-name LOCAL Variables : char-after-at-greater, include-file-name, len, location, module-name, module-number, next-module-begins, and number-of-modules RETURNS : web-module-names USES : web-binary-search-of-names, web-collect-module-names-in-buffer, and web-eliminate-white-space" (let (char-after-at-greater (len 0) include-file-name (location -1) module-name (next-module-begins (point)) ) (save-excursion (goto-char (point-min)) (while (re-search-forward "^@\\(i\\| \\|\n\\|\t\\|\\*\\)" nil t) (if (char-equal ?i (string-to-char (buffer-substring (match-beginning 1) (match-end 1)))) ; then (save-excursion (setq include-file-name (buffer-substring (point) (save-excursion (end-of-line) (point)))) (setq include-file-name (substring include-file-name 0 (string-match " " include-file-name 1))) (set-buffer (get-file-buffer (expand-file-name (web-eliminate-white-space include-file-name) web-default-directory))) (web-collect-module-names-in-buffer) ) ; end excursion ; else (save-excursion (if (re-search-forward "^@\\(i\\| \\|\n\\|\t\\|\\*\\)" nil t) ; then (setq next-module-begins (point)) ; else (setq next-module-begins (point-max)) ) ; end if ) ; end excursion (message "Collecting module names in Module %d" module-number) (while (re-search-forward web-module-name next-module-begins t) (setq module-name (web-eliminate-white-space (buffer-substring (match-beginning 2) (match-end 2)))) (setq len (length module-name)) (if (and (> len 3) (string-equal "..." (substring module-name (- len 3) len))) ; then (setq len (- len 3)) ) ; end if (if (looking-at "=") ; then (setq char-after-at-greater ?=) ; else (setq char-after-at-greater ? ) ) ; end if (setq location (web-binary-search-of-names web-module-names web-number-of-module-names module-name len)) (if (= location -1) ; then a new module name has been encountered (progn (setq web-module-names (sort (append web-module-names (list (concat module-name " " (int-to-string web-number-of-module-names)))) 'string<) web-number-of-module-names (1+ web-number-of-module-names)) (if (char-equal ?= char-after-at-greater) ; then this new module was defined (i.e., @<...@>=) (setq web-module-name-defined-in-used-in (append web-module-name-defined-in-used-in (list (list module-name (list module-number) (list ()))))) ; else this new module was used before defined (setq web-module-name-defined-in-used-in (append web-module-name-defined-in-used-in (list (list module-name (list ()) (list module-number))))) ) ; end if ) ; end then ; else the module name is already in list (setq location (string-to-int (substring (nth location web-module-names) (+ (string-match " " (nth location web-module-names)) 2)))) (if (char-equal ?= char-after-at-greater) ; then an existing module name has been redefined (if (null (car (car (cdr (nth location web-module-name-defined-in-used-in))))) ; then (setcdr (nth location web-module-name-defined-in-used-in) (append (list (list module-number)) (cdr (cdr (nth location web-module-name-defined-in-used-in))))) ; else (setcdr (nth location web-module-name-defined-in-used-in) (append (list (append (car (cdr (nth location web-module-name-defined-in-used-in))) (list module-number))) (cdr (cdr (nth location web-module-name-defined-in-used-in))))) ) ; end if ; else an existing module has been used (if (null (car (car (cdr (cdr (nth location web-module-name-defined-in-used-in)))))) ; then (setcdr (nth location web-module-name-defined-in-used-in) (append (list (car (cdr (nth location web-module-name-defined-in-used-in)))) (list (list module-number)))) ; else (setcdr (nth location web-module-name-defined-in-used-in) (append (list (car (cdr (nth location web-module-name-defined-in-used-in)))) (list (append (car (cdr (cdr (nth location web-module-name-defined-in-used-in)))) (list module-number))))) ) ; end if ) ; end if ) ; end if ) ; end while (setq module-number (1+ module-number)) ) ; end if ) ; end while ) ; end excursion ) ; end let ) (defun web-collect-section-names () "This function collects a list of the major section names used in the Web. It also keeps track of the module number where each major section begins. ARGUMENTS: None GLOBAL Variables : None LOCAL Variables : ctr and section-names RETURNS : section-names USES : web-count-sections, web-eliminate-white-space, web-goto-section, and web-what-module" (let ((ctr 1) (num-of-sections (web-count-sections)) section-names ) (save-excursion (while (<= ctr num-of-sections) (web-goto-section ctr) (re-search-forward "^@\\*\\(.*\\)\\.\\( \\|\n\\)" nil t) (setq section-names (append section-names (list (list (web-eliminate-white-space (buffer-substring (match-beginning 1) (match-end 1))) (web-what-module))))) (setq ctr (1+ ctr)) ) ; end while ) ; end excursion section-names ; return the list ) ; end let ) (defun web-convert-list-to-string (list-of-numbers) "This is an internal support function that accepts a LIST-OF-NUMBERS and converts it into a string. ARGUMENT : list-of-numbers (required) GLOBAL Variables : None LOCAL Variables : ctr and list-as-string RETURNS : list-as-string USES : Nothing" (let ((ctr 0) list-as-string) (while (not (null (nth ctr list-of-numbers))) (setq list-as-string (concat list-as-string (int-to-string (nth ctr list-of-numbers)) " ")) (setq ctr (1+ ctr)) ) ; end while (if (> (length list-as-string) 1) ; then eliminate the trailing space (setq list-as-string (substring list-as-string 0 (1- (length list-as-string)))) ) ; end if list-as-string ; return the list of numbers as a string ) ; end let ) (defun web-count-changes () "Count the number of changes in the CHange file. ARGUMENTS : None GLOBAL Variable : web-location-of-module LOCAL Variables : count, index, and number-of-modules RETURNS : count USES : web-check-if-buffer-is-one-of-the-web-files, web-count-modules, and web-journal" (interactive) (web-journal "web-count-changes") (web-check-if-buffer-is-one-of-the-web-files) (let ((count 0) (index 0) (number-of-modules (web-count-modules)) ) (while (< index number-of-modules) (if (not (zerop (aref (aref web-location-of-module index) 3))) ; then (setq count (1+ count)) ) ; end if (setq index (1+ index)) ) ; end while (message "%d modules have been CHanged." count) count ; return the number of changes in the web ) ; end let ) (defun web-count-modules () "Count the number of modules in the Web file. ARGUMENTS : None GLOBAL Variables : web-number-of-modules-in-file and web-files LOCAL Variable : ctr and module-count RETURNS : module-count USES : web-check-if-buffer-is-one-of-the-web-files and web-journal" (interactive) (web-journal "web-count-modules") (web-check-if-buffer-is-one-of-the-web-files) (let ((module-count 0) (ctr 1) ) (while (<= ctr (length web-files)) (setq module-count (+ module-count (aref web-number-of-modules-in-file ctr)) ctr (1+ ctr)) ) ; end while (message "The number of modules in %s is %d" (upcase (nth 1 web-files)) module-count) module-count ; return the number of modules in the web ) ; end let ) (defun web-count-sections () "Count the number of sections in the Web file. ARGUMENTS : None GLOBAL Variables : None LOCAL Variable : module-count RETURNS : the number of sections USES : web-check-if-buffer-is-one-of-the-web-files, web-count-modules, and web-journal" (interactive) (web-journal "web-count-sections") (web-check-if-buffer-is-one-of-the-web-files) (let ((module-count (web-count-modules))) (message "The number of sections in %s is %d" (upcase (nth 1 web-files)) (aref (aref web-location-of-module module-count) 2)) (aref (aref web-location-of-module module-count) 2) ; return # of sections ) ; end let ) (defun web-count-the-matches (search-string) "This is an internal support function that counts the number of occurrences of SEARCH-STRING in the Web files. ARGUMENT : search-string (required) GLOBAL Variables : done, file-number, module-count, stopping-point, and web-default-directory LOCAL Variable : file-no and include-file-name RETURNS : Nothing USES : web-check-if-buffer-is-one-of-the-web-files, web-count-the-matches, and web-eliminate-white-space" (save-excursion (let ((file-no (web-check-if-buffer-is-one-of-the-web-files)) include-file-name ) (goto-char (point-min)) (while (and (not done) (re-search-forward search-string (aref stopping-point file-no) t) ) ; end condition (if (char-equal ?i (string-to-char (buffer-substring (match-beginning 1) (match-end 1)))) ; then (save-excursion (setq include-file-name (buffer-substring (point) (save-excursion (end-of-line) (point)))) (setq include-file-name (substring include-file-name 0 (string-match " " include-file-name 1))) (set-buffer (get-file-buffer (expand-file-name (web-eliminate-white-space include-file-name) web-default-directory))) (web-count-the-matches "^@\\(i\\| \\|\t\\|\n\\|\\*\\)") ) ; end excursion ; else (setq module-count (1+ module-count)) ) ; end if ) ; end while (if (= file-no file-number) ; then we are done (setq done t) ) ; end if ) ; end let ) ; end excursion ) (defun web-delimiter-match-check () "This function checks if all module delimiters (namely, @<...@>) are matched. It records any missing delimiter pairs, whether they be opening or closing pairs that are missing. If any missing delimiters are discovered, a window pops up with the pertinent information. The user then needs to rectify the situation and re-invoke \\[web-mode]. ARGUMENTS : None GLOBAL Variable : web-module-begins LOCAL Variables : balance, bound-for-search, closing-delimiters, next-module-begins, opening-char, opening-delimiters, and valid-delimiter RETURNS : balance (boolean indicating if module delimiters are balanced) USES : web-check-if-buffer-is-one-of-the-web-files and web-journal" (interactive) (web-journal "web-delimiter-match-check") (web-check-if-buffer-is-one-of-the-web-files) (let ((balance t) (bound-for-search 1) closing-delimiters (module-number 1) (next-module-begins 0) opening-char opening-delimiters valid-delimiter ) (save-excursion (goto-char (point-min)) (while (re-search-forward web-module-begins nil t) (message "Checking balance in Module %d" module-number) (setq bound-for-searc (point)) (save-excursion (if (not (re-search-forward web-module-begins nil t)) ; then (setq next-module-begins (point-max)) ; else (goto-char (match-beginning 0)) (setq next-module-begins (point)) ) ; end if ) ; end excursion (while (re-search-forward "\\(@@\\)*@\\(<\\|>\\)" next-module-begins t) (save-excursion (goto-char (match-beginning 0)) (if (char-equal (preceding-char) ?@) ; then (setq valid-delimiter nil) ; else (setq valid-delimiter t) ) ; end if ) ; end excursion (if valid-delimiter ; then (progn (cond ((char-equal (preceding-char) ?<) (setq opening-delimiters (cons (count-lines (point-min) (point)) opening-delimiters)) ) ; end case ((char-equal (preceding-char) ?>) (save-excursion (setq opening-char nil) (while (and (null opening-char) (re-search-backward "\\(@@\\)*@\\(\\^\\|\\.\\|:\\|t\\|=\\|<\\)" bound-for-search t)) (if (char-equal (preceding-char) ?@) ; then keep searching backward () ; else (setq opening-char (string-to-char (buffer-substring (match-beginning 2) (match-end 2)))) ) ; end if ) ; end while ) ; end excursion (cond ((null opening-char) ; then missing an opening delimiter (setq closing-delimiters (append closing-delimiters (list (count-lines (point-min) (point))))) ) ; end case ((char-equal opening-char ?<) ; valid module name (setq opening-delimiters (cdr opening-delimiters)) ) ; end case ) ; end cond (setq bound-for-search (point)) ) ; end case ) ; end cond ) ; end then ) ; end if ) ; end while (setq module-number (1+ module-number)) ) ; end while ) ; end excursion (if (and (null opening-delimiters) (null closing-delimiters)) ; then (message "All module delimiters match") ; else (setq balance nil) (with-output-to-temp-buffer "*Missing Delimiters*" (princ "After these errors are fixed, reissue the command M-x web-mode.") (if (not (null opening-delimiters)) ; then (if (nth 1 opening-delimiters) ; then (princ (format "\nThe @<'s located on lines %s are missing an @>." (sort opening-delimiters '<))) ; else (princ (format "\nThe @< located on line %d is missing an @>." (car opening-delimiters))) ) ; end if ) ; end if (if (not (null closing-delimiters)) ; then (if (nth 1 closing-delimiters) ; then (princ (format "\nThe @>'s located on lines %s are missing an @<." closing-delimiters)) ; else (princ (format "\nThe @> located on line %d is missing an @<." (car closing-delimiters))) ) ; end if ) ; end if ) ; end output to temp buffer ) ; end if balance ; return the boolean indicating if module delimiters balance ) ; end let ) (defun web-determine-characteristics () "This function is used to give the user an idea of how many lines of text exist in each module's commentary, definition/macro, and code parts. ARGUMENTS : None GLOBAL Variables : web-default-directory and web-files LOCAL Variables : code, code-begins, ctr, current-position, divider, done, file-no, header, header1, header2, header3, header4, line-in-table, lines-in-code, lines-in-commentary, lines-in-macros, macros, macros-begin, max-module, module-no, next-module-begins, number-of-columns, space-to-left-of-table, spacer, spanner, stat-buffer-name, title, and width-of-table RETURNS : Nothing USES : web-check-if-buffer-is-one-of-the-web-files, web-count-modules, web-determine-characteristics-for-buffer, and web-journal" (interactive) (web-journal "web-determine-characteristics") (web-check-if-buffer-is-one-of-the-web-files) (let* ((module-no 1) (max-module (web-count-modules)) (number-of-columns 4) (header1 "Module #") (header2 "Commentary") (header3 "Macros") (header4 "Code") (spanner "Number of Lines in") (title (concat "STATISTICS FOR " (upcase (buffer-name (current-buffer))))) (spacer 2) (width-of-table (+ (length header1) (length header2) (length header3) (length header4) (* number-of-columns spacer 2) (1+ number-of-columns))) (space-to-left-of-table (/ (- (screen-width) width-of-table) 2)) (divider (concat (make-string space-to-left-of-table ? ) "|" (make-string (+ (length header1) (* spacer 2)) ?_) "|" (make-string (+ (length header2) (* spacer 2)) ?_) "|" (make-string (+ (length header3) (* spacer 2)) ?_) "|" (make-string (+ (length header4) (* spacer 2)) ?_) "|\n" (make-string space-to-left-of-table ? ) "|" (make-string (+ (length header1) (* spacer 2)) ? ) "|" (make-string (+ (length header2) (* spacer 2)) ? ) "|" (make-string (+ (length header3) (* spacer 2)) ? ) "|" (make-string (+ (length header4) (* spacer 2)) ? ) "|\n")) (header (concat (make-string (/ (- (screen-width) (length title)) 2) ? ) title "\n" (make-string (1+ (/ (- (screen-width) width-of-table) 2)) ? ) (make-string (- width-of-table 2) ?_) "\n" (make-string space-to-left-of-table ? ) "|" (make-string (+ (length header1) (* spacer 2))? ) "|" (make-string (+ (length header2) (length header3) (length header4) (* 3 spacer 2) 2) ? ) "|\n" (make-string space-to-left-of-table ? ) "|" (make-string (+ (length header1) (* spacer 2)) ? ) "|" (make-string (/ (- (+ (length header2) (length header3) (length header4) (* 3 spacer 2) 2) (length spanner)) 2) ? ) spanner (make-string (1- (- (- width-of-table (+ (length header1) (* spacer 2) 2)) (+ (/ (- (+ (length header2) (length header3) (length header4) (* 3 spacer 2) 2) (length spanner)) 2) (length spanner)))) ? ) "|\n" (make-string space-to-left-of-table ? ) "|" (make-string (+ (length header1) (* spacer 2)) ? ) "|" (make-string (1- (- width-of-table (+ (length header1) (* spacer 2) 2))) ?_) "|\n" (make-string space-to-left-of-table ? ) "|" (make-string (+ (length header1) (* spacer 2)) ? ) "|" (make-string (+ (length header2) (* spacer 2)) ? ) "|" (make-string (+ (length header3) (* spacer 2)) ? ) "|" (make-string (+ (length header4) (* spacer 2)) ? ) "|\n" (make-string space-to-left-of-table ? ) "|" (make-string spacer ? ) header1 (make-string spacer ? ) "|" (make-string spacer ? ) header2 (make-string spacer ? ) "|" (make-string spacer ? ) header3 (make-string spacer ? ) "|" (make-string spacer ? ) header4 (make-string spacer ? ) "|\n" (make-string space-to-left-of-table ? ) "|" (make-string (+ (length header1) (* spacer 2)) ?_) "|" (make-string (+ (length header2) (* spacer 2)) ?_) "|" (make-string (+ (length header3) (* spacer 2)) ?_) "|" (make-string (+ (length header4) (* spacer 2)) ?_) "|\n" (make-string space-to-left-of-table ? ) "|" (make-string (+ (length header1) (* spacer 2)) ? ) "|" (make-string (+ (length header2) (* spacer 2)) ? ) "|" (make-string (+ (length header3) (* spacer 2)) ? ) "|" (make-string (+ (length header4) (* spacer 2)) ? ) "|\n")) code (code-begins) (ctr 0) (current-position 0) done file-no line-in-table (lines-in-code 0) (lines-in-commentary 0) (lines-in-macros 0) macros (macros-begin 0) (next-module-begins 0) (stat-buffer-name (concat "*STATISTICS for " (buffer-name (current-buffer)) "*")) ) (generate-new-buffer stat-buffer-name) (save-excursion (set-buffer stat-buffer-name) (use-local-map web-mode-map) (setq major-mode 'Web-mode mode-name "Web") (goto-char (point-min)) (kill-line (count-lines (point-min) (point-max))) ) ; end excursion (save-excursion (set-buffer (get-file-buffer (expand-file-name (nth 1 web-files) web-default-directory))) (setq file-no (cons (web-check-if-buffer-is-one-of-the-web-files) file-no)) (web-determine-characteristics-for-buffer) ) ; end excursion (switch-to-buffer stat-buffer-name) (goto-char (point-min)) ) ; end let ) (defun web-determine-characteristics-for-buffer () "This is an internal support function used by \\[web-determine-characteristics] to write the characteristics of each individual buffer to the buffer where they are being recorded. ARGUMENTS : None GLOBAL Variables : web-default-directory and web-files LOCAL Variables : code, code-begins, ctr, current-position, divider, done, file-no, header, header1, header2, header3, header4, include-file-name, line-in-table, lines-in-code, lines-in-commentary, lines-in-macros, macros, macros-begin, max-module, module-no, next-module-begins, number-of-columns, space-to-left-of-table, spacer, spanner, stat-buffer-name, title, and width-of-table RETURNS : Nothing USES : web-check-if-buffer-is-one-of-the-web-files and web-eliminate-white-space" (save-excursion (goto-char (point-min)) (while (re-search-forward "^@\\(i\\| \\|\t\\|\n\\|\\*\\)" nil t) (if (char-equal ?i (string-to-char (buffer-substring (match-beginning 1) (match-end 1)))) ; then switch to include file and collect its characteristics (save-excursion (setq include-file-name (buffer-substring (point) (save-excursion (end-of-line) (point)))) (setq include-file-name (substring include-file-name 0 (string-match " " include-file-name 1))) (set-buffer (get-file-buffer (expand-file-name (web-eliminate-white-space include-file-name) web-default-directory))) (setq file-no (cons (web-check-if-buffer-is-one-of-the-web-files) file-no)) (web-determine-characteristics-for-buffer) ) ; end excursion ; else continue collecting in the same buffer (setq current-position (count-lines (point-min) (point))) (save-excursion (if (re-search-forward "^@\\(i\\| \\|\t\\|\n\\|\\*\\)" nil t) ; then (setq next-module-begins (point)) ; else (setq next-module-begins (point-max)) ) ; end if ) ; end excursion (save-excursion (setq macros nil) (if (re-search-forward "@\\(d\\|f\\)" next-module-begins t) ; then (progn (backward-char 2) (setq done nil ctr 0) (while (null done) (while (looking-at "@") (backward-char 1) (setq ctr (1+ ctr)) ) (forward-char (+ ctr 2)) (if (not (zerop (% ctr 2))) ; then (setq macros t done t macros-begin (count-lines (point-min) (point))) ; else (if (re-search-forward "@\\(d\\|f\\)" next-module-begins t) ; then (backward-char 2) ; else (setq done t) ) ; end if ) ; end if ) ; end while ) ; end then ) ; end if ) ; end excursion (save-excursion (setq code nil) (if (re-search-forward "@\\(p\\|c\\|<\\)" next-module-begins t) ; then (progn (backward-char 2) (setq done nil ctr 0) (while (null done) (while (looking-at "@") (backward-char 1) (setq ctr (1+ ctr)) ) (forward-char (+ ctr 2)) (if (not (zerop (% ctr 2))) ; then (setq code t done t code-begins (count-lines (point-min) (point))) ; else (if (re-search-forward "@\\(<\\|p\\|c\\)" next-module-begins t) ; then (backward-char 2) ; else (setq done t) ) ; end if ) ; end if ) ; end while ) ; end then ) ; end if ) ; end excursion (setq next-module-begins (count-lines (point-min) next-module-begins)) (cond ((and (null macros) (null code)) (setq lines-in-commentary (- next-module-begins current-position)) (setq lines-in-macros 0) (setq lines-in-code 0) ) ((and (null macros) (not (null code))) (setq lines-in-commentary (- code-begins current-position)) (setq lines-in-macros 0) (setq lines-in-code (- next-module-begins code-begins)) ) ((and (not (null macros)) (null code)) (setq lines-in-commentary (- macros-begin current-position)) (setq lines-in-macros (- next-module-begins macros-begin)) (setq lines-in-code 0) ) ((and (not (null macros)) (not (null code))) (setq lines-in-commentary (- macros-begin current-position)) (setq lines-in-macros (- code-begins macros-begin)) (setq lines-in-code (- next-module-begins code-begins)) ) ) ; end cond (setq line-in-table (concat (make-string space-to-left-of-table ? ) "|" (make-string spacer ? ) (make-string (- (length header1) (length (int-to-string module-no))) ? ) (int-to-string module-no) (make-string spacer ? ) "|" (make-string spacer ? ) (make-string (- (length header2) (length (int-to-string lines-in-commentary))) ? ) (int-to-string lines-in-commentary) (make-string spacer ? ) "|" (make-string spacer ? ) (make-string (- (length header3) (length (int-to-string lines-in-macros))) ? ) (int-to-string lines-in-macros) (make-string spacer ? ) "|" (make-string spacer ? ) (make-string (- (length header4) (length (int-to-string lines-in-code))) ? ) (int-to-string lines-in-code) (make-string spacer ? ) "|\n" ) ; ends concat ) ; ends setq (message "Module %d" module-no) (set-buffer stat-buffer-name) (if (= module-no 1) ; then (progn (goto-char (point-min)) (kill-line (count-lines (point-min) (point-max))) (insert-string header) ) ; end then ) ; end if (insert-string line-in-table) (cond ((= module-no max-module) (setq divider (concat (make-string space-to-left-of-table ? ) "|" (make-string (+ (length header1) (* spacer 2)) ?_) "|" (make-string (+ (length header2) (* spacer 2)) ?_) "|" (make-string (+ (length header3) (* spacer 2)) ?_) "|" (make-string (+ (length header4) (* spacer 2)) ?_) "|\n" ) ; end concat ) ; end setq (insert-string divider) ) ; end case ((zerop (% module-no 3)) (insert-string divider) ) ; end case ) ; end cond (setq module-no (1+ module-no)) (set-buffer (get-file-buffer (expand-file-name (nth (car file-no) web-files) web-default-directory))) ) ; end if ) ; end while (setq file-no (cdr file-no)) ) ; end excursion ) (defun web-determine-module-name-ending () "This function determines if the appropriate ending to a module name is @> or @>=. ARGUMENTS : None GLOBAL Variable : web-module-begins LOCAL Variables : at-greater-than-equal, at-p, module-name-ending, next-module-begins, and this-module-begins RETURNS : module-name-ending USES : Nothing" (let (at-greater-than-equal at-p module-name-ending (next-module-begins 0) (this-module-begins 0) ) (save-excursion (re-search-backward web-module-begins nil t) (setq this-module-begins (point)) ) ; end excursion (save-excursion (if (re-search-forward web-module-begins nil t) ; then (progn (goto-char (match-beginning 0)) (setq next-module-begins (point)) ) ; end then ; else (setq next-module-begins (point-max)) ) ; end if ) ; end excursion (save-excursion (goto-char this-module-begins) (while (and (re-search-forward "\\(@@\\)*@\\(p\\|c\\|r\\|a\\|n\\)" next-module-begins t) (null at-p)) (if (not (char-equal ?@ (string-to-char (buffer-substring (1- (match-beginning 0)) (match-beginning 0))))) ; then it's valid (setq at-p t) ) ; end if ) ; end while (if at-p ; then do nothing () ; else check for a valid @>= (while (and (re-search-forward "\\(@@\\)*@>=" next-module-begins t) (null at-greater-than-equal)) (if (not (char-equal ?@ (string-to-char (buffer-substring (1- (match-beginning 0)) (match-beginning 0))))) ; then it's valid (setq at-greater-than-equal t) ) ; end if ) ; end while ) ; end if ) ; end excursion (if (and (null at-greater-than-equal) (null at-p)) ; then (setq module-name-ending "@>=") ; else (setq module-name-ending "@>") ) ; end if module-name-ending ; return the proper ending for the module name ) ; end let ) (defun web-display-module-names (top bottom &optional arg) "This function is used to display a list of module names. This function is invoked by \\[web-options-for-module-name-insertion]. It displays the module name of the TOP-th car of web-module-names through the BOTTOM-th car of web-module-names. An optional argument ARG is used to choose between one of two messages displayed at the bottom of the window. ARGUMENTS : top (required), bottom (required), and arg (optional) GLOBAL Variables : web-module-names, web-number-of-lines-in-window, and web-number-of-module-names LOCAL Variables : available-lines, ctr, module-name, phrase, and space-on-left RETURNS : Nothing USES : Nothing" (let ((available-lines (- web-number-of-lines-in-window 11)) (ctr top) module-name phrase (space-on-left (/ (- 6 (length (int-to-string web-number-of-module-names))) 2)) ) (if (null arg) ; then (setq phrase (format "Displaying %d Module Names of %d" (1+ (- bottom top)) web-number-of-module-names)) ; else (setq phrase (format "Displaying %d of %d Matches" (1+ (- bottom top)) arg)) ) (goto-char (point-min)) (forward-line 9) (kill-line (count-lines (point) (point-max))) (insert-string "Number Name\n") (while (<= ctr bottom) (setq module-name (substring (nth (1- ctr) web-module-names) 0 (string-match " " (nth (1- ctr) web-module-names)))) (if (> (length module-name) 71) ; then (setq module-name (concat (substring module-name 0 68) "...")) ) (insert-string (concat (make-string (+ space-on-left (- (length (int-to-string web-number-of-module-names)) (length (int-to-string ctr)))) ? ) (int-to-string ctr) (make-string (- 8 (+ space-on-left (length (int-to-string web-number-of-module-names)))) ? ) module-name "\n")) (setq ctr (1+ ctr)) ) ; end while (insert-string (make-string (- available-lines (1+ (- bottom top))) ?\012)) (insert-string (concat (make-string (/ (- 79 (length phrase)) 2) ? ) phrase)) ) ; end let ) (defun web-edit-module () "This function can only be invoked from the buffer containing the Web document. Whatever module point is positioned in is the module that is to be changed. If the module to be changed already appears in the CHange file, the user is warned but is switched to the buffer containing the CHange file so that further changes can be made. If the module to be changed does not appear in the CHange file, the module to be changed from the Web buffer is copied verbatim at its proper position in the CHange file twice--once between @x and @y and once between @y and @z. Point is then positioned at the beginning of the line following @y so that changes can be made. ARGUMENTS : None GLOBAL Variables : web-change-buffer-name and web-buffer-name LOCAL Variables : comment-string, ctr, module-to-be-changed, module-to-be-changed-begins-at, and module-to-be-changed-ends-at RETURNS : Nothing USES : web-count-changes, web-count-modules, web-goto-change-corresponding-to-module, web-goto-module, web-journal, web-what-change, and web-what-module" (interactive) (web-journal "web-edit-module") (if (not (string-equal web-buffer-name (buffer-name (current-buffer)))) ; then (error "Not in the Web buffer that web-mode was used on most recently.") ; else (let* ((ctr 0) done (module-to-be-changed (web-what-module)) (module-to-be-changed-begins-at 0) (module-to-be-changed-ends-at 0) (comment-string (concat " Module " (int-to-string module-to-be-changed) " " (current-time-string) "\n")) (total-number-of-modules (web-count-modules)) ) (if (= (aref (aref web-location-of-module module-to-be-changed) 3) 1) ; then the module has already been changed (progn (web-goto-change-corresponding-to-module module-to-be-changed) (message "Module %d has already been CHanged." module-to-be-changed) ) ; end then ; else (if (zerop module-to-be-changed) ; then the limbo portion of the Web is to be changed (setq module-to-be-changed-begins-at 1) ; else (save-excursion (web-goto-module module-to-be-changed) (setq module-to-be-changed-begins-at (point)) ) ; end excursion ) ; end if (if (= module-to-be-changed (web-count-modules)) ; then the last module is being changed (setq module-to-be-changed-ends-at (1- (point-max))) ; else (save-excursion (web-goto-module (1+ module-to-be-changed)) (backward-char 1) (while (looking-at "\n") (backward-char 1)) (setq module-to-be-changed-ends-at (1+ (point))) ) ; end excursion ) ; end if (setq ctr (1+ module-to-be-changed)) (while (not done) (cond ((or (> ctr total-number-of-modules) (= (aref (aref web-location-of-module ctr) 3) 1)) (setq done t) ) ; end case (t (setq ctr (1+ ctr) done nil) ) ; end case ) ; end cond ) ; end while (switch-to-buffer web-change-buffer-name) (goto-char (point-min)) ; position point in the CHange file for the insertion of the ; contents of the module that is to be changed. Update the ; web-location-of-module vector. (cond ((zerop (web-count-changes)) (goto-char (point-max)) (aset (aref web-location-of-module module-to-be-changed) 3 1) (aset (aref web-location-of-module module-to-be-changed) 4 1) ) ; end case ((= ctr (1+ total-number-of-modules)) ; then the new change goes at the bottom of the CHange file (goto-char (point-max)) ; update the web-location-of-module vector (aset (aref web-location-of-module module-to-be-changed) 3 1) (save-excursion (re-search-backward "^@z" nil t) (aset (aref web-location-of-module module-to-be-changed) 4 (1+ (aref (aref web-location-of-module (web-what-change)) 4))) ) ; end excursion ) ; end case (t (re-search-forward "^@x" nil t ctr) (goto-char (match-beginning 0)) (recenter 0) (aset (aref web-location-of-module module-to-be-changed) 3 1) (aset (aref web-location-of-module module-to-be-changed) 4 (aref (aref web-location-of-module ctr) 4)) (while (<= ctr total-number-of-modules) (if (not (zerop (aref (aref web-location-of-module ctr) 3))) ; then increment the relative position in the CHange file (aset (aref web-location-of-module ctr) 4 (1+ (aref (aref web-location-of-module ctr) 4))) ) ; end if (setq ctr (1+ ctr)) ) ; end while ) ; end case ) ; end cond (if (re-search-backward "^@z" nil t) ; then (progn (forward-line 1) (if (not (looking-at "\n")) ; then (newline) ; else (forward-line) ) ; end if ) ; end then ) ; end if (insert "@x" comment-string) (insert-buffer-substring web-buffer-name module-to-be-changed-begins-at (1+ module-to-be-changed-ends-at)) (insert "@y" comment-string) (insert-buffer-substring web-buffer-name module-to-be-changed-begins-at (1+ module-to-be-changed-ends-at)) (insert "@z" comment-string "\n") (re-search-backward "^@y" nil t) (recenter 0) (message "Module %d is ready to be changed." module-to-be-changed) ) ; end if ) ; end let ) ; end if ) (defun web-eliminate-control-sequences (search-string &optional replacement-string) "This is an internal support function used to eliminate delimited control sequences. The function searches for SEARCH-STRING replaces these delimited control sequences with their argument. An optional REPLACEMENT-STRING will be appended to the argument of the control sequence if present. This function is used when the index is being reformatted. For example, the index contains entries such as \[#] (where # represents a module number where the index entry was referenced) which are to be underlined in the final output. This function replaces the sequence with #. ARGUMENTS : search-string (required) and replacement-string (optional) GLOBAL Variables : None LOCAL Variables : None RETURNS : Nothing USES : Nothing" (save-excursion (goto-char (point-min)) (while (re-search-forward search-string nil t) (backward-char (length (buffer-substring (match-beginning 0) (match-end 0)))) (insert-string (concat (buffer-substring (match-beginning 1) (match-end 1)) replacement-string)) (delete-char (length (buffer-substring (match-beginning 0) (match-end 0)))) ) ; end while ) ; end excursion ) (defun web-eliminate-white-space (string) "This is an internal function used to eliminate all leading, trailing, and multiple inner occurrences of white space (tabs, carriage returns, and spaces) in STRING. The resulting string will always have a leading space, and hence, must be deleted before returning. If the last character in the input string is white space, a trailing space will also be present, and it, too, must be deleted before returning. This code adapted from Knuth (see Module 153 in tangle.web). ARGUMENT : string (required) GLOBAL Variables : None LOCAL Variables : d, k, loc, new-string RETURNS : new-string USES : Nothing" (let (d (k 1) (loc 1) (new-string " ") ) (while (<= loc (length string)) (setq d (substring string (1- loc) loc) loc (1+ loc) k (1+ k)) (if (or (string-equal d " ") (string-equal d "\n") (string-equal d "\t")) ; then (progn (setq d " ") (if (string-equal (substring new-string (- k 2) (1- k)) " ") ; then (setq k (1- k)) ) ; end if ) ; end then ) ; end if (setq new-string (concat (substring new-string 0 (1- k)) d)) ); end while (if (string-equal (substring new-string (1- k) k) " ") ; then (setq new-string (substring new-string 0 (1- k))) ) ; end if (substring new-string 1 (length new-string)) ; return the new string ) ; end let ) (defun web-file () "Makes the buffer that contains the Web document the current buffer. ARGUMENTS : None LOCAL Variables : None GLOBAL Variables : web-buffer-name RETURNS : Nothing USES : web-check-if-buffer-is-one-of-the-web-files and web-journal" (interactive) (web-journal "web-file") (web-check-if-buffer-is-one-of-the-web-files) (switch-to-buffer web-buffer-name) ) (defun web-goto-change-corresponding-to-module (goto-change-number) "This function positions point at the beginning of the change that corresponds to module GOTO-CHANGE-NUMBER. If no prefix argument is provided, the function prompts for one. ARGUMENT : goto-change-number (required) GLOBAL Variables : None LOCAL Variables : None RETURNS : Nothing USES : web-change-file, web-count-modules, and web-journal" (interactive "NGoto change corresponding to module: ") (web-journal "web-goto-change-corresponding-to-module") (cond ((or (< goto-change-number 0) (> goto-change-number (web-count-modules))) (error "There is no change that corresponds to %d." goto-change-number) ) ; end case ((zerop (aref (aref web-location-of-module goto-change-number) 3)) (error "Module %d has not been CHanged." goto-change-number) ) ; end case (t (web-change-file) (goto-char (point-min)) (re-search-forward "^@y" nil t (aref (aref web-location-of-module goto-change-number) 4)) (goto-char (match-beginning 0)) (recenter 0) (message "CHange for module %d" goto-change-number) ) ; end case ) ; end cond ) (defun web-goto-module (goto-module-number) "This function positions point at the beginning of the GOTO-MODULE-NUMBER module in the Web document. If no argument is provided, the user is prompted for one. The function will not permit a user to go to a module labelled 0 or less; nor will it permit a user to go to a module that exceeds the total number of modules. ARGUMENT : goto-module-number (required) GLOBAL Variables : web-location-of-module, web-files, web-default-directory, web-module-begins, and web-module-changed-then-goto-change LOCAL Variable : tot-num-modules RETURNS : Nothing USES : web-check-if-buffer-is-one-of-the-web-files, web-count-modules, and web-journal" (interactive "NGoto module: ") (web-journal "web-goto-module") (web-check-if-buffer-is-one-of-the-web-files) (let ((tot-num-modules (web-count-modules))) (cond ((< goto-module-number 1) (error "There is no module %d." goto-module-number) ) ; end case ((> goto-module-number tot-num-modules) (error "Can't go to module %d. There are only %d modules." goto-module-number tot-num-modules) ) ; end case (t (if web-module-changed-then-goto-change ; then (progn (web-change-file) (goto-char (point-min)) (re-search-forward "^@y" nil t (aref (aref web-location-of-module goto-module-number) 4)) (goto-char (match-beginning 0)) (recenter 0) ) ; end then ; else (switch-to-buffer (get-file-buffer (expand-file-name (nth (aref (aref web-location-of-module goto-module-number) 0) web-files) web-default-directory))) (goto-char (point-min)) (re-search-forward web-module-begins nil t (aref (aref web-location-of-module goto-module-number) 1)) (goto-char (match-beginning 0)) (recenter 0) ) ; end if (message "Module %d in %s. %s" goto-module-number (nth 1 web-files) (if (= (aref (aref web-location-of-module goto-module-number) 3) 1) "This module has been CHanged." " ")) ) ; end case ) ; end cond ) ; end let ) (defun web-goto-section (goto-section-number) "This function positions point at the beginning of the GOTO-SECTION-NUMBER section in the Web document. If no argument is provided, the user is prompted for one. The function will not permit a user to go to a section labelled 0 or less; nor will it permit a user to go to a section that exceeds the total number of sections. If the current buffer is not the buffer containing the Web document, the buffer containing the Web document is made the current buffer. ARGUMENT : goto-section-number (required) GLOBAL Variables : web-location-of-module and web-files LOCAL Variable : ctr and tot-num-sections RETURNS : Nothing USES : web-check-if-buffer-is-one-of-the-web-files, web-count-sections, web-goto-module, and web-journal" (interactive "NGoto Section Number: ") (web-journal "web-goto-section") (web-check-if-buffer-is-one-of-the-web-files) (let ((tot-num-sections (web-count-sections)) (ctr 1) ) (cond ((< goto-section-number 1) (error "There is no section %d." goto-section-number) ) ((> goto-section-number tot-num-sections) (error "Can't go to section %d. There are only %d sections." goto-section-number tot-num-sections) ) (t (while (/= (aref (aref web-location-of-module ctr) 2) goto-section-number) (setq ctr (1+ ctr)) ) ; end while (web-goto-module ctr) (message "Section %d in %s" goto-section-number (upcase (nth 1 web-files))) ) ; end case ) ; end cond ) ; end let ) (defun web-include-file (include-file-number) "This function switches to the buffer containing the contents of include file INCLUDE-FILE-NUMBER. ARGUMENTS include-file-number (required) GLOBAL Variables : web-default-directory and web-files LOCAL Variables : None RETURNS : Nothing USES : web-check-if-buffer-is-one-of-the-web-files and web-journal" (interactive "NInclude File to be switch to: ") (web-journal "web-include-file") (web-check-if-buffer-is-one-of-the-web-files) (if (or (< include-file-number 1) (> include-file-number (- (length web-files) 2))) ; then (error "There is no include file numbered %d" include-file-number) ; else (switch-to-buffer (get-file-buffer (expand-file-name (nth (1+ include-file-number) web-files) web-default-directory))) (goto-char (point-min)) ) ; end if ) (defun web-initialize-location-of-module-vector () "This is an internal support function used to initialize the web-location-of-module vector. ARGUMENTS : NONE GLOBAL Variables : web-change-buffer-name, web-location-of-module, web-number-of-modules-in-file, web-buffer-name web-files, and web-max-number-of-modules LOCAL Variables : file-number, module-number, and section-number RETURNS : Nothing USES : web-collect-location-of-modules" (let ((file-number '(1)) (module-number 1) (section-number 0) ) (setq web-location-of-module (make-vector (1+ web-max-number-of-modules) (make-vector 5 0)) web-number-of-modules-in-file (make-vector 20 0) web-files () ) ; end setq (aset web-location-of-module 0 (vector 1 0 0 0 0)) (setq web-files (append web-files (list web-change-buffer-name) (list web-buffer-name))) (set-buffer (nth (car file-number) web-files)) (message "Collecting the vector web-location-of-module...") (web-collect-location-of-modules) (message "Collecting the vector web-location-of-module...done") ) ; end let ) (defun web-initialize-module-names-list () "This function is invoked by \\[web-mode] if 1) filename.mods exists and 2) filename.mods is newer than filename.web. If these two conditions are true, then \\[web-mode] does not need to collect the web-module-names list from scratch. It can read this information from the file filename.mods. ARGUMENTS : None GLOBAL Variable : web-module-name-defined-in-used-in, web-module-names, web-number-of-module-names, web-buffer-name, and web-default-directory LOCAL Variables : defined-in-list, module-name, module-name-begins, and used-in-list RETURNS : Nothing USES : web-eliminate-white-space" (let (defined-in-list module-name (module-name-begins 0) used-in-list ) (find-file-noselect (expand-file-name (concat (substring web-buffer-name 0 (string-match "\\." web-buffer-name)) ".mods") web-default-directory)) (set-buffer (concat (substring web-buffer-name 0 (string-match "\\." web-buffer-name)) ".mods")) (goto-char (point-min)) (while (not (eobp)) (setq module-name-begins (point)) (forward-line 1) (while (and (not (eobp)) (char-equal (string-to-char (buffer-substring (point) (1+ (point)))) ? ) ) ; end condition (forward-line 1) ) ; end while (save-excursion (re-search-backward "(" nil t 2) (setq module-name (web-eliminate-white-space (buffer-substring module-name-begins (point)))) ) ; end excursion (save-excursion (setq defined-in-list ()) (re-search-backward "(" nil t 2) (while (not (looking-at ")")) (re-search-forward "[0-9]+" nil t) (setq defined-in-list (append defined-in-list (list (string-to-int (buffer-substring (match-beginning 0) (match-end 0)))))) ) ; end while ) ; end excursion (save-excursion (setq used-in-list ()) (re-search-backward "(" nil t) (while (not (looking-at ")")) (re-search-forward "[0-9]+" nil t) (setq used-in-list (append used-in-list (list (string-to-int (buffer-substring (match-beginning 0) (match-end 0)))))) ) ; end while ) ; end excursion (setq web-module-name-defined-in-used-in (append web-module-name-defined-in-used-in (list (list module-name defined-in-list used-in-list)))) (setq web-module-names (append web-module-names (list (concat module-name " " (int-to-string web-number-of-module-names))))) (setq web-number-of-module-names (1+ web-number-of-module-names)) ) ; end while ) ; end let ) (defun web-insert-index-entry (&optional type-style phrase) "This function inserts the necessary constructs so that an entry is placed in the index by Weave. Web supports three types of index entries. They differ in the type of type style used in the index itself. This function asks the user which TYPE-STYLE he prefers. Once a valid selection has been made, it asks for the PHRASE to be inserted in the index. ARGUMENTS : type-style and phrase (both required) GLOBAL Variables : None LOCAL Variables : first-part and prompt RETURNS : Nothing USES : web-check-if-buffer-is-one-of-the-web-files and web-journal" (interactive) (web-journal "web-insert-index-entry") (web-check-if-buffer-is-one-of-the-web-files) (let (first-part (prompt "rm(R/r), tt(T/t), or User-Defined(U/u): ") ) (if type-style ; then an explicit argument has been provided () ; else prompt for the type-style (setq type-style (read-string (concat "Type Style: " prompt))) (while (and (not (string-equal (upcase type-style) "R")) (not (string-equal (upcase type-style) "U")) (not (string-equal (upcase type-style) "T")) ) (ding) (setq type-style (read-string (concat "Try again. " prompt))) ) ; end while ) ; end if (cond ((string-equal (upcase type-style) "U") (setq first-part "@:") ) ; end case ((string-equal (upcase type-style) "T") (setq first-part "@.") ) ; end case (t ; default (setq first-part "@^") ) ; end case ) ; end cond (if (null phrase) (setq phrase (read-string "Phrase to be placed in index: ")) ) (end-of-line) (newline) (insert first-part phrase "@>") (newline) ) ; end let ) (defun web-insert-limbo-material () "This function is only invoked by \\[web-mode] when the edit buffer is empty, i.e., one is beginning a new Web document. The user is prompted for the title of the Web. ARGUMENTS : None GLOBAL Variables : None LOCAL Variables : limbo-file-name, line1, line2, line3, position-of-colon, title, and width RETURNS : Nothing USES : Nothing" (let (limbo-file-name (line1 (concat "PROGRAM : " (buffer-name (current-buffer)))) (line2 (concat "CREATOR : " (user-full-name) " [" (user-login-name) "@" (system-name) "]")) (line3 (concat "CREATION DATE : " (current-time-string))) (position-of-colon 0) title (width 0) ) (cond ((and (>= (length line1) (length line2)) (>= (length line1) (length line3))) (setq width (length line1) position-of-colon (+ (/ (- 77 width) 2) 9)) ) ; end case ((and (>= (length line2) (length line1)) (>= (length line2) (length line3))) (setq width (length line2) position-of-colon (+ (/ (- 77 width) 2) 9)) ) ; end case ((and (>= (length line3) (length line1)) (>= (length line3) (length line2))) (setq width (length line3) position-of-colon (+ (/ (- 77 width) 2) 15)) ) ; end case (t (error "In web-insert-limbo-material. Shouldn't have reached this code.") ) ; end case ) ; end cond ; insert a nice header (insert (make-string 79 ?%) "\n" ?% (make-string 77 ? ) ?% "\n" ?% (make-string (- position-of-colon 9) ? ) line1 (make-string (- 77 (+ (length line1) (- position-of-colon 9))) ? ) "%\n" ?% (make-string (- position-of-colon 9) ? ) line2 (make-string (- 77 (+ (length line2) (- position-of-colon 9))) ? ) "%\n" ?% (make-string (- position-of-colon 15) ? ) line3 (make-string (- 77 (+ (length line3) (- position-of-colon 15))) ? ) "%\n" ?% (make-string 77 ? ) "%\n" (make-string 79 ?%) "\n") (let ((insert-default-directory t)) (while (null (file-readable-p (setq limbo-file-name (read-file-name "File containing limbo material " (expand-file-name "limbo.material") (expand-file-name "limbo.material"))))) (ding) (message "%s does not exist or is non-readable" limbo-file-name) (sit-for 2) ) ; end while ) ; end let (insert-file-contents limbo-file-name) (setq title (read-string "Title of Web: ")) (goto-char (point-min)) (if (re-search-forward "\\\\def\\\\title{{\\\\tt " nil t) ; then (insert-string title) ) ; end if (goto-char (point-max)) ) ; end let ) (defun web-insert-module-name () "This function is invoked when the user presses <. This function must look at the preceding characters to determine if this represents the beginning of a module name or not. If the < is preceded by an odd number of @'s, then it represents the beginning of a module name; otherwise, it doesn't. ARGUMENTS : None GLOBAL Variables : None LOCAL Variable : ctr RETURNS : Nothing USES : web-check-if-buffer-is-one-of-the-web-files, web-options-for-module-name-insertion, web-journal, and web-what-module" (interactive) (web-journal "web-insert-module-name") (let ((ctr 0) (file-no (web-check-if-buffer-is-one-of-the-web-files)) ) (backward-char 1) (while (and (not (bobp)) (looking-at "@")) (backward-char 1) (setq ctr (1+ ctr)) ) ; end while (forward-char (1+ ctr)) (insert-char ?< 1) (cond ((and (not (zerop (% ctr 2))) (>= (web-what-module) 1)) ; then the preceding @< marks the beginning of a module name (web-options-for-module-name-insertion) ) ; end case ((and (not (zerop (% ctr 2))) (< (web-what-module) 1)) ; then we have a valid module beginning but are in the limbo portion (delete-backward-char (1+ ctr)) (error "You can't insert a module name in the limbo portion") ) ; end case ) ; end cond ) ; end let ) (defun web-is-this-a-new-module-beginning () "This function is invoked whenever the user enters the character @. The function then reads the next character. If this next character is in the set { (space),*,\\t(tab),\\n(newline)}, then it begins a new module and the vector web-location-of-module must be updated to reflect this addition. The @ must be at the beginning of a new line to be a valid module beginning. ARGUMENTS : None GLOBAL Variables : None LOCAL Variable : next-char RETURNS : Nothing USES : web-check-if-buffer-is-one-of-the-web-files, web-insert-module-name, web-update-the-location-of-module-vector, and web-journal" (interactive) (web-journal "web-is-this-a-new-module-beginning") (web-check-if-buffer-is-one-of-the-web-files) (if (not (bolp)) ; then insert an @ -- it's not the beginning of a new module (insert-char ?@ 1) ; else get the next character (let ((next-char (read-char))) (if (not (or (char-equal next-char ? ) (char-equal next-char ?<) (char-equal next-char ?*) (char-equal next-char ?\t) (char-equal next-char ?\015))) ; RET = ^M = \015 (octal) ; then insert an @ and the last input char -- it's not the beginning ; of a new module (progn (insert-char ?@ 1) (insert-char next-char 1) ) ; end then ; else this does begin a new module, major section, or code section (insert-char ?@ 1) (if (char-equal next-char ?<) ; then (web-insert-module-name) ; else (if (char-equal next-char ?\015) ; then (insert-char ?\012 1) ; else (insert-char next-char 1) ) ; end if (web-update-the-location-of-module-vector next-char) ) ; end if ) ; end if ) ; end let ) ; end if ) (defun web-journal (function-name) "This function keeps track of the number of times FUNCTION-NAME has been invoked. Only the interactive functions in web-mode are kept track of. ARGUMENTS : function-name (required) GLOBAL Variables : web-interactive-function-usage, web-buffer-name, and web-interactive-functions LOCAL Variables : ctr, start-time-in-seconds, stop-time, stop-time-in-seconds, time-in-web-mode, and time-in-web-mode-as-string RETURNS : Nothing USES : web-binary-search-of-names" (let ((ctr 0) (start-time-in-seconds 0) stop-time (stop-time-in-seconds 0) (time-in-web-mode 0) time-in-web-mode-as-string ) (cond ((string-equal function-name "web-mode") ; web-mode is the first function invoked ; thus, do initialization (get-buffer-create "web-mode.jou") (setq web-interactive-function-usage (make-vector (length web-interactive-functions) 0) start-time (current-time-string)) (save-excursion (set-buffer "web-mode.jou") (goto-char (point-min)) (kill-line (count-lines (point-min) (point-max))) (insert (make-string 79 ?\045) "\nUSER : " (user-full-name) " [" (user-login-name) "@" (system-name) "]\nFILE : " web-buffer-name "\nSTART TIME : " start-time "\n") ) ; end excursion ) ; end case ((string-equal function-name "web-mode-save-buffers-kill-emacs") ; this is the last function invoked by the user when he wants to quit ; get the stop time, calculate the total time in web-mode, and ; write the usage of the functions to the file web-mode.jou (setq ctr (web-binary-search-of-names web-interactive-functions (length web-interactive-functions) function-name (length function-name))) (aset web-interactive-function-usage ctr (1+ (aref web-interactive-function-usage ctr))) (save-excursion (set-buffer "web-mode.jou") (setq stop-time (current-time-string)) (setq start-time-in-seconds (+ (* 3600 (string-to-int (substring start-time 11 13))) (* 60 (string-to-int (substring start-time 14 16))) (string-to-int (substring start-time 17 19)))) (setq stop-time-in-seconds (+ (* 3600 (string-to-int (substring stop-time 11 13))) (* 60 (string-to-int (substring stop-time 14 16))) (string-to-int (substring stop-time 17 19)))) (if (not (natnump (- stop-time-in-seconds start-time-in-seconds))) ; then add the equivalent of a day to the stop time (setq stop-time-in-seconds (+ stop-time-in-seconds 86400)) ) ; end if (setq time-in-web-mode (- stop-time-in-seconds start-time-in-seconds)) (if (< (/ time-in-web-mode 3600) 10) ; then (setq time-in-web-mode-as-string (concat "0" (int-to-string (/ time-in-web-mode 3600)) ":")) ; else (setq time-in-web-mode-as-string (concat (int-to-string (/ time-in-web-mode 3600)) ":")) ) ; end if (if (< (% (/ time-in-web-mode 60) 60) 10) ; then (setq time-in-web-mode-as-string (concat time-in-web-mode-as-string "0" (int-to-string (% (/ time-in-web-mode 60) 60)) ":")) ; else (setq time-in-web-mode-as-string (concat time-in-web-mode-as-string (int-to-string (% (/ time-in-web-mode 60) 60)) ":")) ) ; end if (if (< (% (% time-in-web-mode 3600) 60) 10) ; then (setq time-in-web-mode-as-string (concat time-in-web-mode-as-string "0" (int-to-string (% (% time-in-web-mode 3600) 60)))) ; else (setq time-in-web-mode-as-string (concat time-in-web-mode-as-string (int-to-string (% (% time-in-web-mode 3600) 60)))) ) ; end if (insert "FINISH TIME : " stop-time "\n" "TOTAL TIME IN web-mode : " time-in-web-mode-as-string "\n" (make-string 79 ?\055) "\nINTERACTIVE FUNCTION USAGE\n") (while (< ctr (length web-interactive-functions)) (if (not (zerop (aref web-interactive-function-usage ctr))) (insert (make-string (- 4 (length (int-to-string (aref web-interactive-function-usage ctr)))) ? ) (int-to-string (aref web-interactive-function-usage ctr)) " " (nth ctr web-interactive-functions) "\n") ) ; end if (setq ctr (1+ ctr)) ) ; end while (write-region (point-min) (point-max) "web-mode.jou" t) ) ; end excursion ) ; end case ) ; end cond (setq ctr (web-binary-search-of-names web-interactive-functions (length web-interactive-functions) function-name (length function-name))) (if (>= ctr 0) ; then the function-name was interactive (aset web-interactive-function-usage ctr (1+ (aref web-interactive-function-usage ctr))) ; else the function was not found in the web-interactive-functions list (error "Function %s wasn't found" function-name) ) ; end if ) ; end let ) (defun web-mode () "This is the definition of the mode for manipulating Web documents. When invoked the function checks to see if the file that is being edited is new. If it is, limbo material is inserted. If the file is not new, the program checks for any undefined module names. If any modules are found to be undefined, stubs are appended. ARGUMENTS : None GLOBAL Variables : web-change-buffer-name, web-defined-in-used-in-location, web-location-of-module, web-module-names, web-number-of-lines-in-window, web-number-of-module-names, web-selected-index-entry-occurrences, web-buffer-name, web-default-directory, web-files, web-mode-map, and web-module-changed-then-goto-change LOCAL Variables : None RETURNS : Nothing USES : web-any-modules-undefined-initially, web-collect-list-of-changed-module-numbers, web-collect-module-names, web-initialize-location-of-module-vector, web-initialize-module-names-list, web-insert-limbo-material, and web-journal" (interactive) (kill-all-local-variables) (use-local-map web-mode-map) (setq major-mode 'Web-mode mode-name "Web") (auto-fill-mode 1) (setq web-change-buffer-name (concat (substring (buffer-name (current-buffer)) 0 (string-match "\\." (buffer-name (current-buffer)))) ".ch") web-defined-in-used-in-location -1 fill-column 70 web-location-of-module nil web-module-names nil web-number-of-lines-in-window (- (screen-height) 2) web-number-of-module-names 0 web-selected-index-entry-occurrences nil web-buffer-name (buffer-name (current-buffer)) web-default-directory default-directory web-files nil web-module-changed-then-goto-change nil ) ; end setq (web-journal "web-mode") (if (= (length (buffer-substring (point-min) (point-max))) 0) ; then (web-insert-limbo-material) ; else initialize the web-module-names list and ; check to see if any modules are undefined (save-excursion (goto-char (point-min)) (while (search-forward "\f" nil t) (replace-match "\n" t t) ) ; end while ) ; end excursion (web-initialize-location-of-module-vector) (if (and (file-readable-p (expand-file-name (concat (substring web-buffer-name 0 (string-match "\\." web-buffer-name)) ".mods"))) (file-newer-than-file-p (expand-file-name (concat (substring web-buffer-name 0 (string-match "\\." web-buffer-name)) ".mods")) (expand-file-name web-buffer-name)) ) ; end condition ; then (progn (message "Initializing the Module Names List...") (web-initialize-module-names-list) (message "Initializing the Module Names List...done") (sit-for 1) ) ; end then ; else (web-collect-module-names) ) ; end if (message "Checking to see if any modules are undefined...") (web-any-modules-undefined-initially) (message "Checking to see if any modules are undefined...done") (find-file-noselect web-change-buffer-name) (save-excursion (set-buffer web-change-buffer-name) (web-collect-list-of-changed-module-numbers) (setq major-mode 'Web-mode mode-name "Web") (use-local-map web-mode-map) ) ; end excursion ) ; end if ) (define-key (current-global-map) "\C-x\C-c" 'web-mode-save-buffers-kill-emacs) (defun web-mode-save-buffers-kill-emacs () "This function is used to replace Emacs' save-buffers-kill-emacs so that the journal file can be written. ARGUMENTS : None GLOBAL Variables : None LOCAL Variables : None RETURNS : Nothing USES : web-check-if-buffer-is-one-of-the-web-files, web-journal, and web-write-module-names-to-a-file" (interactive) (web-check-if-buffer-is-one-of-the-web-files) (web-journal "web-mode-save-buffers-kill-emacs") (web-write-module-names-to-a-file) (save-buffers-kill-emacs) ) (defun web-newline () "This function redefines the newline character so that the following line is indented like the previous one. ARGUMENTS : None GLOBAL Variables : None LOCAL Variable : ctr RETURNS : Nothing USES : web-journal" (interactive) (web-journal "web-newline") (let ((ctr 0)) (save-excursion (beginning-of-line) (while (looking-at " ") (setq ctr (1+ ctr)) (forward-char 1) ) ; end while ) ; end excursion (newline) (insert (make-string ctr ?\040)) ) ; end let ) (defun web-next-change () "Advances point to the beginning of the next change. ARGUMENTS : None GLOBAL Variable : web-change-buffer-name LOCAL Variable : start-position RETURNS : Nothing USES : goto-change and web-journal" (interactive) (web-journal "web-next-change") (if (not (string= web-change-buffer-name (buffer-name (current-buffer)))) ; then (error "Not in the CHange buffer.") ; else (let ((start-position (point))) (if (looking-at "^@x") (forward-char 2)) (if (re-search-forward "^@x" nil t) ; then (progn (re-search-forward "^@y" nil t) (goto-char (match-beginning 0)) (recenter 0) ) ; end then ; else there is no next change (goto-char start-position) (error "No next CHange.") ) ; end if ) ; end let ) ; end if ) (defun web-next-define () "This function is used to traverse the list of Defined In occurrences of the most recently selected module name in the forward direction. A module name is selected by issuing the command \\[web-view-module-names-list] and positioning the cursor on the line that contains the module name of interest. ARGUMENTS : None GLOBAL Variables : web-defined-in-occurrence, web-defined-in-used-in-location, and web-module-name-defined-in-used-in LOCAL Variable : buffer-to-be-returned-to and current-module RETURNS : Nothing USES : web-check-if-buffer-is-one-of-the-web-files, web-goto-module, web-next-or-previous-define-or-use, web-journal, and web-what-module" (interactive) (web-journal "web-next-define") (web-check-if-buffer-is-one-of-the-web-files) (cond ((string= (buffer-name (current-buffer)) "*Module Name (Defined In) (Used In)*") ; then the user needs to select an entry (let ((buffer-to-be-returned-to (web-next-or-previous-define-or-use "next" "defined-in"))) (if (>= web-defined-in-occurrence (length (car (cdr (nth web-defined-in-used-in-location web-module-name-defined-in-used-in))))) ; then there is no next define (progn (switch-to-buffer buffer-to-be-returned-to) (error "No next define of %s" (car (nth web-defined-in-used-in-location web-module-name-defined-in-used-in))) ) ; end then ; else (web-goto-module (nth web-defined-in-occurrence (car (cdr (nth web-defined-in-used-in-location web-module-name-defined-in-used-in))))) (message "Define %d of %d of %s" (1+ web-defined-in-occurrence) (length (car (cdr (nth web-defined-in-used-in-location web-module-name-defined-in-used-in)))) (car (nth web-defined-in-used-in-location web-module-name-defined-in-used-in))) ) ; end if ) ; end let ) ; end case (t ; we are in a valid Web buffer (if (= web-defined-in-used-in-location -1) (error (concat "No selected module. " "Execute M-x web-view-module-names-list to select.")) ; else (let ((current-module (web-what-module))) (setq web-defined-in-occurrence 0) (while (and (nth web-defined-in-occurrence (car (cdr (nth web-defined-in-used-in-location web-module-name-defined-in-used-in)))) (<= (nth web-defined-in-occurrence (car (cdr (nth web-defined-in-used-in-location web-module-name-defined-in-used-in)))) current-module) ) ; end and (setq web-defined-in-occurrence (1+ web-defined-in-occurrence)) ) ; end while (if (>= web-defined-in-occurrence (length (car (cdr (nth web-defined-in-used-in-location web-module-name-defined-in-used-in))))) ; then there is no next define (error "No next define of %s" (car (nth web-defined-in-used-in-location web-module-name-defined-in-used-in))) ; else (web-goto-module (nth web-defined-in-occurrence (car (cdr (nth web-defined-in-used-in-location web-module-name-defined-in-used-in))))) (message "Define %d of %d of %s" (1+ web-defined-in-occurrence) (length (car (cdr (nth web-defined-in-used-in-location web-module-name-defined-in-used-in)))) (car (nth web-defined-in-used-in-location web-module-name-defined-in-used-in))) ) ; end if ) ; end let ) ; end if ) ; end case ) ; end cond ) (defun web-next-index () "This function is used to traverse the list of occurrences of the most recently selected index entry in the forward direction. An index entry is selected by issuing the command \\[web-view-index] and positioning the cursor on the line that contains the index entry of interest. ARGUMENTS : None GLOBAL Variables : web-location-in-selected-index-entry-occurrences, web-selected-index-entry-occurrences, web-index-buffer-name, and web-index-entry LOCAL Variables : buffer-to-be-returned-to and current-module RETURNS : Nothing USES : web-check-if-buffer-is-one-of-the-web-files, web-goto-module, web-journal, web-next-or-previous-index, and web-what-module" (interactive) (web-journal "web-next-index") (web-check-if-buffer-is-one-of-the-web-files) (cond ((string-equal web-index-buffer-name (buffer-name (current-buffer))) ; then we are in the index (let ((buffer-to-be-returned-to (web-next-or-previous-index "next"))) (if (>= web-location-in-selected-index-entry-occurrences (length web-selected-index-entry-occurrences)) ; then there is no next use (progn (switch-to-buffer buffer-to-be-returned-to) (error "No next index reference for %s" web-index-entry) ) ; end then ; else (web-goto-module (nth web-location-in-selected-index-entry-occurrences web-selected-index-entry-occurrences)) (message "Index Reference %d of %d for entry %s" (1+ web-location-in-selected-index-entry-occurrences) (length web-selected-index-entry-occurrences) web-index-entry) ) ; end if ) ; end let ) ; end case (t ; else we are in a Web buffer (if (null web-selected-index-entry-occurrences) ; then (error "Issue the command M-x web-view-index to select an index entry.") ; else (let ((current-module (web-what-module))) (setq web-location-in-selected-index-entry-occurrences 0) (while (and (nth web-location-in-selected-index-entry-occurrences web-selected-index-entry-occurrences) (<= (nth web-location-in-selected-index-entry-occurrences web-selected-index-entry-occurrences) current-module) ) ; end and (setq web-location-in-selected-index-entry-occurrences (1+ web-location-in-selected-index-entry-occurrences)) ) ; end while (if (>= web-location-in-selected-index-entry-occurrences (length web-selected-index-entry-occurrences)) ; then (error "No next index reference for %s" web-index-entry) ; else (web-goto-module (nth web-location-in-selected-index-entry-occurrences web-selected-index-entry-occurrences)) (message "Index Reference %d of %d for entry %s" (1+ web-location-in-selected-index-entry-occurrences) (length web-selected-index-entry-occurrences) web-index-entry) ) ; end if ) ; end let ) ; end if ) ; end case ) ; end cond ) (defun web-next-module () "This function moves point to the beginning of the next module. If point is currently in the last module of the Web, an appropriate message is sent to the minibuffer; otherwise, point is positioned at the first line of the next module. ARGUMENTS : None GLOBAL Variables : None LOCAL Variable : current-module RETURNS : Nothing USES : web-check-if-buffer-is-one-of-the-web-files, web-count-modules, web-goto-module, web-journal, and web-what-module" (interactive) (web-journal "web-next-module") (web-check-if-buffer-is-one-of-the-web-files) (let ((current-module (web-what-module))) (if (>= current-module (web-count-modules)) ; then (error "No next module") ; else (web-goto-module (1+ current-module)) ) ; end if ) ; end let ) (defun web-next-or-previous-define-or-use (direction list) "This is an internal support function that is called by both \\[web-next-use] and \\[web-next-define]. It determines the module name that the cursor is currently located at. After the name has been isolated, it is looked up in the list of module names so that the traversal of the module name's Defined In and Used In lists can be done. ARGUMENTS : direction and list (both required) GLOBAL Variables : web-defined-in-occurrence, web-defined-in-used-in-location, web-module-names, web-number-of-module-names, web-selected-module-name, and web-used-in-occurrence LOCAL Variables : beginning-of-module-name, ctr, current-module, current-position, end-of-module-name, ptr, and web-buffer-list RETURNS : buffer to be returned to on error USES : web-binary-search-of-names, web-eliminate-white-space, and web-what-module" (let ((beginning-of-module-name 0) (ctr 1) (current-module 0) (current-position (point)) (end-of-module-name 0) (ptr 0) web-buffer-list ) (if (eobp) ; then (error "No module name can be selected from point's current position.") ) ; end if (save-excursion (setq current-position (point)) (beginning-of-line) (while (char-equal (string-to-char (buffer-substring (point) (1+ (point)))) ? ) (forward-line -1) ) ; end while (setq beginning-of-module-name (point)) (goto-char current-position) (forward-line 1) (while (and (not (eobp)) (char-equal (string-to-char (buffer-substring (point) (1+ (point)))) ? )) (forward-line 1) ) ; end while (backward-char 1) (setq end-of-module-name (point)) (goto-char end-of-module-name) (re-search-backward "(" beginning-of-module-name t 2) (setq web-selected-module-name (web-eliminate-white-space (buffer-substring beginning-of-module-name (1- (point))))) ; Set the global variable search-last-string so that the user can ; do a C-s C-s to go immediately to the selected module name. (setq search-last-string web-selected-module-name) (setq ptr (web-binary-search-of-names web-module-names web-number-of-module-names web-selected-module-name (length web-selected-module-name))) (setq web-defined-in-used-in-location (string-to-int (substring (nth ptr web-module-names) (+ (string-match " " (nth ptr web-module-names)) 2)))) (setq web-buffer-list (mapcar (function buffer-name) (buffer-list))) (setq ctr 1) (while (char-equal (string-to-char (substring (nth ctr web-buffer-list) 0 1)) ? ) (setq ctr (1+ ctr)) ) ; end while (save-excursion (set-buffer (nth ctr web-buffer-list)) (setq current-module (web-what-module)) ) ; end excursion (cond ((and (string= direction "next") (string= list "defined-in")) (setq web-defined-in-occurrence 0) (while (and (nth web-defined-in-occurrence (car (cdr (nth web-defined-in-used-in-location web-module-name-defined-in-used-in)))) (<= (nth web-defined-in-occurrence (car (cdr (nth web-defined-in-used-in-location web-module-name-defined-in-used-in)))) current-module) ) ; end and (setq web-defined-in-occurrence (1+ web-defined-in-occurrence)) ) ; end while ) ; end case ((and (string= direction "next") (string= list "used-in")) (setq web-used-in-occurrence 0) (while (and (nth web-used-in-occurrence (car (cdr (cdr (nth web-defined-in-used-in-location web-module-name-defined-in-used-in))))) (<= (nth web-used-in-occurrence (car (cdr (cdr (nth web-defined-in-used-in-location web-module-name-defined-in-used-in))))) current-module) ) ; end and (setq web-used-in-occurrence (1+ web-used-in-occurrence)) ) ; end while ) ; end case ((and (string= direction "previous") (string= list "defined-in")) (setq web-defined-in-occurrence (1- (length (car (cdr (nth web-defined-in-used-in-location web-module-name-defined-in-used-in)))))) (while (and (>= web-defined-in-occurrence 0) (>= (nth web-defined-in-occurrence (car (cdr (nth web-defined-in-used-in-location web-module-name-defined-in-used-in)))) current-module) ) ; end and (setq web-defined-in-occurrence (1- web-defined-in-occurrence)) ) ; end while ) ; end case ((and (string= direction "previous") (string= list "used-in")) (setq web-used-in-occurrence (1- (length (car (cdr (cdr (nth web-defined-in-used-in-location web-module-name-defined-in-used-in))))))) (while (and (>= web-used-in-occurrence 0) (>= (nth web-used-in-occurrence (car (cdr (cdr (nth web-defined-in-used-in-location web-module-name-defined-in-used-in))))) current-module) ) ; end and (setq web-used-in-occurrence (1- web-used-in-occurrence)) ) ; end while ) ; end case (t (error "This case should not be reached.") ) ; end case ) ; end cond ; return the name of the buffer to be returned to on error (nth ctr web-buffer-list) ) ; end excursion ) ; end let ) (defun web-next-or-previous-index (direction) "This is an internal support function used by \\[web-next-index] and \\[web-previous-index]. This is common code and is only invoked when the user is viewing the index. This code determines the entry the user has selected and builds a list of the referenced module numbers for the selected index entry. ARGUMENT : direction (required) GLOBAL Variables : web-location-in-selected-index-entry-occurrences, web-selected-index-entry-occurrences, and web-index-entry LOCAL Variables : ctr, current-module, end-of-web-index-entry, and web-buffer-list RETURNS : the name of the buffer to return on an error USES : web-what-module" (let ((ctr 1) (current-module 0) (end-of-web-index-entry 0) web-buffer-list ) (if (eobp) ; then (error "No index entry can be selected from this position.") ) ; end if (save-excursion (beginning-of-line) (while (looking-at " ") (forward-line -1)) (setq web-index-entry (buffer-substring (point) (save-excursion (re-search-forward ": ") (- (point) 2)))) ; Set the global Emacs variable search-last-string to the index ; entry selected by the user so that the user can use C-s C-s to ; get to the entry much easier. (setq search-last-string web-index-entry) (save-excursion (re-search-forward "\\.\n" nil t) (setq end-of-web-index-entry (point)) ) ; end excursion (while (re-search-forward "\\([0-9]+\\)\\*?\\(, \\|,\n\\|\\.\n\\)" end-of-web-index-entry t) (setq web-selected-index-entry-occurrences (append web-selected-index-entry-occurrences (list (string-to-int (buffer-substring (match-beginning 1) (match-end 1)))))) ) ; end while ) ; end excursion (setq web-buffer-list (mapcar (function buffer-nam