;;;MY COLLECTION OF nonlibrary FCNS. ;; Time-stamp: <2002-07-16 10:00:01 deego> ;; Copyright (C) 2002 D. Goel ;; Copyright (C) 2002 Free Software Foundation, Inc. ;; Emacs Lisp Archive entry ;; Filename: functions-my.el ;; Package: functions-my ;; Author: Deepak Goel ;; Version: ;; For latest version: (defvar functions-my-home-page "http://www.glue.umd.edu/~deego") ;; This file is NOT (yet) part of GNU Emacs. ;; This is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; This is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;;========================================== ;;; Code: ;;;###autoload (defun switch-to-compiler-input-my () (interactive) (delete-other-windows) (split-window-vertically) (switch-to-buffer " *Compiler Input*") ) ;;;Tue Feb 20 18:22:21 2001 ;;;###autoload (defun switch-to-scratch-my () (interactive) (delete-other-windows) (split-window-vertically) (switch-to-buffer "*scratch*") ) ;;; 2002-05-15 T16:52:56-0400 (Wednesday) D. Goel (defun switch-to-buffer-two-windows-my (bname) "Switches to buffer, ensuring that there are atmost two windows... if however, we are already in the right buffer, no further widow-manipulaiton is done... " (unless (string= (buffer-name) bname) (delete-other-windows) (split-window-vertically) (switch-to-buffer bname))) ;;; 2002-05-04 T18:24:02-0400 (Saturday) D. Goel ;;;###autoload (defun switch-to-group-my () (interactive) (switch-to-buffer-two-windows-my "*Group*") ) ;;; 2002-04-02 T09:33:07-0500 (Tuesday) Deepak Goel ;;;###autoload (defun switch-to-messages-my () (interactive) (delete-other-windows) (split-window-vertically) (switch-to-buffer "*Messages*") ) ;;;###autoload (defun prevent-editing-TAGS-my () "" (if (string= (buffer-name) "TAGS") (view-mode-enter) )) ;;;###autoload (defun prevent-editing-elder-generated-files-my () "See function-name.." (interactive) (if (file-exists-p (concat buffer-file-name ".e")) (view-mode-enter)) ) ;;;###autoload (defun info-my () (interactive) ;;; (setq Info-directory-list ;;; '("/usr/local/lib/info/" "/usr/local/info/" ;;; "/usr/local/gnu/info/" "/usr/share/local/gnu/info/" ;;; )) (setq Info-directory-list '("/usr/share/local/gnu/info/" )) (info "/usr/share/local/gnu/info/dir") ) ;;;###autoload (defun log2 (arg) (/ (log arg) (log 2)) ) ;;;###autoload (defun log10 (arg) (/ (log arg) (log 10)) ) ;;;###autoload (defun make-text-mode-my () "Makes a file default-text-mode and also turns on the text-mode." (interactive) (push-mark) (beginning-of-buffer) (insert " -*-text-*- \n") (text-mode) (exchange-point-and-mark) ) ;;;###autoload (defun make-outline-mode-my () "Makes a file default-outline-mode and also turns on the outline-mode." (interactive) (push-mark) (beginning-of-buffer) (insert " -*-outline-*- \n") (outline-mode) (exchange-point-and-mark) ) ;;;###autoload (defun make-latex-mode-my () "Makes a file default-text-mode and also turns on the text-mode." (interactive) (push-mark) (beginning-of-buffer) (insert " %-*-Latex-*- \n") (text-mode) (exchange-point-and-mark) ) ;;;###autoload (defun make-html-mode-my () "Makes a file default-text-mode and also turns on the text-mode." (interactive) (push-mark) (beginning-of-buffer) (insert " \n") (text-mode) (exchange-point-and-mark) ) ;;;###autoload (defun dir-file-ext-my (file) "Given a full file's pathname, returns a list of directory, filename and extension. The extension contains the ., and the directory contains the / See also file-name-directory and file-name-nondirectory.. " (interactive "s String: ") (with-temp-buffer (insert file) (goto-char (point-max)) (let ((aa (progn (goto-char (point-max)) (search-backward "/" nil t))) (bb (progn (goto-char (point-max)) (search-backward "." nil t)))) (setq aa (if (null aa) (point-min) (+ aa 1))) (if (null bb) (setq bb (point-max))) (if (> aa bb) (setq bb (point-max))) ;that means that the . occurs in ;the pathname rather than filename. (let ((cc (list (buffer-substring (point-min) aa) (buffer-substring aa bb) (buffer-substring bb (point-max))))) (if (interactive-p) (message (format "%S" cc))) cc))) ) ;;;Thu Mar 1 16:16:06 2001 ;;;###autoload (defun rcdarkanoid () (interactive) (runshell-cd "~/emacs/emacspub/arkanoid/alpha") (find-file "arkanoid.el") ) ;;;###autoload (defun rcdclel () (interactive) (runshell-cd "~/emacs/emacspub/clel/alpha") (find-file "clel.el") ) ;;;Mon Jan 15 02:59:10 2001 ;;;###autoload (defun rcd-lines () (interactive) (runshell-cd "~/emacs/emacspub/lines/alpha") (find-file "lines.el") ) ;;;###autoload (defun rcdmct () (interactive) (runshell-cd "~/plasma/mct") (find-file "mct.tex.e") ) ;;;###autoload (defun rcdrunshell () (interactive) (runshell-cd "~/emacs/emacspub/runshell/alpha") (find-file "runshell.el") ) ;;;###autoload (defun rcdgnusfop () (interactive) (runshell-cd "~/emacs/emacspub/gnusp/alpha") (find-file "gnusfop.el") ) ;;;###autoload (defun rcdreduced () (interactive) (runshell-cd "~/plasma/reduced") (find-file "reduced.tex.e") ) ;;;###autoload (defun rcdunity() (interactive) (runshell-cd "~/emacs/emacspub/lisp-mine/unimax/") (find-file "README") ) ;;;###autoload (defun rcdworks () (interactive) (runshell-cd "~/plasma") (find-file "works.tex.e") ) ;;;###autoload (defun rcdminiedit () (interactive) (runshell-cd "~/emacs/emacspub/miniedit/alpha") (find-file "miniedit.el") ) ;;;###autoload (defun rcdautokey () (interactive) (runshell-cd "~/emacs/emacspub/autokey/alpha") (find-file "autokey.el") ) ;;;###autoload (defun rcdelder () (interactive) (runshell-cd "~/emacs/emacspub/elder/alpha") (find-file "elder.el") ) ;;;###autoload (defun rcdchoose () (interactive) (runshell-cd "~/emacs/emacspub/choose/alpha") (find-file "choose.el") ) ;;;###autoload (defun rcdbbdbrc () (interactive) (runshell-cd "~/emacs/emacspub/bbdbrc/alpha") (find-file "bbdbrc.el") ) ;;;###autoload (defun rcdidledo () (interactive) (runshell-cd "~/emacs/emacspub/idledo/dev") (find-file "idledo.el") ) ;;;###autoload (defun rcdrcd () (interactive) (runshell-cd "~/emacs/emacspub/runshell-shortcuts/alpha") (find-file "runshell-shortcuts.el") ) ;;;###autoload (defun rcdphonemode () (interactive) (runshell-cd "~/emacs/emacspub/phonemode/alpha") (find-file "phonemode.el") ) ;;;###autoload (defun rcdedlib () (interactive) (runshell-cd "~/emacs/emacspub/edlib/alpha") (find-file "edlib.el") ) ;;;###autoload (defun rcdsharp () (interactive) (runshell-cd "~/plasma/sharp") (find-file "sharp.tex.e") ) ;;;###autoload (defun rcdresume () (interactive) (runshell-cd "~/resume") (find-file "cvdg.tex.e") ) ;;;###autoload (defun rcdkz () (interactive) (runshell-cd "~/plasma/vshear") (find-file "kz.tex.e") ) ;;;Thu Mar 1 13:52:30 2001 ;;;###autoload (defun rcdgame () (interactive) (runshell-cd "~/emacs/emacspub/game/alpha") (find-file "game.el") ) ;;;Thu Apr 26 16:02:18 2001 ;;;###autoload (defun rcdsettags () (interactive) (runshell-cd "~/emacs/emacspub/settags/alpha") (find-file "settags.el") ) ;;;###autoload (defun rcdtimerfunctions () (interactive) (runshell-cd "~/emacs/emacspub/timerfunctions/alpha") (find-file "timerfunctions.el") ) ;;;###autoload (defun tex () (interactive) (runshell-cd "~/more/tex") ) ;;;###autoload (defun rcdmyarticle () (interactive ) (tex) (find-file "myarticle.tex.e") ) ;;;###autoload (defun rcdfilewatch () (interactive) (rcd "~/emacs/emacspub/filewatch/alpha") (find-file "deegoprofile.el") ) ;;;###autoload (defun rcdnewmail () (interactive) (runshell-cd "~/emacs/emacspub/newmail/alpha") (find-file "newmail.el") ) ;;;###autoload (defun rcdemacs () (interactive) (runshell-cd "~/emacs") ) ;;;###autoload (defun rcdvplusb () (interactive) (runshell-cd "~/plasma/vplusb") (find-file "vplusb.tex.e") ) ;;;###autoload (defun cycle-mode-my (&optional mode-list) "Cycles modes through a mode-list.. Being defined so can hotkey it to C-c m. Useful to edit .tex.e files." (interactive) (setq mode-list (if (null mode-list) '(emacs-lisp-mode latex-mode) mode-list)) (let ((nummodes (length mode-list)) (trunclist (member major-mode mode-list)) ) (eval (list (if (< (length trunclist) 2) (car mode-list) (cadr trunclist))))) (post-functions-my)) (defun cycle-additional-modes-my () "Cycle through more modes!!" (interactive) (cycle-mode-my '(emacs-lisp-mode html-mode latex-mode text-mode)) ) ;;;###autoload (defun toggle-mode-my () "Toggles modes between emacs and latex. Helpful for latex files.." (interactive) (cycle-mode-my '(emacs-lisp-mode latex-mode)) (post-functions-my)) ;;;###autoload (defun text-mode-my () (interactive) (text-mode) (post-functions-my)) ;;;###autoload (defun emacs-lisp-mode-my () (interactive) (emacs-lisp-mode) (post-functions-my)) ;;;###autoload (defun latex-mode-my () (interactive) (latex-mode) (post-functions-my)) ;;;###autoload (defun insert-demarker-my () (interactive) (insert "\n") (if (not (null comment-start)) (insert comment-start)) (if (not (null comment-start)) (insert comment-start)) (if (not (null comment-start)) (insert comment-start)) (insert "====================================================\n") ) ;;; 2002-05-03 T10:42:52-0400 (Friday) D. Goel ;;;###autoload (defun insert-demarker-no-comments-my () (interactive) (insert "====================================================\n") ) ;;; Save and LOAD FILE ********************************************** ;;;###autoload (defun save-and-load-lisp-file (arg) "Save the latest file, and load it as a LISP file With arg, eval-buffer instead of loading it.." (interactive "P") (save-buffer) (if arg (eval-buffer) (load buffer-file-name)) ) ;;8/10/00 ;;;###autoload (defun // (&rest args) "My sensible definition of /. Does not say 4 / 3 = 0. Note: this usues equal and not equalp, the last time i checked , equalp seemed to work as well.. " (let ((aa (apply '/ args))) (if (equal (car args) (apply '* aa (cdr args))) aa (apply '/ (cons (float (car args)) (cdr args)))))) ;; 7/25/00 ;;;###autoload (defun eval-last-sexp-my (internal-arg) "Helps deal with money.. 2 decimals.. In presence of argument, prints it at \(point\). Note that rounding will NOT work, because you rounding means \(/ (float (round (* 100 arg))) 100), but the last division by 100 itself is suspect, and can spoil the entire effect achieved by rounding. viz. (/ 234 100) can give 2.399999998. See? Also see my definition of //" (interactive "P") (let* ((aa (eval-last-sexp nil)) (bb (if (and (numberp aa) (not (integerp aa))) (string-to-number (format "%.2f" aa)) aa)) ;;(format "%s" aa))) (standard-output t)) (message "%S" aa) (unless internal-arg (sit-for 0.5)) (message "%S" bb) (unless internal-arg (sit-for 0.5)) (if internal-arg ;;(insert bb) (show-my bb "") (prin1 bb)) bb)) ;;;###autoload (defun add-dired-keybindings-my () (local-set-key "\C-cv" 'dired-view-command-my) (local-set-key "v" 'dired-view-command-my) (local-set-key " " 'scroll-up) (local-set-key "b" 'scroll-down) ) ;;;###autoload (defun dired-view-command-my () "View .dvi, .ps, .tex, .html files etc. Also allowing .html files to be viewed.." (interactive) (dired-view-file-my) ) ;;;###autoload (defun dired-view-file-my () "View a file based on extension.. assumes an active dired-listing... for glue.umd.edu: Assumes that u have tapped tetex.. Primarily meant for viewing files that are read-only to me.. Uses the function extension-my defined in .emacs.macros" (let* ((dir-file-ext (dired-get-filename)) (tmp-extlist (extension-my dir-file-ext)) (ext (car tmp-extlist)) (dir-file (cadr tmp-extlist)) (file-ext (dired-get-filename 'no-dir)) (tmp-ext2 (extension-my file-ext)) (file (cadr tmp-ext2))) (apply (lambda (arg) (if (null arg) (browse-url-lynx-xterm (concat "file:" dir-file-ext)) (eval (cadr arg)))) (list (assoc ext '( (".dvi" (progn (if (not (file-directory-p (concat "/tmp/" file ".ps"))) (shell-command (concat "dvips " dir-file-ext " -o /tmp/" file ".ps") (concat dir-file-ext ".dvips.shellcommand"))) (shell-command (concat "gv /tmp/" file " &") (concat dir-file-ext ".gv.shellcommand")))) (".tex" (progn (shell-command (concat "/bin/cp " dir-file-ext " " "/tmp/" file-ext)) (if (not (file-directory-p (concat "/tmp/" file ".ps"))) (progn (shell-command (concat "cd /tmp;" "latv " file " &") (concat dir-file-ext "latv.shellcommand"))) (shell-command (concat "gv " "/tmp/" file " &") (concat dir-file-ext "gv..shellcommand"))))) ; if .e, suggest that use revertfunctions.. (".e" (message "Suggestion: Please go use revertfunctions.")) (".ps" (shell-command (concat "gv " dir-file-ext " &") (concat dir-file-ext ".gv.shellcommand"))) (".pdf" (shell-command (concat "gv " dir-file-ext " &") (concat dir-file-ext ".gv.shellcommand"))) (".PDF" (shell-command (concat "gv " dir-file-ext " &") (concat dir-file-ext ".gv.shellcommand"))) ; (".html" ; (browse-url-lynx-xterm (concat "file:" dir-file-ext))) (".html" (w3-fetch (concat "file:" dir-file-ext))) (".htm" (w3-fetch (concat "file:" dir-file-ext))) (".txt" (browse-url-lynx-xterm (concat "file:" dir-file-ext))) (".au" (shell-command (concat "play " dir-file-ext))) ("" (browse-url-lynx-xterm (concat "file:" dir-file-ext))) ))))) ) ;;;###autoload (defun dired-view-file-my-old () "View a file based on extension.. for glue.umd.edu: Assumes that u have tapped tetex.. Primarily meant for viewing files that are read-only to me.. Uses the function extension-my defined in .emacs.macros" (let* ((dir-file-ext (dired-get-filename)) (tmp-extlist (extension-my dir-file-ext)) (ext (car tmp-extlist)) (dir-file (cadr tmp-extlist)) (file-ext (dired-get-filename 'no-dir)) (tmp-ext2 (extension-my file-ext)) (file (cadr tmp-ext2))) (apply (lambda (arg) (if (null arg) (browse-url-lynx-xterm (concat "file:" dir-file-ext)) (eval (cadr arg)))) (list (assoc ext '( (".dvi" (progn (if (not (file-directory-p (concat "/tmp/" file ".ps"))) (shell-command (concat "dvips " dir-file-ext " -o /tmp/" file ".ps") (concat dir-file-ext ".dvips.shellcommand"))) (shell-command (concat "gv /tmp/" file " &") (concat dir-file-ext ".gv.shellcommand")))) (".tex" (progn (shell-command (concat "/bin/cp " dir-file-ext " " "/tmp/" file-ext)) (if (not (file-directory-p (concat "/tmp/" file ".ps"))) (progn (shell-command (concat "cd /tmp;" "latv " file " &") (concat dir-file-ext "latv.shellcommand"))) (shell-command (concat "gv " "/tmp/" file " &") (concat dir-file-ext "gv..shellcommand"))))) ; if .e, suggest that use revertfunctions.. (".e" (message "Suggestion: Please go use revertfunctions.")) (".ps" (shell-command (concat "gv " dir-file-ext " &") (concat dir-file-ext ".gv.shellcommand"))) (".pdf" (shell-command (concat "gv " dir-file-ext " &") (concat dir-file-ext ".gv.shellcommand"))) (".PDF" (shell-command (concat "gv " dir-file-ext " &") (concat dir-file-ext ".gv.shellcommand"))) (".html" (browse-url-lynx-xterm (concat "file:" dir-file-ext))) (".txt" (browse-url-lynx-xterm (concat "file:" dir-file-ext))) (".au" (shell-command (concat "play " dir-file-ext))) ("" (browse-url-lynx-xterm (concat "file:" dir-file-ext))) ))))) ) ;9/21/00--so that can be called from uix via v.. ;;;###autoload (defun enable-view-mode-my () "Makes view-mode.." (interactive) (if (not view-mode) (view-mode)) ) ;;;###autoload (defun stringize-last-cut () "Inserts the car of kill-ring after stringizing it." (interactive) (insert (format "%S" (car kill-ring))) ) ;;;###autoload (defun list-without-element-my-old-format (element list) "DOES NOT CHANGE THE VALUE OF THE LIST-SYMBOL PASSED. Just returns a list that is modified.. NB: we now prefer the format as in idledo/runshell-list-without-element.. please don't use this any more.." (if (null list) list (if (equal element (car list)) (list-without-element-my-old-format element (cdr list)) (cons (car list) (list-without-element-my-old-format element (cdr list))))) ) ;;;###autoload (defalias 'list-difference-my 'list-sub-my) ;;;###autoload (defun list-sub-my (&rest lists) (apply 'list-op-my '(- 0) lists)) ;;;Wed Jan 17 11:18:46 2001 ;;;###autoload (defun list-add-my (&rest lists) (apply 'list-op-my '(+ 0) lists)) ;;;Wed Jan 17 11:20:35 2001 ;;;###autoload (defun list-op-my (oplist &rest lists) "Applies (first oplist) to the rest of the lists.. oplist's second element should be a default. LIST-OP-MY areturns a list, each element of whose is the result of appling (car oplist) to the corresponding element of lists.. IF some lists are too short, the default is taken from the second element of oplist. This (list-op-my '(+ 0) '(1 2 3) '(1 2)) will give '(2 4 3). Thus, u see why we needed the 0.. " (if (eval (cons 'and (mapcar 'null lists))) nil (cons (apply (first oplist) (mapcar (lambda (ls) (if (null ls) (second oplist) (car ls))) lists)) (apply 'list-op-my oplist (mapcar 'cdr lists)))) ) ; (defun and-my (&rest args) ; "Needed for proper running of list-op-my ; This is ebcause emacs does not allow apply 'and!!! " ; (if (null args ) t ; (and (car args) (apply 'and-my (cdr args))))) ;;;###autoload (defun profile-my (&rest expressions) "May not be safe.. defines some variables durung execution.. The expressions will be evaluated in order at compile time.. Tells the time elapsed in its native form for commands. The expressions have to all be lists which will be evaluated.. " (let ((profile-abcd-time-a (current-time))) (mapcar 'eval expressions) (let ((profile-abcd-time-b (current-time))) (list-sub-my profile-abcd-time-b profile-abcd-time-a)))) (defun tanh-my (arg) (if (> 1 arg) (/ (float (- 1 (exp (* -2 arg)))) (float (+ 1 (exp (* -2 arg))))) (/ (float (- (exp (* 2 arg)) 1)) (float (+ (exp (* 2 arg)) 1)))) ) (defvar mfi-min-my 1) (defvar mfi-max-my 100) (setq mfi-min-my 1) (setq mfi-max-my 100) (defun mfi-my (ctr &optional min max) "mfi ==> message-function-indicator.. Imagine that ctr is the number of seconds passed.. u had no idea how long CTR will last.. At small times, u want to indicate a message every second, but at large times, u don't wanna clog the message buffer.. U don't need no fibonacci numbers.. u need a quick function to tell you at time CTR whether to indicate the message.. a function which will return true every 100 seconds for large times, but will return true every 1 second for small times.. This is that function.. " (if (null min) (setq min mfi-min-my)) (if (null max) (setq max mfi-max-my)) (setq min (ceiling min)) (setq max (floor max)) (if (<= max (+ min 1)) (setq max (+ min 1))) (if (>= ctr (* 10 max)) (< (% ctr max) 1) (if (< ctr (* 10 min)) (< (% ctr min) 1) (mfi-my (- ctr (* 10 min)) (+ min (* 0.1 max)) max))) ) ;;;Wed Jan 17 15:30:33 2001 ;;;###autoload (defun create-list-my (min max step) (if (>= min max) nil (cons min (create-list-my (+ min step) max step)))) (defun pcprint-region () "Print to home-printer.. if logged in fromm home.." (interactive) (if (mark) (if (y-or-n-p "Print region? ") (let ((string (buffer-substring (mark ) (point)))) (with-temp-buffer (insert string) (pcprint-buffer))) (message "Not printed")) (message "There seems to be no mark active"))) (defun pcprint-buffer () "Print to home-printer if logged in from home.." (interactive) (if (y-or-n-p "IS PRINTER ONLINE? Print buffer? ") (progn (save-excursion (let ((text (buffer-substring (point-min) (point-max)))) (find-file "~/tmp/print-home.txt") (set-buffer "print-home.txt") (kill-region (point-min) (point-max)) (insert text) (write-file "~/tmp/print-home.txt" nil) (kill-buffer "print-home.txt") ;;; (runshell) ;;; (runshell-cd "~/tmp") ;;; (runshell-input "setenv TERM vt100") ;;; (runshell-input "~/bin/pcprint < print-home.txt") (message "PLEASE Type printhome on alpha (erie..) terminal NOW") ))) (message "Not printed")) ) (defun elder-ehtml-my-this-file () "Like elder-ehtml-this-file but cleans up the directory afterwards." (interactive) (message "ehtml + cleanup routine..") (let ((this-dir (first (dir-file-ext-my (buffer-file-name))))) (elder-ehtml-this-file) (shell-command (concat "cd " this-dir ";" "rmbad"))) ) ;;;Wed Mar 28 11:04:10 2001 (defun fixup-whitespace-my () "Similar to fixup-whitespace, but removes all newlines too. Makes sure that there's just one space between previous and this object, and no newlines either" (interactive "*") (save-excursion (delete-horizontal-space-my) (if (or (looking-at "^\\|\\s)") (save-excursion (forward-char -1) (looking-at "$\\|\\s(\\|\\s'"))) nil (insert ?\ ))) (forward-word 1) (backward-word 1) ;; just found this in simple.el (delete-indentation) ) ;;;Wed Mar 28 11:05:36 2001 (defun delete-horizontal-space-my () "Similar to delete-horizontal-space, but deletes blank-lines too" (interactive "*") (skip-chars-backward " \t\n") (if (= (following-char) ? ) (forward-char 1) (insert ? )) (delete-region (point) (progn (skip-chars-forward " \t\n") (point))) ) ;;;Wed Apr 25 22:24:54 2001 ;; all this inserted from settags, which is now a public package ;;;Mon Jan 15 20:23:45 2001 ;;;###autoload (defun file-expand-home-my (name) "Expands any occurrence of home-directory in filename." (interactive "s Name:") (let ((newhome (file-truename "~"))) (with-temp-buffer (insert name) (goto-char (point-min)) ; don't use while, use if: so as to replace the first home.. (if (search-forward "~" nil t) (replace-match newhome nil t)) (let ((aa (buffer-substring (point-min) (point-max)))) (if (interactive-p) (message aa)) aa))) ) ;;;###autoload (defun file-truename-my (string) "Will try to live with emacs' bug in file-truename.." (let ((string-ex (file-truename string))) (if (file-exists-p string-ex) string-ex string)) ) ;;;###autoload (defun file-truename-dir-my (string) "Like file-truename-my, but takes care to allow * in filename." (let* ((string-ex (file-truename string)) (filedirext (dir-file-ext-my string-ex))) (if (file-exists-p (first filedirext)) string-ex string)) ) ;;;code from settags.el ends here.. ;;;Thu May 24 14:01:16 2001 (defun tap-and-run-lisp-my () "The source file taprunlisp should be located in ~/more/scripts." (interactive) (run-lisp "taprunlisp") ) ;;;Mon May 21 17:15:39 2001 (defun run-lisp-my () "Will run on glue.umd.edu, assumes that the parent of emacs has already tapped the lisp please." (interactive) (run-lisp "acl") ) ;;;Mon May 28 18:46:01 2001 ;;;###autoload (defun add-to-end-of-list-old (list-var element) "Like add-to-list, but adds at the end, if added at all." (if (member element (symbol-value list-var)) (symbol-value list-var) (set list-var (append (symbol-value list-var) (list element))))) ;;;Tue May 29 17:17:53 2001 ;;;###autoload (defun get-licenses-my (dir &rest args ) "Gets licenses using runshell.. Note: kills any previously existing *shell* buffer.. ARGS are passed to insert-directory command. For this function to work correctly, you should be initially in the correct directory. Please do not forget that insert-directory needs atleast 2 arguments. " (ignore-errors (kill-buffer "*shell*")) (let ( (numcurr 0) dir-list num) (runshell) (runshell-cd dir) (with-temp-buffer (apply #'insert-directory args) (setq num (count-lines (point-min) (point-max))) (goto-char (point-min)) (while (< numcurr num) (setq dir-list (cons (buffer-substring (progn (ignore-errors (beginning-of-line 1)) (point)) (progn (ignore-errors (end-of-line 1)) (point))) dir-list)) (next-line 1) (setq numcurr (+ 1 numcurr)))) (runshell-command "ls") (mapcar (lambda (arg) (runshell-command "echo ==============================") (runshell-command (concat "head " arg))) dir-list))) ;; Defined by Deepak Goel 6/18/01 ;; The previous defintion was very highly file-dependent and did not ;; allow the user to create new definitions easily.. This one simply ;; checks whether a lisp function exists or not, independent of any ;; need for filename.. ;;;###autoload (defun eshell-find-alias-function-possibly-new-obsolete (name) "Check whether a function called 'eshell/NAME' exists.. As of 6/21/01, The author has removed the bug, and so this defn. is unnecessary. " (let (existsp) (with-temp-buffer (insert "(setq existsp (ignore-errors (symbol-function (quote eshell/" name "))))") (eval-buffer) (if existsp (with-temp-buffer (insert "(setq existsp (quote eshell/" name "))") (eval-buffer) existsp) nil)))) (defun buffer-name-p-my (name) "Whether name is the name of a buffer.." (member-if (lambda (arg) (string= name (buffer-name arg))) (buffer-list))) (defun buffer-name-list-my () (mapcar 'buffer-name (buffer-list))) ;;;2001-08-16 T12:51:55-0400 (Thursday) Deepak Goel ;;; Code (defun describe-map (map) "Describe the key bindings of MAP. posted by: From: Cyprian Laskowski " (interactive (list (intern (completing-read "Describe keymap: " obarray #'(lambda (e) (and (boundp e) (string-match "-map$" (symbol-name e)))) t)))) (let (beg end) (with-temp-buffer (use-local-map (eval map)) (describe-bindings)) (set-buffer "*Help*") (rename-buffer (generate-new-buffer-name (concat "*" (symbol-name map) " bindings*"))) (setq beg (and (re-search-forward "^Major Mode Bindings:$" nil t) (1+ (match-end 0))) end (and (re-search-forward "^Global Bindings:$" nil t) (match-beginning 0))) (if (and beg end) (narrow-to-region beg end) (narrow-to-region 1 1) (error (concat (symbol-name map) " has no bindings set."))))) ;;;###autoload (defun setq-justification-full-my () (interactive) (setq default-justification 'full)) ;;; 2001-09-25 T13:21:06-0400 (Tuesday) Deepak Goel ;;;###autoload (defun desktop-save-my () (interactive) (require 'desktop) (desktop-save "~/") (message "Desktop saved to.. ~/") ) ;;; 2001-10-09 T12:00:27-0400 (Tuesday) Deepak Goel ;;;###autoload (defun eshell-rebind-arrows-my () (interactive) (local-set-key [up] 'previous-line) (local-set-key [down] 'next-line) ) ;;; 2001-10-18 T09:13:14-0400 (Thursday) Deepak Goel ;;;###autoload (defun dired-do-search-string-my (string) "" (interactive "sSearch marked files (string): ") (tags-search (regexp-quote string) '(dired-get-marked-files))) ;;;###autoload (defun dired-do-query-replace-string-my (from to &optional delimited) "" (interactive "sQuery replace in marked files (string): \nsQuery replace %s by: \nP") (tags-query-replace (regexp-quote from) to delimited '(dired-get-marked-files))) ;;;###autoload (defun make-case-fold-search-t-my () (interactive) (kill-local-variable 'case-fold-search) (setq case-fold-search t) ) ;;;###autoload (defun eshell/trash (arg) (if (listp arg) (progn (delete-other-windows) (split-window-vertically) (switch-to-buffer "*Messages*") (other-window 1) (mapcar 'eshell/trash arg)) (if (y-or-n-p (format "Trash %S" arg)) (progn (withit (message "now trying to trash %s..., default-directory= %s" arg default-directory) (sit-for 0 200) (eshell/mv "-i" arg "~/trashcan/") it )) (withit (message "NOT trashing %s, default-directory: %s" arg default-directory) (sit-for 1) it)))) ;;; 2002-01-28 T15:10:45-0500 (Monday) Deepak Goel ;;;###autoload (defun find-all-sources (lib &optional path) (unless path (setq path load-path)) (find-all-sources-from-path lib path)) ;;; 2002-01-28 T15:05:00-0500 (Monday) Deepak Goel ;;;###autoload (defun find-all-sources-from-path (lib path) ;;;(unless (listp path) (setq path load-path)) (if path (let ((aa (locate-library lib nil (list (car path))))) (if aa (progn (message aa) (cons aa (find-all-sources-from-path lib (cdr path)))) (find-all-sources-from-path lib (cdr path)))) nil)) ;;; 2002-03-04 T10:32:27-0500 (Monday) Deepak Goel ;;;###autoload (defun alert-my (astring) (ding t) (ding t) (let ((adonep nil) (aastring (concat "Alert:" astring ". OK ? "))) (while (not adonep) (setq adonep (y-or-n-p aastring))))) ;;; 2002-04-12 T13:16:04-0400 (Friday) Deepak Goel (defun no-op-my (&rest args) (interactive) nil) ;;; 2002-04-26 T15:42:23-0400 (Friday) Deepak Goel (defun tree->list-my (tree) "actually, converts anything to a list.." (if (listp tree) (apply 'append (mapcar 'tree->list-my tree)) (list tree))) (defvar find-all-locations-kills-p t "When t, each location gets an (uncompiled) name added to the kill-ring..") ;;; 2002-04-26 T15:56:22-0400 (Friday) Deepak Goel (defalias 'locate-libary-exhaustive-my 'find-all-locations-my) ;;; 2002-04-26 T15:26:13-0400 (Friday) Deepak Goel ;;;###autoload (defun find-all-locations-my (lib) (interactive "sLib: ") (let* ((libstripped (file-name-sans-extension lib)) (libs (remove-duplicates (list lib libstripped (concat libstripped ".el") (concat libstripped ".elc")))) (results (tree->list-my (mapcar '(lambda (dir) (mapcar '(lambda (thislib) (withit (expand-file-name thislib dir) (if (file-readable-p it) (list it) nil))) libs)) load-path)))) (when find-all-locations-kills-p (mapcar '(lambda (arg) (utils-kill-uncompiled-file arg)) results)) (when (interactive-p) (message "Results: %S" results)) results)) ;;; 2002-05-02 T22:46:21-0400 (Thursday) D. Goel ;;;###autoload (defun get-line-contents-my (point) (save-excursion (goto-char point) (buffer-substring (progn (beginning-of-line) (point)) (progn (end-of-line ) (point))))) ;;; 2002-05-05 T02:50:46-0400 (Sunday) D. Goel ;;;###autoload (defun insert-ensure-newline-my () (unless (looking-at "^") (insert "\n"))) ;;; 2002-05-02 T23:30:21-0400 (Thursday) D. Goel ;;;###autoload (defun show-my (x &optional show-init-string dont-justify) "adapted from a reply by John Paul Wallington on g.e.help..." (require 'pp) (insert-ensure-newline-my) (let* ( ;; yes, this ain't perfect.. this removes the opportunity to ;; distinguish between 'foo and "foo" but if i just ;; pp-to-stringed even strings, then i land into other ;; problems.. a multiline string gets converted to a ;; single-lined string with many \n's.. this is because ;; pp-to-string converts newline into \\n. (aa (if (stringp x) x (pp-to-string x))) (cc (if dont-justify aa (indent-string-my aa ))) (numlines (lines-what-string cc)) (s1 (if (> numlines 2) "\n" "")) (s2 (if (> numlines 10) "------------------------------" ""))) (insert (or show-init-string "==>") s1 aa s1 s2 s2 s1)) (insert-ensure-newline-my)) ;;; 2002-05-18 T14:26:18-0400 (Saturday) D. Goel ;;;###autoload (defun indent-string-my (str &optional mode-command) (unless mode-command (setq mode-command '(emacs-lisp-mode))) (with-temp-buffer (eval mode-command) (insert (fill-string-my str mode-command)) (indent-region (point-min) (point-max) nil) (buffer-substring (point-min) (point-max)))) ;;;###autoload (defun fill-string-my (str &optional mode-command) (with-temp-buffer (insert str) (if mode-command (eval mode-command) (text-mode)) (goto-char (point-min)) ;(for-each-paragraph-my ;'(indent-region 1) (fill-paragraph 65536) (buffer-string))) ;;; 2002-05-09 T13:21:03-0400 (Thursday) D. Goel ;;;###autoload (defun display-buffer-my (name &optional lines no-lines-p) "why has this been defined? what is wrong with emacs' display-buffer? have i even looked at that one? " (delete-other-windows) (if no-lines-p (split-window-vertically) (split-window-vertically (or lines 5))) (other-window 1) (switch-to-buffer name) (other-window 1)) ;;; 2002-05-09 T14:38:21-0400 (Thursday) D. Goel ;;;###autoload (defun find-tag-key-my (key) (interactive "kKey: ") (find-tag-other-window (format "%s" (lookup-key (current-global-map) key)))) ;;; 2002-05-09 T14:50:46-0400 (Thursday) D. Goel ;; no need: see find-function-on-key ;(defun find-function-key-my (key) ; (interactive "kKey: ") ; (find-tag-other-window ; (format "%s" (lookup-key (current-global-map) key)))) ;;; 2002-05-10 T13:18:31-0400 (Friday) D. Goel (defun set-assoc-my (list car cdr) "The cdr maybe a list or element, as you like... Does not really setq list to the new assoc.. instead returns you a pointer to a tree-copy of the TREE in which the first occurrence of assoc-car, if present has been removed.. and a new elt. had been added to the alist.. The new element is (cons car cdr). If (cons car cdr) is already present in the list, then none of the above is done.. just a tree-copy is returned.. " (let* ((cop (copy-tree list)) (carcdr (cons car cdr)) (foundp (member carcdr cop))) (if foundp cop (let ((assoced (assoc car cop))) (cons carcdr (if assoced (remove assoced cop) cop)))))) ;;;###autoload (defun delete-line-my (&optional arg) "Is not really the counterpart of kill-line.. because the two handle whitespace differently... This does NOT delete the new-line character unless given an argument..." (save-excursion (unless (eolp) (delete-region (point) (progn (end-of-line) (point))))) (when arg (ignore-errors (delete-char 1)))) ;;;###autoload (defun length-load-history-my () (interactive) (message "%s" (length load-history))) ;;; 2002-05-16 T11:34:28-0400 (Thursday) D. Goel ;;;###autoload (defun concat-symbols-my (&rest args) "each arg be a symbol.." (intern (apply 'concat (mapcar '(lambda (a) (format "%s" a)) args)))) ;;; 2002-05-18 T14:20:00-0400 (Saturday) D. Goel ;;;###autoload (defun recent-keys-show-my () (interactive) (switch-to-scratch-my) (goto-char (point-max)) (show-my (recent-keys))) ;;; 2002-05-18 T15:10:56-0400 (Saturday) D. Goel ;;;###autoload (defun view-lossage-my () (interactive) (electric-helpify 'view-lossage-my-noelectric)) ;;; 2002-05-18 T15:06:50-0400 (Saturday) D. Goel ;;;###autoload (defun view-lossage-my-noelectric () "Display last 100 input keystrokes. Taken from help.el and modified... To record all your input on a file, use `open-dribble-file'." (interactive) (with-output-to-temp-buffer "*Help*" (princ (mapconcat (function (lambda (key) (if (or (integerp key) (symbolp key) (listp key)) (format "%s(%s)" (single-key-description key) key ) (prin1-to-string key nil)))) (recent-keys) " ")) (save-excursion (set-buffer standard-output) (goto-char (point-min)) (while (progn (move-to-column 50) (not (eobp))) (search-forward " " nil t) (insert "\n")) (setq help-xref-stack nil help-xref-stack-item nil)) (print-help-return-message))) ;;;###autoload (defun erc-track-modified-channels-mode-enable-my (&rest args) " allowing args because apparently, erc-server-376-hook calls it with args.. " (interactive) (message "Now trying to enable") (sit-for 1) (erc-track-modified-channels-mode 1) (message "enabled") (sit-for 1) ) ;;;###autoload (defun erc-timestamps-toggle-my () (interactive) (setq erc-echo-timestamps (not erc-echo-timestamps)) (message "Toggled timestamps.. erc-echo-timestampts = %S " erc-echo-timestamps)) ;;;###autoload (defun bol-maybe-general-my (prompt &optional alt-bol-fcn) "" (interactive) (if (and (string-match (concat "^" (regexp-quote prompt) " *$") (buffer-substring-no-properties (line-beginning-position) (point))) (not (bolp))) (beginning-of-line) (if alt-bol-fcn (funcall alt-bol-fcn) (beginning-of-line) (search-forward-regexp prompt)))) ;;;###autoload (defun erc-bol-maybe-my () "Posted by Lawrence Mitchell.. on g.e.help Goto the end of `erc-prompt'. If already there, go to `beginning-of-line'." (interactive) (bol-maybe-general-my erc-prompt 'erc-bol)) ;;; 2002-06-19 T10:35:16-0400 (Wednesday) D. Goel ;;;###autoload (defun eshell-bol-maybe-my () "" (interactive) (bol-maybe-general-my (funcall eshell-prompt-function))) ;;;###autoload (defun erc-select-noninteractive-my (&optional server port nick user-full-name not-connect-arg passwd) "Interactively run ERC, while trying to do a minimal prompting. Optional argument SERVER uses server as default for the input query. Optional argument PORT uses passed port as default for the input query. Optional argument NICK uses the passed nick as default for the input query." (interactive) (require 'erc) (if (null server) (setq server erc-server)) (if (null port) (setq port erc-port)) (setq nick (erc-compute-nick nick)) (let* ( (nick (if (erc-already-logged-in server port nick) (read-from-minibuffer (erc-format-message 'nick-in-use ?n nick) nick nil nil 'erc-nick-history-list) nick))) (if (and passwd (string= "" passwd)) (setq passwd nil)) (while (erc-already-logged-in server port nick) (setq nick (read-from-minibuffer (erc-format-message 'nick-in-use ?n nick) nick nil nil 'erc-nick-history-list))) (run-hook-with-args 'erc-before-connect server port nick) (erc server port nick user-full-name (not not-connect-arg) passwd))) ;;;###autoload (defun run-with-idle-timer-my (secs repeat function &rest args) "Perform an action the next time Emacs is idle for SECS seconds. The action is to call FUNCTION with arguments ARGS. SECS may be an integer or a floating point number. If REPEAT is non-nil, do the action each time Emacs has been idle for exactly SECS seconds (that is, only once for each time Emacs becomes idle). This function returns a timer object which you can use in `cancel-timer'." (interactive (list (read-from-minibuffer "Run after idle (seconds): " nil nil t) (y-or-n-p "Repeat each time Emacs is idle? ") (intern (completing-read "Function: " obarray 'fboundp t)))) (let ((timer (timer-create))) (timer-set-function timer function args) (timer-set-idle-time timer secs repeat) (timer-activate-when-idle timer t) timer)) ;;;###autoload (defun timer-test-my () (interactive) (progn (run-with-idle-timer 5 nil '(lambda () (ding t))) (message (format "%s, %s " timer-list timer-idle-list)) (sit-for 6) (message "Done waiting 6 sec..") (sit-for 1) (message (format "now: %s, %s" timer-list timer-idle-list)))) ;;;###autoload (defun auto-recompile-library-my () "If my file is a library written by me, (and thus doesn't have auto-recompile cookies), this function will recompile it.." (interactive) (let ((nam (buffer-file-name))) (unless nam (message "%S buffer--%S buffer-file-name--%S" "No fie? error with auto-recompilt-library-my? " (buffer-name) (buffer-file-name)) (sit-for 1)) (when (and nam (string-match "deego/" nam) (string-match "lisp-mine/" nam)) (byte-compile-file nam)))) ;;;functions-my.el ends here..