From 444163d568fd3686183f7d08c878cbc4216238bb Mon Sep 17 00:00:00 2001 From: "W. Trevor King" Date: Wed, 30 Nov 2011 09:40:10 -0500 Subject: [PATCH] Strip down to just the framework, and compact that into a single dotfiles.sh. --- README | 141 +- bin/diff.sh | 77 - bin/disconnect.sh | 68 - bin/dotfiles.sh | 22 - bin/fetch.sh | 27 - bin/link.sh | 80 - bin/patch.sh | 39 - dotfiles.sh | 739 ++++++ src/.XCompose | 63 - src/.Xmodmap | 103 - src/.bash_aliases | 45 - src/.bash_logout | 4 - src/.bash_profile | 18 - src/.bashrc | 40 - src/.bashrc.d/completion | 11 - src/.bashrc.d/dotfiles | 6 - src/.bashrc.d/environment | 11 - src/.bashrc.d/gpg_agent | 4 - src/.bashrc.d/lesspipe | 2 - src/.bashrc.d/local_paths | 36 - src/.bashrc.d/nobeep | 12 - src/.bashrc.d/screen | 4 - src/.bashrc.d/ssh_agent | 4 - src/.bazaar/bazaar.conf | 5 - src/.bazaar/ignore | 8 - src/.emacs | 27 - src/.emacs-admin | 13 - src/.emacs.d/load/cython-mode.el | 65 - src/.emacs.d/load/gnugo.el | 2253 ------------------ src/.emacs.d/load/querty.el | 204 -- src/.emacs.d/load/wtk_aspell.el | 11 - src/.emacs.d/load/wtk_centralized_backups.el | 21 - src/.emacs.d/load/wtk_common.el | 14 - src/.emacs.d/load/wtk_epa.el | 6 - src/.emacs.d/load/wtk_layout.el | 2 - src/.emacs.d/load/wtk_no-vc.el | 3 - src/.emacs.d/load/wtk_org.el | 16 - src/.emacs.d/load/wtk_utf-8.el | 3 - src/.fluxbox/keys | 168 -- src/.gitconfig | 6 - src/.gnuplot | 3 - src/.hgrc | 12 - src/.mailcap | 10 - src/.screenrc | 34 - src/.signature | 2 - src/.xinitrc | 20 - 46 files changed, 822 insertions(+), 3640 deletions(-) delete mode 100755 bin/diff.sh delete mode 100755 bin/disconnect.sh delete mode 100755 bin/dotfiles.sh delete mode 100755 bin/fetch.sh delete mode 100755 bin/link.sh delete mode 100755 bin/patch.sh create mode 100755 dotfiles.sh delete mode 100644 src/.XCompose delete mode 100644 src/.Xmodmap delete mode 100644 src/.bash_aliases delete mode 100644 src/.bash_logout delete mode 100644 src/.bash_profile delete mode 100644 src/.bashrc delete mode 100644 src/.bashrc.d/completion delete mode 100644 src/.bashrc.d/dotfiles delete mode 100644 src/.bashrc.d/environment delete mode 100644 src/.bashrc.d/gpg_agent delete mode 100644 src/.bashrc.d/lesspipe delete mode 100644 src/.bashrc.d/local_paths delete mode 100644 src/.bashrc.d/nobeep delete mode 100644 src/.bashrc.d/screen delete mode 100644 src/.bashrc.d/ssh_agent delete mode 100644 src/.bazaar/bazaar.conf delete mode 100644 src/.bazaar/ignore delete mode 100644 src/.emacs delete mode 100644 src/.emacs-admin delete mode 100644 src/.emacs.d/load/cython-mode.el delete mode 100644 src/.emacs.d/load/gnugo.el delete mode 100644 src/.emacs.d/load/querty.el delete mode 100644 src/.emacs.d/load/wtk_aspell.el delete mode 100644 src/.emacs.d/load/wtk_centralized_backups.el delete mode 100644 src/.emacs.d/load/wtk_common.el delete mode 100644 src/.emacs.d/load/wtk_epa.el delete mode 100644 src/.emacs.d/load/wtk_layout.el delete mode 100644 src/.emacs.d/load/wtk_no-vc.el delete mode 100644 src/.emacs.d/load/wtk_org.el delete mode 100644 src/.emacs.d/load/wtk_utf-8.el delete mode 100644 src/.fluxbox/keys delete mode 100644 src/.gitconfig delete mode 100644 src/.gnuplot delete mode 100644 src/.hgrc delete mode 100644 src/.mailcap delete mode 100644 src/.screenrc delete mode 100644 src/.signature delete mode 100644 src/.xinitrc diff --git a/README b/README index 2d0b8aa..5ed61c2 100644 --- a/README +++ b/README @@ -2,65 +2,69 @@ This package provides automatic synchronization of assorted dotfiles, simplifying the maintenance of a uniform configuration across several hosts. -The `original implentation`_ was by Steve Kemp. +The `original implementation`_ was by Steve Kemp. -_original implementation: http://dotfiles.repository.steve.org.uk +.. _original implementation: http://dotfiles.repository.steve.org.uk + +This package only contains the ``dotfiles.sh`` script which manages the +dotfiles framework. The files that are being managed live in separate +repositories. A stand-alone framework has two goals: + +1. Allow others to reuse the framework with their own dotfile + repositories. +2. Allow several concurrent repositories (e.g. public and private). Installation ------------ -To install dotfiles, you'll need to check out a copy of the source, -either by using `git`: +To install the distribution framework, just drop ``dotfiles.sh`` into +your ``PATH``. Also check that you have already installed the utilities +listed in the ``External utilities`` section of ``dotfiles.sh``. + +Setting up managed repositories will look something like this:: - $ git clone http://physics.drexel.edu/~wking/code/git/dotfiles.git + $ mkdir ~/src/dotfiles + $ cd ~/src/dotfiles + $ dotfiles.sh clone public wget http://example.com/public-dotfiles.tar.gz + $ dotfiles.sh patch public + $ dotfiles.sh link --force-file --dry-run public + $ dotfiles.sh link --force-file public -or by downloading and unpacking a tarball: +Maintenance +----------- - $ wget http://physics.drexel.edu/~wking/code/tar/dotfiles.tgz - $ tar -xvf dotfiles.tgz +Once you've got your repository installed, just run:: -It's up to you where you keep the unpacked source. Popular choices -are `~/src/dotfiles` and `~/.dotfiles`. Once you've unpacked the -source, set the `DOTFILES_DIR` environment variable to the source -directory: + $ dotfiles.sh --dotfiles-dir ~/src/dotfiles update - $ export DOTFILES_DIR=~/src/dotfiles/ +to fetch any new developments from the central source, apply local +patches, and link to any new files from your target directory. In +order to automate this, you may want to add this line to your +``.bashrc``, which will update your dotfiles every time you start a new +Bash shell. Since dotfiles are not expected to change rapidly, the +``update`` command remembers the last time it ran and only actually +performs the update if it has been at least a week since the last +update. If you're using Git, you may have a choice of transport protocols for accessing the central repository. Some protocols (e.g. SSH) often require you to authenticate before you are allowed access. Because dotfiles will try and update your local repository as you log in, make sure you set up your authentication mechanism (e.g. SSH agent) before -running `dotfiles.sh`. If you don't want to bother authenticating, +running ``dotfiles.sh``. If you don't want to bother authenticating, use a protocol that does not require authentication (e.g. HTTP) in your default pull URL. -If you aren't using Git, you'll need to set the `DOTFILES_TGZ` -environment variable so dotfiles knows where to look for updated -versions of your central source: - - $ export DOTFILES_TGZ="http://physics.drexel.edu/~wking/code/tar/dotfiles.tgz" - -Once you've setup the environment variables, you can run -`bin/dotfiles.sh` to install dotfiles-controlled versions of any -dotfiles that you don't already have. - -Maintenance ------------ - -In order to stay abreast of changes to the central repository, you -should run `dotfiles.sh` periodically. An easy way to accomplish this -is to source `${DOTFILES_DIR}/src/.bashrc.d/dotfiles` in your -`~/.bashrc` (as I do at the end of my central `.bashrc`). This will -call `dotfiles.sh` whenever you open a Bash shell, ensuring you're -always up-to-date at the start of your session. +Local differences +----------------- After syncing with the central server, any local patches -(`${DOTFILES_DIR}/local-patch/*.patch`) are applied and filenames -`${DOTFILES_DIR}/local-patch/*.remove` are removed to adapt to the local -system. As with installation, symlinks are automatically created for -any dotfile (`${DOTFILES_DIR}/XXX`) that does not already have a -locally installed version (`~/XXX`). +(``${DOTFILES_DIR}/${REPO}/local-patch/*.patch``) are applied and +filenames ``${DOTFILES_DIR}/${REPO}/local-patch/*.remove`` are removed +to adapt to the local system. As with installation, symlinks are +automatically created for any dotfile +(``${DOTFILES_DIR}/${REPO}/patched-src/XXX``) that does not already +have a locally installed version (``${TARGET}/XXX``). If you followed the installation instructions above, you may have received warnings about files that you already have that dotfiles @@ -68,26 +72,47 @@ wants to control. You have two options for dealing with these collisions: 1. Control the file yourself. In this case, you should add the - filename to a `local-patch/*.remove` file, so that dotfiles knows + filename to a ``local-patch/*.remove`` file, so that dotfiles knows you've assumed control. 2. Delegate control to dotfiles. In this case, you should remove your local version of the file. Dotfiles will symlink in its version - the next time you run `dotfiles.sh`. If you have many such files, - `link.sh --force` will overwrite all of them at once. - -Local differences ------------------ - -As we hinted at above, you can tailor how closely your local dotfiles -installation tracks the central repository. Using -`local-patch/*.remove` allows you to select purely-local control for -files. When you only need a small tweak to central version, use -`local-patch/*.patch`, giving some degree of shared control. You run - - $ cd "${DOTFILES_DIR}" - $ ./bin/diff.sh --local-patch - -To create `.patch` and `.remove` files that recreate your currently -installed state from the current source state. Edit (and optionally -rename) these files to get the exact set of local adjustments you -need. + the next time you run ``dotfiles.sh``. If you have many such files, + ``dotfiles.sh link --force`` will overwrite all of them at once. + +You can use the ``diff`` command in ``dotfiles.sh`` to browse the +differences between your checked out source and installed targets. +The ``--local-patch`` option will record all such differences in the +``local-patch`` directory for editing. + +Additional repositories +----------------------- + +Some dotfiles contain passwords, hostnames, or other personal +information. You may want to synchronize these files, but placing +them in a globally readable repository would not be a good idea. A +simple solution would be to distribute *all* your dotfiles through +secure channels (e.g. Git over SSH), but then nobody would benefit +from the cool tricks you've used in your non-sensitive dotfiles. A +better solution is to run two (or more) dotfiles repositories +concurrently, one for sensitive files and the other for public files. +Of course, you might also want to run concurrent repositories reason +besides privacy. Whatever your motivation, installing another +repository is the same as installing the first:: + + $ cd ~/src/dotfiles + $ dotfiles.sh clone private git ssh://example.com/~/private-dotfiles.git + $ dotfiles.sh patch private + $ dotfiles.sh link --force-file private + +Future calls to ``dotfiles.sh update`` will update all of your +repositories in turn. + +Help +---- + +This ``README`` is designed to get you started with this dotfiles +framework and give you a feel for the overall structure. For more +details, browse through the ``dotfiles.sh`` documentation, starting +with:: + + $ dotfiles.sh --help diff --git a/bin/diff.sh b/bin/diff.sh deleted file mode 100755 index e311040..0000000 --- a/bin/diff.sh +++ /dev/null @@ -1,77 +0,0 @@ -#!/bin/bash -# -# Print diffs for each _FILE, ~/.FILE pair -# -# There are two modes: removed and standard. In standard mode, we show -# the transition .file -> ~/.file, which shows the changes changes we -# need to apply to dotfiles to create your current local installation. -# In remove mode, we list the .files that do not have local ~/.file -# analogs (i.e. dotfiles that need to be removed to create your -# current local installation). The --removed option selects removed -# mode. - -if [ -z "${DOTFILES_DIR}" ]; then - echo "DOTFILES_DIR is not set. Bailing out." - exit 1 -fi - -MODE='standard' - -# parse options -while [ -n "${1}" ]; do - case "${1}" in - '--removed') - MODE='removed' - ;; - '--local-patch') - MODE='local-patch' - ;; - esac - shift -done - -if [ "${MODE}" = 'local-patch' ]; then - cd "${DOTFILES_DIR}" - mkdir -p local-patch || exit 1 - echo 'save local patches to local-patch/000-local.patch' - ./bin/diff.sh > local-patch/000-local.patch || exit 1 - echo 'save local removes to local-patch/000-local.remove' - ./bin/diff.sh --removed > local-patch/000-local.remove || exit 1 - exit -fi - -cd "${DOTFILES_DIR}/src" || exit 1 - -# Show the changes we'd apply on installation -# -# Parameters: -# file - The file we're processing '.foo' -function handle_file() -{ - FILE="${1}" - if [ "${MODE}" = 'removed' ]; then - if [ ! -e ~/"${FILE}" ]; then - echo "${FILE}" - fi - else - if [ -f ~/"${FILE}" ]; then - diff -u "${FILE}" ~/"${FILE}" - fi - fi -} - -# For each file in this directory. -FOUND=0 -while read FILE; do - if [ "${FILE}" = '.' ]; then - continue - fi - FILE="${FILE:2}" # strip the leading './' - handle_file "${FILE}" - let "FOUND = FOUND + 1" -done < <(find .) - -# If we found no .XXX files, print a warning -if [ "${FOUND}" -lt 1 ]; then - echo 'WARNING: no source dotfiles were found' >&2 -fi diff --git a/bin/disconnect.sh b/bin/disconnect.sh deleted file mode 100755 index b825cb1..0000000 --- a/bin/disconnect.sh +++ /dev/null @@ -1,68 +0,0 @@ -#!/bin/bash -# -# You're about to give your sysadmin account to some newbie, and -# they'd just be confused by all this efficiency. This script freezes -# your dotfiles in their current state and makes everthing look -# normal. Note that this will delete your dotfiles directory, and -# strip the dotfiles portion from your ~/.bashrc file. - -if [ -z "${DOTFILES_DIR}" ]; then - echo 'DOTFILES_DIR is not set. Bailing out.' - exit 1 -fi - -# See if we've constructed any patched source files that might be -# possible link targets -if [ ! -d "${DOTFILES_DIR}/patched-src" ]; then - echo 'no installed dotfiles to disconnect' - exit -fi - -DOTFILES_SRC="${DOTFILES_DIR}/patched-src" -cd "${DOTFILES_SRC}" || exit 1 - -# See if the bashrc file is involved with dotfiles at all -if [ -e '.bashrc' ]; then - BASHRC='yes' -else - BASHRC='no' -fi - -while read FILE; do - if [ "${FILE}" = '.' ]; then - continue - fi - FILE="${FILE:2}" # strip the leading './' - if [ "${DOTFILES_SRC}/${FILE}" -ef ~/"${FILE}" ] && \ - [ -h ~/"${FILE}" ]; then - # break simlink - echo "de-symlink ~/${FILE}" - rm -f ~/"${FILE}" - mv "${FILE}" ~/"${FILE}" - fi -done < <(find .) - -if [ "${BASHRC}" == 'yes' ]; then - echo 'strip dotfiles section from ~/.bashrc' - sed '/DOTFILES_DIR/d' ~/.bashrc > bashrc_stripped - - # see if the stripped file is any different - DIFF=$(diff ~/.bashrc bashrc_stripped) - DIFF_RC="$?" - if [ ${DIFF_RC} -eq 0 ]; then - echo "no dotfiles section found in ~/.bashrc" - rm -f bashrc_stripped - elif [ ${DIFF_RC} -eq 1 ]; then - echo "replace ~/.bashrc with stripped version" - rm -f ~/.bashrc - mv bashrc_stripped ~/.bashrc - else - exit 1 # diff failed, bail - fi -fi - -#if [ -d "${DOTFILES_DIR}" ]; then -# cd -# echo "remove the dotfiles dir ${DOTFILES_DIR}" -# rm -rf "${DOTFILES_DIR}" -#fi diff --git a/bin/dotfiles.sh b/bin/dotfiles.sh deleted file mode 100755 index b543e9d..0000000 --- a/bin/dotfiles.sh +++ /dev/null @@ -1,22 +0,0 @@ -#!/bin/bash - -if [ -z "${DOTFILES_DIR}" ]; then - echo 'DOTFILES_DIR is not set. Bailing out.' - exit 1 -fi - -cd "${DOTFILES_DIR}" || exit 1 - -# Update once a week from our remote repository. Mark updates by -# touching this file. -UPDATE_FILE="updated.$(date +%U)" - -if [ ! -e "${UPDATE_FILE}" ]; then - echo "update dotfiles" - rm -f updated.* 2>/dev/null - touch "${UPDATE_FILE}" - ./bin/fetch.sh || exit 1 - ./bin/patch.sh || exit 1 - ./bin/link.sh || exit 1 - echo "dotfiles updated" -fi diff --git a/bin/fetch.sh b/bin/fetch.sh deleted file mode 100755 index 11e47f4..0000000 --- a/bin/fetch.sh +++ /dev/null @@ -1,27 +0,0 @@ -#!/bin/bash -# -# Get the current dotfiles from the server using a variety of methods. -# -# If there is a .git directory in $DOTFILES_DIR, use `git pull`, -# otherwise use wget to grab a tarball. - -if [ -z "${DOTFILES_DIR}" ]; then - echo 'DOTFILES_DIR is not set. Bailing out.' - exit 1 -fi - -cd "${DOTFILES_DIR}" || exit 1 - -# Check for Git (versioning system) so we know how to get our .dotfiles -if [ -d .git ];then - git pull || exit 1 -else - # fallback on wgetting the tarball - if [ -z "${DOTFILES_TGZ}" ]; then - echo 'DOTFILES_TGZ is not set. Bailing out.' - exit 1 - fi - wget --output-document dotfiles.tgz "${DOTFILES_TGZ}" || exit 1 - tar -xzvf dotfiles.tgz || exit 1 - rm -rf dotfiles.tgz || exit 1 -fi diff --git a/bin/link.sh b/bin/link.sh deleted file mode 100755 index e76bf5f..0000000 --- a/bin/link.sh +++ /dev/null @@ -1,80 +0,0 @@ -#!/bin/bash -# -# Link each FILE in patched-src to ~/FILE -# -# By default, link.sh only replaces missing files and simlinks. You -# can optionally overwrite any local files by passing the --force -# option. - -if [ -z "${DOTFILES_DIR}" ]; then - echo 'DOTFILES_DIR is not set. Bailing out.' - exit 1 -fi - -DOTFILES_SRC="${DOTFILES_DIR}/patched-src" -FORCE='no' # If 'file', overwrite existing files. - # If 'yes', overwrite existing files and dirs. -DRY_RUN='no' # If 'yes', disable any actions that change the filesystem - -# parse options -while [ -n "${1}" ]; do - case "${1}" in - '--force') - FORCE='yes' - ;; - '--force-file') - FORCE='file' - ;; - '--dry-run') - DRY_RUN='yes' - ;; - esac - shift -done - -# Create the symbolic link, overriding the target if it exists. -# -# link_file( $file ) -# -# Parameters: -# file - The file we're processing '.foo' -function link_file() -{ - FILE="${1}" - if [ -e ~/"${FILE}" ] || [ -h ~/"${FILE}" ]; then - if [ "${DRY_RUN}" = 'yes' ]; then - echo "move ~/${FILE} to ~/${FILE}.bak" - else - echo -n 'move ' - mv -v ~/"${FILE}" ~/"${FILE}.bak" || exit 1 - fi - fi - if [ "${DRY_RUN}" = 'yes' ]; then - echo "link ~/${FILE} to ${DOTFILES_DIR}/${FILE}" - else - echo -n 'link ' - ln -sv "${DOTFILES_DIR}/patched-src/${FILE}" ~/"${FILE}" || exit 1 - fi -} - -cd "${DOTFILES_DIR}/patched-src" || exit 1 - -while read FILE; do - if [ "${FILE}" = '.' ]; then - continue - fi - FILE="${FILE:2}" # strip the leading './' - if [ "${DOTFILES_SRC}/${FILE}" -ef ~/"${FILE}" ]; then - continue # already simlinked - fi - if [ -d "${DOTFILES_SRC}/${FILE}" ] && [ -d ~/"${FILE}" ] && \ - [ "${FORCE}" != 'yes' ]; then - echo "use --force to override the existing directory: ~/${FILE}" - continue # allow unlinked directories - fi - if [ -e ~/"${FILE}" ] && [ "${FORCE}" = 'no' ]; then - echo "use --force to override the existing target: ~/${FILE}" - continue # target already exists - fi - link_file "${FILE}" -done < <(find .) diff --git a/bin/patch.sh b/bin/patch.sh deleted file mode 100755 index dfe7ff5..0000000 --- a/bin/patch.sh +++ /dev/null @@ -1,39 +0,0 @@ -#!/bin/bash -# -# Patch a fresh checkout with local adjustments. - -if [ -z "${DOTFILES_DIR}" ]; then - echo 'DOTFILES_DIR is not set. Bailing out.' - exit 1 -fi - -cd "${DOTFILES_DIR}" || exit 1 - -# clone the checkout into DOTFILES_DIR/patched-src -echo "clone clean checkout into patched-src" -rsync -avz --delete src/ patched-src/ || exit 1 - -# apply all the patches in local-patch/ -for PATCH in local-patch/*.patch; do - if [ -f "${PATCH}" ]; then - echo "apply ${PATCH}" - pushd patched-src/ > /dev/null || exit 1 - patch -p0 < "../${PATCH}" || exit 1 - popd > /dev/null || exit 1 - fi -done - -# remove any files marked for removal in local-patch -for REMOVE in local-patch/*.remove; do - if [ -f "${REMOVE}" ]; then - while read LINE; do - if [ -z "${LINE}" ] || [ "${LINE:0:1}" = '#' ]; then - continue # ignore blank lines and comments - fi - if [ -e "patched-src/${LINE}" ]; then - echo "remove ${LINE}" - rm -rf "patched-src/${LINE}" - fi - done < "${REMOVE}" - fi -done diff --git a/dotfiles.sh b/dotfiles.sh new file mode 100755 index 0000000..2eef6c6 --- /dev/null +++ b/dotfiles.sh @@ -0,0 +1,739 @@ +#!/bin/bash +# +# Dotfiles management script. For details, run +# $ dotfiles.sh --help + +VERSION='0.2' +DOTFILES_DIR="${PWD}" +TARGET=~ +CHECK_WGET_TYPE_AND_ENCODING='no' + +##### +# External utilities + +DIFF=$(which diff) +GIT=$(which git) +LN=$(which ln) +MV=$(which mv) +PATCH=$(which patch) +SED=$(which sed) +RM=$(which rm) +RSYNC=$(which rsync) +TAR=$(which tar) +TOUCH=$(which touch) +WGET=$(which wget) + +##### +# Utility functions + +# usage: nonempty_option LOC NAME VALUE +function nonempty_option() +{ + LOC="${1}" + NAME="${2}" + VALUE="${3}" + if [ -z "${VALUE}" ]; then + echo "ERROR: empty value for ${NAME} in ${LOC}" >&2 + return 1 + fi + echo "${VALUE}" +} + +# usage: maxargs LOC MAX "${@}" +# +# Print and error and return 1 if there are more than MAX arguments. +function maxargs() +{ + LOC="${1}" + MAX="${2}" + shift 2 + if [ "${#}" -gt "${MAX}" ]; then + echo "ERROR: too many arguments (${#} > ${MAX}) in ${LOC}" >&2 + return 1 + fi +} + +# usage: get_selection CHOICE OPTION ... +# +# Check that CHOICE is one of the valid options listed in OPTION. If +# it is, echo the choice and return 0, otherwise print an error to +# stderr and return 1. +function get_selection() +{ + CHOICE="${1}" + shift + for OPT in "${@}"; do + if [ "${OPT}" = "${CHOICE}" ]; then + echo "${OPT}" + return 0 + fi + done + echo "ERROR: invalid selection (${CHOICE})" >&2 + echo "valid choices: ${@}" >&2 + return 1 +} + +function run_on_all_repos() +{ + COMMAND="${1}" + if [ -z "${REPO}" ]; then # run on all repositories + for REPO in *; do + if [ "${REPO}" = '*' ]; then + break # no known repositories + fi + "${COMMAND}" "${REPO}" || return 1 + done + return + fi +} + +function list_files() +{ + DIR=$(nonempty_option 'list_files' 'DIR' "${1}") || return 1 + while read FILE; do + if [ "${FILE}" = '.' ]; then + continue + fi + FILE="${FILE:2}" # strip the leading './' + echo "${FILE}" + done < <(cd "${DIR}" && find .) +} + +# Global variable to allow passing associative arrats between functions +declare -A REPO_SOURCE_DATA + +function set_repo_source() +{ + REPO=$(nonempty_option 'set_repo_source' 'REPO' "${1}") || return 1 + > "${REPO}/source_cache" || return 1 + for KEY in "${!REPO_SOURCE_DATA[@]}"; do + echo "${KEY}=${REPO_SOURCE_DATA[${KEY}]}" >> "${REPO}/source_cache" || return 1 + done +} + +# usage: get_repo_source REPO +function get_repo_source() +{ + REPO=$(nonempty_option 'get_repo_source' 'REPO' "${1}") || return 1 + REPO_SOURCE_DATA=() + if [ -f "${REPO}/source_cache" ]; then + while read LINE; do + KEY="${LINE%%=*}" + VALUE="${LINE#*=}" + REPO_SOURCE_DATA["${KEY}"]="${VALUE}" + done < "${REPO}/source_cache" + else + # autodetect verson control system + REPO_SOURCE_DATA=() + REPO_SOURCE_DATA['repo']="${REPO}" + if [ -d "${REPO}/.git" ]; then + REPO_SOURCE_DATA['transfer']='git' + else + echo "ERROR: no source location found for ${REPO}" >&2 + return 1 + fi + # no need to get further fields for these transfer mechanisms + fi +} + +function wget_fetch() +{ + REPO=$(nonempty_option 'wget_fetch' 'REPO' "${1}") || return 1 + # get_repo_source() was just called on this repo in fetch() + TRANSFER=$(nonempty_option 'wget_fetch' 'TRANSFER' "${REPO_SOURCE_DATA['transfer']}") || return 1 + URL=$(nonempty_option 'wget_fetch' 'URL' "${REPO_SOURCE_DATA['url']}") || return 1 + ETAG="${REPO_SOURCE_DATA['etag']}" + BUNDLE="${REPO}.tgz" + HEAD=$("${WGET}" --server-response --spider "${URL}" 2>&1) || return 1 + SERVER_ETAG=$(echo "${HEAD}" | "${SED}" -n 's/^ *etag: *"\(.*\)"/\1/ip') || return 1 + if [ "${CHECK_WGET_TYPE_AND_ENCODING}" = 'yes' ]; then + TYPE=$(echo "${HEAD}" | "${SED}" -n 's/^ *content-type: *//ip') || return 1 + ENCODING=$(echo "${HEAD}" | "${SED}" -n 's/^ *content-encoding: *//ip') || return 1 + if [ "${TYPE}" != 'application/x-gzip' ] || [ "${ENCODING}" != 'x-gzip' ]; then + echo "ERROR: invalid content type (${TYPE}) or encoding (${ENCODING})." >&2 + echo "while fetching ${URL}" >&2 + return 1 + fi + fi + if [ -z "${ETAG}" ] || [ "${SERVER_ETAG}" != "${ETAG}" ]; then + # Previous ETag not known, or ETag changed. Download new copy. + "${WGET}" --output-document "${BUNDLE}" "${URL}" || return 1 + if [ -n "${SERVER_ETAG}" ]; then # store new ETag + REPO_SOURCE_DATA['etag']="${SERVER_ETAG}" + set_repo_source "${REPO}" || return 1 + else + if [ -n "${ETAG}" ]; then # clear old ETag + unset "${REPO_SOURCE_DATA['etag']}" + set_repo_source "${REPO}" || return 1 + fi + fi + echo "extracting ${BUNDLE} to ${REPO}" + "${TAR}" -xf "${BUNDLE}" -C "${REPO}" --strip-components 1 --overwrite || return 1 + "${RM}" -f "${BUNDLE}" || return 1 + else + echo "already downloaded the ETag=${ETAG} version of ${URL}" + fi +} + +# usage: link_file REPO FILE +# +# Create the symbolic link to the version of FILE in the REPO +# repository, overriding the target if it exists. +function link_file() +{ + REPO=$(nonempty_option 'link_file' 'REPO' "${1}") || return 1 + FILE=$(nonempty_option 'link_file' 'FILE' "${2}") || return 1 + if [ "${BACKUP}" = 'yes' ]; then + if [ -e "${TARGET}/${FILE}" ] || [ -h "${TARGET}/${FILE}" ]; then + if [ "${DRY_RUN}" = 'yes' ]; then + echo "move ${TARGET}/${FILE} to ${TARGET}/${FILE}.bak" + else + echo -n 'move ' + mv -v "${TARGET}/${FILE}" "${TARGET}/${FILE}.bak" || return 1 + fi + fi + else + if [ "${DRY_RUN}" = 'yes' ]; then + echo "rm ${TARGET}/${FILE}" + else + "${RM}" -fv "${TARGET}/${FILE}" + fi + fi + if [ "${DRY_RUN}" = 'yes' ]; then + echo "link ${TARGET}/${FILE} to ${DOTFILES_DIR}/${REPO}/patched-src/${FILE}" + else + echo -n 'link ' + "${LN}" -sv "${DOTFILES_DIR}/${REPO}/patched-src/${FILE}" "${TARGET}/${FILE}" || return 1 + fi +} + +##### +# Top-level commands + +# An array of available commands +COMMANDS=() + +### +# clone command + +COMMANDS+=('clone') + +CLONE_TRANSFERS=('git' 'wget') + +function clone_help() +{ + echo 'Create a new dotfiles repository.' + if [ "${1}" = '--one-line' ]; then return; fi + + cat <<-EOF + + usage: $0 ${COMMAND} REPO TRANSFER URL + + Where 'REPO' is the name the dotfiles repository to create, + 'TRANSFER' is the transfer mechanism, and 'URL' is the URL for the + remote repository. Valid TRANSFERs are: + + ${CLONE_TRANSFERS[@]} + + Examples: + + $0 clone public wget http://example.com/public-dotfiles.tar.gz + $0 clone private git ssh://example.com/~/private-dotfiles.git + EOF +} + +function clone() +{ + REPO=$(nonempty_option 'clone' 'REPO' "${1}") || return 1 + TRANSFER=$(nonempty_option 'clone' 'TRANSFER' "${2}") || return 1 + URL=$(nonempty_option 'clone' 'URL' "${3}") || return 1 + maxargs 'clone' 3 "${@}" || return 1 + TRANSFER=$(get_selection "${TRANSFER}" "${CLONE_TRANSFERS[@]}") || return 1 + if [ -e "${REPO}" ]; then + echo "ERROR: destination path (${REPO}) already exists." >&2 + return 1 + fi + mkdir -p "${REPO}" + CACHE_SOURCE='yes' + FETCH='yes' + case "${TRANSFER}" in + 'git') + CACHE_SOURCE='no' + FETCH='no' + "${GIT}" clone "${URL}" "${REPO}" || return 1 + ;; + 'wget') + ;; + *) + echo "PROGRAMMING ERROR: add ${TRANSFER} support to clone command" >&2 + return 1 + esac + if [ "${CACHE_SOURCE}" = 'yes' ]; then + REPO_SOURCE_DATA=(['transfer']="${TRANSFER}" ['url']="${URL}") + set_repo_source "${REPO}" || return 1 + fi + if [ "${FETCH}" = 'yes' ]; then + fetch "${REPO}" || return 1 + fi +} + +### +# fetch command + +COMMANDS+=('fetch') + +function fetch_help() +{ + echo 'Get the current dotfiles from the server.' + if [ "${1}" = '--one-line' ]; then return; fi + + cat <<-EOF + + usage: $0 ${COMMAND} [REPO] + + Where 'REPO' is the name the dotfiles repository to fetch. If it + is not given, all repositories will be fetched. + EOF +} + +function fetch() +{ + # multi-repo case handled in main() by run_on_all_repos() + REPO=$(nonempty_option 'fetch' 'REPO' "${1}") || return 1 + maxargs 'fetch' 1 "${@}" || return 1 + get_repo_source "${REPO}" || return 1 + TRANSFER=$(nonempty_option 'fetch' 'TRANSFER' "${REPO_SOURCE_DATA['transfer']}") || return 1 + if [ "${TRANSFER}" = 'git' ]; then + "${GIT}" --git-dir "${REPO}/.git" pull || return 1 + elif [ "${TRANSFER}" = 'wget' ]; then + wget_fetch "${REPO}" || return 1 + else + echo "PROGRAMMING ERROR: add ${TRANSFER} support to fetch command" >&2 + return 1 + fi +} + +### +# fetch command + +COMMANDS+=('diff') + +function diff_help() +{ + echo 'Show differences between targets and dotfiles repositories.' + if [ "${1}" = '--one-line' ]; then return; fi + + cat <<-EOF + + usage: $0 ${COMMAND} [--removed|--local-patch] [REPO] + + Where 'REPO' is the name the dotfiles repository to query. If it + is not given, all repositories will be queried. + + By default, ${COMMAND} will list differences between files that + exist in both the target location and the dotfiles repository (as + a patch that could be applied to the dotfiles source). + + With the '--removed' option, ${COMMAND} will list files that + should be removed from the dotfiles source in order to match the + target. + + With the '--local-patch' option, ${COMMAND} will create files in + list files that should be removed from the dotfiles source in + order to match the target. + EOF +} + +function diff() +{ + MODE='standard' + while [ "${1::2}" = '--' ]; do + case "${1}" in + '--removed') + MODE='removed' + ;; + '--local-patch') + MODE='local-patch' + ;; + *) + echo "ERROR: invalid option to diff (${1})" >&2 + return 1 + esac + shift + done + # multi-repo case handled in main() by run_on_all_repos() + REPO=$(nonempty_option 'diff' 'REPO' "${1}") || return 1 + maxargs 'diff' 1 "${@}" || return 1 + + if [ "${MODE}" = 'local-patch' ]; then + mkdir -p "${REPO}/local-patch" || return 1 + + exec 3<&1 # save stdout to file descriptor 3 + echo "save local patches to ${REPO}/local-patch/000-local.patch" + exec 1>"${REPO}/local-patch/000-local.patch" # redirect stdout + diff "${REPO}" + exec 1<&3 # restore old stdout + exec 3<&- # close temporary fd 3 + + exec 3<&1 # save stdout to file descriptor 3 + echo "save local removed to ${REPO}/local-patch/000-local.remove" + exec 1>"${REPO}/local-patch/000-local.remove" # redirect stdout + diff "${REPO}" --removed + exec 1<&3 # restore old stdout + exec 3<&- # close temporary fd 3 + return + fi + + while read FILE; do + if [ "${MODE}" = 'removed' ]; then + if [ ! -e "${TARGET}/${FILE}" ]; then + echo "${FILE}" + fi + else + if [ -f "${TARGET}/${FILE}" ]; then + (cd "${REPO}/src" && "${DIFF}" -u "${FILE}" "${TARGET}/${FILE}") + fi + fi + done <<-EOF + $(list_files "${REPO}/src") + EOF +} + +### +# patch command + +COMMANDS+=('patch') + +function patch_help() +{ + echo 'Patch a fresh checkout with local adjustments.' + if [ "${1}" = '--one-line' ]; then return; fi + + cat <<-EOF + + usage: $0 ${COMMAND} [REPO] + + Where 'REPO' is the name the dotfiles repository to patch. If it + is not given, all repositories will be patched. + EOF +} + +function patch() +{ + # multi-repo case handled in main() by run_on_all_repos() + REPO=$(nonempty_option 'patch' 'REPO' "${1}") || return 1 + maxargs 'patch' 1 "${@}" || return 1 + + echo "copy clean checkout into ${REPO}/patched-src" + "${RSYNC}" -avz --delete "${REPO}/src/" "${REPO}/patched-src/" || return 1 + + # apply all the patches in local-patch/ + for FILE in "${REPO}/local-patch"/*.patch; do + if [ -f "${FILE}" ]; then + echo "apply ${FILE}" + pushd "${REPO}/patched-src/" > /dev/null || return 1 + "${PATCH}" -p0 < "../../${FILE}" || return 1 + popd > /dev/null || return 1 + fi + done + + # remove any files marked for removal in local-patch + for REMOVE in "${REPO}/local-patch"/*.remove; do + if [ -f "${REMOVE}" ]; then + while read LINE; do + if [ -z "${LINE}" ] || [ "${LINE:0:1}" = '#' ]; then + continue # ignore blank lines and comments + fi + if [ -e "${REPO}/patched-src/${LINE}" ]; then + echo "remove ${LINE}" + "${RM}" -rf "${REPO}/patched-src/${LINE}" + fi + done < "${REMOVE}" + fi + done +} + +### +# link command + +COMMANDS+=('link') + +function link_help() +{ + echo 'Link a fresh checkout with local adjustments.' + if [ "${1}" = '--one-line' ]; then return; fi + + cat <<-EOF + + usage: $0 ${COMMAND} [--force|--force-file] [--dry-run] [--no-backup] [REPO] + + Where 'REPO' is the name the dotfiles repository to link. If it + is not given, all repositories will be linked. + + By default, link.sh only replaces missing files and simlinks. You + can optionally overwrite any local files by passing the --force + option. + EOF +} + +function link() +{ + FORCE='no' # If 'file', overwrite existing files. + # If 'yes', overwrite existing files and dirs. + DRY_RUN='no' # If 'yes', disable any actions that change the filesystem + BACKUP='yes' + while [ "${1::2}" = '--' ]; do + case "${1}" in + '--force') + FORCE='yes' + ;; + '--force-file') + FORCE='file' + ;; + '--dry-run') + DRY_RUN='yes' + ;; + '--no-backup') + BACKUP='no' + ;; + *) + echo "ERROR: invalid option to link (${1})" >&2 + return 1 + esac + shift + done + # multi-repo case handled in main() by run_on_all_repos() + REPO=$(nonempty_option 'link' 'REPO' "${1}") || return 1 + maxargs 'link' 1 "${@}" || return 1 + DOTFILES_SRC="${DOTFILES_DIR}/${REPO}/patched-src" + + while read FILE; do + if [ "${DOTFILES_SRC}/${FILE}" -ef "${TARGET}/${FILE}" ]; then + continue # already simlinked + fi + if [ -d "${DOTFILES_SRC}/${FILE}" ] && [ -d "${TARGET}/${FILE}" ] && \ + [ "${FORCE}" != 'yes' ]; then + echo "use --force to override the existing directory: ${TARGET}/${FILE}" + continue # allow unlinked directories + fi + if [ -e "$TARGET/${FILE}" ] && [ "${FORCE}" = 'no' ]; then + echo "use --force to override the existing target: ${TARGET}/${FILE}" + continue # target already exists + fi + link_file "${REPO}" "${FILE}" || return 1 + done <<-EOF + $(list_files "${DOTFILES_SRC}") + EOF +} + +### +# disconnect command + +COMMANDS+=('disconnect') + +function disconnect_help() +{ + echo 'Freeze dotfiles at their current state.' + if [ "${1}" = '--one-line' ]; then return; fi + + cat <<-EOF + + usage: $0 ${COMMAND} [REPO] + + Where 'REPO' is the name the dotfiles repository to disconnect. + If it is not given, all repositories will be disconnected. + + You're about to give your sysadmin account to some newbie, and + they'd just be confused by all this efficiency. This script + freezes your dotfiles in their current state and makes everthing + look normal. Note that this will delete your dotfiles repository + and strip the dotfiles portion from your ~/.bashrc file. + EOF +} + +function disconnect() +{ + # multi-repo case handled in main() by run_on_all_repos() + REPO=$(nonempty_option 'link' 'REPO' "${1}") || return 1 + maxargs 'disconnect' 1 "${@}" || return 1 + DOTFILES_SRC="${DOTFILES_DIR}/${REPO}/patched-src" + + # See if we've constructed any patched source files that might be + # possible link targets + if [ ! -d "${DOTFILES_SRC}" ]; then + echo 'no installed dotfiles to disconnect' + return + fi + + # See if the bashrc file is involved with dotfiles at all + BASHRC='no' + + while read FILE; do + if [ "${FILE}" = '.bashrc' ] && [ "$TARGET" -ef "${HOME}" ]; then + BASHRC='yes' + fi + if [ "${DOTFILES_SRC}/${FILE}" -ef "${TARGET}/${FILE}" ] && [ -h "${TARGET}/${FILE}" ]; then + # break simlink + echo "de-symlink ${TARGET}/${FILE}" + "${RM}" -f "${TARGET}/${FILE}" + "${MV}" "${DOTFILES_SRC}/${FILE}" "${TARGET}/${FILE}" + fi + done <<-EOF + $(list_files "${REPO}/patched-src") + EOF + + if [ "${BASHRC}" == 'yes' ]; then + echo 'strip dotfiles section from ~/.bashrc' + "${SED}" '/DOTFILES_DIR/d' ~/.bashrc > bashrc_stripped + + # see if the stripped file is any different + DIFF_OUTPUT=$("${DIFF}" ~/.bashrc bashrc_stripped) + DIFF_RC="${?}" + if [ "${DIFF_RC}" -eq 0 ]; then + echo "no dotfiles section found in ~/.bashrc" + "${RM}" -f bashrc_stripped + elif [ "${DIFF_RC}" -eq 1 ]; then + echo "replace ~/.bashrc with stripped version" + "${RM}" -f ~/.bashrc + "${MV}" bashrc_stripped ~/.bashrc + else + return 1 # diff failed, bail + fi + fi + + if [ -d "${DOTFILES_DIR}/${REPO}" ]; then + echo "remove the ${REPO} repository" + "${RM}" -rf "${DOTFILES_DIR}/${REPO}" + fi +} + +### +# update command + +COMMANDS+=('update') + +function update_help() +{ + echo 'Utility command that runs fetch, patch, and link.' + if [ "${1}" = '--one-line' ]; then return; fi + + cat <<-EOF + + usage: $0 ${COMMAND} [REPO] + + Where 'REPO' is the name the dotfiles repository to update. + If it is not given, all repositories will be updateed. + + Run 'fetch', 'patch', and 'link' sequentially on each repository + to bring them in sync with the central repositories. Keeps track + of the last update time to avoid multiple fetches in the same + week. + EOF +} + +function update() +{ + # multi-repo case handled in main() by run_on_all_repos() + REPO=$(nonempty_option 'link' 'REPO' "${1}") || return 1 + maxargs 'disconnect' 1 "${@}" || return 1 + + # Update once a week from our remote repository. Mark updates by + # touching this file. + UPDATE_FILE="${REPO}/updated.$(date +%U)" + + if [ ! -e "${UPDATE_FILE}" ]; then + echo "update ${REPO} dotfiles" + "${RM}" -f "${REPO}"/updated.* || return 1 + "${TOUCH}" "${UPDATE_FILE}" || return 1 + fetch "${REPO}" || return 1 + patch "${REPO}" || return 1 + link "${REPO}" || return 1 + echo "${REPO} dotfiles updated" + fi +} + +##### +# Main entry-point + +function main_help() +{ + echo 'Dotfiles management script.' + if [ "${1}" = '--one-line' ]; then return; fi + + cat <<-EOF + + usage: $0 [OPTIONS] COMMAND [ARGS] + + Options: + --help Print this help message and exit. + --version Print the $0 version and exit. + --dotfiles-dir DIR Directory containing the dotfiles reposotories. Defaults to '.'. + --target DIR Directory to install dotfiles into. Defaults to '~'. + + Commands: + EOF + for COMMAND in "${COMMANDS[@]}"; do + echo -en "${COMMAND}\t" + "${COMMAND}_help" --one-line + done + cat <<-EOF + + To get help on any command, pass the '--help' as the first option + to the command. For example: + + ${0} ${COMMANDS[0]} --help + EOF +} + +function main() +{ + COMMAND='' + while [ "${1::2}" = '--' ]; do + case "${1}" in + '--help') + main_help || return 1 + return + ;; + '--version') + echo "${VERSION}" + return + ;; + '--dotfiles-dir') + DOTFILES_DIR="${2}" + shift + ;; + '--target') + TARGET="${2}" + shift + ;; + *) + echo "ERROR: invalid option to ${0} (${1})" >&2 + return 1 + esac + shift + done + COMMAND=$(get_selection "${1}" "${COMMANDS[@]}") || return 1 + shift + + cd "${DOTFILES_DIR}" || return 1 + + if [ "${1}" = '--help' ]; then + "${COMMAND}_help" || return 1 + elif [ "${COMMAND}" = 'clone' ]; then + "${COMMAND}" "${@}" || return 1 + else + OPTIONS=() + while [ "${1::2}" = '--' ]; do + OPTIONS+=("${1}") + shift + done + if [ "${#}" -eq 0 ]; then + run_on_all_repos "${COMMAND}" "$OPTIONS[@]" || return 1 + else + maxargs "${0}" 1 "${@}" || return 1 + "${COMMAND}" "${OPTIONS[@]}" "${1}" || return 1 + fi + fi +} + +main "${@}" || exit 1 diff --git a/src/.XCompose b/src/.XCompose deleted file mode 100644 index 15237ac..0000000 --- a/src/.XCompose +++ /dev/null @@ -1,63 +0,0 @@ -include "%L" - - : "http://physics.drexel.edu/~wking" # Home page - -

: "∝" U221D # PROPORTIONAL TO -Multi_key> : "≈" U2248 # ALMOST EQUAL TO -Multi_key> : "≡" U2261 # IDENTICAL TO - - : "−" U2212 # MINUS SIGN - : "∓" U2213 # MINUS-OR-PLUS SIGN - : "∑" U2211 # N-ARY SUMMATION - : "∏" U220F # N-ARY PRODUCT - : "≪" U226A # MUCH LESS-THAN - : "≫" U226B # MUCH GREATER-THAN - : "⟨" U27E8 # MATHEMATICAL LEFT ANGLE BRACKET - : "⟩" U27E9 # MATHEMATICAL LEFT ANGLE BRACKET - - : "⁺" U207A # SUPERSCRIPT PLUS - : "⁻" U207B # SUPERSCRIPT MINUS - - : "∀" U2200 # FOR ALL - : "∂" U2202 # PARTIAL DIFFERENTIAL - : "∃" U2202 # THERE EXISTS - <0> <0> : "∅" U2205 # EMPTY SET - : "∆" U2206 # INCREMENT (Laplace operator) - : "∇" U2207 # NABLA (gradient) - - : "ℤ" U2115 # DOUBLE STRUCK CAPITAL Z (integers) - : "ℕ" U2115 # DOUBLE STRUCK CAPITAL N (natural numbers) - : "ℚ" U211A # DOUBLE STRUCK CAPITAL Q (rational numbers) - : "ℝ" U211D # DOUBLE STRUCK CAPITAL R (real numbers) - : "ℵ" U2135 # ALEF SYMBOL (countable) - <8> <8> : "∞" U221E # INFINITY - - <0> : "Å" U212B # ANGSTROM SIGN - : "℃" U2103 # DEGREE CELSIUS - : "℉" U2109 # DEGREE FARENHEIT -

: "ℯ" U212F # SCRIPT SMALL E (error; natural exponent) - : "ℰ" U2130 # SCRIPT CAPIPAL E (electromotive force) - : "ℏ" U2105 # PLANC CONSTANT OVER TWO PI - -"ff" UFB00 # LATIN SMALL LIGATURE FF -"fi" UFB01 # LATIN SMALL LIGATURE FI -"fl" UFB02 # LATIN SMALL LIGATURE FL -"ffi" UFB03 # LATIN SMALL LIGATURE FFI -"ffl" UFB04 # LATIN SMALL LIGATURE FFL -"ſt" UFB05 # LATIN SMALL LIGATURE LONG ST -"st" UFB06 # LATIN SMALL LIGATURE ST - - -"ᴬ" U1D2C # MODIFIER LETTER CAPITAL A -"ₐ" U2090 # LATIN SUBSCRIPT SMALL LETTER A -"ᴮ" U1D2E # MODIFIER LETTER CAPITAL B -"ᴰ" U1D30 # MODIFIED LETTER CAPITAL D -"ᴱ" U1D31 # MODIFIER LETTER CAPITAL E -"ₑ" U2091 # LATIN SUBSCRIPT SMALL LETTER E -"ᴳ" U1D33 # MODIFIER LETTER CAPITAL G -"ᴴ" U1D34 # MODIFIER LETTER CAPITAL H -"ⁱ" U2071 # SUPERSCRIPT LATIM SMALL LETTER I -"ⁿ" U207F # SUPERSCRIPT LATIN SMALL LETTER N -" -"ₒ" U2092 # LATIN SUBSCRIPT SMALL LETTER O -"ₓ" U2093 # LATIN SUBSCRIPT SMALL LETTER X diff --git a/src/.Xmodmap b/src/.Xmodmap deleted file mode 100644 index c60ff0a..0000000 --- a/src/.Xmodmap +++ /dev/null @@ -1,103 +0,0 @@ -! .xmodmap bind X characters to keys -! Following http://www.in-ulm.de/~mascheck/X11/input8bit.html -! get keycodes with xev - -keycode 108 = Mode_switch -!clear mod3 -!add mod3 = Mode_switch - -! U208* is subscript * -! U00B9 is superscript one -keycode 10 = 1 exclam U2081 U00B9 -keycode 11 = 2 at U2082 twosuperior -keycode 12 = 3 numbersign U2083 threesuperior -keycode 13 = 4 dollar U2084 foursuperior -keycode 14 = 5 percent U2085 fivesuperior -keycode 15 = 6 asciicircum U207B U00B9 -! U2080 is subscript zero -! U2070 is superscript zerp -keycode 16 = 7 ampersand U2080 U2070 -! U00B7 is the middle dot -! U2219 is the bullet operator -! U22C5 is the dot operator -keycode 17 = 8 asterisk infinity U22C5 -! U2248 is almost equal (asymptotic) -keycode 18 = 9 parenleft U2248 -! U2205 is the empty set -keycode 19 = 0 parenright emptyset -! U207B is superscript minus -! U2213 is minus-or-plus -keycode 20 = minus underscore notsign U2213 -keycode 21 = equal plus notequal plusminus -! U221A is the square root sign (radical) -! U211A is the set of all rationals -keycode 24 = q Q radical U211A -! U1E84 is LATIN CAPITAL LETTER W WITH DIAERESIS -keycode 25 = w W Greek_omega U1E84 -! U2203 is there exists -! U2130 is the electromotive force -! U212F is the natural exponent symbol (script small e) -keycode 26 = e E Greek_epsilon U2130 -! U211D is the set of reals numbers -keycode 27 = r R Greek_rho U211D -keycode 28 = t T Greek_tau Greek_theta -keycode 29 = y Y Greek_psi Greek_PSI -keycode 30 = u U Greek_eta -! U222C is a double integral -keycode 31 = i I integral U222C -! U2126 is the ohm sign (different codepoint from Omega (U03A9)) -keycode 32 = o O elementof U2126 -! U220F is the n-ary product (different codepoint from Pi (U03A0)) -keycode 33 = p P Greek_pi U220F -keycode 34 = bracketleft braceleft leftsinglequotemark leftdoublequotemark -keycode 35 = bracketright braceright rightsinglequotemark rightdoublequotemark -! U2200 is for all -keycode 38 = a A Greek_alpha U2200 -! U2211 is the n-ary summation (different codepoint from Sigma (U03A3)) -keycode 39 = s S Greek_sigma U2211 -! U2202 is partial differential -! (for some reason the keysym partialderivative wasn't working on my eeepc). -keycode 40 = d D U2202 Greek_delta -keycode 41 = f F function Greek_phi -keycode 42 = g G Greek_gamma Greek_GAMMA -! U2103 is degrees Celsius -keycode 43 = h H degree U2103 -! U062A is Arabic "teh", looks like a smiley face :) -keycode 44 = j J j U062A -! U062A is Arabic "teh with ring", looks like a goofey face :p -keycode 45 = k K Greek_kappa U067C -! U0629 is Arabic "teh marbuta", looks like a surprised face :o -keycode 46 = l L Greek_lambda U0629 -! U2026 is an ellipsis -keycode 47 = semicolon colon U2026 -keycode 48 = apostrophe quotedbl -! U223C is the tilde operator -keycode 49 = grave asciitilde U223C approximate -keycode 50 = Shift_L -! U2261 is identical to (three-bar equals) -keycode 51 = backslash bar U2261 -! U2115 is the set of all natural numbers, U2124 is the set of integers -keycode 52 = z Z U2115 U2124 -keycode 53 = x X Greek_chi Greek_xi -keycode 54 = c C Greek_chi -keycode 55 = v V Greek_nu -keycode 56 = b B Greek_beta -keycode 57 = n N Greek_DELTA nabla -! U00B5 is the micro sign (different codepoint from mu (U03BC)) -! U2014 is the em-dash (parenthetical seperator) -keycode 58 = m M U00B5 U2014 -! guillemotleft -! includedin = 'subset of' -! includes = 'superset of' -! U2131 is the Fourier transform -! U2112 is the Laplace transform -keycode 59 = comma less U2131 U2112 -! guillemotright -! U27E8 is the mathematical left angle bracket (bra) -! U27E9 is the mathematical right angle bracket (ket) -keycode 60 = period greater includes U22C5 -keycode 61 = slash question rightarrow questiondown -! U00A0 is a no-break space -keycode 65 = space space U00A0 U00A0 -! Compose key with my right function key -keycode 134 = Multi_key diff --git a/src/.bash_aliases b/src/.bash_aliases deleted file mode 100644 index 4b41733..0000000 --- a/src/.bash_aliases +++ /dev/null @@ -1,45 +0,0 @@ -# Make file system utilities friendlier -alias rm='rm -iv' -alias rmdir='rmdir -v' -alias cp='cp -iv' -alias mv='mv -iv' -alias less='less -R' - -# Configure useful programs -alias lp='/usr/bin/lp -o sides=two-sided-long-edge -o media=letter -o cpi=16 -o lpi=10' -alias lpb='/usr/bin/lp -o sides=two-sided-long-edge -o media=letter -o cpi=12 -o lpi=6' -alias lpi='/usr/bin/lp -o fitplot' -alias emacs='emacs -nw' -alias xterm='xterm -fg white -bg black' -alias w3mg='w3m http://www.google.com' -alias w3mh='w3m http://www.physics.drexel.edu/~wking/' -#alias calendar='calendar -A28' -alias acroread='acroread -geometry 1270x950' -alias graph='graph -TX -C' -alias snownews='snownews -u' -alias oggr='ogg123 -qb 500' # play ogg radio streams (quiet, big input buffer) - -# Alias useful one-liners & common commands -alias findex='find . -perm -u+x ! -type d' -alias sortdat='find . -printf "%TY-%Tm-%Td+%TH:%TM:%TS %h/%f\n" | sort -n' -alias sortdirdat='find . -type d -printf "%TY-%Tm-%Td+%TH:%TM:%TS %h/%f\n" | sort -n' -alias sshy='ssh wking@129.25.24.53' -alias ssha='ssh sysadmin@129.25.7.55' -alias sshxa='ssh -X sysadmin@129.25.7.55' - -# enable color support of ls and also add handy aliases -if [ "$TERM" != "dumb" ] && [ -x /usr/bin/dircolors ]; then - eval "`dircolors -b`" - alias ls='ls --color=auto' - #alias dir='ls --color=auto --format=vertical' - #alias vdir='ls --color=auto --format=long' - - alias grep='grep --color=auto' - #alias fgrep='fgrep --color=auto' - #alias egrep='egrep --color=auto' -fi - -# some more ls aliases -alias ll='ls -l' -alias la='ls -A' -alias l='ls -CF' diff --git a/src/.bash_logout b/src/.bash_logout deleted file mode 100644 index 7251dca..0000000 --- a/src/.bash_logout +++ /dev/null @@ -1,4 +0,0 @@ -# ~/.bash_logout: sourced by bash(1) when a login shell terminates. - -# Clear the screen for security's sake. -clear diff --git a/src/.bash_profile b/src/.bash_profile deleted file mode 100644 index e2bb5a6..0000000 --- a/src/.bash_profile +++ /dev/null @@ -1,18 +0,0 @@ -# This file is sourced by bash for login shells. - -# The following line runs your .bashrc and is recommended by the bash -# info pages. -[[ -f ~/.bashrc ]] && . ~/.bashrc - -# set PATH so it includes user's private bin if it exists -if [ -d ~/bin ]; then - PATH=~/bin:"${PATH}" -fi - -#exec screen -R # automatically attach to first detached session if it exists - -# print my calendar if I've configured it -# http://bsdcalendar.sourceforge.net/ (Gentoo: app-misc/calendar) -if [ -f ~/.calendar/calendar ]; then - calendar -fi diff --git a/src/.bashrc b/src/.bashrc deleted file mode 100644 index 6b99654..0000000 --- a/src/.bashrc +++ /dev/null @@ -1,40 +0,0 @@ -# This file is sourced by all *interactive* bash shells on startup, -# including some apparently interactive shells such as scp and rcp -# that can't tolerate any output. So make sure this doesn't display -# anything or bad things will happen! - -# Test for an interactive shell. There is no need to set anything -# past this point for scp and rcp, and it's important to refrain from -# outputting anything in those cases. -if [[ $- != *i* ]] ; then - # Shell is non-interactive. Be done now! - return -fi - -#source .bashrc.d/local_paths - -# If not running interactively, don't do anything else -[ -z "$PS1" ] && return - -# don't put duplicate line in the history and ignore lines starting -# with a space. See bash(1). -export HISTCONTROL=ignoreboth - -# check the window size after each command and, if necessary, -# update the values of LINES and COLUMNS. -shopt -s checkwinsize - -source .bashrc.d/environment -#source .bashrc.d/screen -#source .bashrc.d/completion -#source .bashrc.d/nobeep -#source .bashrc.d/lesspipe -source .bashrc.d/ssh_agent -source .bashrc.d/gpg_agent - -# load aliases -if [ -f ~/.bash_aliases ]; then - . ~/.bash_aliases -fi - -source "${DOTFILES_DIR}/src/.bashrc.d/dotfiles" diff --git a/src/.bashrc.d/completion b/src/.bashrc.d/completion deleted file mode 100644 index 96dcaa6..0000000 --- a/src/.bashrc.d/completion +++ /dev/null @@ -1,11 +0,0 @@ -# enable programmable completion features (you don't need to enable -# this if it's already enabled in /etc/bash.bashrc and /etc/profile -# sources /etc/bash.bashrc). -if [ -f /etc/bash_completion ]; then - . /etc/bash_completion -fi - -# bugs-everywhere completion -if [ -f ~/.be-completion.sh ]; then - source ~/.be-completion.sh -fi diff --git a/src/.bashrc.d/dotfiles b/src/.bashrc.d/dotfiles deleted file mode 100644 index 1a5e5b2..0000000 --- a/src/.bashrc.d/dotfiles +++ /dev/null @@ -1,6 +0,0 @@ -# Run the dotfiles.sh script if it exists - -DS="${DOTFILES_DIR}/bin/dotfiles.sh" -if [ -f "${DS}" ] && [ -x "${DS}" ]; then - "${DS}"; -fi diff --git a/src/.bashrc.d/environment b/src/.bashrc.d/environment deleted file mode 100644 index 5550652..0000000 --- a/src/.bashrc.d/environment +++ /dev/null @@ -1,11 +0,0 @@ -# path to local dotfiles checkout -export DOTFILES_DIR=~/"src/dotfiles" - -# define default programs -export EDITOR="/usr/bin/emacs -nw" -export PAGER="less" - -# colorize file listings (di was 34 (blue), swapped with 33 (yellow)) -#export LS_COLORS='no=00:fi=00:di=00;33:ln=00;36:pi=40;34:so=00;35:bd=40;34;01:cd=40;34;01:or=01;05;37;41:mi=01;05;37;41:ex=00;32:*.cmd=00;32:*.exe=00;32:*.com=00;32:*.btm=00;32:*.bat=00;32:*.sh=00;32:*.csh=00;32:*.tar=00;31:*.tgz=00;31:*.arj=00;31:*.taz=00;31:*.lzh=00;31:*.zip=00;31:*.z=00;31:*.Z=00;31:*.gz=00;31:*.bz2=00;31:*.bz=00;31:*.tz=00;31:*.rpm=00;31:*.cpio=00;31:*.jpg=00;35:*.gif=00;35:*.bmp=00;35:*.xbm=00;35:*.xpm=00;35:*.png=00;35:*.tif=00;35:' - -export MONKEYSPHERE_CHECK_KEYSERVER=false diff --git a/src/.bashrc.d/gpg_agent b/src/.bashrc.d/gpg_agent deleted file mode 100644 index 5a65e96..0000000 --- a/src/.bashrc.d/gpg_agent +++ /dev/null @@ -1,4 +0,0 @@ -# GnuPG agent -if [ -f "${HOME}/.gnupg/agent-info" ]; then - source "${HOME}/.gnupg/agent-info" -fi diff --git a/src/.bashrc.d/lesspipe b/src/.bashrc.d/lesspipe deleted file mode 100644 index 5b988d1..0000000 --- a/src/.bashrc.d/lesspipe +++ /dev/null @@ -1,2 +0,0 @@ -# make less more friendly for non-text input files, see lesspipe(1) -[ -x /usr/bin/lesspipe ] && eval "$(lesspipe)" diff --git a/src/.bashrc.d/local_paths b/src/.bashrc.d/local_paths deleted file mode 100644 index 06c962f..0000000 --- a/src/.bashrc.d/local_paths +++ /dev/null @@ -1,36 +0,0 @@ -# set LD_LIBRARY_PATH so it includes user's private lib if it exists -if [ -d ~/lib ]; then - LD_LIBRARY_PATH="~/lib" -fi - -# append personal manpages to manpath -export MANPATH=":$HOME/share/man" - -# personalize latex path -export TEXINPUTS=":.:$HOME/projects/latex/common/" - -# personalize font path (Gnuplot uses gd to find fancy fonts) -GDFONTPATH=""; -for x in $(find /usr/share/fonts/ -type d); do - GDFONTPATH="$GDFONTPATH:$x"; -done; -GDFONTPATH="${GDFONTPATH:1}"; -export GDFONTPATH - -# personalize python path -# -# You should use distutil's `--user` option to install per-user -# packages into ~/.local, which Python will pick up automatically. -# This snippet is a relic of the days before `--user` when I used -# `--prefix $HOME`. -PYTHON_VERSION=$(python -c 'import sys; print ".".join([str(i) for i in sys.version_info[:2]])') -export PYTHONPATH=".:$HOME/lib/python:$HOME/lib/python$PYTHON_VERSION/site-packages:$HOME/.python" - -# personalize Java path (found by tracing from `which javac`) -export JAVA_HOME=/usr/lib/jvm/java-6-openjdk/ - -# personalize ruby and rubygems paths -# from http://docs.rubygems.org/read/chapter/15 -PREFIX=$HOME -export GEM_HOME=$PREFIX/lib/ruby/gems/1.8 -export RUBYLIB=$PREFIX/lib/ruby:$PREFIX/lib/site_ruby/1.8 diff --git a/src/.bashrc.d/nobeep b/src/.bashrc.d/nobeep deleted file mode 100644 index 9e784f9..0000000 --- a/src/.bashrc.d/nobeep +++ /dev/null @@ -1,12 +0,0 @@ -# turn off terminal beep in X -if [ $TERM == "xterm" ] && [ -n "$DISPLAY" ] - then - xset b off -fi - -# turn of terminal beeps in the console, unless connecting via SSH -if [ -z "$SSH_CLIENT" ]; then - if [ ! -z "$TERM" ]; then - setterm -blength 0 - fi -fi diff --git a/src/.bashrc.d/screen b/src/.bashrc.d/screen deleted file mode 100644 index 3395c66..0000000 --- a/src/.bashrc.d/screen +++ /dev/null @@ -1,4 +0,0 @@ -# adjust for Ubuntu not recognizing screen.* terms -if [ "${TERM:0:7}" == "screen." ]; then - export TERM="${TERM:7}" -fi diff --git a/src/.bashrc.d/ssh_agent b/src/.bashrc.d/ssh_agent deleted file mode 100644 index 41bb957..0000000 --- a/src/.bashrc.d/ssh_agent +++ /dev/null @@ -1,4 +0,0 @@ -SSH_INFO_FILE="/tmp/$(whoami)/.ssh/.ssh-agent-info-$(hostname)" -if [ -f "$SSH_INFO_FILE" ]; then - . "$SSH_INFO_FILE" -fi diff --git a/src/.bazaar/bazaar.conf b/src/.bazaar/bazaar.conf deleted file mode 100644 index 591ae1c..0000000 --- a/src/.bazaar/bazaar.conf +++ /dev/null @@ -1,5 +0,0 @@ -[DEFAULT] -email = W. Trevor King -viz-compact-view = no -date-column-visible = True -ignore_missing_extensions=True diff --git a/src/.bazaar/ignore b/src/.bazaar/ignore deleted file mode 100644 index a9081c2..0000000 --- a/src/.bazaar/ignore +++ /dev/null @@ -1,8 +0,0 @@ -*.a -*.o -*.py[co] -*.so -*.sw[nop] -*~ -.#* -[#]*# diff --git a/src/.emacs b/src/.emacs deleted file mode 100644 index 9a9c773..0000000 --- a/src/.emacs +++ /dev/null @@ -1,27 +0,0 @@ -;;;; Trevor's sysadmin .emacs file -; started Sept 13, 2006 -; The goal is to set up emacs for personal usage. -; See .emacs-admin for a more general setup - -; Lisp comments begin with a ";" - -; Emacs Load Path -(setq load-path (cons "~/.emacs.d/load" load-path)) - -; Load useful customizations -(load "wtk_common.el") -(load "wtk_centralized_backups.el") -(load "wtk_utf-8.el") -(load "wtk_layout.el") -(load "wtk_aspell.el") -(load "wtk_epa.el") -(load "wtk_org.el") -(load "wtk_no-vc.el") - -(require 'cython-mode) - -; Play GNU Go in an emacs buffer -;(require 'gnugo) - -; Load querty.el, for switching keyboard mappings. -;(load "querty.el") diff --git a/src/.emacs-admin b/src/.emacs-admin deleted file mode 100644 index 7d0b0a0..0000000 --- a/src/.emacs-admin +++ /dev/null @@ -1,13 +0,0 @@ -;;;; Trevor's sysadmin .emacs file -; started Sept 12, 2008 -; The goal is to set up emacs for general usage & organization, without -; too much Trevor-specific personalization. An inheritable .emacs file ;). - -; Lisp comments begin with a ";" - -; Emacs Load Path -(setq load-path (cons "~/.emacs.d/load" load-path)) - -; Load useful customizations -(load "wtk_common.el") -(load "wtk_centralized_backups.el") diff --git a/src/.emacs.d/load/cython-mode.el b/src/.emacs.d/load/cython-mode.el deleted file mode 100644 index 66a2d5e..0000000 --- a/src/.emacs.d/load/cython-mode.el +++ /dev/null @@ -1,65 +0,0 @@ -;; Cython mode - -;; Load python-mode if available, otherwise use builtin emacs python package -(when (not(require 'python-mode nil t)) - (require 'python)) - -(add-to-list 'auto-mode-alist '("\\.pyx\\'" . cython-mode)) -(add-to-list 'auto-mode-alist '("\\.pxd\\'" . cython-mode)) -(add-to-list 'auto-mode-alist '("\\.pxi\\'" . cython-mode)) - - -(defun cython-compile () - "Compile the file via Cython." - (interactive) - (let ((cy-buffer (current-buffer))) - (with-current-buffer - (compile compile-command) - (set (make-local-variable 'cython-buffer) cy-buffer) - (add-to-list (make-local-variable 'compilation-finish-functions) - 'cython-compilation-finish))) - ) - -(defun cython-compilation-finish (buffer how) - "Called when Cython compilation finishes." - ;; XXX could annotate source here - ) - -(defvar cython-mode-map - (let ((map (make-sparse-keymap))) - ;; Will inherit from `python-mode-map' thanks to define-derived-mode. - (define-key map "\C-c\C-c" 'cython-compile) - map) - "Keymap used in `cython-mode'.") - -(defvar cython-font-lock-keywords - `(;; new keywords in Cython language - (,(regexp-opt '("by" "cdef" "cimport" "cpdef" "ctypedef" "enum" "except?" - "extern" "gil" "include" "nogil" "property" "public" - "readonly" "struct" "union" "DEF" "IF" "ELIF" "ELSE") 'words) - 1 font-lock-keyword-face) - ;; C and Python types (highlight as builtins) - (,(regexp-opt '("NULL" "bint" "char" "dict" "double" "float" "int" "list" - "long" "object" "Py_ssize_t" "short" "size_t" "void") 'words) - 1 font-lock-builtin-face) - ;; cdef is used for more than functions, so simply highlighting the next - ;; word is problematic. struct, enum and property work though. - ("\\<\\(?:struct\\|enum\\)[ \t]+\\([a-zA-Z_]+[a-zA-Z0-9_]*\\)" - 1 py-class-name-face) - ("\\\" and so forth - - :diamond -- the part of the subprocess name after \"gnugo\", may be \"\" - - :game-over -- nil until game over at which time its value is set to - the alist `((live GROUP ...) (dead GROUP ...))' - - :sgf-collection -- after a `loadsgf' command, entire parse tree of file, - a simple list of one or more gametrees, updated in - conjunction w/ :sgf-gametree and :monkey - - :sgf-gametree -- one of the gametrees in :sgf-collection - - :monkey -- vector of three elements: LOC, a pointer to a node on the - :sgf-gametree representing the most recently-played move - (the next move modifies the cdr of LOC); MEM, the simple - reverse-chronological list of previous LOC pointers; and - COUNT, the number of moves from the beginning of the game - - :gnugo-color -- either \"black\" or \"white\" - :user-color - :last-mover - - :last-waiting -- seconds and time value, respectively; see `gnugo-push-move' - :waiting-start - - :black-captures -- these are strings since gnugo.el doesn't do anything - :white-captures w/ the information besides display it in the mode line; - gory details in functions `gnugo-propertize-board-buffer' - and `gnugo-merge-showboard-results' (almost more effort - than they are worth!) - - :display-using-images -- XPMs, to be precise; see functions `gnugo-yy', - `gnugo-toggle-image-display' and `gnugo-refresh', - as well as gnugo-xpms.el (available elsewhere) - - :all-yy -- list of 46 keywords used as the `category' text property - (so that their plists, typically w/ property `display' or - `do-not-display') are consulted by the Emacs display engine; - 46 = 9 places * (4 moku + 1 empty) + 1 hoshi; see functions - `gnugo-toggle-image-display', `gnugo-yy' and `gnugo-yang' - - :lparen-ov -- overlays shuffled about to indicate the last move; only - :rparen-ov one is used when displaying using images - - :last-user-bpos -- board position; keep the hapless human happy - -As things stabilize probably more info will be added to this docstring.")) - (put 'gnugo-put 'function-documentation docs) - (put 'gnugo-get 'function-documentation docs)) - -(defun gnugo-describe-internal-properties () - "Pretty-print `gnugo-state' properties in another buffer. -Handle the big, slow-to-render, and/or uninteresting ones specially." - (interactive) - (let ((buf (current-buffer)) - (d (gnugo-get :diamond)) - acc) - (maphash (lambda (&rest args) - (case (car args) - ((:xpms :local-xpms) - (setcdr args (format "hash: %X (%d images)" - (sxhash (cadr args)) - (length (cadr args))))) - (:sgf-collection - (setcdr args (length (cadr args)))) - (:monkey - (let* ((value (cadr args)) - (loc (aref value 0))) - (setcdr args (list - (length (aref value 1)) - (length (cdr loc)) - (car loc)))))) - (setq acc (cons args acc))) - gnugo-state) - (switch-to-buffer (get-buffer-create - (format "%s*GNUGO Board Properties*" - (gnugo-get :diamond)))) - (erase-buffer) - (emacs-lisp-mode) - (setq truncate-lines t) - (save-excursion - (let ((standard-output (current-buffer))) - (pp (reverse acc))) - (goto-char (point-min)) - (let ((rx (format "overlay from \\([0-9]+\\).+\n%s\\s-+" - (if (string= "" d) - ".+\n" - "")))) - (while (re-search-forward rx (point-max) t) - (let ((pos (get-text-property (string-to-number (match-string 1)) - 'gnugo-position buf))) - (delete-region (+ 2 (match-beginning 0)) (point)) - (insert (format " %S" pos)))))) - (message "%d properties" (length acc)))) - -(defun gnugo-board-buffer-p (&optional buffer) - "Return non-nil if BUFFER is a GNUGO Board buffer." - (with-current-buffer (or buffer (current-buffer)) gnugo-state)) - -(defun gnugo-board-user-play-ok-p (&optional buffer) - "Return non-nil if BUFFER is a GNUGO Board buffer ready for a user move." - (with-current-buffer (or buffer (current-buffer)) - (and gnugo-state (not (gnugo-get :waitingp))))) - -(defun gnugo-other (color) - (if (string= "black" color) "white" "black")) - -(defun gnugo-gate (&optional in-progress-p) - (unless (gnugo-board-buffer-p) - (error "Wrong buffer -- try M-x gnugo")) - (unless (gnugo-get :proc) - (error "No \"gnugo\" process!")) - (when (gnugo-get :waitingp) - (error "Not your turn yet -- please wait for \"\(%s to play\)\"" - (gnugo-get :user-color))) - (when (and (gnugo-get :game-over) in-progress-p) - (error "Sorry, game over"))) - -(defun gnugo-sentinel (proc string) - (let ((status (process-status proc))) - (when (or (eq status 'exit) - (eq status 'signal)) - (let ((buf (process-buffer proc))) - (when (buffer-live-p buf) - (with-current-buffer buf - (setq mode-line-process '( " [%s]")) - (when (eq proc (gnugo-get :proc)) - (gnugo-put :proc nil)))))))) - -(defun gnugo-send-line (line) - (let ((proc (gnugo-get :proc))) - (process-send-string proc line) - (process-send-string proc "\n"))) - -(defun gnugo-synchronous-send/return (message) - "Return (TIME . STRING) where TIME is that returned by `current-time' and -STRING omits the two trailing newlines. See also `gnugo-query'." - (when (gnugo-get :waitingp) - (error "Sorry, still waiting for %s to play" (gnugo-get :gnugo-color))) - (gnugo-put :sync-return "") - (let ((proc (gnugo-get :proc))) - (set-process-filter - proc (lambda (proc string) - (let* ((so-far (gnugo-get :sync-return)) - (start (max 0 (- (length so-far) 2))) ; backtrack a little - (full (gnugo-put :sync-return (concat so-far string)))) - (when (string-match "\n\n" full start) - (gnugo-put :sync-return - (cons (current-time) (substring full 0 -2))))))) - (gnugo-send-line message) - (let (rv) - ;; type change => break - (while (stringp (setq rv (gnugo-get :sync-return))) - (accept-process-output proc)) - (gnugo-put :sync-return "") - rv))) - -(defun gnugo-query (message-format &rest args) - "Return cleaned-up value of a call to `gnugo-synchronous-send/return'. -The TIME portion is omitted as well as the first two characters of the STRING -portion (corresponding to the status indicator in the Go Text Protocol). Use -this function when you are sure the command cannot fail. The first arg is -a format string applied to the rest of the args." - (substring (cdr (gnugo-synchronous-send/return - (apply 'format message-format args))) - 2)) - -(defun gnugo-lsquery (message-format &rest args) - (split-string (apply 'gnugo-query message-format args))) - -(defsubst gnugo-treeroot (prop) - (cdr (assq prop (car (gnugo-get :sgf-gametree))))) - -(defun gnugo-goto-pos (pos) - "Move point to board position POS, a letter-number string." - (goto-char (point-min)) - (forward-line (- (1+ (gnugo-treeroot :SZ)) - (string-to-number (substring pos 1)))) - (forward-char 1) - (forward-char (+ (if (= 32 (following-char)) 1 2) - (* 2 (- (let ((letter (aref pos 0))) - (if (> ?I letter) - letter - (1- letter))) - ?A))))) - -(defun gnugo-f (frag) - (intern (format ":gnugo-%s%s-props" (gnugo-get :diamond) frag))) - -(defun gnugo-yang (c) - (cdr (assq c '((?+ . hoshi) - (?. . empty) - (?X . (bmoku . bpmoku)) - (?O . (wmoku . wpmoku)))))) - -(defun gnugo-yy (yin yang &optional momentaryp) - (gnugo-f (format "%d-%s" - yin (cond ((and (consp yang) momentaryp) (cdr yang)) - ((consp yang) (car yang)) - (t yang))))) - -(defun gnugo-toggle-image-display () - (unless (and (fboundp 'display-images-p) (display-images-p)) - (error "Display does not support images, sorry")) - (require 'gnugo-xpms) - (unless (and (boundp 'gnugo-xpms) gnugo-xpms) - (error "Could not load `gnugo-xpms', sorry")) - (let ((fresh (or (gnugo-get :local-xpms) gnugo-xpms))) - (unless (eq fresh (gnugo-get :xpms)) - (gnugo-put :xpms fresh) - (gnugo-put :all-yy nil))) - (let* ((new (not (gnugo-get :display-using-images))) - (act (if new 'display 'do-not-display))) - (mapc (lambda (yy) - (setcar (symbol-plist yy) act)) - (or (gnugo-get :all-yy) - (gnugo-put :all-yy - (prog1 (mapcar (lambda (ent) - (let* ((k (car ent)) - (yy (gnugo-yy (cdr k) (car k)))) - (setplist yy `(not-yet ,(cdr ent))) - yy)) - (gnugo-get :xpms)) - (let ((imul (image-size (get (gnugo-yy 5 (gnugo-yang ?+)) - 'not-yet)))) - (gnugo-put :w-imul (car imul)) - (gnugo-put :h-imul (cdr imul))))))) - (setplist (gnugo-f 'ispc) (and new - ;; `(display (space :width 0))' - ;; works as well, for newer emacs - '(invisible t))) - (gnugo-put :highlight-last-move-spec - (if new - '((lambda (p) - (get (gnugo-yy (get-text-property p 'gnugo-yin) - (get-text-property p 'gnugo-yang) - t) - 'display)) - 0 delete-overlay) - (gnugo-get :default-highlight-last-move-spec))) - ;; a kludge to be reworked another time perhaps by another gnugo.el lover - (dolist (group (cdr (assq 'dead (gnugo-get :game-over)))) - (mapc 'delete-overlay (cdar group)) - (setcdr (car group) nil)) - (gnugo-put :wmul (if new (gnugo-get :w-imul) 1)) - (gnugo-put :hmul (if new (gnugo-get :h-imul) 1)) - (gnugo-put :display-using-images new))) - -(defun gnugo-toggle-grid () - "Turn the grid around the board on or off." - (interactive) - (funcall (if (memq :nogrid buffer-invisibility-spec) - 'remove-from-invisibility-spec - 'add-to-invisibility-spec) - :nogrid) - (save-excursion (gnugo-refresh))) - -(defun gnugo-propertize-board-buffer () - (erase-buffer) - (insert (substring (cdr (gnugo-synchronous-send/return "showboard")) 3)) - (let* ((grid-props (list 'invisible :nogrid - 'font-lock-face gnugo-grid-face)) - (%gpad (gnugo-f 'gpad)) - (%gspc (gnugo-f 'gspc)) - (%lpad (gnugo-f 'lpad)) - (%rpad (gnugo-f 'rpad)) - (ispc-props (list 'category (gnugo-f 'ispc) 'rear-nonsticky t)) - (size (gnugo-treeroot :SZ)) - (size-string (number-to-string size))) - (goto-char (point-min)) - (put-text-property (point) (1+ (point)) 'category (gnugo-f 'tpad)) - (skip-chars-forward " ") - (put-text-property (1- (point)) (point) 'category %gpad) - (put-text-property (point) (progn (end-of-line) (point)) 'category %gspc) - (forward-char 1) - (add-text-properties (1+ (point-min)) (1- (point)) grid-props) - (while (looking-at "\\s-*\\([0-9]+\\)[ ]") - (let* ((row (match-string-no-properties 1)) - (edge (match-end 0)) - (other-edge (+ edge (* 2 size) -1)) - (right-empty (+ other-edge (length row) 1)) - (top-p (string= size-string row)) - (bot-p (string= "1" row))) - (let* ((nL (- edge 1 (length size-string))) - (nR (- edge 1)) - (ov (make-overlay nL nR (current-buffer) t))) - (add-text-properties nL nR grid-props) - ;; We redundantly set `invisible' in the overlay to workaround - ;; a display bug whereby text *following* the overlaid text is - ;; displayed with the face of the overlaid text, but only when - ;; that text is invisible (i.e., `:nogrid' in invisibility spec). - ;; This has something to do w/ the bletcherous `before-string'. - (overlay-put ov 'invisible :nogrid) - (overlay-put ov 'category %lpad)) - (do ((p edge (+ 2 p)) (ival 'even (if (eq 'even ival) 'odd 'even))) - ((< other-edge p)) - (let* ((position (format "%c%s" (aref "ABCDEFGHJKLMNOPQRST" - (truncate (- p edge) 2)) - row)) - (yin (let ((A-p (= edge p)) - (Z-p (= (1- other-edge) p))) - (cond ((and top-p A-p) 1) - ((and top-p Z-p) 3) - ((and bot-p A-p) 7) - ((and bot-p Z-p) 9) - (top-p 2) - (bot-p 8) - (A-p 4) - (Z-p 6) - (t 5)))) - (yang (gnugo-yang (char-after p)))) - (add-text-properties p (1+ p) - `(gnugo-position - ,position - gnugo-yin - ,yin - gnugo-yang - ,yang - category - ,(gnugo-yy yin yang) - front-sticky - (gnugo-position gnugo-yin)))) - (unless (= (1- other-edge) p) - (add-text-properties (1+ p) (+ 2 p) ispc-props) - (put-text-property p (+ 2 p) 'intangible ival))) - (add-text-properties (1+ other-edge) right-empty grid-props) - (goto-char right-empty) - (when (looking-at "\\s-+\\(WH\\|BL\\).*capt.* \\([0-9]+\\).*$") - (let ((prop (if (string= "WH" (match-string 1)) - :white-captures - :black-captures)) - (beg (match-beginning 2)) - (end (match-end 2))) - (put-text-property beg end :gnugo-cf (cons (- end beg) prop)) - (gnugo-put prop (match-string-no-properties 2)))) - (end-of-line) - (put-text-property right-empty (point) 'category %rpad) - (forward-char 1))) - (add-text-properties (1- (point)) (point-max) grid-props) - (skip-chars-forward " ") - (put-text-property (1- (point)) (point) 'category %gpad) - (put-text-property (point) (progn (end-of-line) (point)) - 'category %gspc))) - -(defun gnugo-merge-showboard-results () - (let ((aft (substring (cdr (gnugo-synchronous-send/return "showboard")) 3)) - (adj 1) ; string to buffer position adjustment - (sync "[0-9]+ stones$") - (bef (buffer-substring-no-properties (point-min) (point-max))) - (bef-start 0) (bef-idx 0) - (aft-start 0) (aft-idx 0) - aft-sync-backtrack mis inc cut new very-strange) - (while (numberp (setq mis (compare-strings bef bef-start nil - aft aft-start nil))) - (setq aft-sync-backtrack nil - inc (if (> 0 mis) - (- (+ 1 mis)) - (- mis 1)) - bef-idx (+ bef-start inc) - aft-idx (+ aft-start inc) - bef-start (if (eq bef-idx (string-match sync bef bef-idx)) - (match-end 0) - (1+ bef-idx)) - aft-start (if (and (eq aft-idx (string-match sync aft aft-idx)) - (let ((peek (1- aft-idx))) - (while (not (= 32 (aref aft peek))) - (setq peek (1- peek))) - (setq aft-sync-backtrack (1+ peek)))) - (match-end 0) - (1+ aft-idx)) - cut (+ bef-idx adj - (if aft-sync-backtrack - (- aft-sync-backtrack aft-idx) - 0))) - (goto-char cut) - (if aft-sync-backtrack - (let* ((asb aft-sync-backtrack) - (l-p (get-text-property cut :gnugo-cf)) - (old-len (car l-p)) - (capprop (cdr l-p)) - (keep (text-properties-at cut))) - (setq new (substring aft asb (string-match " " aft asb))) - (plist-put keep :gnugo-cf (cons (length new) capprop)) - (gnugo-put capprop new) - (delete-char old-len) - (insert (apply 'propertize new keep)) - (setq adj (+ adj (- (length new) old-len)))) - (setq new (aref aft aft-idx)) - (insert-and-inherit (char-to-string new)) - (let ((yin (get-text-property cut 'gnugo-yin)) - (yang (gnugo-yang new))) - (add-text-properties cut (1+ cut) - `(gnugo-yang - ,yang - category - ,(gnugo-yy yin yang)))) - (delete-char 1) - ;; do this last to avoid complications w/ font lock - ;; (this also means we cannot include `intangible' in `front-sticky') - (when (setq very-strange (get-text-property (1+ cut) 'intangible)) - (put-text-property cut (1+ cut) 'intangible very-strange)))))) - -(defun gnugo-move-history (&optional rsel) - "Determine and return the game's move history. -Optional arg RSEL controls side effects and return value. -If nil, display the history in the echo area as \"(N moves)\" -followed by the space-separated list of moves. When called -interactively with a prefix arg (i.e., RSEL is `(4)'), display -similarly, but suffix with the mover (either \":B\" or \":W\"). -If RSEL is the symbol `car' return the most-recent move; if -`cadr', the next-to-most-recent move; if `count' the number of -moves thus far. - -For all other values of RSEL, do nothing and return nil." - (interactive "P") - (let ((size (gnugo-treeroot :SZ)) - col - (mem (aref (gnugo-get :monkey) 1)) - acc node mprop move) - (flet ((as-pos (cc) (if (string= "tt" cc) - "PASS" - (setq col (aref cc 0)) - (format "%c%d" - (+ ?A (- (if (> ?i col) col (1+ col)) ?a)) - (- size (- (aref cc 1) ?a))))) - (next (byp) (when (setq node (caar mem) - mprop (or (assq :B node) - (assq :W node))) - (setq move (as-pos (cdr mprop)) - mem (cdr mem)) - (push (if byp - (format "%s%s" move (car mprop)) - move) - acc))) - (tell () (message "(%d moves) %s" - (length acc) - (mapconcat 'identity (nreverse acc) " ")))) - (cond - ((not rsel) (while (next nil)) (tell)) - ((equal '(4) rsel) (while (next t)) (tell)) - ((eq 'car rsel) (car (next nil))) - ((eq 'cadr rsel) (next nil) (car (next nil))) - ((eq 'count rsel) (aref (gnugo-get :monkey) 2)))))) - -(defun gnugo-note (property value &optional movep mogrifyp) - (when mogrifyp - (let ((sz (gnugo-treeroot :SZ))) - (flet ((mog (pos) (if (string= "PASS" pos) - "tt" - (let* ((col (aref pos 0)) - (one (+ ?a (- col (if (< ?H col) 1 0) ?A))) - (two (+ ?a (- sz (string-to-number - (substring pos 1)))))) - (format "%c%c" one two))))) - (setq value (if (consp value) - (mapcar 'mog value) - (mog value)))))) - (let* ((fruit (list (cons property value))) - (monkey (gnugo-get :monkey)) - (loc (aref monkey 0))) - (if movep - (let ((mem (aref monkey 1))) - ;; todo: do variation check/merge/branch here. - (setcdr loc (list fruit)) - (aset monkey 0 (setq loc (cdr loc))) - (aset monkey 1 (cons loc mem)) - (aset monkey 2 (1+ (aref monkey 2)))) - (setcdr (last (car loc)) fruit)))) - -(defun gnugo-close-game (end-time resign) - (gnugo-put :game-end-time end-time) - (let ((now (or end-time (current-time)))) - (gnugo-put :scoring-seed (logior (ash (logand (car now) 255) 16) - (cadr now)))) - (gnugo-put :game-over - (if (or (eq t resign) - (and (stringp resign) - (string-match "[BW][+][Rr]esign" resign))) - (flet ((ls (color) (mapcar - (lambda (x) - (cons (list color) - (split-string x))) - (split-string - (gnugo-query "worm_stones %s" color) - "\n")))) - (let ((live (append (ls "black") (ls "white")))) - `((live ,@live) - (dead)))) - (let ((dd (gnugo-query "dragon_data")) - (start 0) mem color ent live dead) - (while (string-match "\\(.+\\):\n[^ ]+[ ]+\\(black\\|white\\)\n" - dd start) - (setq mem (match-string 1 dd) - color (match-string 2 dd) - start (match-end 0) - ent (cons (list color) - (sort (gnugo-lsquery "dragon_stones %s" mem) - 'string<))) - (string-match "\nstatus[ ]+\\(\\(ALIVE\\)\\|[A-Z]+\\)\n" - dd start) - (if (match-string 2 dd) - (push ent live) - (push ent dead)) - (setq start (match-end 0))) - `((live ,@live) - (dead ,@dead)))))) - -(defun gnugo-push-move (userp move) - (let* ((color (gnugo-get (if userp :user-color :gnugo-color))) - (start (gnugo-get :waiting-start)) - (now (current-time)) - (resignp (string= "resign" move)) - (passp (string= "PASS" move)) - (head (gnugo-move-history 'car)) - (onep (and head (string= "PASS" head))) - (donep (or resignp (and onep passp)))) - (unless passp - (gnugo-merge-showboard-results)) - (gnugo-put :last-mover color) - (when userp - (gnugo-put :last-user-bpos (and (not passp) (not resignp) move))) - (gnugo-note (if (string= "black" color) :B :W) move t (not resignp)) - (when resignp - (gnugo-note :EV "resignation")) - (when start - (gnugo-put :last-waiting (cadr (time-subtract now start)))) - (when donep - (gnugo-close-game now resignp)) - (gnugo-put :waiting-start (and (not donep) now)) - donep)) - -(defun gnugo-venerate (yin yang) - (let* ((fg-yy (gnugo-yy yin yang)) - (fg-disp (or (get fg-yy 'display) - (get fg-yy 'do-not-display))) - (fg-data (plist-get (cdr fg-disp) :data)) - (bg-yy (gnugo-yy yin (gnugo-yang ?.))) - (bg-disp (or (get bg-yy 'display) - (get bg-yy 'do-not-display))) - (bg-data (plist-get (cdr bg-disp) :data)) - (bop (lambda (s) - (let* ((start 0) - (ncolors - (when (string-match "\\([0-9]+\\)\\s-+[0-9]+\"," s) - (setq start (match-end 0)) - (string-to-number (match-string 1 s))))) - (while (and (<= 0 ncolors) (string-match ",\n" s start)) - (setq start (match-end 0) - ncolors (1- ncolors))) - (string-match "\"" s start) - (match-end 0)))) - (new (copy-sequence fg-data)) - (lx (length fg-data)) - (lb (length bg-data)) - (sx (funcall bop fg-data)) - (sb (funcall bop bg-data)) - (color-key (aref new sx))) ; blech, heuristic - (while (< sx lx) - (when (and (not (= color-key (aref new sx))) - (< 0 (random 4))) - (aset new sx (aref bg-data sb))) - (incf sx) - (incf sb)) - (create-image new 'xpm t :ascent 'center))) - -(defun gnugo-refresh (&optional nocache) - "Update GNUGO Board buffer display. -While a game is in progress, parenthesize the last-played stone (no parens -for pass). If the buffer is currently displayed in the selected window, -recenter the board (presuming there is extra space in the window). Update -the mode line. Lastly, move point to the last position played by the user, -if that move was not a pass. - -Prefix arg NOCACHE requests complete reconstruction of the display, which may -be slow. (This should normally be unnecessary; specify it only if the display -seems corrupted.) NOCACHE is silently ignored when GNU Go is thinking about -its move." - (interactive "P") - (when (and nocache (not (gnugo-get :waitingp))) - (gnugo-propertize-board-buffer)) - (let* ((last-mover (gnugo-get :last-mover)) - (other (gnugo-other last-mover)) - (move (gnugo-move-history 'car)) - (game-over (gnugo-get :game-over)) - window last) - ;; last move - (when move - (let ((l-ov (gnugo-get :lparen-ov)) - (r-ov (gnugo-get :rparen-ov))) - (if (member move '("PASS" "resign")) - (mapc 'delete-overlay (list l-ov r-ov)) - (gnugo-goto-pos move) - (let* ((p (point)) - (hspec (gnugo-get :highlight-last-move-spec)) - (display-value (nth 0 hspec)) - (l-offset (nth 1 hspec)) - (l-new-pos (+ p l-offset)) - (r-action (nth 2 hspec))) - (overlay-put l-ov 'display - (if (functionp display-value) - (funcall display-value p) - display-value)) - (move-overlay l-ov l-new-pos (1+ l-new-pos)) - (if r-action - (funcall r-action r-ov) - (move-overlay r-ov (+ l-new-pos 2) (+ l-new-pos 3))))))) - ;; buffer name - (rename-buffer (concat (gnugo-get :diamond) - (if game-over - (format "%s(game over)" - (if (string= move "resign") - (concat move "ation ") - "")) - (format "%s(%s to play)" - (if move (concat move " ") "") - other)))) - ;; pall of death - (when game-over - (let ((live (cdr (assq 'live game-over))) - (dead (cdr (assq 'dead game-over))) - p pall) - (unless (eq game-over (get-text-property 1 'game-over)) - (dolist (group (append live dead)) - (dolist (pos (cdr group)) - (gnugo-goto-pos pos) - (setq p (point)) - (put-text-property p (1+ p) 'group group))) - (put-text-property 1 2 'game-over game-over)) - (dolist (group live) - (when (setq pall (cdar group)) - (mapc 'delete-overlay pall) - (setcdr (car group) nil))) - (dolist (group dead) - (unless (cdar group) - (let (ov pall c (color (caar group))) - (setq c (if (string= "black" color) "x" "o")) - (dolist (pos (cdr group)) - (gnugo-goto-pos pos) - (setq p (point) ov (make-overlay p (1+ p))) - (overlay-put - ov 'display - (if (gnugo-get :display-using-images) - ;; respect the dead individually; it takes more time - ;; but that's not a problem (for them) - (gnugo-venerate (get-text-property p 'gnugo-yin) - (gnugo-yang (aref (upcase c) 0))) - (propertize c 'face 'font-lock-warning-face))) - (push ov pall)) - (setcdr (car group) pall)))))) - ;; window update - (when (setq window (get-buffer-window (current-buffer))) - (let* ((gridp (not (memq :nogrid buffer-invisibility-spec))) - (size (gnugo-treeroot :SZ)) - (under10p (< size 10)) - (h (- (truncate (- (window-height window) - (* size (gnugo-get :hmul)) - (if gridp 2 0)) - 2) - (if gridp 0 1))) - (edges (window-edges window)) - (right-w-edge (nth 2 edges)) - (avail-width (- right-w-edge (nth 0 edges))) - (wmul (gnugo-get :wmul)) - (imagesp (symbol-plist (gnugo-f 'ispc))) - (w (/ (- avail-width - (* size wmul) - (if imagesp - 0 - (1- size)) - 2 ; between board and grid - (if gridp - (if under10p 2 4) - 0)) - 2.0))) - (dolist (pair `((tpad . ,(if (and h (< 0 h)) - `(display ,(make-string h 10)) - '(invisible :nogrid))) - (gpad . (display - (space :align-to - ,(+ w - 2.0 - (cond (imagesp (+ (* 0.5 wmul) - (if under10p - -0.5 - 0.5))) - (under10p 0) - (t 1)))))) - (gspc . ,(when imagesp - `(display (space-width ,(- wmul 1.0))))) - (lpad . ,(let ((d `(display (space :align-to ,w)))) - ;; We distinguish between these cases to - ;; workaround a display bug whereby the - ;; `before-string' is omitted entirely (not - ;; rendered) when interacting w/ the text - ;; mode last-move left-paren for moves in - ;; column A. - (if gridp - `(before-string - ,(apply 'propertize " " d)) - d))) - (rpad . (display - (space :align-to ,(1- avail-width)))))) - (setplist (gnugo-f (car pair)) (cdr pair))))) - ;; mode line update - (let ((cur (gnugo-get :mode-line))) - (unless (equal cur gnugo-mode-line) - (setq cur gnugo-mode-line) - (gnugo-put :mode-line cur) - (gnugo-put :mode-line-form - (cond ((stringp cur) - (setq cur (copy-sequence cur)) - (let (acc cut c) - (while (setq cut (string-match "~[bwpmtu]" cur)) - (aset cur cut ?%) - (setq cut (1+ cut) c (aref cur cut)) - (aset cur cut ?s) - (push - `(,(intern (format "squig-%c" c)) - ,(case c - (?b '(or (gnugo-get :black-captures) 0)) - (?w '(or (gnugo-get :white-captures) 0)) - (?p '(gnugo-other (gnugo-get :last-mover))) - (?t '(let ((ws (gnugo-get :waiting-start))) - (if ws - (cadr (time-since ws)) - "-"))) - (?u '(or (gnugo-get :last-waiting) "-")) - (?m '(gnugo-move-history 'count)))) - acc)) - `(let ,(delete-dups (copy-sequence acc)) - (format ,cur ,@(reverse (mapcar 'car acc)))))) - (t cur)))) - (let ((form (gnugo-get :mode-line-form))) - (setq mode-line-process - (and form - ;; this dynamicism is nice but excessive in its wantonness - ;;- `(" [" (:eval ,form) "]") - ;; this dynamicism is ok because the user triggers it - (list (format " [%s]" (eval form)))))) - (force-mode-line-update)) - ;; last user move - (when (setq last (gnugo-get :last-user-bpos)) - (gnugo-goto-pos last)))) - -;;;--------------------------------------------------------------------------- -;;; Game play actions - -(defun gnugo-get-move-insertion-filter (proc string) - (with-current-buffer (process-buffer proc) - (let* ((so-far (gnugo-get :get-move-string)) - (full (gnugo-put :get-move-string (concat so-far string)))) - (when (string-match "^= \\(.+\\)\n\n" full) - (let ((pos-or-pass (match-string 1 full))) - (gnugo-put :get-move-string nil) - (gnugo-put :waitingp nil) - (gnugo-push-move nil pos-or-pass) - (let ((buf (current-buffer))) - (let (inhibit-gnugo-refresh) - (run-hooks 'gnugo-post-move-hook) - (unless inhibit-gnugo-refresh - (with-current-buffer buf - (gnugo-refresh)))))))))) - -(defun gnugo-get-move (color) - (gnugo-put :waitingp t) - (set-process-filter (gnugo-get :proc) 'gnugo-get-move-insertion-filter) - (gnugo-send-line (concat "genmove " color)) - (accept-process-output)) - -(defun gnugo-cleanup () - (when (gnugo-board-buffer-p) - (unless (= 0 (buffer-size)) - (message "Thank you for playing GNU Go.")) - (mapc (lambda (sym) - (setplist sym nil) ; "...is next to fordliness." --Huxley - (unintern sym)) - (append (gnugo-get :all-yy) - (mapcar 'gnugo-f - '(anim - tpad - gpad - gspc - lpad - rpad - ispc)))) - (setq gnugo-state nil))) - -(defun gnugo-position () - (or (get-text-property (point) 'gnugo-position) - (error "Not a proper position point"))) - -(defun gnugo-move () - "Make a move on the GNUGO Board buffer. -The position is computed from current point. -Signal error if done out-of-turn or if game-over. -To start a game try M-x gnugo." - (interactive) - (gnugo-gate t) - (let* ((buf (current-buffer)) - (pos (gnugo-position)) - (move (format "play %s %s" (gnugo-get :user-color) pos)) - (accept (cdr (gnugo-synchronous-send/return move)))) - (unless (= ?= (aref accept 0)) - (error "%s" accept)) - (gnugo-push-move t pos) ; value always nil for non-pass move - (let (inhibit-gnugo-refresh) - (run-hooks 'gnugo-post-move-hook) - (unless inhibit-gnugo-refresh - (with-current-buffer buf - (gnugo-refresh)))) - (with-current-buffer buf - (gnugo-get-move (gnugo-get :gnugo-color))))) - -(defun gnugo-mouse-move (e) - "Do `gnugo-move' at mouse location." - (interactive "@e") - (mouse-set-point e) - (when (looking-at "[.+]") - (gnugo-move))) - -(defun gnugo-pass () - "Make a pass on the GNUGO Board buffer. -Signal error if done out-of-turn or if game-over. -To start a game try M-x gnugo." - (interactive) - (gnugo-gate t) - (let ((accept (cdr (gnugo-synchronous-send/return - (format "play %s PASS" (gnugo-get :user-color)))))) - (unless (= ?= (aref accept 0)) - (error "%s" accept))) - (let ((donep (gnugo-push-move t "PASS")) - (buf (current-buffer))) - (let (inhibit-gnugo-refresh) - (run-hooks 'gnugo-post-move-hook) - (unless inhibit-gnugo-refresh - (with-current-buffer buf - (gnugo-refresh)))) - (unless donep - (with-current-buffer buf - (gnugo-get-move (gnugo-get :gnugo-color)))))) - -(defun gnugo-mouse-pass (e) - "Do `gnugo-pass' at mouse location." - (interactive "@e") - (mouse-set-point e) - (gnugo-pass)) - -(defun gnugo-resign () - (interactive) - (gnugo-gate t) - (if (not (y-or-n-p "Resign? ")) - (message "(not resigning)") - (gnugo-push-move t "resign") - (gnugo-refresh))) - -(defun gnugo-animate-group (command) - (message "Computing %s ..." command) - (let* ((pos (gnugo-position)) - (stones (if (memq (char-after) '(?X ?O)) - (gnugo-lsquery "%s %s" command pos) - (error "No stone at %s" pos)))) - (message "Computing %s ... %s in group." command (length stones)) - (setplist (gnugo-f 'anim) nil) - (let* ((spec (let ((spec - ;; `(split-string gnugo-animation-string "" t)' - ;; works as well, for newer emacs versions - (delete "" (split-string gnugo-animation-string "")))) - (cond ((gnugo-get :display-using-images) - (let* ((yin (get-text-property (point) 'gnugo-yin)) - (yang (gnugo-yang (char-after))) - (up (get (gnugo-yy yin yang t) 'display)) - (dn (get (gnugo-yy yin yang) 'display)) - flip-flop) - (mapcar (lambda (c) - (if (setq flip-flop (not flip-flop)) - dn up)) - (mapcar 'string-to-char spec)))) - (t spec)))) - (cell (list spec)) - (ovs (save-excursion - (mapcar (lambda (pos) - (gnugo-goto-pos pos) - (let* ((p (point)) - (ov (make-overlay p (1+ p)))) - (overlay-put ov 'category (gnugo-f 'anim)) - (overlay-put ov 'priority most-positive-fixnum) - ov)) - stones)))) - (setplist (gnugo-f 'anim) (cons 'display cell)) - (while (and (cdr spec) ; let last linger lest levity lost - (sit-for 0.08675309)) ; jenny jenny i got your number... - (setcar cell (setq spec (cdr spec))) - (set-buffer-modified-p t)) - (sit-for 5) - (mapc 'delete-overlay ovs) - t))) - -(defun gnugo-display-group-data (command buffer-name) - (message "Computing %s ..." command) - (let ((data (cdr (gnugo-synchronous-send/return - (format "%s %s" command (gnugo-position)))))) - (switch-to-buffer buffer-name) - (erase-buffer) - (insert data)) - (message "Computing %s ... done." command)) - -(defun gnugo-worm-stones () - "In the GNUGO Board buffer, animate \"worm\" at current position. -Signal error if done out-of-turn or if game-over. -See variable `gnugo-animation-string' for customization." - (interactive) - (gnugo-gate) - (gnugo-animate-group "worm_stones")) - -(defun gnugo-worm-data () - "Display in another buffer data from \"worm\" at current position. -Signal error if done out-of-turn or if game-over." - (interactive) - (gnugo-gate) - (gnugo-display-group-data "worm_data" "*gnugo worm data*")) - -(defun gnugo-dragon-stones () - "In the GNUGO Board buffer, animate \"dragon\" at current position. -Signal error if done out-of-turn or if game-over. -See variable `gnugo-animation-string' for customization." - (interactive) - (gnugo-gate) - (gnugo-animate-group "dragon_stones")) - -(defun gnugo-dragon-data () - "Display in another buffer data from \"dragon\" at current position. -Signal error if done out-of-turn or if game-over." - (interactive) - (gnugo-gate) - (gnugo-display-group-data "dragon_data" "*gnugo dragon data*")) - -(defun gnugo-toggle-dead-group () - "In a GNUGO Board buffer, during game-over, toggle a group as dead. -The group is selected from current position (point). Signal error if -not in game-over or if there is no group at that position. - -In the context of GNU Go, a group is called a \"dragon\" and may be -composed of more than one \"worm\" (set of directly-connected stones). -It is unclear to the gnugo.el author whether or not GNU Go supports - - considering worms as groups in their own right; and - - toggling group aliveness via GTP. -Due to these uncertainties, this command is only half complete; the -changes you may see in Emacs are not propagated to the gnugo subprocess. -Thus, GTP commands like `final_score' may give unexpected results. - -If you are able to expose via GTP `change_dragon_status' in utils.c, -you may consider modifying the `gnugo-toggle-dead-group' source code -to enable full functionality." - (interactive) - (let ((game-over (or (gnugo-get :game-over) - (error "Sorry, game still in play"))) - (group (or (get-text-property (point) 'group) - (error "No stone at that position"))) - (now (current-time))) - (gnugo-put :scoring-seed (logior (ash (logand (car now) 255) 16) - (cadr now))) - (let ((live (assq 'live game-over)) - (dead (assq 'dead game-over)) - bef now) - (if (memq group live) - (setq bef live now dead) - (setq bef dead now live)) - (setcdr bef (delq group (cdr bef))) - (setcdr now (cons group (cdr now))) - ;; disabled permanently -- too wrong - (when nil - (flet ((populate (group) - (let ((color (caar group))) - (dolist (stone (cdr group)) - (gnugo-query "play %s %s" color stone))))) - (if (eq now live) - (populate group) - ;; drastic (and wrong -- clobbers capture info, etc) - (gnugo-query "clear_board") - (mapc 'populate (cdr live))))) - ;; here is the desired interface (to be enabled Some Day) - (when nil - (gnugo-query "change_dragon_status %s %s" - (cadr group) (if (eq now live) - 'alive - 'dead))))) - (save-excursion - (gnugo-refresh))) - -(defun gnugo-estimate-score () - "Display estimated score of a game of GNU Go. -Output includes number of stones on the board and number of stones -captured by each player, and the estimate of who has the advantage (and -by how many stones)." - (interactive) - (message "Est.score ...") - (let ((black (length (gnugo-lsquery "list_stones black"))) - (white (length (gnugo-lsquery "list_stones white"))) - (black-captures (gnugo-query "captures black")) - (white-captures (gnugo-query "captures white")) - (est (gnugo-query "estimate_score"))) - ;; might as well update this - (gnugo-put :black-captures black-captures) - (gnugo-put :white-captures white-captures) - (message "Est.score ... B %s %s | W %s %s | %s" - black black-captures white white-captures est))) - -(defun gnugo-write-sgf-file (filename) - "Save the game history to FILENAME (even if unfinished). -If FILENAME already exists, Emacs confirms that you wish to overwrite it." - (interactive "FWrite game as SGF file: ") - (when (and (file-exists-p filename) - (not (y-or-n-p "File exists. Continue? "))) - (error "Not writing %s" filename)) - (gnugo/sgf-write-file (gnugo-get :sgf-collection) filename)) - -(defun gnugo-read-sgf-file (filename) - "Load the first game tree from FILENAME, a file in SGF format." - (interactive "fSGF file to load: ") - (when (file-directory-p filename) - (error "Cannot load a directory (try a filename with extension .sgf)")) - (let (ans play wait samep coll) - ;; problem: requiring GTP `loadsgf' complicates network subproc support; - ;; todo: skip it altogether when confident about `gnugo/sgf-read-file' - (unless (= ?= (aref (setq ans (cdr (gnugo-synchronous-send/return - (format "loadsgf %s" - (expand-file-name filename))))) - 0)) - (error "%s" ans)) - (setq play (substring ans 2) - wait (gnugo-other play) - samep (string= (gnugo-get :user-color) play)) - (gnugo-put :last-mover wait) - (unless samep - (gnugo-put :gnugo-color wait) - (gnugo-put :user-color play)) - (gnugo-put :sgf-collection (setq coll (gnugo/sgf-read-file filename))) - (gnugo-put :sgf-gametree - (nth (let ((n (length coll))) - ;; This is better: - ;; (if (= 1 n) - ;; 0 - ;; (let* ((q (format "Which game? (1-%d)" n)) - ;; (choice (1- (read-number q 1)))) - ;; (if (and (< -1 choice) (< choice n)) - ;; choice - ;; (message "(Selecting the first game)") - ;; 0))) - ;; but this is what we use (for now) to accomodate - ;; (aka faithfully mimic) GTP `loadsgf' limitations: - (unless (= 1 n) - (message "(Selecting the first game)")) - 0) - coll)) - (let* ((tree (gnugo-get :sgf-gametree)) - (loc tree) - (count 0) - mem node play game-over) - (while (setq node (car loc)) - (when (setq play (or (assq :B node) - (assq :W node))) - ;; SGF[4] allows "" to mean PASS. For now, - ;; we normalize here instead of at the lower layer. - (when (string= "" (cdr play)) - (setcdr play "tt")) - (incf count) - (push loc mem)) - (setq loc (cdr loc))) - (gnugo-put :game-over - (setq game-over - (or (cdr (assq :RE (car tree))) - (and (cdr mem) - (equal '("tt" "tt") - (let ((order (if (string= "black" wait) - '(:B :W) - '(:W :B)))) - (mapcar (lambda (pk) - (cdr (assq (funcall pk order) - (car (funcall pk mem))))) - '(car cadr)))) - 'two-passes)))) - (gnugo-put :monkey - (vector (or (car mem) (gnugo-get :sgf-gametree)) - mem - count)) - (when (and game-over - ;; (maybe) todo: user var to inhibit (can be slow) - t) - (gnugo-close-game nil game-over))) - (gnugo-refresh t) - (message "GNU Go %splays as %s, you as %s (%s)" - (if samep "" "now ") - wait play (if samep - "as before" - "NOTE: this is a switch!")))) - -(defun gnugo-magic-undo (spec &optional noalt) - "Undo moves on the GNUGO Board, based on SPEC, a string or number. -If SPEC is a string in the form of a board position (e.g., \"T19\"), -check that the position is occupied by a stone of the user's color, -and if so, remove moves from the history until that position is clear. -If SPEC is a positive number, remove exactly that many moves from the -history, signaling an error if the history is exhausted before finishing. -If SPEC is not recognized, signal \"bad spec\" error. - -Refresh the board for each move undone. If (in the case where SPEC is -a number) after finishing, the color to play is not the user's color, -schedule a move by GNU Go. - -After undoing the move(s), schedule a move by GNU Go if it is GNU Go's -turn to play. Optional second arg NOALT non-nil inhibits this." - (gnugo-gate) - (let* ((n 0) - (monkey (gnugo-get :monkey)) - (mem (aref monkey 1)) - (count (aref monkey 2)) - done ans) - (cond ((and (numberp spec) (< 0 spec)) - (setq n spec done (lambda () (= 0 n)))) - ((string-match "^[a-z]" spec) - (let ((pos (upcase spec))) - (setq done `(lambda () - (gnugo-goto-pos ,pos) - (memq (char-after) '(?. ?+)))) - (when (funcall done) - (error "%s already clear" pos)) - (let ((u (gnugo-get :user-color))) - (when (= (save-excursion - (gnugo-goto-pos pos) - (char-after)) - (if (string= "black" u) - ?O - ?X)) - (error "%s not occupied by %s" pos u))))) - (t (error "Bad spec: %S" spec))) - (when (gnugo-get :game-over) - (gnugo-put :game-over nil)) - (while (not (funcall done)) - (setq ans (cdr (gnugo-synchronous-send/return "undo"))) - (unless (= ?= (aref ans 0)) - (error "%s" ans)) - (aset monkey 2 (decf count)) - (aset monkey 1 (setq mem (cdr mem))) - (aset monkey 0 (or (car mem) (gnugo-get :sgf-gametree))) - (gnugo-put :last-mover (gnugo-other (gnugo-get :last-mover))) - (gnugo-merge-showboard-results) ; all - (gnugo-refresh) ; this - (decf n) ; is - (sit-for 0))) ; eye candy - (let* ((ulastp (string= (gnugo-get :last-mover) (gnugo-get :user-color))) - - (ubpos (gnugo-move-history (if ulastp 'car 'cadr)))) - (gnugo-put :last-user-bpos (if (and ubpos (not (string= "PASS" ubpos))) - ubpos - (gnugo-get :center-position))) - (gnugo-refresh t) - ;; preserve restricted-functionality semantics (todo: remove restriction) - (setcdr (aref (gnugo-get :monkey) 0) nil) - (when (and ulastp (not noalt)) - (gnugo-get-move (gnugo-get :gnugo-color))))) - -(defun gnugo-undo-one-move () - "Undo exactly one move (perhaps GNU Go's, perhaps yours). -Do not schedule a move by GNU Go even if it is GNU Go's turn to play. -See also `gnugo-undo-two-moves'." - (interactive) - (gnugo-gate) - (gnugo-magic-undo 1 t)) - -(defun gnugo-undo-two-moves () - "Undo a pair of moves (GNU Go's and yours). -However, if you are the last mover, undo only one move. -Regardless, after undoing, it is your turn to play again." - (interactive) - (gnugo-gate) - (gnugo-magic-undo (if (string= (gnugo-get :user-color) - (gnugo-get :last-mover)) - 1 - 2))) - -(defun gnugo-display-final-score () - "Display final score and other info in another buffer (when game over). -If the game is still ongoing, Emacs asks if you wish to stop play (by -making sure two \"pass\" moves are played consecutively, if necessary). -Also, add the `:RE' SGF property to the root node of the game tree." - (interactive) - (unless (or (gnugo-get :game-over) - (and (not (gnugo-get :waitingp)) - (y-or-n-p "Game still in play. Stop play now? "))) - (error "Sorry, game still in play")) - (unless (gnugo-get :game-over) - (flet ((pass (userp) - (message "Playing PASS for %s ..." - (gnugo-get (if userp :user-color :gnugo-color))) - (sit-for 1) - (gnugo-push-move userp "PASS"))) - (unless (pass t) - (pass nil))) - (gnugo-refresh) - (sit-for 3)) - (let ((b= " Black = ") - (w= " White = ") - (res (let* ((node (car (aref (gnugo-get :monkey) 0))) - (event (and node (cdr (assq :EV node))))) - (and event (string= "resignation" event) - (if (assq :B node) "black" "white")))) - blurb result) - (if res - (setq blurb (list - (format "%s wins.\n" - (substring (if (= ?b (aref res 0)) w= b=) - 3 8)) - "The game is over.\n" - (format "Resignation by %s.\n" res)) - result (concat (upcase (substring (gnugo-other res) 0 1)) - "+Resign")) - (message "Computing final score ...") - (let* ((live (cdr (assq 'live (gnugo-get :game-over)))) - (dead (cdr (assq 'dead (gnugo-get :game-over)))) - (seed (gnugo-get :scoring-seed)) - (terr-q (format "final_status_list %%s_territory %d" seed)) - (terr "territory") - (capt "captures") - (b-terr (length (gnugo-lsquery terr-q "black"))) - (w-terr (length (gnugo-lsquery terr-q "white"))) - (b-capt (string-to-number (gnugo-get :black-captures))) - (w-capt (string-to-number (gnugo-get :white-captures))) - (komi (gnugo-treeroot :KM))) - (setq blurb (list "The game is over. Final score:\n") - result (gnugo-query "final_score %d" seed)) - (cond ((string= "Chinese" (gnugo-treeroot :RU)) - (dolist (group live) - (let ((count (length (cdr group)))) - (if (string= "black" (caar group)) - (setq b-terr (+ b-terr count)) - (setq w-terr (+ w-terr count))))) - (dolist (group dead) - (let* ((color (caar group)) - (count (length (cdr group)))) - (if (string= "black" color) - (setq w-terr (+ count w-terr)) - (setq b-terr (+ count b-terr))))) - (push (format "%s%d %s = %3.1f\n" b= b-terr terr b-terr) blurb) - (push (format "%s%d %s + %3.1f %s = %3.1f\n" w= - w-terr terr komi 'komi (+ w-terr komi)) - blurb)) - (t - (dolist (group dead) - (let* ((color (caar group)) - (adjust (* 2 (length (cdr group))))) - (if (string= "black" color) - (setq w-terr (+ adjust w-terr)) - (setq b-terr (+ adjust b-terr))))) - (push (format "%s%d %s + %s %s = %3.1f\n" b= - b-terr terr - b-capt capt - (+ b-terr b-capt)) - blurb) - (push (format "%s%d %s + %s %s + %3.1f %s = %3.1f\n" w= - w-terr terr - w-capt capt - komi 'komi - (+ w-terr w-capt komi)) - blurb))) - (push (if (string= "0" result) - "The game is a draw.\n" - (format "%s wins by %s.\n" - (substring (if (= ?B (aref result 0)) b= w=) 3 8) - (substring result 2))) - blurb) - (message "Computing final score ... done"))) - ;; extra info - (when (gnugo-get :game-end-time) - (push "\n" blurb) - (dolist (spec '(("Game start" . :game-start-time) - (" end" . :game-end-time))) - (push (format-time-string - (concat (car spec) ": %Y-%m-%d %H:%M:%S %z\n") - (gnugo-get (cdr spec))) - blurb))) - (setq blurb (apply 'concat (nreverse blurb))) - (let* ((root (car (gnugo-get :sgf-gametree))) - (cur (assq :RE root))) - (if cur - (setcdr cur result) - (setcdr (last root) (list (cons :RE result))))) - (switch-to-buffer (format "%s*GNUGO Final Score*" (gnugo-get :diamond))) - (erase-buffer) - (insert blurb))) - -;;;--------------------------------------------------------------------------- -;;; Command properties and gnugo-command - -;; GTP commands entered by the user are never issued directly to GNU Go; -;; instead, their behavior and output are controlled by the property -;; `:gnugo-gtp-command-spec' hung off of each (interned/symbolic) command. -;; The value of this property is a sub-plist, w/ sub-properties as follows: -;; -;; :full -- completely interpret the command string; the value is a -;; func that takes the list of words derived from splitting the -;; command string (minus the command) and handles everything. -;; -;; :output -- either a keyword specifying the preferred output method: -;; :message -- show output in minibuffer -;; :discard -- sometimes you just don't care; -;; or a function that takes one arg, the output string, and -;; handles it completely. default is to switch to buffer -;; "*gnugo command output*" if the output has a newline, -;; otherwise use `message'. -;; -;; :post-hook -- normal hook run after output processing (at the very end). - -(defun gnugo-command (command) - "Send the Go Text Protocol COMMAND (a string) to GNU Go. -Output and Emacs behavior depend on which command is given (some -commands are handled completely by Emacs w/o using the subprocess; -some commands have their output displayed in specially prepared -buffers or in the echo area; some commands are instrumented to do -gnugo.el-specific housekeeping). - -For example, for the command \"help\", Emacs visits the -GTP command reference info page. - -NOTE: At this time, GTP command handling specification is still - incomplete. Thus, some commands WILL confuse gnugo.el." - (interactive "sCommand: ") - (if (string= "" command) - (message "(no command given)") - (let* ((split (split-string command)) - (cmd (intern (car split))) - (spec (get cmd :gnugo-gtp-command-spec)) - (full (plist-get spec :full)) - (last-message nil)) - (if full - (funcall full (cdr split)) - (message "Doing %s ..." command) - (let* ((ans (cdr (gnugo-synchronous-send/return command))) - (where (plist-get spec :output))) - (if (string-match "unknown.command" ans) - (message ans) - (cond ((functionp where) (funcall where ans)) - ((eq :discard where) (message "")) - ((or (eq :message where) - (not (string-match "\n" ans))) - (message ans)) - (t (switch-to-buffer "*gnugo command output*") - (erase-buffer) - (insert ans) - (message "Doing %s ... done." command))) - (let ((hook - ;; do not elide this binding; `run-hooks' needs it - (plist-get spec :post-hook))) - (run-hooks 'hook)))))))) - -;;;--------------------------------------------------------------------------- -;;; Major mode for interacting with a GNUGO subprocess - -(put 'gnugo-board-mode 'mode-class 'special) -(defun gnugo-board-mode () - "Major mode for playing GNU Go. -Entering this mode runs the normal hook `gnugo-board-mode-hook'. -In this mode, keys do not self insert. Default keybindings: - - ? View this help. - - RET or SPC Run `gnugo-move'. - - q or Q Quit (the latter without confirmation). - - R Resign. - - u Run `gnugo-undo-two-moves'. - - U Pass to `gnugo-magic-undo' either the board position - at point (if no prefix arg), or the prefix arg converted - to a number. E.g., to undo 16 moves: `C-u C-u U' (see - `universal-argument'); to undo 42 moves: `M-4 M-2 U'. - - C-l Run `gnugo-refresh'. - - _ or M-_ Bury the Board buffer (when the boss is near). - - P Run `gnugo-pass'. - - i Toggle display using XPM images (if supported). - - w Run `gnugo-worm-stones'. - d Run `gnugo-dragon-stones'. - - W Run `gnugo-worm-data'. - D Run `gnugo-dragon-data'. - - t Run `gnugo-toggle-dead-group'. - - ! Run `gnugo-estimate-score'. - - : or ; Run `gnugo-command' (for GTP commands to GNU Go). - - = Display board position under point (if valid). - - h Run `gnugo-move-history'. - - F Run `gnugo-display-final-score'. - - s Run `gnugo-write-sgf-file'. - or C-x C-w - or C-x C-s - - l Run `gnugo-read-sgf-file'." - (switch-to-buffer (generate-new-buffer "(Uninitialized GNUGO Board)")) - (buffer-disable-undo) ; todo: undo undo undoing - (kill-all-local-variables) - (setq truncate-lines t) - (use-local-map gnugo-board-mode-map) - (set (make-local-variable 'font-lock-defaults) - '(gnugo-font-lock-keywords t)) - (setq major-mode 'gnugo-board-mode) - (setq mode-name "GNUGO Board") - (add-hook 'kill-buffer-hook 'gnugo-cleanup nil t) - (set (make-local-variable 'gnugo-state) - (make-hash-table :size (1- 42) :test 'eq)) - (add-to-invisibility-spec :nogrid) - (mapc (lambda (prop) - (gnugo-put prop nil)) ; todo: separate display/game aspects; - '(:game-over ; move latter to func `gnugo' - :waitingp - :last-waiting - :black-captures - :white-captures - :mode-line - :mode-line-form - :display-using-images - :xpms - :local-xpms - :all-yy)) - (let ((name (if (string-match "[ ]" gnugo-program) - (let ((p (substring gnugo-program 0 (match-beginning 0))) - (o (substring gnugo-program (match-end 0))) - (h (or (car gnugo-option-history) ""))) - (when (string-match "--mode" o) - (error "Found \"--mode\" in `gnugo-program'")) - (when (and o (< 0 (length o)) - h (< 0 (length o)) - (or (< (length h) (length o)) - (not (string= (substring h 0 (length o)) - o)))) - (push (concat o " " h) gnugo-option-history)) - p) - gnugo-program)) - (args (read-string "GNU Go options: " - (car gnugo-option-history) - 'gnugo-option-history)) - (rules "Japanese") - board-size user-color handicap komi minus-l infile) - (mapc (lambda (x) - (apply (lambda (var default opt &optional rx) - (set var - (or (when (string-match opt args) - (let ((start (match-end 0)) s) - (string-match (or rx "[0-9.]+") args start) - (setq s (match-string 0 args)) - (if rx s (string-to-number s)))) - default))) - x)) - '((board-size 19 "--boardsize") - (user-color "black" "--color" "\\(black\\|white\\)") - (handicap 0 "--handicap") - (komi 0.0 "--komi") - (minus-l nil "\\([^-]\\|^\\)-l[ ]*" "[^ ]+") - (infile nil "--infile" "[ ]*[^ ]+"))) - (gnugo-put :user-color user-color) - (when (string-match "--chinese-rules" args) - (setq rules "Chinese")) - (let ((proc-args (split-string args))) - (gnugo-put :proc-args proc-args) - (gnugo-put :proc (apply 'start-process "gnugo" nil name - "--mode" "gtp" "--quiet" - proc-args))) - (when (or minus-l infile) - (mapc (lambda (x) - (apply (lambda (prop q) - (set prop (string-to-number (gnugo-query q)))) - x)) - '((board-size "query_boardsize") - (komi "get_komi") - (handicap "get_handicap")))) - (gnugo-put :diamond (substring (process-name (gnugo-get :proc)) 5)) - (gnugo-put :gnugo-color (gnugo-other (gnugo-get :user-color))) - (gnugo-put :highlight-last-move-spec - (gnugo-put :default-highlight-last-move-spec '("(" -1 nil))) - (gnugo-put :lparen-ov (make-overlay 1 1)) - (gnugo-put :rparen-ov (let ((ov (make-overlay 1 1))) - (overlay-put ov 'display ")") - ov)) - (gnugo-put :sgf-gametree (list (list '(:FF . 4) '(:GM . 1)))) - (let ((tree (gnugo-get :sgf-gametree))) - (gnugo-put :sgf-collection (list tree)) - (gnugo-put :monkey (vector tree nil 0))) - (let ((g-blackp (string= "black" (gnugo-get :gnugo-color)))) - (mapc (lambda (x) (apply 'gnugo-note x)) - `((:SZ ,board-size) - (:DT ,(format-time-string "%Y-%m-%d")) - (:RU ,rules) - (:AP ("gnugo.el" . ,gnugo-version)) - (:KM ,komi) - (,(if g-blackp :PW :PB) ,(user-full-name)) - (,(if g-blackp :PB :PW) ,(concat "GNU Go " - (gnugo-query "version"))) - ,@(when (not (= 0 handicap)) - `((:HA ,handicap) - (:AB ,(gnugo-lsquery "fixed_handicap %d" handicap) - nil t))))))) - (set-process-sentinel (gnugo-get :proc) 'gnugo-sentinel) - (set-process-buffer (gnugo-get :proc) (current-buffer)) - (gnugo-put :waiting-start (current-time)) - (gnugo-put :hmul 1) - (gnugo-put :wmul 1) - (run-hooks 'gnugo-board-mode-hook) - (gnugo-refresh t)) - -;;;--------------------------------------------------------------------------- -;;; Entry point - -;;;###autoload -(defun gnugo (&optional new-game) - "Run gnugo in a buffer, or resume a game in progress. -Prefix arg means skip the game-in-progress check and start a new -game straight away. - -You are queried for additional command-line options (Emacs supplies -\"--mode gtp --quiet\" automatically). Here is a list of options -that gnugo.el understands and handles specially: - - --boardsize num Set the board size to use (5--19) - --color Choose your color ('black' or 'white') - --handicap Set the number of handicap stones (0--9) - -If there is already a game in progress you may resume it instead of -starting a new one. See `gnugo-board-mode' documentation for more info." - (interactive "P") - (let* ((all (let (acc) - (dolist (buf (buffer-list)) - (when (gnugo-board-buffer-p buf) - (push (cons (buffer-name buf) buf) acc))) - acc)) - (n (length all))) - (if (and (not new-game) - (< 0 n) - (y-or-n-p (format "GNU Go game%s in progress, resume play? " - (if (= 1 n) "" "s")))) - ;; resume - (switch-to-buffer - (cdr (if (= 1 n) - (car all) - (let ((sel (completing-read "Which one? " all nil t))) - (if (string= "" sel) - (car all) - (assoc sel all)))))) - ;; set up a new board - (gnugo-board-mode) - (let ((half (truncate (1+ (gnugo-treeroot :SZ)) 2))) - (gnugo-goto-pos (format "A%d" half)) - (forward-char (* 2 (1- half))) - (gnugo-put :last-user-bpos - (gnugo-put :center-position - (get-text-property (point) 'gnugo-position)))) - ;; first move - (gnugo-put :game-start-time (current-time)) - (let ((g (gnugo-get :gnugo-color)) - (n (or (gnugo-treeroot :HA) 0)) - (u (gnugo-get :user-color))) - (gnugo-put :last-mover g) - (when (or (and (string= "black" u) (< 1 n)) - (and (string= "black" g) (< n 2))) - (gnugo-put :last-mover u) - (gnugo-refresh t) - (gnugo-get-move g)))))) - -;;;--------------------------------------------------------------------------- -;;; Load-time actions - -(unless gnugo-board-mode-map - (setq gnugo-board-mode-map (make-sparse-keymap)) - (suppress-keymap gnugo-board-mode-map) - (mapc (lambda (pair) - (define-key gnugo-board-mode-map (car pair) (cdr pair))) - '(("?" . describe-mode) - ("\C-m" . gnugo-move) - (" " . gnugo-move) - ("P" . gnugo-pass) - ("R" . gnugo-resign) - ("q" . (lambda () (interactive) - (if (or (gnugo-get :game-over) - (y-or-n-p "Quit? ")) - (kill-buffer nil) - (message "(not quitting)")))) - ("Q" . (lambda () (interactive) - (kill-buffer nil))) - ("U" . (lambda (x) (interactive "P") - (gnugo-magic-undo - (cond ((numberp x) x) - ((consp x) (car x)) - (t (gnugo-position)))))) - ("u" . gnugo-undo-two-moves) - ("\C-l" . gnugo-refresh) - ("\M-_" . bury-buffer) - ("_" . bury-buffer) - ("h" . gnugo-move-history) - ("i" . (lambda () (interactive) - (gnugo-toggle-image-display) - (save-excursion (gnugo-refresh)))) - ("w" . gnugo-worm-stones) - ("W" . gnugo-worm-data) - ("d" . gnugo-dragon-stones) - ("D" . gnugo-dragon-data) - ("t" . gnugo-toggle-dead-group) - ("g" . gnugo-toggle-grid) - ("!" . gnugo-estimate-score) - (":" . gnugo-command) - (";" . gnugo-command) - ("=" . (lambda () (interactive) - (message (gnugo-position)))) - ("s" . gnugo-write-sgf-file) - ("\C-x\C-s" . gnugo-write-sgf-file) - ("\C-x\C-w" . gnugo-write-sgf-file) - ("l" . gnugo-read-sgf-file) - ("F" . gnugo-display-final-score) - ;; mouse - ([(down-mouse-1)] . gnugo-mouse-move) - ([(down-mouse-2)] . gnugo-mouse-move) ; mitigate accidents - ([(down-mouse-3)] . gnugo-mouse-pass) - ;; delving into the curiosities - ("\C-c\C-p" . gnugo-describe-internal-properties)))) - -(unless (get 'help :gnugo-gtp-command-spec) - (flet ((sget (x) (get x :gnugo-gtp-command-spec)) - (jam (cmd prop val) (put cmd :gnugo-gtp-command-spec - (plist-put (sget cmd) prop val))) - (add (cmd prop val) (jam cmd prop (let ((cur (plist-get - (sget cmd) - prop))) - (append (delete val cur) - (list val))))) - (defgtp (x &rest props) (dolist (cmd (if (symbolp x) (list x) x)) - (let ((ls props)) - (while ls - (funcall (if (eq :post-hook (car ls)) - 'add - 'jam) - cmd (car ls) (cadr ls)) - (setq ls (cddr ls))))))) - - (defgtp 'help :full - (lambda (sel) - (info "(gnugo)GTP command reference") - (when sel (setq sel (intern (car sel)))) - (let (buffer-read-only pad cur spec output found) - (flet ((note (s) (insert pad "[NOTE: gnugo.el " s ".]\n"))) - (goto-char (point-min)) - (save-excursion - (while (re-search-forward "^ *[*] \\([a-zA-Z_]+\\)\\(:.*\\)*\n" - (point-max) t) - (unless pad - (setq pad (make-string (- (match-beginning 1) - (match-beginning 0)) - 32))) - (when (plist-get - (setq spec - (get (setq cur (intern (match-string 1))) - :gnugo-gtp-command-spec)) - :full) - (note "handles this command completely")) - (when (setq output (plist-get spec :output)) - (cond ((functionp output) - (note "handles the output specially")) - ((eq :discard output) - (note "discards the output")) - ((eq :message output) - (note "displays the output in the echo area")))) - (when (eq sel cur) - (setq found (match-beginning 0)))))) - (cond (found (goto-char found)) - ((not sel)) - (t (message "(no such command: %s)" sel)))))) - - (defgtp 'final_score :full - (lambda (sel) (gnugo-display-final-score))) - - (defgtp '(boardsize - clear_board - fixed_handicap) - :output :discard - :post-hook (lambda () - (gnugo-put :game-over nil) - (gnugo-put :last-mover nil) - (gnugo-refresh t))) - - (defgtp 'loadsgf :full - (lambda (sel) (gnugo-read-sgf-file (car sel)))) - - (defgtp '(undo gg-undo) :full - (lambda (sel) (gnugo-magic-undo - (let (n) - (cond ((not sel) 1) - ((< 0 (setq n (string-to-number (car sel)))) n) - (t (car sel))))))))) - -(provide 'gnugo) - - -;;;--------------------------------------------------------------------------- -;;; The remainder of this file defines a simplified SGF-handling library. -;;; When/if it should start to attain generality, it should be split off into -;;; a separate file (probably named sgf.el) w/ funcs and vars renamed sans the -;;; "gnugo/" prefix. - -(defconst gnugo/sgf-*r4-properties* - '((AB "Add Black" setup list stone) - (AE "Add Empty" game list point) - (AN "Annotation" game simpletext) - (AP "Application" root (simpletext . simpletext)) - (AR "Arrow" - list (point . point)) - (AS "Who adds stones" - simpletext) ; (LOA) - (AW "Add White" setup list stone) - (B "Black" move move) - (BL "Black time left" move real) - (BM "Bad move" move double) - (BR "Black rank" game simpletext) - (BT "Black team" game simpletext) - (C "Comment" - text) - (CA "Charset" root simpletext) - (CP "Copyright" game simpletext) - (CR "Circle" - list point) - (DD "Dim points" - elist point) ; (inherit) - (DM "Even position" - double) - (DO "Doubtful" move none) - (DT "Date" game simpletext) - (EV "Event" game simpletext) - (FF "Fileformat" root [number (1 . 4)]) - (FG "Figure" - (or none (number . simpletext))) - (GB "Good for Black" - double) - (GC "Game comment" game text) - (GM "Game" root [number (1 . 20)]) - (GN "Game name" game simpletext) - (GW "Good for White" - double) - (HA "Handicap" game number) ; (Go) - (HO "Hotspot" - double) - (IP "Initial pos." game simpletext) ; (LOA) - (IT "Interesting" move none) - (IY "Invert Y-axis" game simpletext) ; (LOA) - (KM "Komi" game real) ; (Go) - (KO "Ko" move none) - (LB "Label" - list (point . simpletext)) - (LN "Line" - list (point . point)) - (MA "Mark" - list point) - (MN "set move number" move number) - (N "Nodename" - simpletext) - (OB "OtStones Black" move number) - (ON "Opening" game text) - (OT "Overtime" game simpletext) - (OW "OtStones White" move number) - (PB "Player Black" game simpletext) - (PC "Place" game simpletext) - (PL "Player to play" setup color) - (PM "Print move mode" - number) ; (inherit) - (PW "Player White" game simpletext) - (RE "Result" game simpletext) - (RO "Round" game simpletext) - (RU "Rules" game simpletext) - (SE "Markup" - point) ; (LOA) - (SL "Selected" - list point) - (SO "Source" game simpletext) - (SQ "Square" - list point) - (ST "Style" root [number (0 . 3)]) - (SU "Setup type" game simpletext) ; (LOA) - (SZ "Size" root (or number (number . number))) - (TB "Territory Black" - elist point) ; (Go) - (TE "Tesuji" move double) - (TM "Timelimit" game real) - (TR "Triangle" - list point) - (TW "Territory White" - elist point) ; (Go) - (UC "Unclear pos" - double) - (US "User" game simpletext) - (V "Value" - real) - (VW "View" - elist point) ; (inherit) - (W "White" move move) - (WL "White time left" move real) - (WR "White rank" game simpletext) - (WT "White team" game simpletext) - (LT "Lose on time" setup simpletext)) - ;; r4-specific notes - ;; - changed: DT FG LB RE RU SZ - ;; - added: AP AR AS DD IP IY LN OT PM SE SQ ST SU VW - "List of SGF[4] properties, each of the form (PROP NAME CONTEXT SPEC...).") - -(defun gnugo/sgf-read-file (filename) - "Return the collection (list) of gametrees in SGF[4] file FILENAME." - (let ((keywords (or (get 'gnugo/sgf-*r4-properties* :keywords) - (put 'gnugo/sgf-*r4-properties* :keywords - (mapcar (lambda (full) - (cons (car full) - (intern (format ":%s" (car full))))) - gnugo/sgf-*r4-properties*)))) - (specs (or (get 'gnugo/sgf-*r4-properties* :specs) - (put 'gnugo/sgf-*r4-properties* :specs - (mapcar (lambda (full) - (cons (car full) (cdddr full))) - gnugo/sgf-*r4-properties*))))) - (flet ((sw () (skip-chars-forward " \t\n")) - (x (end) (let ((beg (point)) - (endp (case end - (:end (lambda (char) (= ?\] char))) - (:mid (lambda (char) (= ?\: char))) - (t (lambda (char) (or (= ?\: char) - (= ?\] char)))))) - c) - (while (not (funcall endp (setq c (char-after)))) - (cond ((= ?\\ c) - (delete-char 1) - (if (eolp) - (kill-line 1) - (forward-char 1))) - ((looking-at "\\s-+") - (delete-region (point) (match-end 0)) - (insert " ")) - (t (forward-char 1)))) - (buffer-substring-no-properties beg (point)))) - (one (type end) (unless (eq 'none type) - (forward-char 1) - (let ((s (x end))) - (case type - ((stone point move simpletext color) s) - ((number real double) (string-to-number s)) - ((text) s) - (t (error "Unhandled type: %S" type)))))) - (val (spec) (cond ((symbolp spec) - (one spec :end)) - ((vectorp spec) - ;; todo: check range here. - (one (aref spec 0) :end)) - ((eq 'or (car spec)) - (let ((v (one (cadr spec) t))) - (if (= ?\] (char-after)) - v - (forward-char 1) - ;; todo: this assumes `spec' has the form - ;; (or foo (foo . bar)) - ;; i.e., foo is not rescanned. e.g., `SZ'. - ;; probably this assumption is consistent - ;; w/ the SGF authors' desire to make the - ;; parsing easy, but you never know... - (cons v (one (cdaddr spec) :end))))) - (t (cons (one (car spec) :mid) - (one (cdr spec) :end))))) - (short (who) (when (eobp) - (error "Unexpected EOF while reading %s" who))) - (atvalp () (= ?\[ (char-after))) - (PROP () (let (name spec ltype) - (sw) (short 'property) - (when (looking-at "[A-Z]") - (setq name (read (current-buffer)) - spec (cdr (assq name specs))) - (sw) - (cons - (cdr (assq name keywords)) - (prog1 (if (= 1 (length spec)) - (val (car spec)) - (unless (memq (setq ltype (car spec)) - '(elist list)) - (error "Bad spec: %S" spec)) - (if (and (eq 'elist ltype) (sw) - (not (atvalp))) - nil - (let ((type (cadr spec)) - mo ls) - (while (and (sw) (atvalp) - (setq mo (val type))) - (push mo ls) - (forward-char 1)) - (forward-char -1) - (nreverse ls)))) - (forward-char 1)))))) - (NODE () (let (prop props) - (sw) (short 'node) - (when (= ?\; (char-after)) - (forward-char 1) - (while (setq prop (PROP)) - (push prop props)) - (nreverse props)))) - (TREE () (let (nodes) - (while (and (sw) (not (eobp))) - (case (char-after) - (?\; (push (NODE) nodes)) - (?\( (forward-char 1) - (push (TREE) nodes)) - (?\) (forward-char 1)))) - (nreverse nodes)))) - (with-temp-buffer - (insert-file-contents filename) - (let (trees) - (while (and (sw) (not (eobp)) (= 40 (char-after))) ; left paren - (forward-char 1) - (push (TREE) trees)) - (nreverse trees)))))) - -(defun gnugo/sgf-write-file (collection filename) - ;; take responsibility for our actions - (dolist (tree collection) - (let* ((root (car tree)) - (who (assq :AP root)) - (fruit (cons "gnugo.el" gnugo-version))) - (if who - (setcdr who fruit) - (setcdr (last root) (list (cons :AP fruit)))))) - ;; write it out - (let ((aft-newline-appreciated '(:AP :GN :PB :PW :HA :KM :RU :RE)) - (specs (mapcar (lambda (full) - (cons (intern (format ":%s" (car full))) - (cdddr full))) - gnugo/sgf-*r4-properties*)) - p name v spec) - ;; todo: escape special chars for `text' and `simpletext'. - (flet ((>>one (v) (insert (format "[%s]" v))) - (>>two (v) (insert (format "[%s:%s]" (car v) (cdr v)))) - (>>nl () (cond ((memq name aft-newline-appreciated) - (insert "\n")) - ((< 60 (current-column)) - (save-excursion - (goto-char p) - (insert "\n")))))) - (with-temp-buffer - (dolist (tree collection) - (insert "(") - (dolist (node tree) - (insert ";") - (dolist (prop node) - (setq p (point) - name (car prop) - v (cdr prop)) - (insert (substring (symbol-name name) 1)) - (cond ((not v)) - ((and (consp v) - (memq (car (setq spec (cdr (assq name specs)))) - '(list elist))) - (>>nl) - (let ((>> (if (consp (cadr spec)) - '>>two - '>>one))) - (dolist (little-v v) - (setq p (point)) (funcall >> little-v) (>>nl)))) - ((consp v) - (>>two v) (>>nl)) - (t - (>>one v) (>>nl))))) - (insert ")\n")) - (write-file filename))))) - -;;; gnugo.el ends here diff --git a/src/.emacs.d/load/querty.el b/src/.emacs.d/load/querty.el deleted file mode 100644 index f908565..0000000 --- a/src/.emacs.d/load/querty.el +++ /dev/null @@ -1,204 +0,0 @@ -;------------------------------------------------------------; -; qwerty.el -; -; For people who are used to more efficient keyboard layouts. -; -; version 1.1 -; -; * Now includes `M-x dvorak' to switch to a Dvorak keyboard layout. -; -; Written by Neil Jerram , -; Monday 14 December 1992. -; Copyright (C) 1993 Neil Jerram. - -;;; 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 1, 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. -;;; -;;; The GNU General Public License is available by anonymous ftp from -;;; prep.ai.mit.edu in pub/gnu/COPYING. Alternately, you can write to -;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, -;;; USA. - -; This trivial piece of Emacs Lisp was inspired by Stephen Jay Gould's -; essay "The Panda's Thumb of Technology" in his book "Bully for -; Brontosaurus". In this essay, he explains how the intrinsically -; inefficient QWERTY keyboard layout (all the most common keys are in -; weak finger positions) is a hangover from the days when typists -; needed to be slowed down so that the (hidden) mechanics of the -; typewriter didn't get jammed. Maybe if enough people come to use -; Emacs and realise the advantages of different keyboard layouts, the -; days of QWERTY could be numbered. - -; EXAMPLE: French keyboards often have A and Q swapped around -; (in comparison with English keyboards). So a French person -; unused to the English layout (and vice-versa) could re-program -; his/her keyboard by typing `M-x anti-qwerty RET aq RET qa RET'. - -; I would be very interested to hear about alternative keyboard -; layouts that anyone may use, preferably with their definitions -; with respect to the usual QWERTY layout. - -; Public functions - -(defun qwerty () - - "Qwerty keyboard layout." - - (interactive) - (setq keyboard-translate-table nil) - (message "Default keyboard restored.")) - -(defun dvorak () - - "Dvorak keyboard layout: -------------------------------------------------------------------------- -| Esc| 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 0 | [ | ] | <- | -------------------------------------------------------------------------- -| Tab | / | , | . | p | y | f | g | c | r | l | ; | = | | -------------------------------------------------------------------- | | -| Ctrl | a | o | e | u | i | d | h | t | n | s | - | <- | -------------------------------------------------------------------------- -| Shift | ' | q | j | k | x | b | m | w | v | z | Shift | ---------------------------------------------------------------------- -" - (interactive) - (anti-qwerty "/,.pyfgcrl;=aoeuidhtns-'qjkxbmwvz?<>PYFGCRL:+AOEUIDHTNS_QJKXBMWVZ[]{}\"" - "qwertyuiop[]asdfghjkl;'zxcvbnm,./QWERTYUIOP{}ASDFGHJKL:\"XCVBNM<>?-=_+Z")) - -(defun anti-qwerty (old new &optional ctrl unsafe) - - "Remaps the keyboard according to OLD and NEW strings. OLD should -include all the keys that the user wants to change, typed in the -default keyboard system (usually qwerty). NEW is what the user would -like to be typing in order to produce the contents of OLD on the -screen. - - The third (optional prefix) argument CTRL, if non-nil, means that -any transformations on letters that occur should be duplicated in the -related control characters: in other words, if `a' becomes `z', then -`C-a' should become `C-z'. - - Before implementing any changes the function first checks that the -mapping implied by OLD and NEW is one to one, in other words no two -keyboard keys may map to the same character and a single keyboard key -may not be given two different mappings. If any such errors are -discovered in the mapping, no changes to the keyboard are made. - - As an additional safeguard, this function binds the keystroke `M-\' -to the restoring function `qwerty'. If the fourth (optional) argument -UNSAFE is non-nil, this binding is suppressed." - - (interactive "sQWERTY expression: \nsNew system expression: \nP") - (let ((o-n-map (if (qwerty-translation-safe-p old new) - 0 - (sit-for 1))) - (n-o-map (if (qwerty-translation-safe-p new old) - 0 - (sit-for 1))) - llp) - (if (and (numberp o-n-map) - (numberp n-o-map)) - (progn - (setq llp (and (letters-to-letters-p old new) - (letters-to-letters-p new old))) - (un-qwerty old new llp ctrl) - (or unsafe - (progn (global-set-key "\e\\" 'qwerty) - (local-unset-key "\e\\")) - t) - (message - (concat "Keyboard changed. " - (if unsafe - "Type `M-x qwerty' to restore default." - "Type `M-\\' or `M-x qwerty' to restore default.")))) - (error "! Expressions given are not a one to one mapping")))) - -; Private functions - -(defun un-qwerty (old new llp ctrl) - (let* ((the-table (make-string 128 0)) - (ml (min (length old) - (length new))) - (old (substring old 0 ml)) - (new (substring new 0 ml)) - (i 0) - co cn) - (while (< i ml) - (setq co (aref old i) - cn (aref new i)) - (if (and (< co 128) (< cn 128)); Reject Meta characters. - (if (= (aref the-table cn) 0); No unnecessary repeats. - (progn - (if (not llp) - (aset the-table cn co) - (aset the-table (upcase cn) (upcase co)) - (aset the-table (downcase cn) (downcase co))) - (setq co (- (upcase co) 64)) - (if (or (not ctrl) (not llp) (< co 0) (> co 31)) - nil - (aset the-table (- (upcase cn) 64) co))))) - (setq i (1+ i))) - (setq i 0) - (while (< i 128) - (if (= (aref the-table i) 0) - (aset the-table i i)) - (setq i (1+ i))) - (setq keyboard-translate-table the-table))) - -(defun qwerty-translation-safe-p (old new) - "Returns nil if the mapping from OLD to NEW is not one to one." - (let* ((mapping-length (min (length old) - (length new))) - (old (substring old 0 mapping-length)) - (new (substring new 0 mapping-length)) - (i 0) - (errors 0) - (case-fold-search nil) - j co cn match) - (while (< i mapping-length) - (setq co (aref old i) - cn (aref new i) - j (1+ i)) - (while (setq match - (string-match (regexp-quote (char-to-string co)) - (substring old j))) - (if (/= cn (aref (substring new j) match)) - (setq errors (1+ errors))) - (setq j (+ j match 1))) - (setq i (1+ i))) - (if (= errors 0) - t - (message "\"%s\" -> \"%s\" : %d %s" old new errors - (if (> errors 1) "errors" "error")) - nil))) - -(defun letters-to-letters-p (old new) - "Returns t if all letters in OLD are mapped to letters in NEW." - (let* ((mapping-length (min (length old) - (length new))) - (old (substring old 0 mapping-length)) - (new (substring new 0 mapping-length)) - (i 0) - (llp t) - (case-fold-search nil) - co cn) - (while (< i mapping-length) - (setq co (upcase (aref old i)) - cn (upcase (aref new i)) - j (1+ i)) - (and (>= co ?A) - (<= co ?Z) - (or (< cn ?A) - (> cn ?Z)) - (setq llp nil)) - (setq i (1+ i))) - llp)) - -;------------------------------------------------------------; diff --git a/src/.emacs.d/load/wtk_aspell.el b/src/.emacs.d/load/wtk_aspell.el deleted file mode 100644 index f20df62..0000000 --- a/src/.emacs.d/load/wtk_aspell.el +++ /dev/null @@ -1,11 +0,0 @@ -;;; Set up spell-checking with aspell -;; http://aspell.net/man-html/Using-Aspell-with-other-Applications.html -;; http://www.delorie.com/gnu/docs/emacs/emacs_109.html -(setq-default ispell-program-name "aspell") -(global-set-key "\C-xs" 'ispell) -;; http://newsgroups.derkeiler.com/Archive/Comp/comp.emacs/2006-03/msg00005.html -;; http://blog.infion.de/archives/2007/07/09/GNU-Emacs,-aspell-and-the-problem-with-encodings/ -(eval-after-load 'ispell - '(when ispell-aspell-supports-utf8 - (setq ispell-extra-args - (append ispell-extra-args '("--encoding" "none"))))) diff --git a/src/.emacs.d/load/wtk_centralized_backups.el b/src/.emacs.d/load/wtk_centralized_backups.el deleted file mode 100644 index 2e66dc9..0000000 --- a/src/.emacs.d/load/wtk_centralized_backups.el +++ /dev/null @@ -1,21 +0,0 @@ -;------------------------------------------------------------------------------ -; Set up a more organized version control -; -; Backups are saved to ~/.emacs.d/.backup, and autosaves to -; ~/.emacs.d/.autosave. If ~/.emacs.d/.backup doesn't exist it is -; created. If ~/.emacs.d/.autosave doesn't exist it is created, the -; standard autosave procedure is followed. -; -; following J.T. Halbert at http://www.math.umd.edu/~halbert/dotemacs.html -; and the Emacs manual at -; http://www.gnu.org/software/emacs/manual/html_node/emacs/Backup-Names.html - -(setq backup-directory-alist (quote ((".*" . "~/.emacs.d/.backup")))) -(defconst use-backup-dir t) ; Use backup directory - -; From http://www.delorie.com/gnu/docs/emacs/emacs_125.html -; Emacs records interrupted sessions for later recovery in files named -; `~/.emacs.d/auto-save-list/.saves-pid-hostname'. The -; `~/.emacs.d/auto-save-list/.saves-' portion of these names comes -; from the value of auto-save-list-file-prefix. -(setq auto-save-list-file-prefix "~/.emacs.d/.auto-save-list/.saves-") diff --git a/src/.emacs.d/load/wtk_common.el b/src/.emacs.d/load/wtk_common.el deleted file mode 100644 index cefe9f6..0000000 --- a/src/.emacs.d/load/wtk_common.el +++ /dev/null @@ -1,14 +0,0 @@ -;------------------------------------------------------------------------------ -; Make operating on buffers more convienient - -(setq inhibit-startup-message t) ; no splash screen -(fset 'yes-or-no-p 'y-or-n-p) ; use y or n instead of yes or n -(setq require-final-newline t) ; always end a file with a newline -(setq backup-by-copying-when-mismatch t) ; preserve file's owner and group -(when (fboundp 'global-font-lock-mode) ; turn on font-lock mode - (global-font-lock-mode t)) -(setq transient-mark-mode t) ; enable visual feedback on selections -(global-set-key "\C-xg" 'goto-line) ; bind the goto-line function - -; Make scripts executable on Save (saves having to do the chmod every time) -(add-hook 'after-save-hook 'executable-make-buffer-file-executable-if-script-p) diff --git a/src/.emacs.d/load/wtk_epa.el b/src/.emacs.d/load/wtk_epa.el deleted file mode 100644 index 976fee9..0000000 --- a/src/.emacs.d/load/wtk_epa.el +++ /dev/null @@ -1,6 +0,0 @@ -; Setup bundled EasyPG (encryption with gpg) -; from minor emacs wizardry -; http://emacs.wordpress.com/2008/07/18/keeping-your-secrets-secret/ -(require 'epa) -;(epa-file-enable) -; end EasyPG diff --git a/src/.emacs.d/load/wtk_layout.el b/src/.emacs.d/load/wtk_layout.el deleted file mode 100644 index 04bdb20..0000000 --- a/src/.emacs.d/load/wtk_layout.el +++ /dev/null @@ -1,2 +0,0 @@ -(setq fill-column 78) ;; set M-q wrapping just under the std terminal width -(setq default-tab-width 2) diff --git a/src/.emacs.d/load/wtk_no-vc.el b/src/.emacs.d/load/wtk_no-vc.el deleted file mode 100644 index c3c64bf..0000000 --- a/src/.emacs.d/load/wtk_no-vc.el +++ /dev/null @@ -1,3 +0,0 @@ -; Turn off VC -; http://www.gnu.org/software/emacs/manual/html_node/emacs/Version-Control.html -(setq vc-handled-backends 'nil) diff --git a/src/.emacs.d/load/wtk_org.el b/src/.emacs.d/load/wtk_org.el deleted file mode 100644 index b124416..0000000 --- a/src/.emacs.d/load/wtk_org.el +++ /dev/null @@ -1,16 +0,0 @@ -; setup org-mode -; http://orgmode.org/manual/Activation.html -; The following lines are always needed. Choose your own keys. -(add-to-list 'auto-mode-alist '("\\.org\\'" . org-mode)) -(global-set-key "\C-cl" 'org-store-link) -(global-set-key "\C-ca" 'org-agenda) -(global-set-key "\C-cb" 'org-iswitchb) - -(setq browse-url-browser-function 'browse-url-firefox) ; loki hack - -(defun org-time-stamp-now () - "Insert the current timestamp in org-mode, without recourse to the calendar." - (interactive) - (org-insert-time-stamp (current-time) 'with-hm 'inactive)) -(global-set-key "\C-cn" 'org-time-stamp-now) -; end org-mode diff --git a/src/.emacs.d/load/wtk_utf-8.el b/src/.emacs.d/load/wtk_utf-8.el deleted file mode 100644 index 4cb7e77..0000000 --- a/src/.emacs.d/load/wtk_utf-8.el +++ /dev/null @@ -1,3 +0,0 @@ -;;; Set up keyboard encoding for utf-8 (Emacs 21.4.1 trouble parsing LANG?) -;; http://www.gnu.org/software/emacs/manual/html_node/emacs/Terminal-Coding.html#Terminal-Coding -(set-keyboard-coding-system 'utf-8) diff --git a/src/.fluxbox/keys b/src/.fluxbox/keys deleted file mode 100644 index 76f387c..0000000 --- a/src/.fluxbox/keys +++ /dev/null @@ -1,168 +0,0 @@ -# begin /usr/share/fluxbox/keys from Gentoo's x11-wm/fluxbox-1.3.1 package - -# click on the desktop to get menus -OnDesktop Mouse1 :HideMenus -OnDesktop Mouse2 :WorkspaceMenu -OnDesktop Mouse3 :RootMenu - -# scroll on the desktop to change workspaces -OnDesktop Mouse4 :PrevWorkspace -OnDesktop Mouse5 :NextWorkspace - -# scroll on the toolbar to change current window -OnToolbar Mouse4 :PrevWindow {static groups} (iconhidden=no) -OnToolbar Mouse5 :NextWindow {static groups} (iconhidden=no) - -# alt + left/right click to move/resize a window -OnWindow Mod1 Mouse1 :MacroCmd {Raise} {Focus} {StartMoving} -OnWindowBorder Move1 :StartMoving - -OnWindow Mod1 Mouse3 :MacroCmd {Raise} {Focus} {StartResizing NearestCorner} -OnLeftGrip Move1 :StartResizing bottomleft -OnRightGrip Move1 :StartResizing bottomright - -# alt + middle click to lower the window -OnWindow Mod1 Mouse2 :Lower - -# control-click a window's titlebar and drag to attach windows -OnTitlebar Control Mouse1 :StartTabbing - -# double click on the titlebar to shade -OnTitlebar Double Mouse1 :Shade - -# left click on the titlebar to move the window -OnTitlebar Mouse1 :MacroCmd {Raise} {Focus} {ActivateTab} -OnTitlebar Move1 :StartMoving - -# middle click on the titlebar to lower -OnTitlebar Mouse2 :Lower - -# right click on the titlebar for a menu of options -OnTitlebar Mouse3 :WindowMenu - -# alt-tab -Mod1 Tab :NextWindow {groups} (workspace=[current]) -Mod1 Shift Tab :PrevWindow {groups} (workspace=[current]) - -# cycle through tabs in the current window -Mod4 Tab :NextTab -Mod4 Shift Tab :PrevTab - -# go to a specific tab in the current window -Mod4 1 :Tab 1 -Mod4 2 :Tab 2 -Mod4 3 :Tab 3 -Mod4 4 :Tab 4 -Mod4 5 :Tab 5 -Mod4 6 :Tab 6 -Mod4 7 :Tab 7 -Mod4 8 :Tab 8 -Mod4 9 :Tab 9 - -# open a terminal -Mod1 F1 :Exec xterm - -# open a dialog to run programs -Mod1 F2 :Exec fbrun - -# volume settings, using common keycodes -# if these don't work, use xev to find out your real keycodes -176 :Exec amixer sset Master,0 1+ -174 :Exec amixer sset Master,0 1- -160 :Exec amixer sset Master,0 toggle - -# current window commands -Mod1 F4 :Close -Mod1 F5 :Kill -Mod1 F9 :Minimize -Mod1 F10 :Maximize -Mod1 F11 :Fullscreen - -# open the window menu -Mod1 space :WindowMenu - -# exit fluxbox -Control Mod1 Delete :Exit - -# change to previous/next workspace -Control Mod1 Left :PrevWorkspace -Control Mod1 Right :NextWorkspace - -# send the current window to previous/next workspace -Mod4 Left :SendToPrevWorkspace -Mod4 Right :SendToNextWorkspace - -# send the current window and follow it to previous/next workspace -Control Mod4 Left :TakeToPrevWorkspace -Control Mod4 Right :TakeToNextWorkspace - -# change to a specific workspace -Control F1 :Workspace 1 -Control F2 :Workspace 2 -Control F3 :Workspace 3 -Control F4 :Workspace 4 -Control F5 :Workspace 5 -Control F6 :Workspace 6 -Control F7 :Workspace 7 -Control F8 :Workspace 8 -Control F9 :Workspace 9 -Control F10 :Workspace 10 -Control F11 :Workspace 11 -Control F12 :Workspace 12 - -# send the current window to a specific workspace -Mod4 F1 :SendToWorkspace 1 -Mod4 F2 :SendToWorkspace 2 -Mod4 F3 :SendToWorkspace 3 -Mod4 F4 :SendToWorkspace 4 -Mod4 F5 :SendToWorkspace 5 -Mod4 F6 :SendToWorkspace 6 -Mod4 F7 :SendToWorkspace 7 -Mod4 F8 :SendToWorkspace 8 -Mod4 F9 :SendToWorkspace 9 -Mod4 F10 :SendToWorkspace 10 -Mod4 F11 :SendToWorkspace 11 -Mod4 F12 :SendToWorkspace 12 - -# send the current window and change to a specific workspace -Control Mod4 F1 :TakeToWorkspace 1 -Control Mod4 F2 :TakeToWorkspace 2 -Control Mod4 F3 :TakeToWorkspace 3 -Control Mod4 F4 :TakeToWorkspace 4 -Control Mod4 F5 :TakeToWorkspace 5 -Control Mod4 F6 :TakeToWorkspace 6 -Control Mod4 F7 :TakeToWorkspace 7 -Control Mod4 F8 :TakeToWorkspace 8 -Control Mod4 F9 :TakeToWorkspace 9 -Control Mod4 F10 :TakeToWorkspace 10 -Control Mod4 F11 :TakeToWorkspace 11 -Control Mod4 F12 :TakeToWorkspace 12 - -# end /usr/share/fluxbox/keys - -# my local additions -# -# Fluxbox Standard keyboard -# Mod1 Alt -# Mod4 Windows key -# Control Ctrl -# Shift Shift - -Mod1 t :ExecCommand xterm -fg white -bg black -fa mono-medium -Mod1 f :ExecCommand firefox -Mod1 l :ExecCommand xlock -mode blank - -Mod1 i :Move 0 -10 -Mod1 k :Move 0 10 -Mod1 j :Move -10 0 -Mod1 l :Move 10 0 -Mod4 i :Resize 0 -10 -Mod4 k :Resize 0 10 -Mod4 j :Resize -10 0 -Mod4 l :Resize 10 0 - -Mod1 m :Maximize -Mod4 m :Close -Mod1 c :ToggleCmd {Exec conky} {pkill conky} - -Control Mod1 r :Reconfigure diff --git a/src/.gitconfig b/src/.gitconfig deleted file mode 100644 index 533cfe5..0000000 --- a/src/.gitconfig +++ /dev/null @@ -1,6 +0,0 @@ -# .gitconfig a Git configuration file - -[user] - name = W. Trevor King - email = wking@drexel.edu - signingkey = 0xFC29BDCDF15F5BE8 diff --git a/src/.gnuplot b/src/.gnuplot deleted file mode 100644 index 6d1d01a..0000000 --- a/src/.gnuplot +++ /dev/null @@ -1,3 +0,0 @@ -# .gnuplot a Gnuplot configuration file - -set terminal x11 diff --git a/src/.hgrc b/src/.hgrc deleted file mode 100644 index e57b39d..0000000 --- a/src/.hgrc +++ /dev/null @@ -1,12 +0,0 @@ -# .hgrc a Mercurial configuration file -[ui] -username = W. Trevor King - -[extensions] -hgext.churn = -hgext.convert = -hgext.graphlog = -hgext.purge = -mq = -rebase = -transplant = diff --git a/src/.mailcap b/src/.mailcap deleted file mode 100644 index 8a40ce3..0000000 --- a/src/.mailcap +++ /dev/null @@ -1,10 +0,0 @@ -image/*; qiv %s; test=test -n "$DISPLAY" -image/*; fbi -a %s; test=test "$TERM" == "linux"; needsterminal -audio/*; mplayer %s; -text/html; /usr/bin/firefox %s; test=test -n "$DISPLAY"; description=HTML Text; nametemplate %s.html -text/html; w3m -T text/html %s -#text/html; w3m -T text/html %s; description=HTML Text; nametemplate %s.html -#application/pdf; /usr/bin/xpdf %s; test=test -n "$DISPLAY"; description=Portable Document Format; nametemplate=%s.pdf -application/pdf; /usr/bin/evince %s; test=test -n "$DISPLAY"; description=Portable Document Format; nametemplate=%s.pdf -application/pdf; /usr/bin/fbgs %s; test=test "$TERM" == "linux"; description=Portable Document Format; nametemplate=%s.pdf; needsterminal -application/msword; /usr/bin/ooffice %s; test=test "$DISPLAY" != ""; description=MS Word Document Format; nametemplate=%s.doc diff --git a/src/.screenrc b/src/.screenrc deleted file mode 100644 index 83d8b29..0000000 --- a/src/.screenrc +++ /dev/null @@ -1,34 +0,0 @@ -# .screenrc startup file for GNU Screen -# -# note, -# screen -x -# will attatch you to a screen without detaching other clients, creating a -# multi-user session. You can detach a single client from this session like -# you normally would with '^a d'. However, if you ran 'screen -x ...' *from* -# another screen, the '^a d' will detach your *original* screen. You can pass -# escaped commands on to deeper levels of screens with '^a a', which sends an -# '^a' to the process running inside your top level screen. So '^a a d' will -# detach you from the multi-user screen running inside your base screen :p. -# -# there is a nice introduction by Chris Lumens, at -# http://www.bangmoney.org/presentations/screen.html - - -# don't show the startup splash screen -startup_message off - -# we're not graphical -unsetenv DISPLAY - -# automatically detach on hangup. -autodetach on - -# These keybindings always annoy me (and Steve :p): xon/xoff. -# Remove them. -bind ^Q -bind q -bind ^S -bind s - -# If a window goes unresponsive, don't block the whole session waiting for it. -nonblock on diff --git a/src/.signature b/src/.signature deleted file mode 100644 index 2b665b2..0000000 --- a/src/.signature +++ /dev/null @@ -1,2 +0,0 @@ -This email may be signed or encrypted with GnuPG (http://www.gnupg.org). -For more information, see http://en.wikipedia.org/wiki/Pretty_Good_Privacy diff --git a/src/.xinitrc b/src/.xinitrc deleted file mode 100644 index 9e5775a..0000000 --- a/src/.xinitrc +++ /dev/null @@ -1,20 +0,0 @@ -#!/bin/sh -# -# .xinitrc, a startup file for X - -if [ -n $(which conky) ]; then - conky & -fi - -# Setup ACPI on my ASUS EEPC -if [ -e /usr/bin/asus_acpid ]; then - ASUS_ACPID=$(ps -u $(whoami) | grep asus_acpid) - if [ "$ASUS_ACPID" == "" ]; then - /usr/bin/asus_acpid --logfile /tmp/asus_acpid.log & - fi -fi - -# Set up keybindings -xmodmap ~/.Xmodmap - -exec startfluxbox -- 2.26.2