;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;; ;;;;;;;; ;;;;;; All files in this directory or any subdirectories are ;;;;;;;; ;;;;;; copyright 1997, 1998, 1999, 2000, 2002, 2003. ;;;;;;;; ;;;;;; by Rafael D. Sorkin. All rights reserved. ;;;;;;;; ;;;;;; ;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; bibliotek.emacs.el Time-stamp:<2003-Dec-05 22:33:36 16337.19984> ;========================================================================= ; Functions to enhance the operation of the emacs editor ; ; They could in principle go into { .emacs } but are put here instead, usually ; because they use csynf or algo similar. (At one time they waited to be ; autoloaded, but now we just load the whole file at startup from .emacs). ; ; WE DON'T COMPILE THEM (neither are the functions in .emacs compiled). ; ; For MH and other mail things see ~/Mail/bibliotek.mh.el ;========================================================================= ;: Roster of functions and variables ; ; Grep ; refgrep ; utupe ; restore-unmodified-buffer ; sasa ; ts (stands for time stamp) ; ; macroexpand-region ; lisp-insert-comment ; lisp-retrieve-result ; gcl ; maple ; clisp ; scheme ; ; mime-decode-attachment ; display-8-bit-accents ; convert-8-bit-accents ; clean-windows-garbage ; email-forward-mime-message ; ; anza-comment ; bookmarks-set ; footnote (move to bib.eltex?) ; ; tunza ; *kutunza-destinations* (MACHINE DEPENDENT, set in .emacs.local) ; nakili-file-umojani (andika-file-umojani is commented out) ; andika-file-kwa-rcp ; andika-file-sunix ; ; chapa-region-nyumbani ; chapa-region-shuleni ; chapa-file-nyumbani ; (commented out:) andika-region-nyumbani ; ps-chapa-region ; ps-chapa-buffer ; ps-right-margin (value) ; ps-print-buffer (plist) ; ps-print-region (plist) ; ; wrap-region-as-block ; fetch-block ; goto-block ; *block-0* ; *block-1* ; ; ngojea ; warning-message ; ; outline-ellipses ;----------------------------------------------------------------------- ;: tengeneza (require 'preparations "~/lisp/preparations.el") ;: The functions ;:: Various I (defun Grep () (interactive) (call-interactively 'grep) (other-window 1) (delete-other-windows) ;; (next-line 1) (toggle-line-truncation)) (deff Grep-find () "\ Runs `grep-find' slightly more conveniently. " (interactive) (call-interactively 'grep-find) (other-window 1) (delete-other-windows) (toggle-line-truncation) (when (y-or-n-p "Shall I flush all that appear to be backup files ") (setf (current-buffer) "*grep*") (beginning-of-buffer) (flush-lines "~:[0-9]"))) (deff refgrep (name) (interactive "sSearch bibliographies for: ") (grep (concat "zgrep -isn " ;; "zgrep -isn -A2 " ;;; temporarily changed name " ~/ms/refs.*[^~] " " ~/Repository/2_Bibliographies/*[^~] " ;; " ~/Repository/@Bibliographies.lk/*[^~] " " ~/Repository/[n] " " ~/Repository/*/References " " ~/Repository/*/*/References " " ~/Repository/1_Articles.to.lookup " )) (unless (equalp (buffer-name) "*grep*") (other-window 1)) (goto-line 2) (toggle-line-truncation) (message "Toggle line truncation to see full lines. May still be running!)")) ; ; Because emacs had trouble parsing the filname "1:Articles.to.lookup" ; we changed it to "1_Articles.to.lookup". ; Similarly, we have used "[n]" rather than "8:Notes.from.books.etc" ; The problem comes when we use ^C^C to go to the reference (not in finding it ; in the first place) (deff utupe (&optional overwrite) "\ This is intended to provide `utupe' from within dired. It will move the file on the current line to the directory ~/.Taka, but will not overwrite a file already there, unless the optional arg `overwrite' is nonnil. \ " (interactive "P") (require 'preparations "~/lisp/preparations.el") (varbind x (dired-get-filename) y (concat "~/.Taka/" (dired-get-filename 'no-dir)) ow (o not not overwrite)) (when (y-or-n-p (format " ? %s ? " (dired-get-filename 'no-dir))) (dired-rename-file x y ow))) ; ; Notes ; ; The third argument to `dired-rename-file' is a flag, whose meaning is not ; documented. Empirically, if it is nil you won't overwrite another file of ; the same name, if it is t then you will. Are there other values? ; ; Instead of providing an optional argument, as we have done, you ; could get it to ASK whether to overwrite, by use of error handling. ; Or (more simply?) could just check for the file there, and ask first ; whether to overwrite if it's present. ; ; It is important in `interactive' that you use big "P" because using little ; "p" makes a void argument turn into the number 1 (!) ; ; The alternative approach to use `dired-do-shell-command' is bad, because it ; won't update the file list. (deff restore-unmodified-buffer (&optional (max 16)) "\ Undoes changes until unmodified buffer is restored up to a maximum of 16 tries, then asks whether to continue. (Before answering you can do ^L to see better the current buffer state.) " (interactive) (varbind lbul buffer-undo-list) (loop for j from 0 while (<= j max) do (setf lbul (primitive-undo 1 lbul)) (message "%s `undo's completed" j) if (not (buffer-modified-p)) return t if (and (= j max) (y-or-n-p (format "Not restored after %s tries, keep trying? " j))) do (setq max (+ max 16)))) (defalias 'recover-unmodified-buffer 'restore-unmodified-buffer) (deff sasa (&optional date-only) " Insert current date and time in buffer at point (date only if arg)" (interactive "P") ;------------------------------------- ;/assemble components of date and time ;------------------------------------- (varbind year-and-month (format-time-string "%Y %b ") day-of-month (format-time-string "%d ") week-day-and-time (format-time-string "%a %T %Z") emacs-numerical-time (current-time)) ;------------- ;/massage them ;------------- (setq day-of-month (if (equal ?0 (elt day-of-month 0)) (subseq day-of-month 1) day-of-month) emacs-numerical-time (format " %s %s" (nth 0 emacs-numerical-time) (nth 1 emacs-numerical-time))) ;---------------------------------- ;/insert specified things in buffer ;---------------------------------- (cond (date-only (insert year-and-month day-of-month)) (else (insert year-and-month day-of-month week-day-and-time emacs-numerical-time)))) (deff ts (&optional nosave) " Update time stamp in buffer. Save file if no prefix arg." (interactive "P") (varbind time-stamp-format (concat (format-time-string "%Y-%b-%d %T ") (format "%s.%s" (nth 0 (current-time)) (nth 1 (current-time))))) (time-stamp) (unless nosave (save-buffer))) ; ; The `time-stamp-format' is also set in .emacs (along with other ; parameters), so we don't really need to duplicate it here. ; The syntax we use currently might cease to be allowed someday (see ; comments in .emacs) ;;: Stuff for editing papers (deff anza-comment (arg) "\ Insert a comment template. It will contain [[ ]] unless there's a prefix argument. " (interactive "P") (cond (arg (insert "%%(RDS) ")) (else (varbind insert "%% [[(RDS) ]] " n (length insert)) (insert insert) (backward-char (- n 11))))) (deff bookmarks-set () "\ Set bookmarks in both buffers on the screen (ie for the @ files), using the buffer names as the names of the bookmarks. " (interactive) (save-excursion (bookmark-set (buffer-name)) (other-window 1) (bookmark-set (buffer-name)) (other-window -1) (message "Bookmarks set in both buffers"))) ;;; Shouldn't this go to bibliotek.eltex ? (deff footnote () " Insert template for an eltex sytle footnote" (interactive) (insert "\\footnote{}\n%\n{\n}\n%") (previous-line 2)) ;:: Stuff to use the ps- package within emacs ;; We don't want to print accidentally so we disable following ; also it seemed to produce multiple copies (on bananoid)! ; (We do same thing in .emacs too for good measure) (put 'ps-print-buffer 'disabled t) (put 'ps-print-region 'disabled t) ; ; Here was a more drastic way to disable: ; (defun ps-print-buffer () ; (interactive) ; (error "Don't use this! Use ps-spool-region or ps-chapa instead")) (setq ps-right-margin 76) ; apparently best possible at umoja printer? (defun ps-chapa-region () "\ Write postscript version of region to the file ~/chapa/takataka.ps for subsequent printing, then suspend emacs. " (interactive) (ps-print-region (region-beginning) (region-end) "~/chapa/takataka.ps") (suspend-emacs "if [ `dirs +0` != \"~/chapa\" ]; then pushd ~/chapa; fi; ls taka*.ps;")) (defun ps-chapa-buffer () "\ Write postscript version of buffer to the file ~/chapa/takataka.ps for subsequent printing, then suspend emacs. " (interactive) (ps-print-buffer "~/chapa/takataka.ps") (suspend-emacs "if [ `dirs +0` != \"~/chapa\" ]; then pushd ~/chapa; fi; ls taka*.ps;")) ;:: The functions ngojea and warning-message (+ code to auto-start ngojea) (deff ngojea () "\ Just idles, generating periodic output. Puts you into buffer ``*scratch*'' Issues warning messages once a time of `limit' has elapsed. Idling terminates when keyboard input is received. (There exists also a `ngojea' for use outside of emacs, at shell level.) \ " (interactive) (varbind mvivu 5 saa 0 limit (* 60 20)) (save-excursion (switch-to-buffer "*scratch*" nil) (loop do (message "nimengojea kwa sekondi %d (dakika %d)" saa (/ saa 60)) unless (sit-for mvivu) return nil do (message "ninangojea bado (dakika %d)" (/ saa 60)) unless (sit-for mvivu) return nil do (setq saa (+ saa (* 2 mvivu))) ; update saa do (if (> saa limit) (warning-message))))) ; ; Explanatory Notes ; ; All times are in seconds ; ; mvivu = wait cycle time ; saa = accumulated time (once we began with 30, why?) ; limit = time for warning ; ; `sit-for' returns `t' if it completes without interruption, this allows ; it to be used as a kind of timer, and also to break out of the loop if ; it is interrupted. ; ; For some reason `save-excursion' does not restore the original buffer (defun warning-message () "\ Issues a warning message that time is running out. Use in conjuction with `run-at-time' `ngojea' or whatever. " (interactive) (save-excursion (ding) (delete-other-windows) (with-output-to-temp-buffer "*WARNING*" (princ (make-string 2000 ?@))) (sit-for 1) (with-output-to-temp-buffer "*WARNING*" (princ (concat " * WARNING * WARNING * WARNING * WARNING * " "\n\n\n " "! Check the Time ! " "\n\n\n\n" " " "Before bing kicked off, you may want to clean up \n" " " "(purge, compress, save abbrevs, ...). \n" " " "Perhaps also set a bookmark to know where to resume. " "\n " ))))) ;; The following will turn on `ngojea' automatically if (we are in emacs and) ; the terminal is idle for 30 seconds, and if it thinks we are at home ; (as indicated by terminal type or machine name). ; Not needed at present, so commented out. ; ; (if ; (or ; (equal *termtype* "vt320") ; (equal (system-name) "umoja.syr.edu") ; ) ; (run-with-idle-timer 30 'repeat 'ngojea)) ;:: Stuff for moving a block of text from one place to another ; REMARK ; Good to use markers since they move with text when insertions are made. (global-set-key "\^C\^S" (quote wrap-region-as-block)) (global-set-key "\e\^^" (quote fetch-block)) ; this is the key M-^ ;; (global-set-key "\^C\^F" (quote fetch-block)) (defvar *block-0* (make-marker) "marker used by `fetch-block' after being set by `wrap-region-as-block'") (defvar *block-1* (make-marker) "marker used by `fetch-block' after being set by `wrap-region-as-block'") (deff wrap-region-as-block () "\ Mark a block of text for removal (or copying) to somewhere else. Also copy the block ``as if it had been killed''. (The text to be ``marked'' is that bounded by `point' and `mark', ie it is ``the region''. To mark it, we set `*block-0*'/`*block-1*' before/after it.) " (interactive) ;------------------- ;/set up the markers ;------------------- (set-marker *block-0* (region-beginning)) (set-marker *block-1* (region-end)) ;-------------------------- ;/show user what was marked ;-------------------------- (exchange-point-and-mark) (sit-for 0.8) (exchange-point-and-mark) (sit-for 0.6) ;------------------------ ;/also save on kill ring ;------------------------ (copy-region-as-kill *block-0* *block-1*) (message "Region wrapped as block ")) ; ; We also save it, in case user forgets how exactly s/he grabbed it (deff fetch-block (&optional (copy-only nil)) "\ Moves a block of text from one place to another. First ``activate'' the block using `wrap-region-as-block', then position the cursor where you want the block to go. After the transfer, point and mark will surround the fetched text, with mark before and point after. If the optional argument `copy-only' is true then we don't delete the text from its original home (and the original block remains ``active''). \ " (interactive "P") (vbind from-buffer (marker-buffer *block-0*) to-buffer (current-buffer) from=to (equal from-buffer to-buffer)) (if (not from-buffer) (error "Must wrap block before fetching it ")) (if (and from=to (<= *block-0* (point)) (<= (point) *block-1*)) (error "Attempt to move block to point within itself")) ;----------------------------------------------------------------- ;/ask confirmation if text is to be deleted from some other buffer ;----------------------------------------------------------------- (vbind OK (or copy-only from=to (y-or-n-p (format "? Transfer text here from the buffer \"%s\" ? " (buffer-name from-buffer))))) (unless OK (error "No text transferred ")) ;------------------------------- ;/bring the text to new location ;------------------------------- (set-buffer to-buffer) (set-mark-command nil) (insert-buffer-substring from-buffer *block-0* *block-1*) ;---------------------------------------------------------------------------- ;/delete from old location and de-acativate block unless instructed otherwise ;---------------------------------------------------------------------------- (unless copy-only (set-buffer from-buffer) (delete-region *block-0* *block-1*) (setq *block-0* (make-marker))) ; unwrapping the block left behind ;---------------------------------------- ;/message to user if two distinct buffers ;---------------------------------------- (unless from=to (message (if copy-only "Text copied here from buffer %s. Block still active!" "Text transferred here from buffer %s") from-buffer))) (defalias 'bring-selected-text 'fetch-block) (deff goto-block () "\ If a block of text is ``active'' (has been ``wrapped'') then go to it, and let it be the `region' in its buffer." (interactive) (vbind block-buffer (marker-buffer *block-0*)) (setf (current-buffer) block-buffer (point) *block-0* (mark) *block-1*) (switch-to-buffer block-buffer)) ;:: Various II (deff tunza () "\ Yatunza the current buffer. Backup files go to addresses listed in the global variable `*kutunza-destinations*' \ " (interactive) (varbind destinations *kutunza-destinations*) ;----------------------------------------------------------------------- ;/specify buffer to take output from shell command and name of temp file ;----------------------------------------------------------------------- (varbind command-out "*kutunza*" tempfile "*kutunza*.tmp") ;----------------------------------------------------- ;/get name of file and extract its last two components ;----------------------------------------------------- (varbind full-filename buffer-file-name short-name (subseq full-filename (1+ (string-match "/[^/]*/[^/]*$" full-filename)))) ;------------------- ;/update time-stamp ;------------------- (time-stamp) ;---------------------------------------- ;/write buffer contents to temporary file ;---------------------------------------- (write-region (point-min) (point-max) tempfile) ;--------------------------- ;/ask whether to save buffer ;--------------------------- (if (and (buffer-modified-p) (y-or-n-p "Save file locally? ")) (save-buffer)) ;---------------------------------- ;/Mail copies out to `destinations' ;---------------------------------- (loop for kuda in destinations do (shell-command (concat "< " tempfile " Mail " " -s " (concat "'" "[backup]" short-name "'") " " kuda) command-out)) ;---------------------- ;/delete temporary file ;---------------------- (delete-file tempfile) ;------------------------------------------------------------------- ;/finally issue completion message, and show output if there was any ;------------------------------------------------------------------- (message "imetunzwa: %s " short-name) (if (get-buffer command-out) (switch-to-buffer (get-buffer command-out)))) ; ; NOTES ; ; The destinations are set in the file { ~/.emacs.local.el } ; ; Now `shell-command' *does* appear to return the return status of the ; command (previously it seemed to return `t' no matter what happened). So ; should we we now monitor the return status directly to detect problems? ; ; Output from the command should appear in buffer "*Shell Command Output*". ; If an error message comes from the shell it should appear in ; buffer "*kutunza*" and be displayed. ; ; old version of subject line: " -s " (concat "[backup]" short-name) ; ; Should we make this uuencode the file first? (deff macroexpand-region () " REPLACE region by its pretty-printed macro expansion " (interactive) (varbind H (read (buffer-substring (region-beginning) (region-end)))) (setf (buffer-substring (region-beginning) (region-end)) (pp (Macroexpand H)))) (deff lisp-insert-comment () " insert comment line into lisp code before current line" (interactive) ;---------------------------------------------------------- ;\get the text of the comment and make a border line for it ;---------------------------------------------------------- (varbind comment-line (read-from-minibuffer "comment: " ";/") border-line (make-string (1- (length comment-line)) ?-)) ;------------------ ;/insert top border ;------------------ (beginning-of-line) (open-line 1) (indent-for-tab-command) (backward-delete-char-untabify 1) (insert (concat ";" border-line)) (newline) ;---------------------- ;/insert comment itself ;---------------------- (indent-for-tab-command) (backward-delete-char-untabify 1) (insert comment-line) (newline) ;--------------------- ;/insert bottom border ;--------------------- (indent-for-tab-command) (backward-delete-char-untabify 1) (insert (concat ";" border-line))) ;;; Many things for running lisp are still in the .emacs file ;;; Next seems designed for cmulisp only but apparently works for gcl too??? (deff lisp-retrieve-result () " Retrieve last output value from inferior lisp buffer and insert" (interactive) (save-excursion (cmulisp) (other-window 1) (beginning-of-line) (backward-char) (varbind b (point)) (backward-sexp) (beginning-of-line) (varbind a (point)) (varbind value (buffer-substring a b)) (end-of-buffer) (other-window -1) (indent-for-comment) (insert " ") (insert value))) ; ; This assumes that point will be at the end of the inferior lisp buffer (deff gcl () "\ Run GNU Common Lisp as an inferior lisp (or bring up one already running). The key [kp-f2] will send last sexp as input. The key [f7] will send something to clear errors. " (interactive) (save-excursion ;------------------------------------------------------------- ;/get the current buffer and the running gcl (if there is one) ;------------------------------------------------------------- (varbind running-gcl (get-process "inferior-lisp") current-buffer (current-buffer)) ;-------------------------------------- ;/case where a gcl is already running ;-------------------------------------- (when running-gcl (pop-to-buffer "*inferior-lisp*" t) (end-of-buffer) (other-window 1)) ;; (inferior-lisp "gcl") ;------------------------------- ;/case where no gcl is running ;------------------------------- (when (not running-gcl) (inferior-lisp "gcl") (if (y-or-n-p "Load the biblioteks? ") (process-send-string "inferior-lisp" (concat "(require 'preparations " "\"" (expand-file-name "~/") "lisp/TCL/preparations.gcl" "\")\n")))) ;------------------------------------------- ;/try to keep cursor at bottom of gcl window ;------------------------------------------- (setq comint-scroll-to-bottom-on-input t) (setq comint-scroll-to-bottom-on-output t) ;---------------------------------------------------- ;/remind user yeye can have input sent in lisp buffer ;---------------------------------------------------- (message "`toggle-echo-input' is available"))) ; ; The def of the [kp-f2] and [f7] keys is in a hook in the .emacs file (deff maple() "\ Run maple as an inferior process. Make the key [kp-f2] send (the entire) current line as input. CAUTION once you run this all ^M will be stripped from output of ANY inferior process! " (interactive) ;--------------------------------- ;/save current buffer and location ;--------------------------------- (varbind marker (point-marker)) (save-excursion ;------------------------------------------------ ;/make the key [kp-f2] send current line as input ;------------------------------------------------ (global-set-key [kp-f2] (lambda () (interactive) (csynf (pop-to-buffer "*Maple*" t) ; bring up maple window (other-window 1) (beginning-of-line) (varbind start (point)) (end-of-line) (varbind stop (point)) (varbind string (buffer-substring start stop)) (process-send-string "Maple" (concat string "\n"))))) ;---------------------------- ;/stripping of ^M from output ;---------------------------- (add-hook 'comint-preoutput-filter-functions (lambda (str) (remove ?\C-M str))) ;----------------- ;/comment handling ;----------------- (setq comment-start "#" comment-end "" comment-start-skip "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\)#+ *") ;--------------------------------------------- ;/start up Maple and adjust location of cursor ;--------------------------------------------- (delete-other-windows) (make-comint "Maple" "maple") (setf (current-buffer) (pop-to-buffer "*Maple*")) (recenter)) ;------------------------------------ ;/restore current buffer and location ;------------------------------------ (switch-to-buffer-other-frame (marker-buffer marker))) ; ; The `recenter' seems needed to make contents of maple window appear. ; Following failed to produce their desired effects ; (other-window -1) ; save-excursion doesn't work ; (setf (point-marker) marker) ; Not clear that `save-excursion' does anything, but we keep it anyhow (defun clisp () (interactive) (inferior-lisp "clisp")) ; for xochitl,sphinx (defun scheme () (interactive) (inferior-lisp "guile")) ; for ICN machines (deff mime-decode-attachment () "\ Decode a MIME attachment in the current buffer. (In the case of multiple attachments, it's often easier just to write the whole message to a file and call `munpack -t' on it -- especially if in the end you want each decoded attachment to be in its own file.) When you call this, ``region'' should contain precisely one MIME attachment. (It needn't include either ``boundary marker'', however.) The decoded text will replace the original and will be on a page of its own (ie will be wrapped in ^L). The name of the attachment will appear at the beginning of the decoded text, where `point' will also be. NB The directory { ~/.unpacking/ } must be empty when this function is called. \ " (interactive) ;-------------------------- ;/specify working directory ;-------------------------- (vbind wdir "~/.unpacking/") ;---------------------------------------- ;/check that unpacking directory is empty ;---------------------------------------- (vbind files (remove ".." (remove "." (directory-files wdir)))) (if files (error "Please empty %s first" wdir)) ;----------------------------------------------------------- ;/make sure point is at start of region, rather than end ;----------------------------------------------------------- (if (< (mark) (point)) (exchange-point-and-mark)) ;-------------------------------- ;/write region out to `mime.tmp' ;-------------------------------- (write-region (region-beginning) (region-end) (concat wdir "mime.tmp")) ;----------------------------------------------------------------------- ;/unpack and delete `mime.tmp'. Then rename unpacked file to "mime.out" ;----------------------------------------------------------------------- (save-excursion (shell-command (format "munpack -t -C %s %smime.tmp" wdir wdir) t)) (delete-file (format "%smime.tmp" wdir)) (setq files (remove ".." (remove "." (directory-files wdir)))) (assert (singleton-p files) nil "Tried to unpack more than one attachment") (vbind unpacked-short-name (car files) unpacked-file (format "%s%s" wdir unpacked-short-name)) ;---------------------------------------------- ;/replace region with decoded text between ^F's ;---------------------------------------------- (vbind newpage "\n\f\n") (delete-region (region-beginning) (region-end)) (insert "\n\n") (insert unpacked-short-name) (insert newpage) (insert-file unpacked-file) (exchange-point-and-mark) (insert newpage) (exchange-point-and-mark) ;----------------------------- ;/delete the unpacked file too ;----------------------------- (delete-file unpacked-file) (message "region unpacked, name seems to be %s" unpacked-short-name)) ; ; ; NOTES ; ; The final `t' argument to `shell-command' tells emacs to insert any output ; into the current buffer. ; ; The -t option to `munpack' tells it to unpack the text parts as well ; ; The -C option to `munpack' changes the current directory before unpacking. ; Otherwise the unpacked file(s) would go somewhere else. (deff display-8-bit-accents (limited) "\ We ``activate'' certain 8-bit characters so emacs will send them to the terminal ``as themselves''. These include the accented characters occuring in Espan~ol, but (absent a prefix argument) you also get many more. To undo this, just kill the buffer. \ " (interactive "P") ;---------------------------------------------------- ;/make a display table for the buffer if it lacks one ;---------------------------------------------------- (unless buffer-display-table (setf buffer-display-table (make-display-table))) ;---------------------------------------- ;/choose which characters to ``activate'' ;---------------------------------------- (varbind characters (if limited (list 161 193 201 205 209 211 218 220 225 233 237 241 242 243 250 252 191) (loop for j from 160 below 256 collect j))) ;-------------------------------------- ;/make these characters "be themselves" ;-------------------------------------- (loop for n in characters do (setf (elt buffer-display-table n) (vector n)))) (deff convert-8-bit-accents () "\ Mainly for 8 bit spanish characters, this converts them to plain letters together following (or preceding) accents, all taken from the 7-bit ascii codes. Instead of using this, consider using `display-8-bit-accents' which will ``activate'' these letters as is for the vt320. \ " (interactive) (save-excursion (replace-string "¿" "?" nil)) ; inverted `?' ; (save-excursion (replace-string "Á" "A'" nil)) (save-excursion (replace-string "É" "E'" nil)) (save-excursion (replace-string "Í" "I'" nil)) (save-excursion (replace-string "Ñ" "N~" nil)) (save-excursion (replace-string "Ó" "O'" nil)) (save-excursion (replace-string "Ú" "U'" nil)) (save-excursion (replace-string "Ü" "{U\"}" nil)) ; (save-excursion (replace-string "á" "a'" nil)) (save-excursion (replace-string "é" "e'" nil)) (save-excursion (replace-string "í" "i'" nil)) (save-excursion (replace-string "ñ" "n~" nil)) (save-excursion (replace-string "ò" "`o" nil)) (save-excursion (replace-string "ó" "o'" nil)) (save-excursion (replace-string "ú" "u'" nil)) (save-excursion (replace-string "ü" "{u\"}" nil)) ; (message "8-bit Spanish accents converted to plain ascii")) ; NOTE for the last two functions ; ; The above a.s. reflects the iso-8859-1 (Latin 1) character set, which was ; derived from DEC's Multinational Character Set (the vt320 has both). ; It also coincides with the first 256 characters in the "unicode" numbering. ; However, the latter are basically 32 bit codes, not 8. ;; Following is for some obscure system that shows up in some emails ; (query-replace "=C9" "E'" nil) ; (query-replace "=E1" "a'" nil) ; (query-replace "=E8" "e'" nil) ; (query-replace "=E9" "e'" nil) ; (query-replace "=EC" "i'" nil) ; (query-replace "=ED" "i'" nil) ; (query-replace "=F2" "o'" nil) ; (query-replace "=F3" "o'" nil) ; (query-replace "=FA" "u'" nil) ; (query-replace "=F1" "n~" nil) ; ; (query-replace "=93" "``" nil) ? ; (query-replace "=94" "''" nil) ? (deff clean-windows-garbage () "\ Removes garbage emanating from microsoft windows machines, also converts some 8bit windows stuff to what it should be, eg apostrophe" (interactive) (save-excursion (query-replace-regexp " =$" " " nil)) (save-excursion (query-replace-regexp "=\n" "" nil)) (save-excursion (query-replace-regexp "=20$" "" nil)) (save-excursion (query-replace-regexp "‘" "`" nil)) ; ok? (save-excursion (query-replace-regexp "’" "'" nil)) (save-excursion (query-replace-regexp "“" "``" nil)) (save-excursion (query-replace-regexp "”" "''" nil)) (save-excursion (query-replace-regexp "–" " -- " nil)) ; ok? (save-excursion (query-replace-regexp "—" " -- " nil)) ; ok? (save-excursion (query-replace-regexp "=2E" "." nil)) ; ok? (save-excursion (query-replace-regexp "=3D" "=" nil)) ; ok? (save-excursion (query-replace-regexp "=09\n" "\n" nil)) ; ok? ) ; ;; Another possibility ; (query-replace "=0D" "" nil) (deff email-forward-mime-message (selfcopy destination) "\ Forward contents of buffer literally, using sendmail. To get a self copy, give a prefix arg. The idea is that MIME ``attachments'' will be preserved. You can use this either to forward a MIME-formatted email received from someone else or to send one you have created yourself. In interactive use, you will be prompted for `destination', which should be a valid email address bila aliases etc. The buffer should be a validly formatted message, suitable for passing to `sendmail'. The header -- which does not influence who actually gets the message! -- will go out exactly as is (unless it is missing altogether, in which case a minimal one will probably be provided.) We return the exit code of the `sendmail' command, which is nonzero iff an error occurred. ADVERTENCIA The `To:' and `cc:' fields in the message currently have no effect on where the message goes! \ " (interactive "P\nMdestination: ") ;---------------------------------------- ;/write buffer contents to temporary file ;---------------------------------------- (vbind tempfile-name "~/.Taka/*literal-forwarding*.tmp") (write-region (point-min) (point-max) tempfile-name) ;------------------ ;/invoke `sendmail' ;------------------ (varbind return-code (shell-command (if selfcopy (format "<%s sendmail %S,%S" tempfile-name destination (mh-expand-alias "self")) (format "<%s sendmail %S" tempfile-name destination)))) ;---------------------- ;/delete temporary file ;---------------------- (delete-file tempfile-name) ;---------------------------------------------- ;/show user return code from `sendmail' command ;---------------------------------------------- (if (= 0 return-code) (message "%s sent (i hope) to `%s'" (if (equal "show-+inbox" (buffer-name)) (car mode-line-buffer-identification) (buffer-name)) destination) (message "Sending seems to have failed, return code was %s" return-code))) ; ; ; We could add " -Nsuccess,failure,delay " ; ; We could make it take the address from the To: and cc: fields rather than ; ask for them interactively. ; ; This invokes `sendmail' but does not rely on MH in any way (deff nakili-file-umojani () "\ Update time stamp, save buffer, and copy its contents (destructively) to a file of the same name on umoja's disks. Use this only when you are logged into umoja ``as if on suhep''. If you are really logged on to suhep this won't work! \ " (interactive) ; (varbind original-home "/home1/sorkin/" copy-home "/home/rdsorkin/") ; (unless (member system-name (list "umoja.syr.edu" "umoja.phy.syr.edu")) (error "Can only use this from umoja")) (unless buffer-file-name (error "Buffer has no file")) (unless (equal (subseq buffer-file-name 0 14) original-home) (error "Only use this if you are ``pretending to be at suhep''")) (unless (or (not (buffer-modified-p)) (y-or-n-p "Continue even though buffer will be saved? ")) (error "Sijanakili file")) ;----------------------------------------------------------------- ;/get name of file @ current buffer and form further names from it ;----------------------------------------------------------------- (varbind filename (subseq (abbreviate-file-name buffer-file-name) 2) tempname (format "%s%s.tmp" copy-home filename) copy-name (format "%s%s" copy-home filename)) ;--------------------------------------- ;/avoid overwriting eigen-files of umoja ;--------------------------------------- (if (member filename (list ".bash_profile" ".bashrc.local" ".rhosts" ".forward")) (error "Don't overwrite umoja's version of { %s } !" filename)) ;---------------------------------- ;/update time stamp and save buffer ;---------------------------------- (ts) ;------------------------------------------------------------ ;/write to temp file in counterpart directory on umoja disks ;------------------------------------------------------------ (write-region (point-min) (point-max) tempname) ;--------------------------------- ;/rename temp file to correct name ;--------------------------------- (rename-file tempname copy-name 'overwrite) (message "written to: %s" copy-name)) ; ; The reason for copying first and then moving the copy is to protect the ; previous version from being erased. If a writing error occurs due to full ; disks, then it should only affect the temp file: execution should stop at ; that point, and old file should not be touched. (deff redefine-outline-ellipses () " Changes ellipses from { ... } to something else, currently { <> }" (interactive) (unless buffer-display-table (setf buffer-display-table (make-display-table))) (set-display-table-slot buffer-display-table 'selective-display [? ?< ?>])) (defalias 'outline-ellipses 'redefine-outline-ellipses) ;: e n d