EmacsLisp
From Pickwiki
Emacs can be used very effectively for Basic source development with the help of unibasic.el Emacs Lisp package. Here are some additional Emacs Lisp packages that can be used to aid viewing and editing records in MV database files: uv-edit-mode uv-mode (+ align-regexp) uv-tools
uv-edit-mode
;; $Id: uv-edit-mode.el,v 1.1 2009/11/13 00:14:13 kford Exp $
;;
;; This mode is used in conjunction with the UV Basic program UV.EM, along
;; with Emacs under X, in client-server mode. Editing a record in a UV DB
;; file, e.g. UV.EM VOC LOGIN, will place the LOGIN record in an Emacs buffer
;; for editing. Control-F will toggle formatted editing mode.
;;
;; Put the following in your .emacs or .emacs.el file:
;; (auto-execute "EMACS.TMP[0-9]+" 'uv-edit-mode)
;; (autoload 'uv-edit-mode "uv-edit-mode" t) ; Mode for editing Universe files
;;
;; In case you don't have "auto-execute", here it is:
;; (defun auto-execute (pattern function-name); For extending auto-mode-alist
;; "Execute function named FUNCTION-NAME whenever a filename matching
;; PATTERN is loaded by find-file"
;; (setq auto-mode-alist
;; (cons (cons pattern function-name)
;; auto-mode-alist)))
;;
(defvar uv-field-num-regexp
"^\\([0-9]+: \\)"
"Regular expression used to recognise Universe file item line numbers.")
(defvar uv-value-num-regexp
"^\\( [0-9]+: \\)"
"Regular expression used to recognise Universe file item value numbers.")
(defvar uv-edit-mode-map nil
"Keymap used in uv edit mode.")
(defvar uv-edit-mode-formatted nil
"Flag set if in formatted edit mode")
(if (not uv-edit-mode-map)
(setq uv-edit-mode-map (make-sparse-keymap)))
(define-key uv-edit-mode-map "\C-f" '(lambda ()
(interactive)
(save-excursion
(goto-char (point-min))
(if (looking-at "Record Id: ")
(if (buffer-modified-p)
(unformat-uv-item)
(unformat-uv-item)
(setq uv-edit-mode-formatted nil)
(set-buffer-modified-p nil))
(if (buffer-modified-p)
(format-uv-item)
(format-uv-item)
(setq uv-edit-mode-formatted t)
(set-buffer-modified-p nil))))))
;; Insert a Universe value mark
(define-key uv-edit-mode-map "\C-xv" '(lambda () (interactive)
(if uv-edit-mode-formatted
(progn
(insert-string "ý")
(forward-char 1)
(save-excursion
(unformat-uv-item)
(format-uv-item)))
(insert-string "ý"))))
;; Insert a Universe subvalue mark
(define-key uv-edit-mode-map "\C-xs" '(lambda () (interactive)
(if uv-edit-mode-formatted
(progn
(insert-string "ü")
(forward-char 1)
(save-excursion
(unformat-uv-item)
(format-uv-item)))
(insert-string "ü"))))
;; Insert a Universe field mark
(define-key uv-edit-mode-map "\C-m" '(lambda () (interactive)
(if uv-edit-mode-formatted
(progn
(open-line 1)
(forward-char 1)
(save-excursion
(unformat-uv-item)
(format-uv-item)))
(open-line 1)
(forward-char 1))))
(defun uv-edit-mode ()
"Major mode for editing Universe file items with numbered fields and
multivalues which can be toggled on and off before saving changes.
\\{uv-edit-mode-map}"
(interactive)
(kill-all-local-variables)
(use-local-map uv-edit-mode-map)
(setq mode-name "uv-edit")
(setq major-mode 'uv-edit-mode)
(load-library "uv-tools")
(add-hook 'write-file-hooks 'uv-edit-mode-save nil)
)
(defun uv-edit-mode-save ()
(interactive)
(save-excursion
(goto-char (point-min))
(if (looking-at "Record Id: ")
(if (buffer-modified-p)
(error "Remove formatting (^F) before saving")))))
(provide 'uv-edit-mode)
;; End of uv-edit-mode.el
uv-mode
;; $Id: uv-mode.el,v 1.2 2003/09/01 23:53:23 kenf Exp $
;; uv-mode.el
;;
;; Mode for editing Universe files in an Emacs buffer.
;;
;; Written by Ken Ford, Universe Systems Administrator, The System Works.
(defvar uv-mode-map nil
"Keymap used in uv mode.")
(defvar uv-delimiter-regexp
"\\(ÿ\\|?\\|ý\\|ü\\)"
"Regular expression used to recognise Universe file delimiters - item
mark, field mark, value mark and sub-value mark.")
(defvar uv-item-id-regexp
"^\\([^ÿ]+\\)"
"Regular expression used to recognise Universe file item ids.")
(if (not uv-mode-map)
(setq uv-mode-map (make-sparse-keymap)))
(define-key uv-mode-map "\t" 'uv-next-id) ;; Move to next item id.
;; Insert an item mark
(define-key uv-mode-map [C-M-S-insert] '(lambda () (interactive) (insert-string "ÿ")))
;; Insert a field mark
(define-key uv-mode-map [insert] '(lambda () (interactive) (insert-string "?")))
;; Insert a value mark
(define-key uv-mode-map [S-insert] '(lambda () (interactive) (insert-string "ý")))
;; Insert a sub-value mark
(define-key uv-mode-map [C-insert] '(lambda () (interactive) (insert-string "ü")))
;; Display formatted item in separate window
(define-key uv-mode-map "\C-v" 'format-this-item)
(defvar uv-mode-syntax-table nil
"Syntax table in use in uv-mode buffers.")
(defun uv-mode ()
"Major mode for editing Universe files in (almost) raw format.
Prepends each record with its item id. aligned such that all item ids.
are left justified in a field equal in length to the longest item id.
Item id. is separated by an item mark form its data.
\\{uv-mode-map}"
(interactive)
(kill-all-local-variables)
(use-local-map uv-mode-map)
(setq mode-name "uv")
(setq major-mode 'uv-mode)
(load-library "align-regexp")
(highlight-regexp uv-delimiter-regexp 'region)
(highlight-regexp uv-item-id-regexp 'secondary-selection)
(align-regexp "ÿ" (point-min) (point-max) 1)
(add-hook 'local-write-file-hooks
'(lambda ()
(replace-regexp "\\s-+ÿ" "ÿ" nil (point-min) (point-max)))))
(defun uv-next-id ()
"Go to the next Universe file record id. in the buffer."
(interactive)
(re-search-forward "^[^ÿ]+ÿ" (point-max) t)
(if (not (point-max)) (beginning-of-line)))
(provide 'uv-mode)
;; End of uv-mode.
align-regexp ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; align-regexp.el[c] ;; Copyright (C) 1993-1994, Steve Koren ([email protected]) ;; ;; Version 1.2 ;; ;; In accordance with the GNU license, this file may be freely ;; distributed and copied, provided that further distribution is not ;; restricted. ;; ;; There is no warranty on this software; it is distributed freely and ;; therefore 'as is'. ;; ;; DISCLAIMER: This software is a personal utility written by Steve ;; Koren and is not associated in any way with Hewlett ;; Packard Company. Neither HP nor I support this software. ;; Use it at your own risk. ;; ;; This very simple function is the most wonderful function of all time. ;; ;; Well maybe not quite, but it is right up there. It is similar to ;; the align-equals function, but prompts for a regexp. It finds ;; the first occurance of that regexp in each line, and lines them ;; up as far left as possible but no further left than the leftmost ;; occurance in any of the lines. See the documentation for details. ;; ;; Change history: ;; 19 Apr 93 Steve Koren - initial creation ;; 25 Jan 94 Steve Koren - add function docs for public consumption ;; 18 May 94 Steve Koren - numeric prefix does not insert space ;; - optional argument gives char to insert ;; - another optional argument for subexp ;; - allow multiple alignments at once. ;; 19 May 94 Steve Koren - allow for columns using same regexp ;; ;; This code has been tested on: ;; Machine OS Emacs Version ;; ------------------------------------------------ ;; Amiga 4000, [[AmigaDos]] 3.0, GNU emacs 18.58.1 ;; HP 9000/720, HP-UX 9.0, GNU emacs 18.57.4 ;; ;; Notes: ;; ;; Known Bugs: ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;*************************************************************************** ;** Little insert-to-column function that is useful in its own right. ;*************************************************************************** (defun alr-insert-to-column (col &optional pad-char) (interactive "nColumn: ") (insert (make-string (max (- col (current-column)) 0) (or pad-char ? )))) ;*************************************************************************** ;** Our align-regexp function. ;*************************************************************************** ;; When called non-interactively, it has the following arguments: ;; ;; (align-regexp regexp begin end &optional no-space pad-char subexp-num) ;; ;; regexp - string for the regular expression to align. This ;; can contain multiple comma separated regexps. To ;; use a comma in the expression, backslash escape it. ;; ;; begin - start of region on which to operate ;; ;; end - end of region on which to operate ;; ;; no-space - numeric prefix from interactive call. 1 will always ;; force at least once space, >1 will not. ;; ;; pad-char - character to use for adjusting text instead of ;; the default space. ;; ;; subexp-num - the number of the subexpression within regexp which ;; is where the alignment should begin. This is usually ;; 0 for the entire regexp (and thus the alignment ;; happens at the beginning of it) but it could be ;; something else. Passed to match-beginning. ;; ;; fold-case - whether the regexp search should be case sensitive. (defun align-regexp (regexp begin end &optional no-space pad-char subexp-num fold-case) "Align region according to regular expressions. Prompts for a regexp, then finds the first occurance of that regexp in each line, and lines them up as far left as possible but no further left than the leftmost occurance in any of the lines. Example: bool operator< (const char* abc) { return strcmp([[LS_Str]], abc) < 0; } bool operator> (const char* s) { return strcmp([[LS_Str]], s) > 0; } bool operator<= (char* s) { return strcmp([[LS_Str]], s) <=0; } bool operator>= (char* s) { return strcmp([[LS_Str]], s) >=0; } Performing align-regexp and entering \"{\" will yield: bool operator< (const char* abc) { return strcmp([[LS_Str]], abc) < 0; } bool operator> (const char* s) { return strcmp([[LS_Str]], s) > 0; } bool operator<= (char* s) { return strcmp([[LS_Str]], s) <=0; } bool operator>= (char* s) { return strcmp([[LS_Str]], s) >=0; } By lining up things from left to right, you can pretty much make any alignment. Furthermore, you can perform multiple alignments at once, by specifying a comma separated list of expressions to align. For example, the string \"{,}\" would align the opening and closing braces in the above text. Beware of regexp chars with special meanings. With a numeric prefix, the function does not force a space in the text." (interactive "sAlign-regexp: \nd\nm\np") (let (min-column min-char (start-pos 0) end-pos fullexp (old-case-fold-search case-fold-search) (last-start-column 0) sep-string) (setq case-fold-search fold-case) (save-excursion (save-restriction (narrow-to-region begin end) (untabify (point-min) (point-max)) (setq fullexp (concat regexp ",")) ;; -- horrifying kludge to use backslashes as separator chars -------- (save-excursion (get-buffer-create " *arx-buf* *") (set-buffer " *arx-buf* *") (erase-buffer) (insert fullexp) (goto-char (point-min)) (while (search-forward "\\\\," nil t) (replace-match "\\\\.*," nil t)) (setq fullexp (buffer-substring (point-min) (point-max)))) ;; -- loop through once per regexp to align -------------------------- (while (setq end-pos (string-match "[^\\]," fullexp start-pos)) (setq end-pos (1+ end-pos)) (setq min-column 0 min-char 9999) (setq regexp (substring fullexp start-pos end-pos)) (goto-char (point-min)) ;; -- find place where column starts ------------------------------- (while (re-search-forward regexp (point-max) t nil) (goto-char (match-beginning (or subexp-num 0))) (if (< (current-column) last-start-column) (forward-char 1) (setq min-char (min min-char (current-column))) (skip-chars-backward " ") (setq min-column (max min-column (+ (current-column) (if (> no-space 1) 0 1)))) (beginning-of-line) (forward-line 1))) (goto-char (point-min)) (setq min-column (max min-column min-char)) ;; -- insert enough spaces to line things up ----------------------- (while (re-search-forward regexp (point-max) t nil) (goto-char (match-beginning (or subexp-num 0))) (if (< (current-column) last-start-column) (forward-char 1) (just-one-space) (if (> no-space 1) (backward-delete-char 1)) (alr-insert-to-column min-column pad-char) (forward-line 1))) (setq last-start-column (1+ min-column) start-pos (1+ end-pos)) ))) (setq case-fold-search old-case-fold-search))) ;; End of align-regexp.
uv-tools
;; $Id: uv-tools.el,v 1.1 2009/11/13 00:48:41 kford Exp $
;; These tools enable viewing, listing, editing records in Pick and Universe DB files.
;; It puts a "Universe Tools" item in the Tools item of the Emacs Toolbar.
;; Put the following in your .emacs or .emacs.el file
;; (load "uv-tools")
;; (autoload 'uv-mode "uv-mode" "" t) ; Mode for editing Universe files
;; (auto-execute "\\.uv$" 'uv-mode) ; Mode for Universe file viewing
;;
(defvar no-wait "")
(defvar last-file-id "")
(defvar last-uvaccount "")
;;
(defun uv-find-file (&optional file-id item-id)
"Get a Universe directory or file item into a buffer"
(interactive "P")
(if (not file-id)
(setq file-id
(read-from-minibuffer "Unix pathname of File or Universe A/c Name and optional Filename: "
default-directory
minibuffer-local-map nil)))
(if (string-equal file-id "")
(setq file-id default-directory))
(setq last-file-id file-id)
(if (not item-id)
(setq item-id
(read-from-minibuffer "Record Id (or null): "
""
minibuffer-local-map nil)))
(if (or (not (string-match "/" file-id))
(string-match "\\s-+" file-id))
(save-excursion
(if (string-match "\\s-+" file-id)
(progn
(setq uvac (substring file-id 0 (progn (string-match "\\s-" file-id) (1- (match-end 0)))))
(setq uvfile-id (substring file-id (match-end 0)))
(setq partpath (concat "/" uvfile-id "/")))
(setq uvac file-id)
(setq uvfile-id "")
(setq partpath "/")
)
(with-temp-buffer
(get-uvaccount-unix-path uvac))
)
(setq dir-id file-id)
(setq partpath "/")
)
(find-file (concat dir-id partpath item-id))
)
;;
(defun list-uv-file (&optional file-id item-id)
"List formatted and expanded Universe file items."
(interactive "P")
(if (not file-id)
(setq file-id
(read-from-minibuffer "Unix pathname of File or Universe A/c Name and Filename: "
last-file-id
minibuffer-local-map nil)))
(setq last-file-id file-id)
(if (not item-id)
(setq item-id
(read-from-minibuffer "Record Id (or GET.LIST <listname> or [S]SELECT ... etc.): "
""
minibuffer-local-map nil))
)
(if (or (not (string-match "/" file-id))
(string-match "\\s-+" file-id))
;; Derive Unix path from Universe A/c
(with-temp-buffer
(setq uvac (substring file-id 0 (progn (string-match "\\s-" file-id) (1- (match-end 0)))))
(setq uvfile-id (substring file-id (match-end 0)))
(get-uvaccount-unix-path uvac)
)
(setq uvfile-id (substring file-id (1+ (string-match "\/[^\/]+$" file-id))))
(setq dir-id (substring file-id 0 (string-match "\/[^\/]+$" file-id)))
)
;; Allow filename to default if set to "..."
(if (string-match "SELECT ..." item-id)
(setq item-id
(concat
(substring item-id 0 (- (match-end 0) 3))
uvfile-id
(if (not (= (match-end 0) (length item-id)))
(substring item-id (1+ (match-end 0))))
)
)
)
;; Initialise Universe file item/s buffer
(if (not (get-file-buffer file-id))
(progn
(get-buffer-create file-id)
(switch-to-buffer file-id)
(goto-char (point-max))
(if (not (= (point) (point-min)))
(newline 2))
(setq beginning-of-record (point)))
(switch-to-buffer file-id)
(goto-char (point-max))
(newline 2)
(setq beginning-of-record (point))
)
;; Handle an item selection statement
(setq item-list "")
(if (or (string-match "GET.LIST" item-id)
(string-match "SELECT" item-id))
(progn
(setq item-list (concat item-id "\\n"))
(setq item-id "")
;; Clean up any SELECT statement arguments
(setq item-list (cleanup-uv-command item-list))
)
(setq item-id (concat "= \\\"" item-id "\\\""))
)
;; Get Universe file item/s into buffer
(call-process shell-file-name nil t t
"-c"
(concat "perl -e \'chdir(\"" dir-id "\");open(UV,\"|uv\");print UV \"1\\n"
item-list
"LIST.ITEM "
uvfile-id " " item-id
" COL.HDR.SUPP NOPAGE\\nOFF\\n\";close UV\'"))
;;
(goto-char beginning-of-record)
(if (and (not (re-search-forward "^[^0-9]+ does not exist" nil t))
(not (re-search-forward "Unable to open" nil t))
(not (re-search-forward "not found" nil t))
(not (re-search-forward "syntax error" nil t))
(not (eobp)))
(progn
;; Clean up output in buffer
(goto-char beginning-of-record)
(save-window-excursion
(kill-region (point)
(save-excursion
(search-forward "LIST.ITEM " nil)
(goto-char (match-beginning 0))
(end-of-line)
(forward-char 1)
(forward-line 2)
(point)))
(while (re-search-forward "\n�.+\n\n\n" nil t)
(goto-char (match-beginning 0))
(forward-char 1)
(kill-line 3))
(goto-char beginning-of-record)
(while (re-search-forward "\n�.+\n\n" nil t)
(goto-char (match-beginning 0))
(forward-char 1)
(kill-line 2))
(goto-char beginning-of-record)
(while (re-search-forward "\n\n\n" nil t)
(goto-char (match-beginning 0))
(forward-char 1)
(kill-line 2))
(goto-char beginning-of-record)
(while (re-search-forward "\n\n\n\n" nil t)
(goto-char (match-beginning 0))
(forward-char 1)
(kill-line 3))
;; (flush-lines "^$")
(goto-char (point-max))
(re-search-backward "^[0-9][0-9][0-9] " nil t)
(end-of-line)
(forward-char 1)
(kill-region (point) (point-max)))
(goto-char beginning-of-record)
;; Process Records in Selection
(while (not (eobp))
(setq string-begin (point))
(insert "Record Id: ")
(facemenu-set-intangible string-begin (point))
(delete-char 4)
(end-of-line)
(forward-char 1)
;; Process Lines in Record
(format-item)
(end-of-line)
(if (not (eobp))
(forward-char 1))
)
(if (not (eobp))
(forward-char 1))
(goto-char beginning-of-record)
)
(goto-char beginning-of-record)
(kill-region (point) (point-max))
(error "File not readable or no such record"))
)
;;
(defun read-item (&optional file-id item-id item)
"Read a Universe file item into a buffer."
(interactive "P")
(if (not file-id)
(setq file-id
(read-from-minibuffer "Unix pathname of File or Universe A/c Name and Filename: "
last-file-id
minibuffer-local-map nil)))
(setq last-file-id file-id)
(if (not item-id)
(setq item-id
(read-from-minibuffer "Record Id: "
""
minibuffer-local-map nil)))
(if (or (not (string-match "/" file-id))
(string-match "\\s-+" file-id))
(save-excursion
(if (string-match "\\s-+" file-id)
(progn
(setq uvac (substring file-id 0 (progn (string-match "\\s-" file-id) (1- (match-end 0)))))
(setq uvfile-id (substring file-id (match-end 0)))
(setq partpath (concat "/" uvfile-id "/")))
(setq uvac file-id)
(setq uvfile-id "")
(setq partpath "/")
)
(with-temp-buffer
(get-uvaccount-unix-path uvac))
)
(setq dir-id file-id)
(setq uvfile-id "")
(setq partpath "/")
)
(if (not (get-file-buffer file-id))
(progn
(get-buffer-create file-id)
(switch-to-buffer file-id)
(setq beginning-of-record (point)))
(switch-to-buffer file-id)
(goto-char (point-max))
(newline)
(setq beginning-of-record (point)))
(if (not item)
(call-process shell-file-name nil t t
"-c"
(concat "UVread " dir-id "/" uvfile-id " " item-id))
(insert item))
(if (string-match "^[^0-9]+ does not exist"
(buffer-substring-no-properties
(point-min) (point-max)))
(save-excursion
(goto-char (point-min))
(kill-line 1)))
(if (not (string-match "Unable to open"
(buffer-substring-no-properties
(point-min) (point-max))))
(progn
(goto-char beginning-of-record)
(if (not (bobp)) (newline))
(delete-char (1+ (length item-id)))
(while (re-search-forward "^\t" nil t)
(replace-match "" nil nil))
(goto-char beginning-of-record)
(not-modified)
(load "uv-edit-mode")
(uv-edit-mode)
)
(goto-char beginning-of-record)
(kill-buffer file-id)
(error "Universe file not readable or no such record"))
)
;;
(defun write-item (&optional file-id item-id)
"Write current buffer as a Universe file item."
(interactive "P")
(if (not file-id)
(setq file-id
(read-from-minibuffer "Unix pathname of File or Universe A/c Name and Filename: "
last-file-id
minibuffer-local-map nil)))
(setq last-file-id file-id)
(if (not item-id)
(setq item-id
(read-from-minibuffer "Record Id: "
""
minibuffer-local-map nil)))
(if (or (not (string-match "/" file-id))
(string-match "\\s-+" file-id))
(save-excursion
(setq uvac (substring file-id 0 (progn (string-match "\\s-" file-id) (1- (match-end 0)))))
(setq uvfile-id (substring file-id (match-end 0)))
(with-temp-buffer
(get-uvaccount-unix-path uvac))
)
)
(goto-char (point-min))
(setq fields "")
(while (not (eobp))
(setq field
(buffer-substring-no-properties
(point) (point-at-eol)))
(setq fields (concat fields "'" field "'" " "))
(forward-line 1))
(shell-command (concat
"UVwrite " dir-id "/" uvfile-id " " item-id " " fields))
)
;;
(defun view-uv-item (&optional file-id item-id item)
"View a formatted and expanded Universe file item."
(interactive "P")
(if (not file-id)
(setq file-id
(read-from-minibuffer "Unix pathname of File or Universe A/c Name and Filename: "
last-file-id
minibuffer-local-map nil)))
(setq last-file-id file-id)
(if (not item-id)
(setq item-id
(read-from-minibuffer "Record Id: "
""
minibuffer-local-map nil)))
(if (not item)
(progn
(if (or (not (string-match "/" file-id))
(string-match "\\s-+" file-id))
(save-excursion
(setq uvac (substring file-id 0 (progn (string-match "\\s-" file-id) (1- (match-end 0)))))
(setq uvfile-id (substring file-id (match-end 0)))
(with-temp-buffer
(get-uvaccount-unix-path uvac))
)
)
(if (not (get-file-buffer file-id))
(progn
(get-buffer-create file-id)
(switch-to-buffer file-id)
(setq beginning-of-record (point)))
(switch-to-buffer file-id)
(goto-char (point-max))
(newline)
(setq beginning-of-record (point)))
(setq file-id (concat dir-id "/" uvfile-id)) ;; test
(call-process shell-file-name nil t t
"-c"
(concat "UVread "
file-id " " item-id))
)
(goto-char (point-min))
(setq beginning-of-record (point))
)
;;
(if (and (not (string-match "^[^0-9]+ does not exist"
(buffer-substring-no-properties
(point-min) (point-max))))
(not (string-match "^Unable to open"
(buffer-substring-no-properties
(point-min) (point-max)))))
(progn
(goto-char beginning-of-record)
(if (not (bobp)) (newline))
(setq string-begin (point))
(insert "Record Id: ")
(facemenu-set-intangible string-begin (point))
(search-forward "\t")
(forward-char -1)
(open-line 1)
(forward-char 1)
(setq eor nil)
(setq current-pos (point))
(setq field-no 0)
(setq field-count
(count-matches "\n"
(point) (point-max)))
;; (setq field-count
;; (string-to-int
;; (substring field-count
;; 0 (string-match " " field-count))))
(goto-char current-pos)
(while (not (= field-no field-count))
(format-field))
(goto-char (point-min))
)
(goto-char beginning-of-record)
(kill-region (point) (point-max))
(error "Universe file not readable or no such record"))
)
;;
(defun uv-shell-cmd (&optional uvaccount)
"Execute a Universe shell command"
(interactive "P")
(if (not uvaccount)
(setq uvaccount
(read-from-minibuffer "Unix pathname of Account or Universe A/c Name: "
last-uvaccount
minibuffer-local-map nil)))
(setq last-uvaccount uvaccount)
(if (not (string-match "/" uvaccount))
;; Derive Unix path from Universe A/c
(with-temp-buffer
(get-uvaccount-unix-path uvaccount))
(setq uvfile-id (substring uvaccount (1+ (string-match "\/" uvaccount)) 99))
(setq dir-id (substring uvaccount 1 (string-match "\/" uvaccount))))
;; Get Universe TCL command
(setq uvcommand
(read-from-minibuffer "Universe TCL commands delimited by ';'s : "
""
minibuffer-local-map nil))
;; Initialise Universe TCL command output buffer
(if (not (get-file-buffer uvaccount))
(progn
(get-buffer-create uvaccount)
(switch-to-buffer uvaccount)
(goto-char (point-max))
(if (not (= (point) (point-min)))
(newline 2))
(setq beginning-of-record (point)))
(switch-to-buffer uvaccount)
(goto-char (point-max))
(newline 2)
(setq beginning-of-record (point))
)
;; Clean up Universe shell command
(setq uvcommand (cleanup-uv-command uvcommand))
;; Get Universe file item/s into buffer
(call-process shell-file-name nil t t
"-c"
(concat "perl -e \'chdir(\"" dir-id "\");open(UV,\"|uv\");print UV \"1\\n"
uvcommand
"\\nOFF\\n\";close UV\'"))
;; Clean up output in buffer
(goto-char beginning-of-record)
(save-window-excursion
(kill-region (point)
(save-excursion
(re-search-forward (concat "^." (substring uvcommand 0 2)) nil t)
(beginning-of-line)
(point)))
(goto-char (point-max))
(re-search-backward "^.OFF" nil t)
(kill-region (point) (point-max)))
(goto-char beginning-of-record)
)
;;
(defun format-this-item ()
"Display a formatted and expanded Universe file item"
(interactive)
(beginning-of-line)
(get-buffer-create "** Universe file item **")
(setq item-id (buffer-substring-no-properties (progn (beginning-of-line) (point)) (1- (search-forward "ÿ"))))
(setq item-line item-id)
(setq current-loc (point))
(setq last-buffer (buffer-name))
(save-excursion (set-buffer "** Universe file item **")
(kill-region (point-min) (point-max)))
(while (search-forward "?" (save-excursion (progn (end-of-line) (point))) t)
(setq field (buffer-substring-no-properties current-loc (1- (point))))
(setq item-line (concat item-line "\t" field))
(save-excursion
(set-buffer "** Universe file item **")
(goto-char (point-max))
(insert item-line)
(newline))
(setq current-loc (point))
(setq item-line ""))
(setq field (buffer-substring-no-properties current-loc (progn (end-of-line) (point))))
(setq item-line (concat item-line "\t" field))
(save-excursion
(set-buffer "** Universe file item **")
(goto-char (point-max))
(insert item-line)
(newline)
(view-uv-item "" "" "this-buffer"))
(beginning-of-line)
(delete-other-windows)
(split-window-vertically)
(switch-to-buffer "** Universe file item **")
(other-window 1)
)
;;
(defun format-field ()
"Format current field in viewed item"
(setq field-no (1+ field-no))
(delete-char 1)
;; (setq string-begin (point))
(insert (format "%04d: " field-no))
;; (facemenu-set-intangible string-begin (point))
(setq current-pos (point))
(setq value-no 0)
(setq value-count
(1+ (count-matches "ý"
(point) (point-at-eol))))
;; (setq value-count
;; (1+ (string-to-int (substring value-count
;; 0
;; (string-match " " value-count)))))
(goto-char current-pos)
(while (not (= value-no value-count))
(format-value))
)
;;
(defun format-value ()
"Format current value in current field of viewed item"
(setq value-no (1+ value-no))
(if (> value-count 1)
(progn
(if (= value-no 1)
(progn
(open-line 1)
;; (setq string-begin (point))
(insert "[[MultiValues]]:")
;; (facemenu-set-intangible string-begin (point))
(forward-char 1)))
;; (setq string-begin (point))
(insert " ")
(insert (format "%03d: " value-no))
;; (facemenu-set-intangible string-begin (point))
(if (not (= value-no value-count))
(progn
(re-search-forward "ý")
(forward-char -1))
(end-of-line))
(delete-char 1)
(open-line 1)
(forward-char 1))
(end-of-line)
(delete-char 1)
(open-line 1)
(forward-char 1)))
;;
(defun get-uvaccount-unix-path (uvaccount)
(call-process shell-file-name nil t t
"-c"
(concat "UVread /u1/uv[[/UV]].ACCOUNT "
uvaccount))
(goto-char (point-min))
(if (or (re-search-forward "Does Not Exist" nil t)
(re-search-forward "Unable to open" nil t)
(re-search-forward "syntax error" nil t)
(eobp))
(error (concat "Universe A/c not found" uvaccount)))
(setq dir-id
(substring
(buffer-substring-no-properties
(point-min) (point-max))
(string-match "\/"
(buffer-substring-no-properties
(point-min) (point-max))) -1))
(setq dir-id
(substring
dir-id
0
(string-match "\n" dir-id))))
;;
(defun cleanup-uv-command (uvcommand)
(setq occurrence 1)
(while (string-match "\"" uvcommand occurrence)
(setq occurrence (1+(match-end 0)))
(setq uvcommand (concat (substring uvcommand 0 (match-beginning 0))
"\\\""
(substring uvcommand (match-end 0)))))
(setq occurrence 1)
(while (string-match "\\\[" uvcommand occurrence)
(setq occurrence (1+ (match-end 0)))
(setq uvcommand (concat (substring uvcommand 0 (match-beginning 0))
"\\\["
(substring uvcommand (match-end 0)))))
(setq occurrence 1)
(while (string-match "\\\]" uvcommand occurrence)
(setq occurrence (1+ (match-end 0)))
(setq uvcommand (concat (substring uvcommand 0 (match-beginning 0))
"\\\]"
(substring uvcommand (match-end 0)))))
(setq occurrence 1)
(while (string-match "\\\@" uvcommand occurrence)
(setq occurrence (1+ (match-end 0)))
(setq uvcommand (concat (substring uvcommand 0 (match-beginning 0))
"\\\@"
(substring uvcommand (match-end 0)))))
(setq occurrence 1)
(while (string-match ";" uvcommand occurrence)
(setq occurrence (1+ (match-end 0)))
(setq uvcommand (concat (substring uvcommand 0 (match-beginning 0))
"\\n"
(substring uvcommand (match-end 0)))))
uvcommand
)
;;
(defun format-item ()
"Format current item in viewed file"
(while (and (not (eobp)) (not (eolp)))
(while (looking-at "[0-9][0-9][0-9] ")
(save-excursion
(end-of-line)
(forward-char 1)
;; Rejoin split lines
(setq complete-line nil)
(while (not complete-line)
(if (or (eobp)
(looking-at "[0-9][0-9][0-9] "))
(setq complete-line t)
(if (looking-at " ")
(progn
(delete-char 4)
(beginning-of-line)
(forward-char -1)
(delete-char 1)
(end-of-line)
(forward-char 1))
(setq complete-line t)))
)
)
(forward-char 4)
(setq current-pos (point))
(setq value-no 0)
(setq value-count
(1+ (count-matches "ý"
(point) (point-at-eol))))
;; (setq value-count
;; (1+ (string-to-int (substring value-count
;; 0
;; (string-match " " value-count)))))
(goto-char current-pos)
;; Process Values in Line
(while (not (= value-no value-count))
(format-value))
))
)
;;
(defun format-uv-item ()
"Format item in edit buffer"
(interactive)
(load-library "uv-edit-mode")
(uv-edit-mode)
(goto-char (point-min))
(open-line 1)
(insert (concat "Record Id: " (buffer-name)))
(facemenu-set-intangible (point-min) (point))
(forward-char 1)
(setq eor nil)
(setq current-pos (point))
(setq field-no 0)
(setq field-count
(count-matches "\n"
(point) (point-max)))
;; (setq field-count
;; (string-to-int
;; (substring field-count
;; 0 (string-match " " field-count))))
(goto-char current-pos)
(while (not (= field-no field-count))
(format-uv-field))
(goto-char (point-min))
(not-modified)
(forward-line 1)
(forward-char 6)
(highlight-regexp uv-field-num-regexp 'secondary-selection)
(highlight-regexp uv-value-num-regexp 'secondary-selection)
)
;;
(defun format-uv-field ()
"Format current field in item in edit buffer"
(interactive)
(setq field-no (1+ field-no))
(setq string-begin (point))
(insert (format "%04d: " field-no))
(facemenu-set-intangible (1- string-begin) (point))
(setq current-pos (point))
(setq value-no 0)
(setq value-count
(1+ (count-matches "ý"
(point) (point-at-eol))))
;; (setq value-count
;; (1+ (string-to-int (substring value-count
;; 0
;; (string-match " " value-count)))))
(goto-char current-pos)
(while (not (= value-no value-count))
(format-uv-value))
)
;;
(defun format-uv-value ()
"Format current value in current field in item in edit buffer"
(interactive)
(setq value-no (1+ value-no))
(if (> value-count 1)
(progn
(if (= value-no 1)
(progn
(facemenu-remove-all (point) (point-at-eol))
;; (setq string-begin (point))
(insert "[[MultiValues]]:")
;; (facemenu-set-intangible string-begin (point))
(open-line 1)
(forward-char 1)
))
(setq string-begin (point))
(facemenu-remove-all (point) (point-at-eol))
(insert " ")
(insert (format "%03d: " value-no))
(forward-char -1)
(facemenu-set-intangible string-begin (point))
(if (not (= value-no value-count))
(progn
(re-search-forward "ý")
(forward-char -1))
(end-of-line))
(delete-char 1)
(open-line 1)
(forward-char 1))
(end-of-line)
(delete-char 1)
(open-line 1)
(if (not (bolp))
(forward-char 1))))
;;
;; Key binding to toggle formatting of item in edit buffer.
(global-set-key [C-M-f8] '(lambda ()
(interactive)
(save-excursion
(goto-char (point-min))
(if (looking-at "Record Id: ")
(if (buffer-modified-p)
(unformat-uv-item)
(unformat-uv-item)
(set-buffer-modified-p nil))
(if (buffer-modified-p)
(format-uv-item)
(format-uv-item)
(set-buffer-modified-p nil))))))
;;
;; Key binding to execute Universe TCL command in a buffer.
(global-set-key [M-f12] 'uv-shell-cmd)
(global-set-key [C-f8] 'uv-find-file)
;;
(defun unformat-uv-item ()
"Unformat current item in edit buffer"
(interactive)
(goto-char (point-min))
(facemenu-remove-all (point) (point-max))
(kill-line 1)
(while (not (eobp))
(delete-char 6)
(if (looking-at "[[MultiValues]]:")
(progn
(kill-line 1)
(while (looking-at " [0-9][0-9][0-9]: ")
(delete-char 11)
(end-of-line)
(if (looking-at "\n [0-9][0-9][0-9]: ")
(progn
(insert "ý")
(delete-char 1))
(if (not (eobp))
(forward-char 1)))))
(end-of-line)
(forward-char 1))
)
(goto-char (point-min)))
;;
(defvar UVtools-menu-bar-tools-map (make-sparse-keymap "Universe Tools"))
(fset 'UVtools-update-menu-bar
(function
(lambda ()
(define-key-after (lookup-key global-map [menu-bar tools])
[UVTools] (cons "Universe Tools" UVtools-menu-bar-tools-map) [UVtools]))))
(mapcar
(function
(lambda (bind)
(define-key UVtools-menu-bar-tools-map (vector (car bind)) (cdr bind))))
(nreverse
'((readdir "Get UV Directory or File" . uv-find-file)
(viewfile "List UV File Items" . list-uv-file)
(readitem "Read UV File Item" . read-item)
(writeitem "Write UV File Item" . write-item)
(viewitem "View Formatted UV File Item" . view-uv-item)
(uvshellcmd "Execute UV Shell Commands" . uv-shell-cmd)
)))
(add-hook 'menu-bar-update-hook 'UVtools-update-menu-bar t)
;; End of uv-tools.
