12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060 |
- (defgroup forms nil
- "Edit a file as a form to fill in."
- :group 'data)
- (provide 'forms)
- (provide 'forms-mode)
- (defcustom forms-mode-hook nil
- "Hook run upon entering Forms mode."
- :group 'forms
- :type 'hook)
- (defvar forms-file nil
- "Name of the file holding the data.")
- (defvar forms-format-list nil
- "List of formatting specifications.")
- (defvar forms-number-of-fields nil
- "Number of fields per record.")
- (defcustom forms-check-number-of-fields t
- "If non-nil, warn about records with wrong number of fields."
- :group 'forms
- :type 'boolean)
- (defvar forms-field-sep "\t"
- "Field separator character (default TAB).")
- (defvar forms-read-only nil
- "Non-nil means: visit the file in view (read-only) mode.
- This is set automatically if the file permissions don't let you write it.")
- (defvar forms-multi-line "\C-k" "\
- If not nil: use this character to separate multi-line fields (default C-k).")
- (defcustom forms-forms-scroll nil
- "Non-nil means replace scroll-up/down commands in Forms mode.
- The replacement commands performs forms-next/prev-record."
- :group 'forms
- :type 'boolean)
- (defcustom forms-forms-jump nil
- "Non-nil means redefine beginning/end-of-buffer in Forms mode.
- The replacement commands performs forms-first/last-record."
- :group 'forms
- :type 'boolean)
- (defvar forms-read-file-filter nil
- "The name of a function that is called after reading the data file.
- This can be used to change the contents of the file to something more
- suitable for forms processing.")
- (defvar forms-write-file-filter nil
- "The name of a function that is called before writing the data file.
- This can be used to undo the effects of `form-read-file-hook'.")
- (defvar forms-new-record-filter nil
- "The name of a function that is called when a new record is created.")
- (defvar forms-modified-record-filter nil
- "The name of a function that is called when a record has been modified.")
- (defvar forms-fields nil
- "List with fields of the current forms. First field has number 1.
- This variable is for use by the filter routines only.
- The contents may NOT be modified.")
- (defcustom forms-use-text-properties t
- "Non-nil means: use text properties.
- Defaults to t if this Emacs is capable of handling text properties."
- :group 'forms
- :type 'boolean)
- (defcustom forms-insert-after nil
- "Non-nil means: inserts of new records go after current record.
- Also, initial position is at last record."
- :group 'forms
- :type 'boolean)
- (defcustom forms-ro-face 'default
- "The face (a symbol) that is used to display read-only text on the screen."
- :group 'forms
- :type 'face)
- (defcustom forms-rw-face 'region
- "The face (a symbol) that is used to display read-write text on the screen."
- :group 'forms
- :type 'face)
- (defvar forms--file-buffer nil
- "Buffer which holds the file data")
- (defvar forms--total-records 0
- "Total number of records in the data file.")
- (defvar forms--current-record 0
- "Number of the record currently on the screen.")
- (defvar forms-mode-map nil
- "Keymap for form buffer.")
- (defvar forms-mode-ro-map nil
- "Keymap for form buffer in view mode.")
- (defvar forms-mode-edit-map nil
- "Keymap for form buffer in edit mode.")
- (defvar forms--markers nil
- "Field markers in the screen.")
- (defvar forms--dyntexts nil
- "Dynamic texts (resulting from function calls) on the screen.")
- (defvar forms--the-record-list nil
- "List of strings of the current record, as parsed from the file.")
- (defvar forms--search-regexp nil
- "Last regexp used by forms-search functions.")
- (defvar forms--format nil
- "Formatting routine.")
- (defvar forms--parser nil
- "Forms parser routine.")
- (defvar forms--mode-setup nil
- "To keep track of forms-mode being set-up.")
- (make-variable-buffer-local 'forms--mode-setup)
- (defvar forms--dynamic-text nil
- "Array that holds dynamic texts to insert between fields.")
- (defvar forms--elements nil
- "Array with the order in which the fields are displayed.")
- (defvar forms--ro-face nil
- "Face used to represent read-only data on the screen.")
- (defvar forms--rw-face nil
- "Face used to represent read-write data on the screen.")
- (defun forms-mode (&optional primary)
- "Major mode to visit files in a field-structured manner using a form.
- Commands: Equivalent keys in read-only mode:
- TAB forms-next-field TAB
- C-c TAB forms-next-field
- C-c < forms-first-record <
- C-c > forms-last-record >
- C-c ? describe-mode ?
- C-c C-k forms-delete-record
- C-c C-q forms-toggle-read-only q
- C-c C-o forms-insert-record
- C-c C-l forms-jump-record l
- C-c C-n forms-next-record n
- C-c C-p forms-prev-record p
- C-c C-r forms-search-reverse r
- C-c C-s forms-search-forward s
- C-c C-x forms-exit x
- "
- (interactive)
-
-
-
-
-
-
-
-
-
-
-
- (if (or primary (not forms--mode-setup))
- (progn
-
- (kill-all-local-variables)
-
- (make-local-variable 'forms-file)
- (make-local-variable 'forms-number-of-fields)
- (make-local-variable 'forms-format-list)
-
- (make-local-variable 'forms-field-sep)
- (make-local-variable 'forms-read-only)
- (make-local-variable 'forms-multi-line)
- (make-local-variable 'forms-forms-scroll)
- (make-local-variable 'forms-forms-jump)
- (make-local-variable 'forms-insert-after)
- (make-local-variable 'forms-use-text-properties)
-
- (make-local-variable 'forms-read-file-filter)
- (make-local-variable 'forms-write-file-filter)
- (make-local-variable 'forms-new-record-filter)
- (make-local-variable 'forms-modified-record-filter)
-
- (setq forms-read-file-filter nil)
- (setq forms-write-file-filter nil)
- (setq forms-new-record-filter nil)
- (setq forms-modified-record-filter nil)
-
-
- (if (fboundp 'make-face)
- (progn
- (make-local-variable 'forms-ro-face)
- (make-local-variable 'forms-rw-face)))
-
-
-
- (if (or (eq enable-local-eval t)
- (yes-or-no-p
- (concat "Evaluate lisp code in buffer "
- (buffer-name) " to display forms? ")))
- (eval-buffer)
- (error "`enable-local-eval' inhibits buffer evaluation"))
-
- (or forms-file
- (error (concat "Forms control file error: "
- "`forms-file' has not been set")))
-
-
- (or (stringp forms-field-sep)
- (error (concat "Forms control file error: "
- "`forms-field-sep' is not a string")))
- (if forms-number-of-fields
- (or (and (numberp forms-number-of-fields)
- (> forms-number-of-fields 0))
- (error (concat "Forms control file error: "
- "`forms-number-of-fields' must be a number > 0")))
- (or (null forms-format-list)
- (error (concat "Forms control file error: "
- "`forms-number-of-fields' has not been set"))))
- (or forms-format-list
- (forms--intuit-from-file))
- (if forms-multi-line
- (if (and (stringp forms-multi-line)
- (eq (length forms-multi-line) 1))
- (if (string= forms-multi-line forms-field-sep)
- (error (concat "Forms control file error: "
- "`forms-multi-line' is equal to `forms-field-sep'")))
- (error (concat "Forms control file error: "
- "`forms-multi-line' must be nil or a one-character string"))))
- (or (fboundp 'set-text-properties)
- (setq forms-use-text-properties nil))
-
-
- (make-local-variable 'forms--elements)
- (forms--process-format-list)
-
-
- (make-local-variable 'forms--format)
- (make-local-variable 'forms--markers)
- (make-local-variable 'forms--dyntexts)
-
- (forms--make-format)
- (make-local-variable 'forms--parser)
- (forms--make-parser)
-
-
- (if (and forms-new-record-filter
- (not (fboundp forms-new-record-filter)))
- (error (concat "Forms control file error: "
- "`forms-new-record-filter' is not a function")))
- (if (and forms-modified-record-filter
- (not (fboundp forms-modified-record-filter)))
- (error (concat "Forms control file error: "
- "`forms-modified-record-filter' is not a function")))
-
- (make-local-variable 'forms-fields)
-
- (make-local-variable 'forms--dynamic-text)
-
- (set-visited-file-name nil)
-
- (setq buffer-read-only nil)
- (erase-buffer)
-
- ))
-
- (setq forms--mode-setup t)
-
- (if (fboundp 'make-face)
- (progn
- (make-local-variable 'forms--ro-face)
- (make-local-variable 'forms--rw-face)
- (if forms-read-only
- (progn
- (setq forms--ro-face forms-ro-face)
- (setq forms--rw-face forms-ro-face))
- (setq forms--ro-face forms-ro-face)
- (setq forms--rw-face forms-rw-face))))
-
- (make-local-variable 'forms--file-buffer)
- (make-local-variable 'forms--total-records)
- (make-local-variable 'forms--current-record)
- (make-local-variable 'forms--the-record-list)
- (make-local-variable 'forms--search-regexp)
-
-
-
-
- (if forms-mode-map
- nil
-
- (forms--mode-commands)
-
- )
-
- (setq major-mode 'forms-mode)
- (setq mode-name "Forms")
-
- (setq forms--file-buffer (find-file-noselect forms-file))
-
- (let ((read-file-filter forms-read-file-filter)
- (write-file-filter forms-write-file-filter))
- (if read-file-filter
- (with-current-buffer forms--file-buffer
- (let ((inhibit-read-only t)
- (file-modified (buffer-modified-p)))
- (run-hooks 'read-file-filter)
- (if (not file-modified) (set-buffer-modified-p nil)))
- (if write-file-filter
- (add-hook 'write-file-functions write-file-filter nil t)))
- (if write-file-filter
- (with-current-buffer forms--file-buffer
- (add-hook 'write-file-functions write-file-filter nil t)))))
-
- (let (ro)
- (setq forms--total-records
- (with-current-buffer forms--file-buffer
- (prog1
- (progn
-
- (bury-buffer (current-buffer))
- (setq ro buffer-read-only)
- (count-lines (point-min) (point-max)))
-
- )))
- (if ro
- (setq forms-read-only t)))
-
-
-
-
- (make-local-variable 'minor-mode-alist)
- (setq minor-mode-alist (list (list 'forms-read-only " View")))
-
- (forms--set-keymaps)
-
- (forms--change-commands)
-
- (set-buffer-modified-p nil)
- (if (= forms--total-records 0)
-
- (progn
- (insert
- "GNU Emacs Forms Mode\n\n"
- (if (file-exists-p forms-file)
- (concat "No records available in file `" forms-file "'\n\n")
- (format "Creating new file `%s'\nwith %d field%s per record\n\n"
- forms-file forms-number-of-fields
- (if (= 1 forms-number-of-fields) "" "s")))
- "Use " (substitute-command-keys "\\[forms-insert-record]")
- " to create new records.\n")
- (setq forms--current-record 1)
- (setq buffer-read-only t)
- (set-buffer-modified-p nil))
-
- (if (< forms--current-record 1)
- (setq forms--current-record 1))
- (forms-jump-record forms--current-record)
- (if forms-insert-after
- (forms-last-record)
- (forms-first-record))
- )
-
-
- (run-mode-hooks 'forms-mode-hook 'forms-mode-hooks)
-
-
- (forms--help)
- )
- (defun forms--process-format-list ()
-
-
-
-
-
-
-
-
-
-
-
- (or forms-format-list
- (error (concat "Forms control file error: "
- "`forms-format-list' has not been set")))
-
- (or (listp forms-format-list)
- (error (concat "Forms control file error: "
- "`forms-format-list' is not a list")))
-
-
- (setq forms--elements (make-vector forms-number-of-fields nil))
- (let ((the-list forms-format-list)
- (prev-item nil)
- (field-num 0))
- (setq forms-format-list nil)
- (while the-list
- (let ((el (car-safe the-list))
- (rem (cdr-safe the-list)))
-
- (if (and (symbolp el)
- (boundp el))
- (setq el (eval el)))
- (cond
-
- ((stringp el)
- (if (stringp prev-item)
- (setq prev-item (concat prev-item el))
- (if prev-item
- (setq forms-format-list
- (append forms-format-list (list prev-item) nil)))
- (setq prev-item el)))
-
- ((numberp el)
-
- (if (or (<= el 0)
- (> el forms-number-of-fields))
- (error (concat "Forms format error: "
- "field number %d out of range 1..%d")
- el forms-number-of-fields))
-
- (if (>= field-num (length forms--elements))
- (setq forms--elements (vconcat forms--elements (1- el)))
- (aset forms--elements field-num (1- el)))
- (setq field-num (1+ field-num))
- (if prev-item
- (setq forms-format-list
- (append forms-format-list (list prev-item) nil)))
- (setq prev-item el))
-
- ((listp el)
-
- (or (fboundp (car-safe el))
- (error (concat "Forms format error: "
- "%S is not a function")
- (car-safe el)))
-
- (if prev-item
- (setq forms-format-list
- (append forms-format-list (list prev-item) nil)))
- (setq prev-item el))
-
- (t
- (error (concat "Forms format error: "
- "invalid element %S")
- el)))
-
- (setq the-list rem)))
-
- (if prev-item
- (progn
- (setq forms-format-list
- (append forms-format-list (list prev-item) nil))
-
-
-
- (if (numberp prev-item)
- (setq forms-format-list
- (append forms-format-list (list "\n") nil))))))
- (forms--debug 'forms-format-list
- 'forms--elements))
- (defvar forms--iif-start nil
- "Record start of modification command.")
- (defvar forms--iif-properties nil
- "Original properties of the character being overridden.")
- (defun forms--iif-hook (_begin _end)
- "`insert-in-front-hooks' function for read-only segments."
-
-
-
- (or forms--iif-start
- (setq forms--iif-start (copy-marker (1+ (point)))))
-
- (if (or (<= forms--iif-start 2)
- (get-text-property (- forms--iif-start 2)
- 'read-only))
- (progn
-
- (setq forms--iif-properties
- (text-properties-at (1- forms--iif-start)))
-
- (let ((inhibit-read-only t))
- (set-text-properties
- (1- forms--iif-start) forms--iif-start
- (list 'face forms--rw-face 'front-sticky '(face))))
-
- (setq post-command-hook
- (append (list 'forms--iif-post-command-hook) post-command-hook)))
-
- (setq forms--iif-start nil)))
- (defun forms--iif-post-command-hook ()
- "`post-command-hook' function for read-only segments."
-
- (setq post-command-hook
- (delq 'forms--iif-hook-post-command-hook post-command-hook))
-
- (if forms--iif-start
- (let ((inhibit-read-only t))
- (set-text-properties
- (1- forms--iif-start) forms--iif-start
- forms--iif-properties)))
-
- (setq forms--iif-start nil))
- (defvar forms--marker)
- (defvar forms--dyntext)
- (defun forms--make-format ()
- "Generate `forms--format' using the information in `forms-format-list'."
-
-
-
-
- (let ((forms--marker 0)
- (forms--dyntext 0))
- (setq
- forms--format
- (if forms-use-text-properties
- `(lambda (arg)
- (let ((inhibit-read-only t))
- ,@(apply 'append
- (mapcar 'forms--make-format-elt-using-text-properties
- forms-format-list))
-
- ,@(if (numberp (car forms-format-list))
- nil
- '((add-text-properties (point-min) (1+ (point-min))
- '(front-sticky (read-only intangible)))))
-
- (remove-text-properties (1- (point)) (point)
- '(rear-nonsticky)))
- (setq forms--iif-start nil))
- `(lambda (arg)
- ,@(apply 'append
- (mapcar 'forms--make-format-elt forms-format-list)))))
-
-
- (setq forms--markers (make-vector forms--marker nil))
- (setq forms--dyntexts (make-vector forms--dyntext nil)))
- (forms--debug 'forms--format))
- (defun forms--make-format-elt-using-text-properties (el)
- "Helper routine to generate format function."
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
- (cond
- ((stringp el)
- `((set-text-properties
- (point)
- (progn
- (insert ,el)
- (point))
- (list 'face forms--ro-face
- 'read-only ,@(list (1+ forms--marker))
- 'intangible ,@(list (1+ forms--marker))
- 'insert-in-front-hooks '(forms--iif-hook)
- 'rear-nonsticky '(face read-only insert-in-front-hooks
- intangible)))))
- ((numberp el)
- `((let ((here (point)))
- (aset forms--markers
- ,(prog1 forms--marker
- (setq forms--marker (1+ forms--marker)))
- (point-marker))
- (insert (elt arg ,(1- el)))
- (or (= (point) here)
- (set-text-properties
- here (point)
- (list 'face forms--rw-face
- 'front-sticky '(face)))))))
- ((listp el)
- `((set-text-properties
- (point)
- (progn
- (insert (aset forms--dyntexts
- ,(prog1 forms--dyntext
- (setq forms--dyntext (1+ forms--dyntext)))
- ,el))
- (point))
- (list 'face forms--ro-face
- 'read-only ,@(list (1+ forms--marker))
- 'intangible ,@(list (1+ forms--marker))
- 'insert-in-front-hooks '(forms--iif-hook)
- 'rear-nonsticky '(read-only face insert-in-front-hooks
- intangible)))))
-
- ))
- (defun forms--make-format-elt (el)
- "Helper routine to generate format function."
-
-
-
-
-
-
-
-
-
-
-
-
-
-
- (cond
- ((stringp el)
- `((insert ,el)))
- ((numberp el)
- (prog1
- `((aset forms--markers ,forms--marker (point-marker))
- (insert (elt arg ,(1- el))))
- (setq forms--marker (1+ forms--marker))))
- ((listp el)
- (prog1
- `((insert (aset forms--dyntexts ,forms--dyntext ,el)))
- (setq forms--dyntext (1+ forms--dyntext))))))
- (defvar forms--field)
- (defvar forms--recordv)
- (defvar forms--seen-text)
- (defun forms--make-parser ()
- "Generate `forms--parser' from the information in `forms-format-list'."
-
-
-
-
- (setq
- forms--parser
- (if forms-use-text-properties
- (function forms--parser-using-text-properties)
- (let ((forms--field nil)
- (forms--seen-text nil)
- (forms--dyntext 0))
-
-
- `(lambda nil
- (let (here)
- (goto-char (point-min))
- ,@(apply 'append
- (mapcar
- 'forms--make-parser-elt
- (append forms-format-list (list nil)))))))))
- (forms--debug 'forms--parser))
- (defun forms--parser-using-text-properties ()
- "Extract field info from forms when using text properties."
-
-
- (let ((i 0)
- here there)
- (while (< i (length forms--markers))
- (goto-char (setq here (aref forms--markers i)))
- (if (get-text-property here 'read-only)
- (aset forms--recordv (aref forms--elements i) nil)
- (if (setq there
- (next-single-property-change here 'read-only))
- (aset forms--recordv (aref forms--elements i)
- (buffer-substring-no-properties here there))
- (aset forms--recordv (aref forms--elements i)
- (buffer-substring-no-properties here (point-max)))))
- (setq i (1+ i)))))
- (defun forms--make-parser-elt (el)
- "Helper routine to generate forms parser function."
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
- (cond
- ((stringp el)
- (prog1
- (if forms--field
- `((setq here (point))
- (if (not (search-forward ,el nil t nil))
- (error "Parse error: cannot find `%s'" ,el))
- (aset forms--recordv ,(1- forms--field)
- (buffer-substring-no-properties here
- (- (point) ,(length el)))))
- `((if (not (looking-at ,(regexp-quote el)))
- (error "Parse error: not looking at `%s'" ,el))
- (forward-char ,(length el))))
- (setq forms--seen-text t)
- (setq forms--field nil)))
- ((numberp el)
- (if forms--field
- (error "Cannot parse adjacent fields %d and %d"
- forms--field el)
- (setq forms--field el)
- nil))
- ((null el)
- (if forms--field
- `((aset forms--recordv ,(1- forms--field)
- (buffer-substring-no-properties (point) (point-max))))))
- ((listp el)
- (prog1
- (if forms--field
- `((let ((here (point))
- (forms--dyntext (aref forms--dyntexts ,forms--dyntext)))
- (if (not (search-forward forms--dyntext nil t nil))
- (error "Parse error: cannot find `%s'" forms--dyntext))
- (aset forms--recordv ,(1- forms--field)
- (buffer-substring-no-properties here
- (- (point) (length forms--dyntext))))))
- `((let ((forms--dyntext (aref forms--dyntexts ,forms--dyntext)))
- (if (not (looking-at (regexp-quote forms--dyntext)))
- (error "Parse error: not looking at `%s'" forms--dyntext))
- (forward-char (length forms--dyntext)))))
- (setq forms--dyntext (1+ forms--dyntext))
- (setq forms--seen-text t)
- (setq forms--field nil)))
- ))
- (defvar read-file-filter)
- (defun forms--intuit-from-file ()
- "Get number of fields and a default form using the data file."
-
- (if (null forms-number-of-fields)
-
- (if (not (file-exists-p forms-file))
- (error "Need existing file or explicit `forms-number-of-fields'")
-
- (setq forms--file-buffer (find-file-noselect forms-file))
- (let ((read-file-filter forms-read-file-filter)
- (the-record))
- (setq the-record
- (with-current-buffer forms--file-buffer
- (let ((inhibit-read-only t))
- (run-hooks 'read-file-filter))
- (goto-char (point-min))
- (forms--get-record)))
-
-
- (kill-buffer forms--file-buffer)
-
- (let ((start-pos 0)
- found-pos
- (field-sep-length (length forms-field-sep)))
- (setq forms-number-of-fields 1)
- (while (setq found-pos
- (string-match forms-field-sep the-record start-pos))
- (progn
- (setq forms-number-of-fields (1+ forms-number-of-fields))
- (setq start-pos (+ field-sep-length found-pos))))))))
-
- (setq forms-format-list (list "Forms file \"" forms-file "\".\n\n"))
- (let ((i 0))
- (while (<= (setq i (1+ i)) forms-number-of-fields)
- (setq forms-format-list
- (append forms-format-list
- (list (format "%4d: " i) i "\n"))))))
- (defun forms--set-keymaps ()
- "Set the keymaps used in this mode."
- (use-local-map (if forms-read-only
- forms-mode-ro-map
- forms-mode-edit-map)))
- (defun forms--mode-commands ()
- "Fill the Forms mode keymaps."
-
- (setq forms-mode-map (make-keymap))
- (define-key forms-mode-map "\t" 'forms-next-field)
- (define-key forms-mode-map "\C-k" 'forms-delete-record)
- (define-key forms-mode-map "\C-q" 'forms-toggle-read-only)
- (define-key forms-mode-map "\C-o" 'forms-insert-record)
- (define-key forms-mode-map "\C-l" 'forms-jump-record)
- (define-key forms-mode-map "\C-n" 'forms-next-record)
- (define-key forms-mode-map "\C-p" 'forms-prev-record)
- (define-key forms-mode-map "\C-r" 'forms-search-backward)
- (define-key forms-mode-map "\C-s" 'forms-search-forward)
- (define-key forms-mode-map "\C-x" 'forms-exit)
- (define-key forms-mode-map "<" 'forms-first-record)
- (define-key forms-mode-map ">" 'forms-last-record)
- (define-key forms-mode-map "\C-?" 'forms-prev-record)
-
- (setq forms-mode-ro-map (make-keymap))
- (suppress-keymap forms-mode-ro-map)
- (define-key forms-mode-ro-map "\C-c" forms-mode-map)
- (define-key forms-mode-ro-map "q" 'forms-toggle-read-only)
- (define-key forms-mode-ro-map "l" 'forms-jump-record)
- (define-key forms-mode-ro-map "n" 'forms-next-record)
- (define-key forms-mode-ro-map "p" 'forms-prev-record)
- (define-key forms-mode-ro-map "r" 'forms-search-backward)
- (define-key forms-mode-ro-map "s" 'forms-search-forward)
- (define-key forms-mode-ro-map "x" 'forms-exit)
- (define-key forms-mode-ro-map "<" 'forms-first-record)
- (define-key forms-mode-ro-map ">" 'forms-last-record)
- (define-key forms-mode-ro-map "?" 'describe-mode)
- (define-key forms-mode-ro-map " " 'forms-next-record)
- (forms--mode-commands1 forms-mode-ro-map)
- (forms--mode-menu-ro forms-mode-ro-map)
-
- (setq forms-mode-edit-map (make-keymap))
- (define-key forms-mode-edit-map "\C-c" forms-mode-map)
- (forms--mode-commands1 forms-mode-edit-map)
- (forms--mode-menu-edit forms-mode-edit-map)
- )
- (defun forms--mode-menu-ro (map)
- (define-key map [menu-bar forms]
- (cons "Forms" (make-sparse-keymap "Forms")))
- (define-key map [menu-bar forms menu-forms-exit]
- '("Exit Forms Mode" . forms-exit))
- (define-key map [menu-bar forms menu-forms-sep1]
- '("----"))
- (define-key map [menu-bar forms menu-forms-save]
- '("Save Data" . forms-save-buffer))
- (define-key map [menu-bar forms menu-forms-print]
- '("Print Data" . forms-print))
- (define-key map [menu-bar forms menu-forms-describe]
- '("Describe Mode" . describe-mode))
- (define-key map [menu-bar forms menu-forms-toggle-ro]
- '("Toggle View/Edit" . forms-toggle-read-only))
- (define-key map [menu-bar forms menu-forms-jump-record]
- '("Jump" . forms-jump-record))
- (define-key map [menu-bar forms menu-forms-search-backward]
- '("Search Backward" . forms-search-backward))
- (define-key map [menu-bar forms menu-forms-search-forward]
- '("Search Forward" . forms-search-forward))
- (define-key map [menu-bar forms menu-forms-delete-record]
- '("Delete" . forms-delete-record))
- (define-key map [menu-bar forms menu-forms-insert-record]
- '("Insert" . forms-insert-record))
- (define-key map [menu-bar forms menu-forms-sep2]
- '("----"))
- (define-key map [menu-bar forms menu-forms-last-record]
- '("Last Record" . forms-last-record))
- (define-key map [menu-bar forms menu-forms-first-record]
- '("First Record" . forms-first-record))
- (define-key map [menu-bar forms menu-forms-prev-record]
- '("Previous Record" . forms-prev-record))
- (define-key map [menu-bar forms menu-forms-next-record]
- '("Next Record" . forms-next-record))
- (define-key map [menu-bar forms menu-forms-sep3]
- '("----"))
- (define-key map [menu-bar forms menu-forms-prev-field]
- '("Previous Field" . forms-prev-field))
- (define-key map [menu-bar forms menu-forms-next-field]
- '("Next Field" . forms-next-field))
- (put 'forms-insert-record 'menu-enable '(not forms-read-only))
- (put 'forms-delete-record 'menu-enable '(not forms-read-only))
- )
- (defun forms--mode-menu-edit (map)
- (define-key map [menu-bar forms]
- (cons "Forms" (make-sparse-keymap "Forms")))
- (define-key map [menu-bar forms menu-forms-edit--exit]
- '("Exit" . forms-exit))
- (define-key map [menu-bar forms menu-forms-edit-sep1]
- '("----"))
- (define-key map [menu-bar forms menu-forms-edit-save]
- '("Save Data" . forms-save-buffer))
- (define-key map [menu-bar forms menu-forms-edit-print]
- '("Print Data" . forms-print))
- (define-key map [menu-bar forms menu-forms-edit-describe]
- '("Describe Mode" . describe-mode))
- (define-key map [menu-bar forms menu-forms-edit-toggle-ro]
- '("Toggle View/Edit" . forms-toggle-read-only))
- (define-key map [menu-bar forms menu-forms-edit-jump-record]
- '("Jump" . forms-jump-record))
- (define-key map [menu-bar forms menu-forms-edit-search-backward]
- '("Search Backward" . forms-search-backward))
- (define-key map [menu-bar forms menu-forms-edit-search-forward]
- '("Search Forward" . forms-search-forward))
- (define-key map [menu-bar forms menu-forms-edit-delete-record]
- '("Delete" . forms-delete-record))
- (define-key map [menu-bar forms menu-forms-edit-insert-record]
- '("Insert" . forms-insert-record))
- (define-key map [menu-bar forms menu-forms-edit-sep2]
- '("----"))
- (define-key map [menu-bar forms menu-forms-edit-last-record]
- '("Last Record" . forms-last-record))
- (define-key map [menu-bar forms menu-forms-edit-first-record]
- '("First Record" . forms-first-record))
- (define-key map [menu-bar forms menu-forms-edit-prev-record]
- '("Previous Record" . forms-prev-record))
- (define-key map [menu-bar forms menu-forms-edit-next-record]
- '("Next Record" . forms-next-record))
- (define-key map [menu-bar forms menu-forms-edit-sep3]
- '("----"))
- (define-key map [menu-bar forms menu-forms-edit-prev-field]
- '("Previous Field" . forms-prev-field))
- (define-key map [menu-bar forms menu-forms-edit-next-field]
- '("Next Field" . forms-next-field))
- (put 'forms-insert-record 'menu-enable '(not forms-read-only))
- (put 'forms-delete-record 'menu-enable '(not forms-read-only))
- )
- (defun forms--mode-commands1 (map)
- "Helper routine to define keys."
- (define-key map "\t" 'forms-next-field)
- (define-key map [S-tab] 'forms-prev-field)
- (define-key map [next] 'forms-next-record)
- (define-key map [prior] 'forms-prev-record)
- (define-key map [begin] 'forms-first-record)
- (define-key map [last] 'forms-last-record)
- (define-key map [backtab] 'forms-prev-field)
- )
- (defun forms--change-commands ()
- "Localize some commands for Forms mode."
-
-
- (if forms-forms-scroll
- (progn
- (local-set-key [remap scroll-up] 'forms-next-record)
- (local-set-key [remap scroll-down] 'forms-prev-record)
- (local-set-key [remap scroll-up-command] 'forms-next-record)
- (local-set-key [remap scroll-down-command] 'forms-prev-record)))
-
-
-
- (if forms-forms-jump
- (progn
- (local-set-key [remap beginning-of-buffer] 'forms-first-record)
- (local-set-key [remap end-of-buffer] 'forms-last-record)))
-
-
- (local-set-key "\C-x\C-s" 'forms-save-buffer)
-
-
- (make-local-variable 'revert-buffer-function)
- (setq revert-buffer-function 'forms--revert-buffer)
- t)
- (defun forms--help ()
- "Initial help for Forms mode."
- (message "%s" (substitute-command-keys (concat
- "\\[forms-next-record]:next"
- " \\[forms-prev-record]:prev"
- " \\[forms-first-record]:first"
- " \\[forms-last-record]:last"
- " \\[describe-mode]:help"))))
- (defun forms--trans (subj arg rep)
- "Translate in SUBJ all chars ARG into char REP. ARG and REP should
- be single-char strings."
- (let ((i 0)
- (re (regexp-quote arg))
- (k (string-to-char rep)))
- (while (setq i (string-match re subj i))
- (aset subj i k)
- (setq i (1+ i)))))
- (defun forms--exit (&optional save)
- "Internal exit from forms mode function."
- (let ((buf (buffer-name forms--file-buffer)))
- (forms--checkmod)
- (if (and save
- (buffer-modified-p forms--file-buffer))
- (forms-save-buffer))
- (with-current-buffer forms--file-buffer
- (delete-auto-save-file-if-necessary)
- (kill-buffer (current-buffer)))
- (if (get-buffer buf)
- (if save
- (error "Problem saving buffer %s" (buffer-name buf)))
- (delete-auto-save-file-if-necessary)
- (kill-buffer (current-buffer)))))
- (defun forms--get-record ()
- "Fetch the current record from the file buffer."
-
- (or (bolp)
- (beginning-of-line nil))
- (let ((here (point)))
- (prog2
- (end-of-line)
- (buffer-substring-no-properties here (point))
- (goto-char here))))
- (defun forms--show-record (the-record)
- "Format THE-RECORD and display it in the current buffer."
-
- (let (the-result
- (start-pos 0)
- found-pos
- (field-sep-length (length forms-field-sep)))
- (if forms-multi-line
- (forms--trans the-record forms-multi-line "\n"))
-
- (setq the-record (concat the-record forms-field-sep))
- (while (setq found-pos (string-match forms-field-sep the-record start-pos))
- (let ((ent (substring the-record start-pos found-pos)))
- (setq the-result
- (append the-result (list ent)))
- (setq start-pos (+ field-sep-length found-pos))))
- (setq forms--the-record-list the-result))
- (setq buffer-read-only nil)
- (if forms-use-text-properties
- (let ((inhibit-read-only t))
- (set-text-properties (point-min) (point-max) nil)))
- (erase-buffer)
-
- (if (= (length forms--the-record-list) forms-number-of-fields)
- nil
- (if (null forms-check-number-of-fields)
- nil
- (message "Warning: this record has %d fields instead of %d"
- (length forms--the-record-list) forms-number-of-fields))
- (if (< (length forms--the-record-list) forms-number-of-fields)
- (setq forms--the-record-list
- (append forms--the-record-list
- (make-list
- (- forms-number-of-fields
- (length forms--the-record-list))
- "")))))
-
- (setq forms-fields (append (list nil) forms--the-record-list nil))
- (funcall forms--format forms--the-record-list)
-
- (goto-char (point-min))
- (set-buffer-modified-p nil)
- (setq buffer-read-only forms-read-only)
- (setq mode-line-process
- (concat " " (int-to-string forms--current-record)
- "/" (int-to-string forms--total-records))))
- (defun forms--parse-form ()
- "Parse contents of form into list of strings."
-
-
-
-
-
-
- (let (forms--recordv)
-
- (setq forms--recordv (vconcat forms--the-record-list))
-
- (let ((forms--dynamic-text forms--dynamic-text))
- (funcall forms--parser))
- (if forms-modified-record-filter
-
-
- (let ((the-fields (vconcat [nil] forms--recordv)))
- (setq the-fields (funcall forms-modified-record-filter the-fields))
- (cdr (append the-fields nil)))
-
- (append forms--recordv nil))))
- (defun forms--update ()
- "Update current record with contents of form.
- As a side effect: sets `forms--the-record-list'."
- (if forms-read-only
- (error "Buffer is read-only"))
- (let (the-record)
-
- (setq forms--the-record-list (forms--parse-form))
- (setq the-record
- (mapconcat 'identity forms--the-record-list forms-field-sep))
- (if (string-match (regexp-quote forms-field-sep)
- (mapconcat 'identity forms--the-record-list ""))
- (error "Field separator occurs in record - update refused"))
-
- (if forms-multi-line
- (forms--trans the-record "\n" forms-multi-line))
-
- (if (string-match "\n" the-record)
- (error "Multi-line fields in this record - update refused"))
- (with-current-buffer forms--file-buffer
-
-
- (delete-region (line-beginning-position) (line-end-position))
- (insert the-record)
- (beginning-of-line))))
- (defun forms--checkmod ()
- "Check if this form has been modified, and call forms--update if so."
- (if (buffer-modified-p nil)
- (let ((here (point)))
- (forms--update)
- (set-buffer-modified-p nil)
- (goto-char here))))
- (defun forms-find-file (fn)
- "Visit a file in Forms mode."
- (interactive "fForms file: ")
- (let ((enable-local-eval t)
- (enable-local-variables t))
- (find-file-read-only fn)
- (or forms--mode-setup (forms-mode t))))
- (defun forms-find-file-other-window (fn)
- "Visit a file in Forms mode in other window."
- (interactive "fFbrowse file in other window: ")
- (let ((enable-local-eval t)
- (enable-local-variables t))
- (find-file-other-window fn)
- (or forms--mode-setup (forms-mode t))))
- (defun forms-exit ()
- "Normal exit from Forms mode. Modified buffers are saved."
- (interactive)
- (forms--exit t))
- (defun forms-exit-no-save ()
- "Exit from Forms mode without saving buffers."
- (interactive)
- (forms--exit nil))
- (defun forms-next-record (arg)
- "Advance to the ARGth following record."
- (interactive "P")
- (forms-jump-record (+ forms--current-record (prefix-numeric-value arg)) t))
- (defun forms-prev-record (arg)
- "Advance to the ARGth previous record."
- (interactive "P")
- (forms-jump-record (- forms--current-record (prefix-numeric-value arg)) t))
- (defun forms--goto-record (rn &optional current)
- "Goto record number RN.
- If CURRENT is provided, it specifies the current record and can be used
- to speed up access to RN. Returns the number of records missing, if any."
- (if current
- (forward-line (- rn current))
-
- (goto-char (point-min))
- (forward-line (1- rn))))
- (defun forms-jump-record (arg &optional relative)
- "Jump to a random record."
- (interactive "NRecord number: ")
-
- (if (or (> arg forms--total-records)
- (<= arg 0))
- (error
-
- (if (not relative)
- (message "Record number %d out of range 1..%d"
- arg forms--total-records)
- "")))
-
- (forms--checkmod)
-
- (let ((cur forms--current-record))
-
- (setq forms--current-record arg)
-
- (forms--show-record
- (with-current-buffer forms--file-buffer
- (beginning-of-line)
-
- (setq cur (- arg (forms--goto-record arg (if relative cur))))
- (forms--get-record)))
-
- (if (/= forms--current-record cur)
- (progn
- (setq forms--current-record cur)
- (error "Stuck at record %d" cur)))))
- (defun forms-first-record ()
- "Jump to first record."
- (interactive)
- (forms-jump-record 1))
- (defun forms-last-record ()
- "Jump to last record.
- As a side effect: re-calculates the number of records in the data file."
- (interactive)
- (let
- ((numrec
- (with-current-buffer forms--file-buffer
- (count-lines (point-min) (point-max)))))
- (if (= numrec forms--total-records)
- nil
- (setq forms--total-records numrec)
- (message "Warning: number of records changed to %d" forms--total-records)))
- (forms-jump-record forms--total-records))
- (defun forms-toggle-read-only (arg)
- "Toggles read-only mode of a forms mode buffer.
- With an argument, enables read-only mode if the argument is positive.
- Otherwise enables edit mode if the visited file is writable."
- (interactive "P")
- (if (if arg
-
- (<= (prefix-numeric-value arg) 0)
-
- forms-read-only)
-
- (let ((ro forms-read-only))
- (if (with-current-buffer forms--file-buffer
- buffer-read-only)
- (progn
- (setq forms-read-only t)
- (message "No write access to `%s'" forms-file))
- (setq forms-read-only nil))
- (if (equal ro forms-read-only)
- nil
- (forms-mode)))
-
- (if forms-read-only
- nil
- (forms--checkmod)
- (setq forms-read-only t)
- (forms-mode))))
- (defun forms-insert-record (arg)
- "Create a new record before the current one.
- With ARG: store the record after the current one.
- If `forms-new-record-filter' contains the name of a function,
- it is called to fill (some of) the fields with default values.
- If `forms-insert-after is non-nil, the default behavior is to insert
- after the current record."
- (interactive "P")
- (if forms-read-only
- (error ""))
- (let (ln the-list the-record)
- (if (or (and arg forms-insert-after)
- (and (not arg) (not forms-insert-after)))
- (setq ln forms--current-record)
- (setq ln (1+ forms--current-record)))
- (forms--checkmod)
- (if forms-new-record-filter
-
-
- (let ((the-fields (make-vector (1+ forms-number-of-fields) "")))
- (setq the-fields (funcall forms-new-record-filter the-fields))
- (setq the-list (cdr (append the-fields nil))))
- (setq the-list (make-list forms-number-of-fields "")))
- (setq the-record
- (mapconcat
- 'identity
- the-list
- forms-field-sep))
- (with-current-buffer forms--file-buffer
- (forms--goto-record ln)
- (open-line 1)
- (insert the-record)
- (beginning-of-line))
- (setq forms--current-record ln))
- (setq forms--total-records (1+ forms--total-records))
- (forms-jump-record forms--current-record))
- (defun forms-delete-record (arg)
- "Deletes a record. With a prefix argument: don't ask."
- (interactive "P")
- (if forms-read-only
- (error ""))
- (forms--checkmod)
- (if (or arg
- (y-or-n-p "Really delete this record? "))
- (let ((ln forms--current-record))
- (with-current-buffer forms--file-buffer
- (forms--goto-record ln)
-
-
- (delete-region (progn (beginning-of-line) (point))
- (progn (beginning-of-line 2) (point))))
- (setq forms--total-records (1- forms--total-records))
- (if (> forms--current-record forms--total-records)
- (setq forms--current-record forms--total-records))
- (forms-jump-record forms--current-record)))
- (message ""))
- (defun forms-search-forward (regexp)
- "Search forward for record containing REGEXP."
- (interactive
- (list (read-string (concat "Search forward for"
- (if forms--search-regexp
- (concat " ("
- forms--search-regexp
- ")"))
- ": "))))
- (if (equal "" regexp)
- (setq regexp forms--search-regexp))
- (forms--checkmod)
- (let (the-line the-record here)
- (with-current-buffer forms--file-buffer
- (end-of-line)
- (setq here (point))
- (if (or (re-search-forward regexp nil t)
- (and (> here (point-min))
- (progn
- (goto-char (point-min))
- (re-search-forward regexp here t))))
- (progn
- (setq the-record (forms--get-record))
- (setq the-line (1+ (count-lines (point-min) (point))))
- (if (< (point) here)
- (message "Wrapped")))
- (goto-char here)
- (error "Search failed: %s" regexp)))
- (setq forms--current-record the-line)
- (forms--show-record the-record))
- (re-search-forward regexp nil t)
- (setq forms--search-regexp regexp))
- (defun forms-search-backward (regexp)
- "Search backward for record containing REGEXP."
- (interactive
- (list (read-string (concat "Search backward for"
- (if forms--search-regexp
- (concat " ("
- forms--search-regexp
- ")"))
- ": "))))
- (if (equal "" regexp)
- (setq regexp forms--search-regexp))
- (forms--checkmod)
- (let (the-line the-record here)
- (with-current-buffer forms--file-buffer
- (beginning-of-line)
- (setq here (point))
- (if (or (re-search-backward regexp nil t)
- (and (< (point) (point-max))
- (progn
- (goto-char (point-max))
- (re-search-backward regexp here t))))
- (progn
- (setq the-record (forms--get-record))
- (setq the-line (1+ (count-lines (point-min) (point))))
- (if (> (point) here)
- (message "Wrapped")))
- (goto-char here)
- (error "Search failed: %s" regexp)))
- (setq forms--current-record the-line)
- (forms--show-record the-record))
- (re-search-forward regexp nil t)
- (setq forms--search-regexp regexp))
- (defun forms-save-buffer (&optional args)
- "Forms mode replacement for save-buffer.
- It saves the data buffer instead of the forms buffer.
- Calls `forms-write-file-filter' before, and `forms-read-file-filter'
- after writing out the data."
- (interactive "p")
- (forms--checkmod)
- (let ((write-file-filter forms-write-file-filter)
- (read-file-filter forms-read-file-filter)
- (cur forms--current-record))
- (with-current-buffer forms--file-buffer
- (let ((inhibit-read-only t))
-
-
-
-
-
-
-
-
-
- (or (null write-file-filter)
- (set-buffer-modified-p t))
- (save-buffer args)
- (if read-file-filter
- (save-excursion
- (run-hooks 'read-file-filter)))
- (set-buffer-modified-p nil)))
-
-
-
- (forms-jump-record cur))
- t)
- (defun forms--revert-buffer (&optional _arg noconfirm)
- "Reverts current form to un-modified."
- (interactive "P")
- (if (or noconfirm
- (yes-or-no-p "Revert form to unmodified? "))
- (progn
- (set-buffer-modified-p nil)
- (forms-jump-record forms--current-record))))
- (defun forms-next-field (arg)
- "Jump to ARG-th next field."
- (interactive "p")
- (let ((i 0)
- (here (point))
- there
- (cnt 0)
- (inhibit-point-motion-hooks t))
- (if (zerop arg)
- (setq cnt 1)
- (setq cnt (+ cnt arg)))
- (if (catch 'done
- (while (< i (length forms--markers))
- (if (or (null (setq there (aref forms--markers i)))
- (<= there here))
- nil
- (if (<= (setq cnt (1- cnt)) 0)
- (progn
- (goto-char there)
- (throw 'done t))))
- (setq i (1+ i))))
- nil
- (goto-char (aref forms--markers 0)))))
- (defun forms-prev-field (arg)
- "Jump to ARG-th previous field."
- (interactive "p")
- (let ((i (length forms--markers))
- (here (point))
- there
- (cnt 0)
- (inhibit-point-motion-hooks t))
- (if (zerop arg)
- (setq cnt 1)
- (setq cnt (+ cnt arg)))
- (if (catch 'done
- (while (> i 0)
- (setq i ( 1- i))
- (if (or (null (setq there (aref forms--markers i)))
- (>= there here))
- nil
- (if (<= (setq cnt (1- cnt)) 0)
- (progn
- (goto-char there)
- (throw 'done t))))))
- nil
- (goto-char (aref forms--markers (1- (length forms--markers)))))))
- (defun forms-print ()
- "Send the records to the printer with `print-buffer', one record per page."
- (interactive)
- (let ((inhibit-read-only t)
- (save-record forms--current-record)
- (total-nb-records forms--total-records)
- (nb-record 1)
- (record nil))
- (while (<= nb-record forms--total-records)
- (forms-jump-record nb-record)
- (setq record (buffer-string))
- (with-current-buffer (get-buffer-create "*forms-print*")
- (goto-char (buffer-end 1))
- (insert record)
- (setq buffer-read-only nil)
- (if (< nb-record total-nb-records)
- (insert "\n\n")))
- (setq nb-record (1+ nb-record)))
- (with-current-buffer "*forms-print*"
- (print-buffer)
- (set-buffer-modified-p nil)
- (kill-buffer (current-buffer)))
- (forms-jump-record save-record)))
- (defun forms-enumerate (the-fields)
- "Take a quoted list of symbols, and set their values to sequential numbers.
- The first symbol gets number 1, the second 2 and so on.
- It returns the highest number.
- Usage: (setq forms-number-of-fields
- (forms-enumerate
- '(field1 field2 field2 ...)))"
- (let ((the-index 0))
- (while the-fields
- (setq the-index (1+ the-index))
- (let ((el (car-safe the-fields)))
- (setq the-fields (cdr-safe the-fields))
- (set el the-index)))
- the-index))
- (defvar forms--debug nil
- "*Enables forms-mode debugging if not nil.")
- (defun forms--debug (&rest args)
- "Internal debugging routine."
- (if forms--debug
- (let ((ret nil))
- (while args
- (let ((el (car-safe args)))
- (setq args (cdr-safe args))
- (if (stringp el)
- (setq ret (concat ret el))
- (setq ret (concat ret (prin1-to-string el) " = "))
- (if (boundp el)
- (let ((vel (eval el)))
- (setq ret (concat ret (prin1-to-string vel) "\n")))
- (setq ret (concat ret "<unbound>" "\n")))
- (if (fboundp el)
- (setq ret (concat ret (prin1-to-string (symbol-function el))
- "\n"))))))
- (with-current-buffer (get-buffer-create "*forms-mode debug*")
- (if (zerop (buffer-size))
- (emacs-lisp-mode))
- (goto-char (point-max))
- (insert ret)))))
|