GNU   davin.50webs.com/research
Bringing to you notes for the ages

       Main Menu          Research Projects         Photo Album            Curriculum Vitae      The Greatest Artists
    Email Address       Computer Games          Web Design          Java Training Wheels      The Fly (A Story)   
  Political Activism   Bob Dylan Quotes+       My Life Story          Smoking Cessation          Other Links      
Debugging Macros     String Class I     Linked List System I Java for C Programmers Naming Convention
    String Class II         How I use m4              Strings III                 Symmetrical I/O             Linked Lists II     
Run-Time Type Info   Virtual Methods      An Array System        Science & Religion            Submodes       
  Nested Packages      Memory Leaks    Garbage Collection      Internet & Poverty      What is Knowledge?
Limits of Evolution   Emacs Additions      Function Plotter           Romantic Love        The Next Big Thing
    Science Fiction     Faster Compilation Theory of Morality         Elisp Scoping               Elisp Advice      
  S.O.G.M. Pattern       Safe Properties         School Bullying          Charisma Control          Life and Death    
     Splitting Java          Multiple Ctors       Religious Beliefs         Conversation 1           Conversation 2    
   J.T.W. Language    Emacs Additions II      Build Counter             Relation Plotter          Lisp++ Language  
  Memory Leaks II   Super Constructors CRUD Implementation Order a Website Form There Is An Afterlife
More Occam's Razor C to Java Translator Theory of Morality II


diagnose.el

    

;; diagnose.el --- Core customization routines for dlisp

;; Copyright (C) 2006-2016 Davin Pearson

;; Author/Maintainer: Davin Max Pearson <http://davin.50webs.com>
;; Keywords: Core customization routines
;; Package: dlisp (Davin's version of elisp)
;; Note: The d- prefix stands for _D_avin's customizations to Emacs
;; Version: 2.0

;;; Commentary:

;; This program is part of GNU Java Training Wheels

;; This file contains definitions of functions that are used by other
;; elisp files.

;;; Limitation of Warranty

;; This program 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 3 of the License, or (at
;; your option) any later version.
;;
;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs, see the file COPYING.  If not, see:
;;
;; <http://www.gnu.org/licenses/gpl-3.0.txt>.


;;; Install Instructions:
;; See the following URL for the latest info and a tarball:
;;
;; <http://davin.50webs.com/research/2006/mopa2e.html#diagnose>
;;
;; Then untar the tarball to a folder pointed to by the Emacs variable
;; load-path and add the following line to your ~/.emacs file.
;;
;; (require 'diagnose)

;;; Known Bugs:

;; None!

;;; Code:

(defvar prefs-advanced-user-p nil
  "Enables ESC ESC (Eval Expression), backquote, dabbrev key,
aliases, (not d-movement) and track-eol

not prefs-advanced-user-p => f5 for html indent buffer

")


(defvar prefs-calendar-online-p nil
  "Whether or not to set the calendar online")

(defvar prefs-home-emacs-p nil
  "Sets READONLY and d-log navigation"
  ;; was d-movement.el
  )

(defvar prefs-font-p t
  "Home-style fontification online")

(defvar prefs-font-libd-p nil
  "Fontification of libd online")

(defvar prefs-font-xtra-p t
  "Extra fontification online (in case not d-htmlize.el)")

(defvar prefs-lcd-emacs-p nil
  "Sets bizarre LCD colour scheme")

(defvar prefs-font-lisp++-p nil
  "Turns on Lisp++ fontification")

(defvar prefs-windows-bindings-p t
  "To load cua.el (if t) and C-o bound to dlgopen-open-files
and C-z for UNDO
")

(defvar prefs-scratch-java-online-p nil
  "Java keywords appear in the scratch buffer")

(defvar prefs-scratch-libd-online-p nil
  "LIBD keywords appear in the scratch buffer")

(defvar prefs-dlisp-keybindings-online t
  "Load dlisp keybindings (for debugging Elisp)")

(defvar prefs-safe-comands-online-p t
  "Load dlisp safe commands (for debugging Elisp)")

(defvar prefs-large-font-p t
  "Whether or not to set the large font")

;;(require 'cl-19 "cl")
(require 'cl)

(assert (fboundp 'incf))
(assert (fboundp 'cdddr))

(defmacro d-quote (&rest rest)
  )

(d-quote 1 2 3)

;;; (fboundp 'let)
;;; NOTE: bug fix for emacs 23.* lacking this function
(if (not (fboundp 'read-only-mode))
    (defun read-only-mode (&optional arg)
      "P"
      (toggle-read-only arg)))


;; DIAGNOSTIC VARIABLES ;;(checkpoint "d2") (setq emacs-dialect--dosemacs-p (if (string-match "msdos" (emacs-version)) t)) (setq emacs-dialect--xemacs-p (and (boundp 'xemacsp) (if (string-match "/usr/share/xemacs-" (car (last load-path))) t))) (setq emacs-dialect--gnuemacs-p (eq system-type 'gnu/linux)) (setq os-type--microsoft-p (if (memq system-type '(windows-nt ms-dos)) t)) (setq os-type--linux-p (eq system-type 'gnu/linux)) (setq os-type--mswindows-p (if (and os-type--microsoft-p (not os-type--linux-p) (not emacs-dialect--dosemacs-p)) t)) (setq os-type--windows-p os-type--mswindows-p) (setq os-type--msdos-p (if emacs-dialect--dosemacs-p t)) (setq os-type--graphical-p (let ((answer nil)) (save-window-excursion (list-colors-display) (set-buffer "*Colors*") (goto-char (point-min)) (setq answer (re-search-forward "snow" nil t)) (kill-buffer "*Colors*") (if answer t nil)))) (setq os-type--text-p (not os-type--graphical-p))
;; ESSENTIAL KEYBINDINGS ;;(checkpoint "d3") (if (fboundp 'pc-bindings-mode) (pc-bindings-mode)) ;;(when t () 'foo) (when prefs-dlisp-keybindings-online (global-set-key "\C-xg" 'goto-line) (global-set-key "\C-x\C-g" 'goto-line) (global-set-key "\C-ha" 'apropos) ;; NOTE: better than command-apropos ;;(global-set-key "\C-ha" 'command-apropos) ;;(global-set-key "\C-x\C-q" 'save-buffers-kill-emacs) (global-unset-key "\C-x\C-q" ) ;;(global-set-key "\C-x\C-c" (function (lambda () (interactive) (message "Press \C-x\C-q to quit") (beep) (sleep-for 1)))) (global-unset-key "\C-x\C-c" ) (global-set-key "\C-d" 'd-control-f) (global-set-key "\C-f" 'd-control-f) (defun d-patch-control-d () (local-set-key "\C-d" 'd-control-f) (local-set-key "\C-f" 'd-control-f) ) (add-hook 'c-mode-common-hook 'd-patch-control-d) (defun d-control-f (filename) "Fixed the bug where you try to load the same file into Emacs, instead loads the directory into dired mode." (interactive "FFind file/folder: ") ;;(if (not (boundp 'safe-expand-file-name)) (if (string-match "/$" filename) (find-file (substring filename 0 -1)) (find-file filename)) ;; (if (string= (safe-expand-file-name (buffer-file-name)) ;; (safe-expand-file-name filename)) ;; (dired (file-name-directory filename)) ;; (find-file filename))) ) (global-set-key "\C-s" 'd-control-s) (defun d-control-s () (interactive) (let ((table (syntax-table)) (case-fold-search t)) (unwind-protect (progn ;; NOTE: this line makes it work... (set (make-local-variable 'font-lock-syntax-table) table) (if (and (boundp 'c-mode-syntax-table) c-mode-syntax-table) (set-syntax-table c-mode-syntax-table)) (isearch-forward)) (set-syntax-table table)))) (global-set-key "\M-\C-s" 'd-meta-control-s) (defun d-meta-control-s () (interactive) (let ((table (syntax-table)) (case-fold-search t)) (unwind-protect (progn ;; NOTE: this line makes it work... (set (make-local-variable 'font-lock-syntax-table) table) (if (and (boundp 'c-mode-syntax-table) c-mode-syntax-table) (set-syntax-table c-mode-syntax-table)) (isearch-forward t)) (set-syntax-table table)))) (global-set-key "\C-r" 'd-control-r) (defun d-control-r () (interactive) (let ((table (syntax-table)) (case-fold-search t)) (unwind-protect (progn ;; NOTE: this line makes it work... (set (make-local-variable 'font-lock-syntax-table) table) (if (and (boundp 'c-mode-syntax-table) c-mode-syntax-table) (set-syntax-table c-mode-syntax-table)) (isearch-backward)) (set-syntax-table table)))) (global-set-key "\M-\C-r" 'd-meta-control-r) (defun d-meta-control-r () (interactive) (let ((table (syntax-table)) (case-fold-search t)) (unwind-protect (progn ;; NOTE: this line makes it work... (set (make-local-variable 'font-lock-syntax-table) table) (if (and (boundp 'c-mode-syntax-table) c-mode-syntax-table) (set-syntax-table c-mode-syntax-table)) (isearch-backward t)) (set-syntax-table table)))) (let ((b (generate-new-buffer "*eraseme*"))) ;; ;; NOTE: ensures that c-mode-syntax-table is bound for C-s / C-r ;; (set-buffer b) (c++-mode) (kill-buffer b) ) (global-set-key "\C-w" 'really-cut) (defun really-cut () (interactive "*") (if (y-or-n-p "Really cut? ") (call-interactively 'kill-region))) (defun insert-prin1 (args) (insert (prin1-to-string args))) ;; (setq x 32.456) (defun d-show (x) (kill-sexp 2) (insert (format " %5.2f " (/ (round (* x 100)) 100.0)))) (defun d-dollar (x) (kill-sexp 2) (insert (format " $%5.2f " (/ (round (* x 100)) 100.0)))) (defun d-f1 () (interactive) (info) (delete-other-windows)) (global-set-key [f1] 'd-f1) (defun d-meta-f1 () (interactive) (kill-ring-save (point-min) (point-max)) (message "Copied buffer to clipboard")) (global-set-key [(meta f1)] 'd-meta-f1) (global-set-key [(shift f1)] 'd-meta-f1) (global-set-key [(control f1)] 'd-meta-f1) (global-set-key [(f2)] 'd-f2) (defun d-f2 () (interactive) (save-excursion (save-window-excursion (message "Saving some buffers") (save-some-buffers 'NO-QUESTIONS)))) (global-set-key [f4] 'delete-other-windows) (global-set-key [f8] 'undo) (global-set-key [f9] 'd-f9) (defun d-f9 () (interactive) (save-some-buffers 'NO-QUESTIONS) (execute-kbd-macro "\M-xcompile\n")) (global-set-key [(control f9)] 'd-shift-f9) (global-set-key [(meta f9)] 'd-shift-f9) (global-set-key [(shift f9)] 'd-shift-f9) (defun d-shift-f9 () (interactive) (save-some-buffers 'NO-QUESTIONS) (call-interactively 'compile) ) (assert (boundp 'prefs-advanced-user-p)) (if prefs-advanced-user-p (global-set-key [(f12)] 'eval-last-sexp) (global-set-key [(f12)] 'electric-buffer-list)) ;;(global-set-key [f12] 'backward-delete-char-untabify) ;; NOTE: was here (progn ;;(global-unset-key [kp-delete]) (global-set-key [kp-delete] 1) ;;; NOTE: better than the above way to unset the key ) (when prefs-advanced-user-p (global-set-key "\e\e" 'eval-expression) (global-set-key "`" 'dabbrev-expand) ;; for when you miss the real key (global-set-key "\e`" 'dabbrev-expand) (global-set-key "'" 'd-quote-key) (global-set-key "\M-/" 'dabbrev-expand) (global-set-key "¿" 'dabbrev-expand) (global-set-key "\"" 'self-insert-command) ;;(global-set-key "`" 'self-insert-command) (defun d-quote-key () (interactive) (if (eq (char-after (1- (point))) ?') (progn (backward-delete-char 1) ;; varsity fixed: (insert "`")) (if (eq (char-after (1- (point))) ?`) (progn (backward-delete-char 1) ;; varsity fixed: (insert "'")) (self-insert-command 1)))) ) (if (not prefs-windows-bindings-p) (global-set-key [(shift up)] 'd-shift-up)) (global-set-key [(control up)] 'd-shift-up) (global-set-key [(meta up)] 'd-shift-up) (global-set-key [(prior)] 'd-shift-up) (defun d-shift-up () (interactive) (scroll-down 2)) (global-set-key [(control down)] 'd-shift-down) (global-set-key [(meta down)] 'd-shift-down) (if (not prefs-windows-bindings-p) (global-set-key [(shift down)] 'd-shift-down)) (global-set-key [(next)] 'd-shift-down) (defun d-shift-down () (interactive) (scroll-up 2)) (global-set-key [(control next)] 'scroll-up) (global-set-key [(meta next)] 'end-of-defun) (global-set-key [(shift next)] 'd-forward-page) (defun d-forward-page () (interactive) (if (fboundp 'd-deposit-mark-if-small-movement) (d-deposit-mark-if-small-movement)) (if (not (re-search-forward "^[ \t]* " nil t)) (goto-char (point-max))) ;;(forward-page) (if (= (point) (point-max)) (recenter (- (window-height) 4)) (recenter (/ (window-height) 6)))) (global-set-key [(control prior)] 'scroll-down) (global-set-key [(meta prior)] 'beginning-of-defun) (global-set-key [(shift prior)] 'd-backward-page) (defun d-backward-page () (interactive) (beginning-of-line) (if (not (re-search-backward "^[ \t]* " nil t)) (goto-char (point-min))) (skip-chars-forward " \t") (skip-chars-forward " ") (if (fboundp 'd-deposit-mark-if-small-movement) (d-deposit-mark-if-small-movement)) ;;(backward-page) (recenter (/ (window-height) 6))) (progn (global-set-key [(control meta prior)] 'd-backward-page) (global-set-key [(control meta next)] 'd-forward-page)) (defun d-control-prior () (interactive) (d-scroll-up (- (window-height) 2))) (defun d-control-next () (interactive) (d-scroll-down (- (window-height) 2))) (defun d-scroll-up (amount) "Used by d-control-meta-prior" (scroll-down amount) (forward-line (- amount)) (move-to-window-line (/ (window-height) 2))) (defun d-scroll-down (amount) "Used by d-control-meta-next" (if (/= (point) (point-max)) (progn (scroll-up amount) (forward-line amount))) (move-to-window-line (/ (window-height) 2))) (progn (global-set-key [(control home)] 'beginning-of-buffer) (global-set-key [(control end)] 'end-of-buffer) (global-set-key [(meta home)] 'beginning-of-buffer) (global-set-key [(meta end)] 'end-of-buffer) (global-set-key [(shift home)] 'beginning-of-buffer) (global-set-key [(shift end)] 'end-of-buffer) ) (global-set-key [(control right)] 'forward-sexp) (global-set-key [(meta right)] 'forward-sexp) (global-set-key [(shift right)] 'forward-sexp) (global-set-key [(control meta right)] 'forward-sexp) (global-set-key [(control left)] 'backward-sexp) (global-set-key [(meta left)] 'backward-sexp) (global-set-key [(shift left)] 'backward-sexp) (global-set-key [(control meta left)] 'backward-sexp) (global-set-key [(control backspace)] 'backward-kill-word) (global-set-key [(meta backspace)] 'backward-kill-word) (global-set-key [(shift backspace)] 'backward-kill-word) (global-set-key [(control delete)] 'kill-word) (global-set-key [(meta delete)] 'kill-word) (global-set-key [(shift delete)] 'kill-word) ;;(if prefs-advanced-user-p (global-set-key [insert] 'electric-buffer-list) ;;) (global-set-key [(control tab)] 'other-window) (global-set-key [(shift tab)] 'other-window) (global-set-key [(control ?0)] 'delete-window) (global-set-key [(control ?1)] 'delete-other-windows) (global-set-key [(control ?@)] 'split-window-vertically) ;; NOTE: Only applicable to Dos Emacs (global-set-key [(control ?2)] 'split-window-vertically) (global-set-key [(control ?3)] 'split-window-horizontally) (progn (global-set-key [(shift ? )] 'd-shift-space) (global-set-key [(s ?\s- )] 'd-s-space) (defun d-shift-space () (interactive) (message "pop-mark") (pop-mark) (recenter) ) (defun d-s-space () (interactive) (message "push-mark") (push-mark) (recenter) ) ) (when prefs-advanced-user-p (defalias 'dtp 'describe-text-properties) ;;(defalias 'lta 'list-text-properties-at) ;; version 21.3 (defalias 'lta 'describe-text-properties) ;; version 22.1 (defalias 'elm 'emacs-lisp-mode) (defalias 'flm 'font-lock-mode) (defalias 'qrr 'query-replace-regexp) (defalias 'eb 'eval-buffer) (defalias 'hff 'hexl-find-file) ) (defalias 'buffer-substring-properties 'buffer-substring) (defun tde () (interactive) (message "tde") (if debug-on-error (setq debug-on-error nil) (setq debug-on-error t))) )
;; SAFE COMMANDS ;;; (d-ding) (defun d-ding () (let ((visible-bell t)) (beep)) ) ;;(checkpoint "d4") ;; (d-nbeeps 3 "hello joe") (defun d-nbeeps (n &rest msg) (let ((string (concat "*** BEEPS: " (apply 'format msg)))) (decf n) (decf n) (d-ding) (message string) (sleep-for 1) (while (> n 0) (d-ding) (sleep-for 1) (decf n)) (ding t))) (defun d-beeps (&rest msg) "Defined by me" (let ((string (concat "*** BEEPS: " (apply 'format msg) )) (d-message-on t)) (d-ding) (message string) (sleep-for 1) (d-ding) (sleep-for 1) (d-ding))) (defun d-beep (&rest msg) "Defined by me" (let ((string (concat "*** BEEP: " (apply 'format msg) )) (d-message-on t)) (d-ding) (message string) (sleep-for 1) )) ;; (safe-command (forward-sexp 1)) ;; (safe-command (message "foo")) ;; (safe-command (safe-load-file "~/dlisp/imported-stuff/zzdotemacs.el")) ;; (safe-command (setq cmd (make-directory "/media/www/G16GB/home/bak/" 'parents))) ;; (safe-command (setq cmd (make-directory "/media/www/BLU16GB/home/bak/" 'parents))) (defmacro safe-command (cmd &optional quietp) ;;(debug "Tuesday") `(condition-case err ,cmd (error (if (not ,quietp) (d-beeps "Command: %s failed, reason = %s, current-buffer = %s" (quote ,cmd) err (buffer-name) ))))) ;;; (prin1-to-string (setq foo 'bar)) (defun safe-load-file (filename) (let ((cmd (list 'load-file filename))) (safe-command (eval cmd)))) ;; (safe-load-file "~/dlisp/imported-stuff/tabbar.el") ;; (safe-command (safe-load-file "~/dlisp/imported-stuff/tabbar.el")) (defun safe-load-library (filename) (let ((cmd (list 'load-library filename))) (safe-command (eval cmd)))) (defun safe-find-file (file) (if (file-exists-p file) (if (fboundp 'd-find-file) (d-find-file file) (find-file file)))) (defun safe-downcase (string) (if string (downcase string) nil)) (defun safe-getenv (var) "Useful as the second argument to string-match" (setq var (getenv var)) (if (eq var nil) "" var)) ;;; ;;; NOTE: standard notation follows... ;;; ;;; File/directory spec is (setq dir-1 "d:/home") or (setq dir-1 "d:") (note no trailing slash) ;;; File access is (concat dir-1 "/" file-1) ;;; Relative directory spec (setq rel-1 "abc/def") ;;; Therefore joiner is (concat dir-1 "/" rel-1) ;;; Shell script joiner is $ABC/$DEF or $ABC/foo (note $ABCfoo is an error) ;;; Makefile joiner is $$ABC/$$DEF or $$ABC/foo (note $$ABCfoo is an error) ;;; Makefile joiner is $(ABC)/$(DEF) or $(ABC)/foo (note $(ABC)foo works without error) ;;; ;;; BUG: d: denotes the current directory in the d drive in some cases (outside of Emacs) ;;; ;;; (safe-expand-file-name nil) ;;; (safe-expand-file-name "d:/") ;;; (safe-expand-file-name (setq file "d:/home/")) ;;; (safe-expand-file-name "d:/home") ;;; (safe-expand-file-name "d:/home/.emacs") ;;; (safe-expand-file-name "d:/home//text/..") ;;; ;;; NOTE: never returns a trailing slash ;;; ;;; (setenv "HOME" "d:/") ;;; (safe-expand-file-name "d:/") ;;; (safe-expand-file-name "d:/frog") ;;; (safe-expand-file-name "d:/FROG") ;;; (safe-expand-file-name "~/.emacs") ;;; (safe-expand-file-name "~/dlisp") ;;; (defun safe-expand-file-name (filename) "Replaces ~/ with expanded file name" (save-match-data (setq filename (if filename (expand-file-name filename))) ;; ;; NOTE: removes trailing slash ;; (if (and filename (string-match "/$" filename)) (setq filename (substring filename 0 -1))) filename)) ;;; ;;; (safe-compress-file-name nil) ;;; (safe-compress-file-name "d:/") ;;; (safe-compress-file-name "d:/home") ;;; (safe-compress-file-name (setq filename "d:\\home")) ;;; (safe-compress-file-name (setq filename "d:\\home\\")) ;;; (safe-compress-file-name "d:\\home\\fddf") ;;; (safe-compress-file-name "d://home//frog") ;;; (safe-compress-file-name "d:/HOME/fddf") ;;; (safe-compress-file-name "d:/home/fddf/") ;;; (safe-compress-file-name "d:/home//fddf") ;;; (safe-compress-file-name "d:/fred/fddf") ;;; ;;; NOTE: never returns a trailing slash ;;; ;;; (setenv "HOME" "d:/") ;;; (safe-compress-file-name "d:/") ;;; (safe-compress-file-name "d:/frog") ;;; (safe-compress-file-name "d:/home//text/..") ;;; (safe-compress-file-name "/home/www/text") ;;; (safe-compress-file-name "/home/davin/text") ;;; (defun safe-compress-file-name (filename) "Replaces expanded ~/ expression with ~/" (save-match-data (assert (getenv "HOME")) (assert (file-directory-p (getenv "HOME"))) (let* ((filename (safe-expand-file-name filename)) (new-home (safe-expand-file-name (getenv "HOME")))) ;;(debug) (progn ;; ;; NOTE: adds trailing slash ;; (if (and filename (file-directory-p filename) (not (string-match "/$" filename))) (setq filename (concat filename "/"))) (if (and new-home (not (string-match "/$" new-home))) (setq new-home (concat new-home "/")))) ;;(debug) ;; (safe-compress-file-name "d:/home") ;; (setq new-home "d:/home/") ;; (setq filename "d:/home/") ;; ;; NOTE: replaces HOME folder with ~/ ;; (if (and filename (string-match (concat "^" new-home "\\(.*$\\)") filename)) (setq filename (concat "~/" (substring filename (match-beginning 1) (match-end 1))))) (progn ;; ;; NOTE: removes trailing slash ;; (when (and filename (string-match "/$" filename)) ;;(d-foo) (setq filename (substring filename 0 -1))) ) filename))) ;; (setq to "~/src/davin/research/2004") ;; (setq from "~/four") ;;(safe-make-link "~/src/davin_pearson/research/2004" "~/four") (defun safe-make-link (to from) ;;(debug "smeg") (assert (stringp to)) (assert (stringp from)) (if (and (file-exists-p to) (not (file-exists-p (concat from ".lnk")))) (shell-command (concat "ln -s " (expand-file-name to) " " (expand-file-name from))))) (defun safe-window-restore () (if (fboundp 'w32-send-sys-command) (w32-send-sys-command 61728) ) ) (defun safe-window-maximise () (if (fboundp 'w32-send-sys-command) (w32-send-sys-command 61488) ) ) (global-set-key [(control l)] 'd-recenter) (d-quote if (and (boundp 'prefs-large-font-p) prefs-large-font-p os-type--microsoft-p) (progn ;;(d-beeps "Loading courier font") (set-default-font "-*-courier new-normal-r-*-*-22-*-*-*-c-*-fontset-standard") ) (set-default-font "-*-Courier New-normal-r-*-*-16-*-*-*-c-*-iso8859-1")) (defun d-recenter () (interactive) (recenter) (progn (safe-window-restore) (safe-window-maximise) ) ) (global-set-key "\C-b" 'd-kill-buffer) (defun kill-buffer-no-questions (&optional buf) (interactive) (set-buffer-modified-p nil) (kill-buffer buf) ) (defun d-kill-buffer () (interactive) (unwind-protect (if (or (string= (buffer-name) "*Messages*") (string= (buffer-name) "*scratch*") (string= (buffer-name) "*compilation*") (eq major-mode 'dired-mode)) (bury-buffer) (kill-buffer nil)) ;;(if (fboundp 'd-speedbar--kill-speedbar-buffers) ;; (run-with-timer 1 nil 'd-speedbar--kill-speedbar-buffer)) )) (d-quote defun d-kill-buffer () ;;(bury-buffer) ) (d-quote defun d-speedbar--kill-speedbar-buffers () ;;(message "foo") (sit-for 1) ;;(d-walk-frames ;;(if (string= (buffer-name (current-buffer)) (cdar ptr-walk)) ;; (kill-buffer (cdar ptr-walk))) ) (define-key global-map [tool-bar kill-buffer] '(menu-item "Maybe Kill Buffer" d-kill-buffer :enable 1 :visible 1 :help "Maybe Kill Buffer" :image (image :type xpm :file "../etc/images/close.xpm") ))
;; DLISP COMMANDS ;;(checkpoint "d5") (defun d-cadar (list) (car (cdr (car list)))) (defun d-current-line-as-string () (buffer-substring-no-properties (point-at-bol) (point-at-eol))) (defun d-current-line-width () (length (d-current-line-as-string))) (defun read-ready (str) (and (stringp str) (not (string= "" str)))) ;; (setq str "") (defun read-str (str) (assert (read-ready str)) (read str)) ;; (setq str1 "abc") ;; (setq str2 "Abc") ;; (string=-ignore-case str1 str2) (defun string=-ignore-case (str1 str2) (string= (upcase str1) (upcase str2))) (defun string<-ignore-case (str1 str2) (string< (upcase str1) (upcase str2))) (defun d-current-buffer-to-lines () (let ((answer nil)) (save-excursion (goto-char (point-min)) (while (< (point) (point-max)) (setq answer (cons (d-current-line-as-string) answer)) (forward-line 1))) (reverse answer))) (defun d-sort-buffer () (interactive) (let ((list)) (setq list (d-current-buffer-to-lines)) (setq list (stable-sort list 'string<)) (erase-buffer) (let ((ptr list)) (while ptr ;;(debug) (insert (car ptr) "\n") (setq ptr (cdr ptr)))))) ;;; ;;; (find-file "~/dlisp/keys.el") ;;; (d-currently-editing-file "d:\\home\\dlisp\\keys.el") ;;; (d-currently-editing-file "d:\\home\\not\\editing.el") ;;; (d-currently-editing-file "d:\\HOME\\DLISP\\DIAGNOSE.EL") ;;; (defun d-currently-editing-file (filename) "If not editing that filename, retures nil otherwise returns the buffer object corresponding to the given filename." (setq filename (safe-expand-file-name filename)) (if os-type--microsoft-p (setq filename (safe-downcase filename))) (let* ((list (buffer-list)) (ptr list) (found nil)) (while (and ptr (not found)) (let ((curname (buffer-file-name (car ptr)))) (setq curname (safe-expand-file-name curname)) (if os-type--microsoft-p (setq curname (safe-downcase curname))) (if (string= curname filename) (setq found (car ptr)))) (setq ptr (cdr ptr))) found)) (setq d-emacs-start-time (current-time)) (defun d-delete-line () (delete-region (point-at-bol) (point-at-eol)) (if (looking-at "\n") (delete-char 1)) ) (defun d-delta-looking-at (regexp delta) (save-excursion (forward-char delta) (looking-at regexp))) (defun d-font-lock-add-begin (keywords) (if (fboundp 'font-lock-add-keywords) (font-lock-add-keywords nil keywords nil) (setq font-lock-keywords (append keywords font-lock-keywords)))) (defun d-font-lock-add-end (keywords) (if (fboundp 'font-lock-add-keywords) (font-lock-add-keywords nil keywords 'end) (setq font-lock-keywords (append font-lock-keywords keywords)))) (defun d-font-lock-remove-keywords () (if (fboundp 'font-lock-add-keywords) (font-lock-add-keywords nil nil 'set) (setq font-lock-keywords nil))) (defun d-foo (&optional who-cares) "Useful function for debugging" (interactive) (message "###############") (sleep-for 0.1) (message " ") (sleep-for 0.1) (message "###############") (sleep-for 0.1) (message " ") (sleep-for 0.1) (message "###############") (sleep-for 0.1) (message " ") nil ) (defun d-insert-prin1 (x) (insert (prin1-to-string x) "\n")) (defun d-is-first-line () "Faster than (eq (d-what-line) 1)" (save-excursion (beginning-of-line) (bobp))) (defun d-is-last-line () (save-excursion (end-of-line) (eobp))) ;;; (get-buffer-window) ;;; (d-is-buffer-visible (current-buffer)) (defun d-is-buffer-visible (buffer) (and buffer (get-buffer-window buffer))) ;;; (d-kill-adjacent-duplicates '("abc" "abc" "abc" "def" "abc" "abc")) ;;; (d-kill-adjacent-duplicates '("abc" "abc" "abc" "abc" "abc" "abc" "def" "abc" "abc")) ;;; (d-kill-adjacent-duplicates '("abc" "abc" "abc" "abc" "abc" "abc" "def" "abc" "abc")) (defun d-kill-adjacent-duplicates (list) ;;(setq list '("abc" "abc" "def" "abc")) (let ((ptr list)) (while ptr (while (string= (car ptr) (cadr ptr)) ;;(debug) (setcar ptr (cadr ptr)) (setcdr ptr (cddr ptr))) (setq ptr (cdr ptr))) list)) ;;(defun d-kill-adjacent-duplicates (list) ;; (d-kill-adjacent-duplicates--inner (d-kill-adjacent-duplicates--inner list))) ;;; ;;; (d-last-string-match "src" "~/hairy-lemon/src/davin/webdesign/tutorial-4/src/site/index.hts") ;; yes ;;; (d-last-string-match "src" "~/hairy-lemon/src/davin/webdesign/tutorial-4/not/site/index.hts") ;; yes ;;; (d-last-string-match "src" "~/hairy-lemon/not/davin/webdesign/tutorial-4/not/site/index.hts") ;; no ;;; (defun d-last-string-match (regexp string) (let ((i (length string)) (done nil)) (while (and (>= i 0) (not done)) (if (string-match regexp string i) (setq done t)) (decf i)) done)) ;;; ;;; COOL: ;;; (defun d-splat (old-text new-text) (save-match-data (save-excursion (goto-char (point-min)) (while (search-forward old-text nil t) (replace-match new-text nil nil))))) ;;; ;;; COOL: ;;; (defun d-splat-re (old-text new-text) (save-match-data (save-excursion (goto-char (point-min)) (while (re-search-forward old-text nil t) (replace-match new-text nil nil))))) ;;; ;;; (d-trim-left "\r\t abc \t\r\n abc def ") ;;; (defun d-trim-left-old (s) (progn (while (and (setq ch (aref s 0)) (or (eq ch ?\ ) (eq ch ?\t) (eq ch ?\r) (eq ch ?\n))) (setq s (substring s 1))) s) ) ;; (d-trim-left " abc def ") ;; (d-trim-left " ") (defun d-trim-left (s) (let (i len ch) (setq i 0) (setq len (length s)) (while (and (< i len) (setq ch (aref s i)) (or (eq ch ?\ ) (eq ch ?\t) (eq ch ?\r) (eq ch ?\n))) (incf i)) (setq s (substring s i))) s) ;;; ;;; (d-trim-right "abc def \r\t abc \r\t\n def \r\n") ;;; (d-trim-right s) (defun d-trim-right-old (s) (progn (setq i (1- (length s))) (while (and (setq ch (aref s i)) (or (eq ch ?\ ) (eq ch ?\t) (eq ch ?\r) (eq ch ?\n))) (setq s (substring s 0 i)) (decf i)) s) ) ;; (d-trim-right "abc def \n\n\n") ;; (d-trim-right " ") ;; (d-trim-right "class") (defun d-trim-right (s) (let (i ch) (setq i (1- (length s))) (while (and (>= i 0) (setq ch (aref s i)) (or (eq ch ?\ ) (eq ch ?\t) (eq ch ?\r) (eq ch ?\n))) (decf i)) (setq s (substring s 0 (1+ i))) ) ) ;;; ;;; (d-trim-string (setq s "\r\t\n abc def \n sexy rexy \n")) ;;; (d-trim-left "") ;;; (d-trim-right "") (defun d-trim-string (s) (if (or (not s) (string= s "")) "" (if s (d-trim-left (d-trim-right s))))) ;;(defun d-what-line () ;; (read (substring (what-line) 5))) (defun d-what-line () "Different from what-line in that it returns the result rather than printing it" (save-excursion (beginning-of-line) (1+ (count-lines 1 (point))))) ;;(global-set-key [kp-enter] 'd-random-play-emacs-midi)
;; VARIABLES ;;(checkpoint "d6") ;; ;; NOTE: these variable appear to have no effect ;; (d-quote (setq blink-cursor-interval 0.5) (setq blink-cursor-delay 0.5) (run-with-idle-timer 0.1 t 'blink-cursor-start)) (setq kill-whole-line t) ;;(setq eol-mnemonic-unix "(Unix)") (setq eol-mnemonic-dos "(Dos)") (if prefs-advanced-user-p (setq track-eol t) (setq track-eol nil)) (setq compile-command "make ") (setq message-log-max 10000) (put 'eval-expression 'disabled nil) (put 'narrow-to-region 'disabled nil) (put 'downcase-region 'disabled nil) (put 'upcase-region 'disabled nil) (put 'set-goal-column 'disabled nil) (setq enable-local-eval t) (setq backup-inhibited t) ;; NOTE: disables ~ style backups (setq auto-save-timeout 30) ;; NOTE: #*# style backups are online (setq-default c-basic-offset 3) (setq-default transient-mark-mode nil indent-tabs-mode nil ;;; never put tabs in d- code parse-sexp-ignore-comments t comment-column 40 completion-ignore-case t ;;; Good for Win95 mode. case-fold-search nil c-basic-offset 3 truncate-lines nil ) (setq gc-cons-threshold 2000000 visible-bell t same-window-buffer-names nil compilation-window-height 15 line-number-mode t require-final-newline t search-highlight t compilation-window-height 10 compilation-ask-about-save nil next-line-add-newlines nil ;; Doesn't add newlines at end kill-whole-line t ;; Makes C-k more convenient. next-screen-context-lines 1 ;; Overlap with PGUP/PGDN compile-command "make " default-major-mode 'fundamental-mode three-step-help t apropos-do-all t ;; more extensive online help enable-recursive-minibuffers nil ;; advanced customisation feature... column-number-mode t diary-file (expand-file-name "~/.diary") eval-expression-debug-on-error nil ) (setq undo-limit (* 1000 1000)) (progn ;; ;; NOTE: this command is obsolete ;; ;;(hscroll-global-mode) ;;(setq hscroll-mode-name nil) ) (setq-default tab-width 8) (setq delete-old-versions t)
;; HISTORY VARIABLES ;;(checkpoint "d7") (if (or (not (boundp 'compile-history)) (not compile-history)) (setq compile-history '("make "))) (setq file-name-history (cons (if emacs-dialect--gnuemacs-p (concat (getenv "HOME") "/bak/") "~/bak/") file-name-history)) (if (string= (user-real-login-name) "root") (setq file-name-history (cons "~davin/" file-name-history))) (if emacs-dialect--gnuemacs-p (setq file-name-history (cons "~/" file-name-history))) (if (boundp 'safe-compress-file-name) (setq file-name-history (cons (concat (safe-compress-file-name "~/dlisp") "/") file-name-history))) (when (and emacs-dialect--gnuemacs-p os-type--microsoft-p) (setq file-name-history (cons "c:/" file-name-history)) ;;(setq file-name-history (cons (concat (safe-compress-file-name (getenv "HOME")) "/") file-name-history)) ) ;;(if os-type--linux-p (setq file-name-history (cons "~/src/davin/research/2004/" file-name-history))) (when emacs-dialect--gnuemacs-p ;;(setq extended-command-history (cons "eval-buffer" extended-command-history)) (setq extended-command-history (cons "meal-timer" extended-command-history))4 (setq extended-command-history (cons "bak" extended-command-history)) (setq extended-command-history (cons "grep" extended-command-history)) (setq dired-shell-command-history (if (boundp 'dired-shell-command-history) (cons "du -h" dired-shell-command-history) '("du -h"))) ) (when emacs-dialect--xemacs-p ;;(setq read-command-history (cons "eval-buffer" read-command-history)) (setq read-command-history (cons "bak" read-command-history)) (setq read-command-history (cons "grep" read-command-history)) ) ;;; ;;; NOTE: mouse wheel in XEmacs ;;; (if emacs-dialect--xemacs-p (when window-system ;; enable wheelmouse support by default (mwheel-install) (setq mouse-wheel-scroll-amount '(2 . 1)) ;; use extended compound-text coding for X clipboard (set-selection-coding-system 'compound-text-with-extensions) (set-scroll-bar-mode 'right) (set-frame-name (concat "Gnu Emacs " (capitalize (user-real-login-name))))))
;; LINKS and CRUD ;;(checkpoint "d8") (defun d-make-links () (when os-type--microsoft-p ;;(d-make-links--year "1999") ;;(d-make-links--year "2003") ;;(d-make-links--year "2004") ;;(d-make-links--year "2005") ;;(safe-make-link (concat webdata "/src/davin/") "~/davin") ;;(safe-make-link (concat "~/zallegro/2004/Tritus-II/") "~/tritus") ;;(safe-make-link (concat "~/zallegro/2005/dd3/") "~/dd3") ;;(safe-make-link (concat "~/zallegro/2005/tests/") "~/tests") ) (when os-type--linux-p ;;(safe-make-link "/usr/share/emacs/site-lisp/dlisp/" "~/dlisp") ;;(safe-make-link "/bak-dos" "~/bak-dos") ;;(safe-make-link "/bak-unix" "~/bak-unix") ;;(safe-make-link "~davin/src/davin/research/2003" "~/3") ;;(safe-make-link "~davin/src/davin/research/2004" "~/4") ;;(if (string= (user-real-login-name) "root") ;; (safe-make-link "~davin/web" "~/web")) ;;(safe-make-link "/mnt/cdrom" "~/cdrom") ) ) (d-make-links) (if (not (assoc 'debug-on-error minor-mode-alist)) (setq minor-mode-alist (cons '(debug-on-error " DEBUG") minor-mode-alist))) (when prefs-home-emacs-p ;;(setenv "WEBDATA" "c:/home/hairy-lemon") (setq webdata "~/hairy-lemon")) (global-font-lock-mode 1) (add-hook 'text-mode-hook 'turn-on-font-lock) (recenter) ;; ;; NOTE: needed for sensible bindings of CAPS LOCK key ;; (defun d-xmodmap () (interactive) (save-window-excursion (shell-command (concat "xmodmap ~www/dlisp/caps/xmodmaprc")) (if (get-buffer "*Shell Command Output*") (kill-buffer "*Shell Command Output*")) (message "Ran xmodmap ~www/dlisp/caps/xmodmaprc") ;;(sit-for 1) )) (when (not os-type--text-p) (load-file (concat (car load-path) "imported-stuff/tabbar.el")) (tabbar-mode 1) ) (setq file-name-history (append '("~/" "~/dlisp/" "~/lisp++-projects/") file-name-history)) (provide 'diagnose)
Back
| Main Menu | Research Projects | Photo Album | Curriculum Vitae | The Greatest Artists |
| Email Address | Computer Games | Web Design | Java Training Wheels | The Fly (A Story) |
| Political Activism | Bob Dylan Quotes+ | My Life Story | Smoking Cessation | Other Links |
| Debugging Macros | String Class I | Linked List System I | Java for C Programmers | Naming Convention |
| String Class II | How I use m4 | Strings III | Symmetrical I/O | Linked Lists II |
| Run-Time Type Info | Virtual Methods | An Array System | Science & Religion | Submodes |
| Nested Packages | Memory Leaks | Garbage Collection | Internet & Poverty | What is Knowledge? |
| Limits of Evolution | Emacs Additions | Function Plotter | Romantic Love | The Next Big Thing |
| Science Fiction | Faster Compilation | Theory of Morality | Elisp Scoping | Elisp Advice |
| S.O.G.M. Pattern | Safe Properties | School Bullying | Charisma Control | Life and Death |
| Splitting Java | Multiple Ctors | Religious Beliefs | Conversation 1 | Conversation 2 |
| J.T.W. Language | Emacs Additions II | Build Counter | Relation Plotter | Lisp++ Language |
| Memory Leaks II | Super Constructors | CRUD Implementation | Order a Website Form | There Is An Afterlife |
| More Occam's Razor | C to Java Translator | Theory of Morality II
Last modified: Sat Apr 29 18:38:35 NZST 2017
Best viewed at 800x600 or above resolution.
© Copyright 1999-2017 Davin Pearson.
Please report any broken links to