Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Misc changes

  • Loading branch information...
commit 61e89969738624b94a4234a656e3279142761e2b 1 parent c88df7d
John Wiegley authored
16 gnus-settings.el
@@ -13,11 +13,13 @@
13 13 '(gnus-agent-mark-unread-after-downloaded nil)
14 14 '(gnus-agent-synchronize-flags t)
15 15 '(gnus-alias-default-identity "Gmail")
16   - '(gnus-alias-identity-alist (quote (("Gmail" "" "\"John Wiegley\" <jwiegley@gmail.com>" "" nil "" "") ("BoostPro" "" "\"John Wiegley\" <johnw@boostpro.com>" "BoostPro Computing" nil "" "John Wiegley
  16 + '(gnus-alias-identity-alist (quote (("Gmail" "" "\"John Wiegley\" <jwiegley@gmail.com>" "" nil "" "") ("FPComplete" "" "\"John Wiegley\" <johnw@fpcomplete.com>" "FP Complete Corp." nil "" "John Wiegley
  17 +FP Complete Haskell tools, training and consulting
  18 +http://fpcomplete.com johnw on #haskell/irc.freenode.net") ("BoostPro" "" "\"John Wiegley\" <johnw@boostpro.com>" "BoostPro Computing" nil "" "John Wiegley
17 19 BoostPro Computing Software Development Training
18 20 http://www.boostpro.com Clang/LLVM/EDG Compilers C++ Boost") ("NewArtisans" "" "\"John Wiegley\" <johnw@newartisans.com>" "New Artisans LLC" nil "" "") ("Assembly" "" "\"John Wiegley\" <jwiegley@gmail.com>" "Spiritual Assembly of the Bahá'ís of Peoria" nil "" "Spiritual Assembly of the Bahá'ís of Peoria
19 21 John Wiegley, Chairperson"))))
20   - '(gnus-alias-identity-rules (quote (("Ledger Mailing List" ("To" "ledger-cli@googlegroups\\.com" current) "NewArtisans") ("Emacs Mailing Lists" ("To" "emacs" current) "NewArtisans") ("Emacs Newsgroups" ("Newsgroups" "emacs" current) "NewArtisans") ("BoostPro Mail" ("From" "@boostpro\\.com" current) "BoostPro") ("BoostPro Clients" ("To" "@\\(ti\\)\\.com" current) "BoostPro") ("BoostPro Clients (Copied)" ("Cc" "@\\(ti\\)\\.com" current) "BoostPro") ("C++, LLVM, Boost, and Clang Groups" ("Newsgroups" "\\(c\\+\\+\\|clang\\|llvm\\|[Bb]oost\\|[Rr]yppl\\)" current) "BoostPro") ("C++, LLVM, Boost, and Clang Mailing Lists" ("To" "\\(c\\+\\+\\|clang\\|llvm\\|[Bb]oost\\|[Rr]yppl\\|llvm\\|cfe\\)" current) "BoostPro"))))
  22 + '(gnus-alias-identity-rules (quote (("Ledger Mailing List" ("To" "ledger-cli@googlegroups\\.com" current) "NewArtisans") ("Emacs Mailing Lists" ("To" "emacs" current) "NewArtisans") ("Emacs Newsgroups" ("Newsgroups" "emacs" current) "NewArtisans") ("FP Complete Mail" ("From" "@fpcomplete\\.com" current) "FPComplete") ("FP Complete Clients" ("To" "@someone\\.com" current) "FPComplete") ("FP Complete Clients (copied)" ("Cc" "@someone\\.com" current) "FPComplete") ("Haskell Groups" ("Newsgroups" "\\(haskell\\|ghc\\)" current) "FPComplete") ("Haskell Mailing Lists" ("To" "\\(haskell\\|ghc\\)" current) "FPComplete") ("BoostPro Mail" ("From" "@boostpro\\.com" current) "BoostPro") ("BoostPro Clients" ("To" "@\\(ti\\)\\.com" current) "BoostPro") ("BoostPro Clients (Copied)" ("Cc" "@\\(ti\\)\\.com" current) "BoostPro") ("C++, LLVM, Boost, and Clang Groups" ("Newsgroups" "\\(c\\+\\+\\|clang\\|llvm\\|[Bb]oost\\|[Rr]yppl\\)" current) "BoostPro") ("C++, LLVM, Boost, and Clang Mailing Lists" ("To" "\\(c\\+\\+\\|clang\\|llvm\\|[Bb]oost\\|[Rr]yppl\\|llvm\\|cfe\\)" current) "BoostPro"))))
21 23 '(gnus-alias-override-user-mail-address t)
22 24 '(gnus-alias-unknown-identity-rule (quote error))
23 25 '(gnus-always-read-dribble-file t)
@@ -35,20 +37,20 @@ John Wiegley, Chairperson"))))
35 37 ")
36 38 '(gnus-group-mode-hook (quote (gnus-topic-mode gnus-agent-mode hl-line-mode)))
37 39 '(gnus-group-use-permanent-levels t)
38   - '(gnus-harvest-sender-alist (quote ((".*@\\(boostpro\\|boost-consulting\\|ti\\)\\.com" . johnw@boostpro\.com) (".*@gnu\\.org" . johnw@gnu\.org))))
  40 + '(gnus-harvest-sender-alist (quote ((".*@fpcomplete\\.com" . johnw@fpcomplete\.com) (".*@\\(boostpro\\|boost-consulting\\|ti\\)\\.com" . johnw@boostpro\.com) (".*@gnu\\.org" . johnw@gnu\.org))))
39 41 '(gnus-home-directory "~/Messages/Gnus/")
40   - '(gnus-ignored-from-addresses "\\(johnw\\|jwiegley\\)\\(-[^@]+\\)?@\\(gnu\\.org\\|\\(forumjobs\\|3dex\\|gmail\\|hotmail\\|newartisans\\|boostpro\\)\\.com\\|public\\.gmane\\.org\\)")
  42 + '(gnus-ignored-from-addresses "\\(johnw\\|jwiegley\\)\\(-[^@]+\\)?@\\(gnu\\.org\\|\\(forumjobs\\|3dex\\|gmail\\|hotmail\\|newartisans\\|fpcomplete\\|boostpro\\)\\.com\\|public\\.gmane\\.org\\)")
41 43 '(gnus-ignored-mime-types (quote ("application/x-pkcs7-signature" "application/ms-tnef" "text/x-vcard")))
42 44 '(gnus-interactive-exit (quote quiet))
43 45 '(gnus-large-newsgroup 4000)
44   - '(gnus-local-domain "boostpro.com")
  46 + '(gnus-local-domain "fpcomplete.com")
45 47 '(gnus-mailing-list-groups "\\`\\(list\\|wg21\\)\\.")
46 48 '(gnus-mark-unpicked-articles-as-read t)
47 49 '(gnus-message-archive-group (quote ((format-time-string "sent.%Y"))))
48 50 '(gnus-message-replyencrypt nil)
49 51 '(gnus-novice-user nil)
50 52 '(gnus-parameters (quote (("list\\.haskell\\.ghc" (to-address . "glasgow-haskell-users@haskell.org") (to-list . "glasgow-haskell-users@haskell.org") (list-identifier . "\\[Haskell\\]") (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "glasgow-haskell-users@haskell.org") (header :contains "list-id" "<glasgow-haskell-users.haskell.org>")))) ("\\`gmane\\." (spam-process gnus-group-spam-exit-processor-report-gmane)) ("mail\\.spam" (total-expire . t) (expiry-wait . 28) (expiry-target . delete) (gnus-article-sort-functions gnus-article-sort-by-chars) (ham-process-destination . "INBOX") (spam-contents gnus-group-spam-classification-spam) (spam-process ((spam spam-use-spamassassin) (ham spam-use-spamassassin)))) ("list\\." (subscribed . t) (gcc-self . t)) ("list\\.wg21\\.\\(.*\\)" (to-address . "c++std-\\1@accu.org") (to-list . "c++std-\\1@accu.org") (gcc-self . t) (gnus-list-identifiers "\\[c\\+\\+std-.+?\\]") (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "c++std-\\1@accu.org") (header :contains "list-id" "<c++std-\\1.accu.org>")))) ("INBOX" (total-expire . t) (expiry-wait . 14) (expiry-target . "mail.archive") (spam-process-destination . "mail.spam") (spam-contents gnus-group-spam-classification-ham) (spam-process ((spam spam-use-spamassassin) (ham spam-use-spamassassin)))) ("\\(mail\\.\\|INBOX\\)" (gnus-use-scoring nil)) ("mail\\.archive" (gnus-summary-line-format "%«%U%R %uS %ur %»%(%*%-14,14f %4u&size; %1«%B%s%»%)
51   -")) ("list\\.ledger\\.devel" (to-address . "ledger-cli@googlegroups.com") (to-list . "ledger-cli@googlegroups.com") (gcc-self . t) (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "ledger-cli@googlegroups.com") (header :contains "list-id" "<ledger-cli.googlegroups.com>")))) ("list\\.bahai\\.tarjuman" (to-address . "TARJUMAN-LIST@listserv.buffalo.edu") (to-list . "TARJUMAN-LIST@listserv.buffalo.edu") (sieve header :contains ("To" "From" "Cc" "Sender") "TARJUMAN-LIST@LISTSERV.BUFFALO.EDU")) ("list\\.emacs\\.devel" (to-address . "emacs-devel@gnu.org") (to-list . "emacs-devel@gnu.org") (total-expire . t) (expiry-wait . 90) (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "emacs-devel@gnu.org") (header :contains "list-id" "<emacs-devel.gnu.org>")))) ("list\\.emacs\\.help" (to-address . "help-gnu-emacs@gnu.org") (to-list . "help-gnu-emacs@gnu.org") (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "help-gnu-emacs@gnu.org") (header :contains "list-id" "<help-gnu-emacs.gnu.org>")))) ("list\\.emacs\\.bugs" (to-list . "bug-gnu-emacs@gnu.org") (sieve anyof ((header :matches ("To" "From" "Cc" "Sender") "*@debbugs.gnu.org") (header :contains ("To" "From" "Cc" "Sender") "bug-gnu-emacs@gnu.org") (header :contains "list-id" "<bug-gnu-emacs.gnu.org>")))) ("list\\.emacs\\.diffs" (to-address . "emacs-diffs@gnu.org") (to-list . "emacs-diffs@gnu.org") (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "emacs-diffs@gnu.org") (header :contains "list-id" "<emacs-diffs.gnu.org>")))) ("list\\.emacs\\.elpa\\.diffs" (to-address . "emacs-elpa-diffs@gnu.org") (to-list . "emacs-diffs@gnu.org") (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "emacs-elpa-diffs@gnu.org") (header :contains "list-id" "<emacs-elpa-diffs.gnu.org>")))) ("list\\.emacs\\.buildstatus" (to-address . "emacs-buildstatus@gnu.org") (to-list . "emacs-buildstatus@gnu.org") (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "emacs-buildstatus@gnu.org") (header :contains "list-id" "<emacs-buildstatus.gnu.org>")))) ("list\\.emacs\\.sources" (to-address . "gnu-emacs-sources@gnu.org") (to-list . "gnu-emacs-sources@gnu.org") (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "gnu-emacs-sources@gnu.org") (header :contains "list-id" "<gnu-emacs-sources.gnu.org>")))) ("list\\.emacs\\.orgmode" (to-address . "emacs-orgmode@gnu.org") (to-list . "emacs-orgmode@gnu.org") (list-identifier . "\\[O\\]") (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "emacs-orgmode@gnu.org") (header :contains "list-id" "<emacs-orgmode.gnu.org>")))) ("list\\.emacs\\.diffs" (list-identifier . "\\[Emacs-diffs\\] /srv/bzr/emacs/")) ("list\\.boost\\.cppnow" (to-address . "boostcon-plan@googlegroups.com") (to-list . "boostcon-plan@googlegroups.com") (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "boostcon-plan@googlegroups.com") (header :contains "list-id" "<boostcon-plan.googlegroups.com>")))) ("list\\.boost\\.ryppl" (to-address . "ryppl-dev@googlegroups.com") (to-list . "ryppl-dev@googlegroups.com") (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "ryppl-dev@googlegroups.com") (header :contains "list-id" "<ryppl-dev.googlegroups.com>")))) ("list\\.boost\\.devel" (to-address . "boost@lists.boost.org") (to-list . "boost@lists.boost.org") (list-identifier . "\\[boost\\]") (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "boost@lists.boost.org") (header :contains "list-id" "<boost.lists.boost.org>")))) ("list\\.boost\\.\\(users\\|announce\\)" (to-address . "boost-\\1@lists.boost.org") (to-list . "boost-\\1@lists.boost.org") (list-identifier . "\\\\[Boost-\\1\\\\]") (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "boost-\\1@lists.boost.org") (header :contains "list-id" "<boost-\\1.lists.boost.org>")))) ("list\\.isocpp\\.\\(proposals\\|discussion\\)" (to-address . "std-\\1@isocpp.org") (to-list . "std-\\1@isocpp.org") (list-identifier . "\\\\[\\\\(lang\\\\|lib\\\\|std\\\\)-\\1\\\\]") (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "std-\\1@isocpp.org") (header :contains "list-id" "<std-\\1.isocpp.org>")))) ("list\\.clang\\.devel" (to-address . "cfe-dev@cs.uiuc.edu") (to-list . "cfe-dev@cs.uiuc.edu") (list-identifier . "\\[\\(cfe-dev\\|LLVMdev\\)\\]") (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "cfe-dev@cs.uiuc.edu") (header :contains "list-id" "<cfe-dev.cs.uiuc.edu>")))) ("list\\.llvm\\.devel" (to-address . "llvmdev@cs.uiuc.edu") (to-list . "llvmdev@cs.uiuc.edu") (list-identifier . "\\[\\(cfe-dev\\|LLVMdev\\)]") (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "llvmdev@cs.uiuc.edu") (header :contains "list-id" "<llvmdev.cs.uiuc.edu>")))) ("list\\.nix\\.devel" (to-address . "nix-dev@lists.science.uu.nl") (to-list . "nix-dev@lists.science.uu.nl") (list-identifier . "\\[Nix-dev\\]") (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "nix-dev@lists.science.uu.nl") (header :contains "list-id" "<nix-dev.lists.science.uu.nl>")))) ("list\\.haskell\\.cafe" (to-address . "haskell-cafe@haskell.org") (to-list . "haskell-cafe@haskell.org") (list-identifier . "\\[Haskell-cafe\\]") (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "haskell-cafe@haskell.org") (header :contains "list-id" "<haskell-cafe.haskell.org>")))) ("list\\.haskell\\.beginners" (to-address . "beginners@haskell.org") (to-list . "beginners@haskell.org") (list-identifier . "\\[Haskell-beginners\\]") (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "beginners@haskell.org") (header :contains "list-id" "<beginners.haskell.org>")))) ("list\\.haskell\\.infrastructure" (to-address . "haskell-infrastructure@community.galois.com") (to-list . "haskell-infrastructure@community.galois.com") (list-identifier . "\\[Haskell-infrastructure\\]") (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "haskell-infrastructure@community.galois.com") (header :contains "list-id" "<haskell-infrastructure.community.galois.com>")))) ("list\\.haskell\\.announce" (to-address . "haskell@haskell.org") (to-list . "haskell@haskell.org") (list-identifier . "\\[Haskell\\]") (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "haskell@haskell.org") (header :contains "list-id" "<haskell.haskell.org>")))) ("list\\.haskell\\.cabal" (to-address . "cabal-devel@haskell.org") (to-list . "cabal-devel@haskell.org") (list-identifier . "\\[Haskell\\]") (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "cabal-devel@haskell.org") (header :contains "list-id" "<cabal-devel.haskell.org>")))))))
  53 +")) ("list\\.ledger\\.devel" (to-address . "ledger-cli@googlegroups.com") (to-list . "ledger-cli@googlegroups.com") (gcc-self . t) (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "ledger-cli@googlegroups.com") (header :contains "list-id" "<ledger-cli.googlegroups.com>")))) ("list\\.bahai\\.tarjuman" (to-address . "TARJUMAN-LIST@listserv.buffalo.edu") (to-list . "TARJUMAN-LIST@listserv.buffalo.edu") (sieve header :contains ("To" "From" "Cc" "Sender") "TARJUMAN-LIST@LISTSERV.BUFFALO.EDU")) ("list\\.emacs\\.devel" (to-address . "emacs-devel@gnu.org") (to-list . "emacs-devel@gnu.org") (total-expire . t) (expiry-wait . 90) (expiry-target . "archive.emacs.devel") (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "emacs-devel@gnu.org") (header :contains "list-id" "<emacs-devel.gnu.org>")))) ("list\\.emacs\\.help" (to-address . "help-gnu-emacs@gnu.org") (to-list . "help-gnu-emacs@gnu.org") (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "help-gnu-emacs@gnu.org") (header :contains "list-id" "<help-gnu-emacs.gnu.org>")))) ("list\\.emacs\\.bugs" (to-list . "bug-gnu-emacs@gnu.org") (sieve anyof ((header :matches ("To" "From" "Cc" "Sender") "*@debbugs.gnu.org") (header :contains ("To" "From" "Cc" "Sender") "bug-gnu-emacs@gnu.org") (header :contains "list-id" "<bug-gnu-emacs.gnu.org>")))) ("list\\.emacs\\.diffs" (to-address . "emacs-diffs@gnu.org") (to-list . "emacs-diffs@gnu.org") (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "emacs-diffs@gnu.org") (header :contains "list-id" "<emacs-diffs.gnu.org>")))) ("list\\.emacs\\.elpa\\.diffs" (to-address . "emacs-elpa-diffs@gnu.org") (to-list . "emacs-diffs@gnu.org") (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "emacs-elpa-diffs@gnu.org") (header :contains "list-id" "<emacs-elpa-diffs.gnu.org>")))) ("list\\.emacs\\.buildstatus" (to-address . "emacs-buildstatus@gnu.org") (to-list . "emacs-buildstatus@gnu.org") (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "emacs-buildstatus@gnu.org") (header :contains "list-id" "<emacs-buildstatus.gnu.org>")))) ("list\\.emacs\\.sources" (to-address . "gnu-emacs-sources@gnu.org") (to-list . "gnu-emacs-sources@gnu.org") (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "gnu-emacs-sources@gnu.org") (header :contains "list-id" "<gnu-emacs-sources.gnu.org>")))) ("list\\.emacs\\.orgmode" (to-address . "emacs-orgmode@gnu.org") (to-list . "emacs-orgmode@gnu.org") (list-identifier . "\\[O\\]") (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "emacs-orgmode@gnu.org") (header :contains "list-id" "<emacs-orgmode.gnu.org>")))) ("list\\.emacs\\.diffs" (list-identifier . "\\[Emacs-diffs\\] /srv/bzr/emacs/")) ("list\\.boost\\.cppnow" (to-address . "boostcon-plan@googlegroups.com") (to-list . "boostcon-plan@googlegroups.com") (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "boostcon-plan@googlegroups.com") (header :contains "list-id" "<boostcon-plan.googlegroups.com>")))) ("list\\.boost\\.ryppl" (to-address . "ryppl-dev@googlegroups.com") (to-list . "ryppl-dev@googlegroups.com") (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "ryppl-dev@googlegroups.com") (header :contains "list-id" "<ryppl-dev.googlegroups.com>")))) ("list\\.boost\\.devel" (to-address . "boost@lists.boost.org") (to-list . "boost@lists.boost.org") (list-identifier . "\\[boost\\]") (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "boost@lists.boost.org") (header :contains "list-id" "<boost.lists.boost.org>")))) ("list\\.boost\\.\\(users\\|announce\\)" (to-address . "boost-\\1@lists.boost.org") (to-list . "boost-\\1@lists.boost.org") (list-identifier . "\\\\[Boost-\\1\\\\]") (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "boost-\\1@lists.boost.org") (header :contains "list-id" "<boost-\\1.lists.boost.org>")))) ("list\\.isocpp\\.\\(proposals\\|discussion\\)" (to-address . "std-\\1@isocpp.org") (to-list . "std-\\1@isocpp.org") (list-identifier . "\\\\[\\\\(lang\\\\|lib\\\\|std\\\\)-\\1\\\\]") (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "std-\\1@isocpp.org") (header :contains "list-id" "<std-\\1.isocpp.org>")))) ("list\\.clang\\.devel" (to-address . "cfe-dev@cs.uiuc.edu") (to-list . "cfe-dev@cs.uiuc.edu") (list-identifier . "\\[\\(cfe-dev\\|LLVMdev\\)\\]") (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "cfe-dev@cs.uiuc.edu") (header :contains "list-id" "<cfe-dev.cs.uiuc.edu>")))) ("list\\.llvm\\.devel" (to-address . "llvmdev@cs.uiuc.edu") (to-list . "llvmdev@cs.uiuc.edu") (list-identifier . "\\[\\(cfe-dev\\|LLVMdev\\)]") (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "llvmdev@cs.uiuc.edu") (header :contains "list-id" "<llvmdev.cs.uiuc.edu>")))) ("list\\.nix\\.devel" (to-address . "nix-dev@lists.science.uu.nl") (to-list . "nix-dev@lists.science.uu.nl") (list-identifier . "\\[Nix-dev\\]") (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "nix-dev@lists.science.uu.nl") (header :contains "list-id" "<nix-dev.lists.science.uu.nl>")))) ("list\\.haskell\\.cafe" (to-address . "haskell-cafe@haskell.org") (to-list . "haskell-cafe@haskell.org") (total-expire . t) (expiry-wait . 90) (expiry-target . "archive.haskell.cafe") (list-identifier . "\\[Haskell-cafe\\]") (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "haskell-cafe@haskell.org") (header :contains "list-id" "<haskell-cafe.haskell.org>")))) ("list\\.haskell\\.libraries" (to-address . "libraries@haskell.org") (to-list . "libraries@haskell.org") (total-expire . t) (expiry-wait . 90) (expiry-target . "archive.haskell.libraries") (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "libraries@haskell.org") (header :contains "list-id" "<libraries.haskell.org>")))) ("list\\.haskell\\.prime" (to-address . "haskell-prime@haskell.org") (to-list . "haskell-prime@haskell.org") (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "haskell-prime@haskell.org") (header :contains "list-id" "<haskell-prime.haskell.org>")))) ("list\\.haskell\\.template-haskell" (to-address . "template-haskell@haskell.org") (to-list . "template-haskell@haskell.org") (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "template-haskell@haskell.org") (header :contains "list-id" "<template-haskell.haskell.org>")))) ("list\\.haskell\\.beginners" (to-address . "beginners@haskell.org") (to-list . "beginners@haskell.org") (list-identifier . "\\[Haskell-beginners\\]") (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "beginners@haskell.org") (header :contains "list-id" "<beginners.haskell.org>")))) ("list\\.haskell\\.infrastructure" (to-address . "haskell-infrastructure@community.galois.com") (to-list . "haskell-infrastructure@community.galois.com") (list-identifier . "\\[Haskell-infrastructure\\]") (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "haskell-infrastructure@community.galois.com") (header :contains "list-id" "<haskell-infrastructure.community.galois.com>")))) ("list\\.haskell\\.announce" (to-address . "haskell@haskell.org") (to-list . "haskell@haskell.org") (list-identifier . "\\[Haskell\\]") (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "haskell@haskell.org") (header :contains "list-id" "<haskell.haskell.org>")))) ("list\\.haskell\\.cabal" (to-address . "cabal-devel@haskell.org") (to-list . "cabal-devel@haskell.org") (list-identifier . "\\[Haskell\\]") (sieve anyof ((header :contains ("To" "From" "Cc" "Sender") "cabal-devel@haskell.org") (header :contains "list-id" "<cabal-devel.haskell.org>")))))))
52 54 '(gnus-permanently-visible-groups "INBOX")
53 55 '(gnus-read-active-file nil)
54 56 '(gnus-read-newsrc-file nil)
@@ -106,7 +108,7 @@ John Wiegley, Chairperson"))))
106 108 '(mail-sources (quote ((file :path "/var/mail/johnw"))))
107 109 '(mail-specify-envelope-from t)
108 110 '(mail-user-agent (quote gnus-user-agent))
109   - '(message-alternative-emails "\\(johnw?\\|jwiegley\\)@\\(gmail\\|newartisans\\|boostpro\\).com")
  111 + '(message-alternative-emails "\\(johnw?\\|jwiegley\\)@\\(gmail\\|newartisans\\|fpcomplete\\|boostpro\\).com")
110 112 '(message-directory "~/Messages/Gnus/Mail/")
111 113 '(message-fill-column 78)
112 114 '(message-interactive t)
62 init.el
@@ -1067,6 +1067,13 @@
1067 1067 (use-package ace-jump-mode
1068 1068 :bind ("C-. C-s" . ace-jump-mode))
1069 1069
  1070 +;;;_ , agda
  1071 +
  1072 +(use-package agda2-mode
  1073 + :mode ("\\.agda\\'" . agda2-mode)
  1074 + :init
  1075 + (use-package agda-input))
  1076 +
1070 1077 ;;;_ , allout
1071 1078
1072 1079 (use-package allout
@@ -1093,10 +1100,6 @@
1093 1100
1094 1101 (add-hook 'allout-mode-hook 'my-allout-mode-hook)))
1095 1102
1096   -;;;_ , apl-ascii
1097   -
1098   -(use-package apl)
1099   -
1100 1103 ;;;_ , archive-region
1101 1104
1102 1105 (use-package archive-region
@@ -1161,13 +1164,18 @@
1161 1164 "site-lisp/ac/ac-yasnippet"
1162 1165 "site-lisp/ac/fuzzy-el"
1163 1166 "site-lisp/ac/popup-el")
1164   - :commands auto-complete-mode
1165 1167 :diminish auto-complete-mode
  1168 + :init
  1169 + (progn
  1170 + (use-package pos-tip)
  1171 + (ac-config-default))
  1172 +
1166 1173 :config
1167 1174 (progn
1168 1175 (ac-set-trigger-key "TAB")
1169 1176 (setq ac-use-menu-map t)
1170 1177
  1178 + (bind-key "A-M-?" 'ac-last-help)
1171 1179 (unbind-key "C-s" ac-completing-map)))
1172 1180
1173 1181 ;;;_ , autopair
@@ -1409,6 +1417,15 @@
1409 1417 (use-package copy-code
1410 1418 :bind ("A-M-W" . copy-code-as-rtf))
1411 1419
  1420 +;;;_ , coq
  1421 +
  1422 +(if nil
  1423 + (use-package coq-mode
  1424 + :mode ("\\.v\\'" . coq-mode))
  1425 + (use-package proof-site
  1426 + :command proofgeneral
  1427 + :load-path "site-lisp/proofgeneral/generic/"))
  1428 +
1412 1429 ;;;_ , crosshairs
1413 1430
1414 1431 (use-package crosshairs
@@ -1419,6 +1436,14 @@
1419 1436 (use-package css-mode
1420 1437 :mode ("\\.css\\'" . css-mode))
1421 1438
  1439 +;;;_ , cursor-chg
  1440 +
  1441 +(use-package cursor-chg
  1442 + :init
  1443 + (progn
  1444 + (change-cursor-mode 1)
  1445 + (toggle-cursor-type-when-idle 1)))
  1446 +
1422 1447 ;;;_ , ibuffer
1423 1448
1424 1449 (use-package ibuffer
@@ -1718,8 +1743,26 @@ The output appears in the buffer `*Async Shell Command*'."
1718 1743 :if running-alternate-emacs
1719 1744 :init
1720 1745 (progn
  1746 + (defun setup-irc-environment ()
  1747 + (interactive)
  1748 + (set-input-method "Agda")
  1749 + (set-frame-font
  1750 + "-*-Lucida Grande-normal-normal-normal-*-*-*-*-*-p-0-iso10646-1" nil
  1751 + nil)
  1752 + (set-frame-parameter (selected-frame) 'width 90)
  1753 + (setq erc-timestamp-only-if-changed-flag nil
  1754 + erc-timestamp-format "%H:%M "
  1755 + erc-fill-prefix " "
  1756 + erc-fill-column 88
  1757 + erc-insert-timestamp-function 'erc-insert-timestamp-left)
  1758 + (custom-set-faces
  1759 + '(erc-timestamp-face ((t (:foreground "dark violet"))))))
  1760 +
  1761 + (add-hook 'erc-mode-hook 'setup-irc-environment)
  1762 +
1721 1763 (defun irc ()
1722 1764 (interactive)
  1765 +
1723 1766 (erc-tls :server "irc.freenode.net"
1724 1767 :port 6697
1725 1768 :nick "johnw"
@@ -1730,10 +1773,11 @@ The output appears in the buffer `*Async Shell Command*'."
1730 1773 :type 'netrc
1731 1774 :port 6667))
1732 1775 :secret)))
1733   - ;(erc-tls :server "irc.oftc.net"
1734   - ; :port 6697
1735   - ; :nick "johnw")
1736   - )
  1776 +
  1777 + (erc :server "irc.well-typed.com"
  1778 + :port 6665
  1779 + :nick "johnw")
  1780 + )
1737 1781
1738 1782 (defun im ()
1739 1783 (interactive)
2  lisp/haskell-config
... ... @@ -1 +1 @@
1   -Subproject commit 628860180c61a7ac44dddfa9137f670891b4d873
  1 +Subproject commit 3f57bdbb522d6a1d5c9732e7f89dfa3656d09d6b
16 settings.el
@@ -10,7 +10,7 @@
10 10 '(TeX-view-program-list (quote (("Skim" ("osascript" " ~/bin/skim-gotopage.script" " %O" (mode-io-correlate " %(outpage)"))))))
11 11 '(TeX-view-program-selection (quote (((output-dvi style-pstricks) "dvips and gv") (output-dvi "xdvi") (output-pdf "Skim") (output-html "xdg-open"))))
12 12 '(abbrev-file-name "~/.emacs.d/abbrevs")
13   - '(ac-auto-show-menu nil)
  13 + '(ac-auto-show-menu 1.0)
14 14 '(ac-auto-start 3)
15 15 '(ac-comphist-file "/Users/johnw/.emacs.d/data/ac-comphist.dat")
16 16 '(ac-dwim nil)
@@ -101,11 +101,11 @@
101 101 '(enable-recursive-minibuffers t)
102 102 '(erc-auto-query (quote window-noselect))
103 103 '(erc-autoaway-message "I'm away (after %i seconds of idle-time)")
104   - '(erc-autojoin-channels-alist (quote (("localhost" "&bitlbee") ("freenode.net" "#emacs" "#haskell" "#haskell-in-depth" "#haskell-overflow" "#haskell-blah" "#ledger" "##categorytheory") ("oftc.net" "#llvm"))))
  104 + '(erc-autojoin-channels-alist (quote (("localhost" "&bitlbee") ("freenode.net" "#emacs-ops" "#haskell" "#haskell-in-depth" "#haskell-overflow" "#haskell-blah" "#haskell-ops" "#haskell-lens" "#scannedinavian" "#ledger" "##categorytheory" "#agda") ("well-typed.com" "#fpcomplete") ("oftc.net" "#llvm"))))
105 105 '(erc-autojoin-mode t)
106 106 '(erc-fill-function (quote erc-fill-variable))
107 107 '(erc-fill-static-center 12)
108   - '(erc-fools (quote ("JordiGH")))
  108 + '(erc-fools (quote ("JordiGH" "nyc")))
109 109 '(erc-generate-log-file-name-function (quote erc-generate-log-file-name-short))
110 110 '(erc-header-line-format nil)
111 111 '(erc-hide-list (quote ("JOIN" "NICK" "PART" "QUIT" "MODE")))
@@ -113,7 +113,7 @@
113 113 '(erc-keywords (quote ("wiegley" "ledger" "eshell")))
114 114 '(erc-log-channels-directory "~/Messages/ERC")
115 115 '(erc-log-write-after-send t)
116   - '(erc-modules (quote (autojoin button completion dcc fill identd irccontrols list log match menu move-to-prompt netsplit networks noncommands readonly replace ring scrolltobottom services smiley stamp spelling track highlight-nicknames)))
  116 + '(erc-modules (quote (autojoin button completion dcc fill identd irccontrols list log match menu move-to-prompt netsplit networks noncommands readonly replace ring scrolltobottom services smiley stamp spelling track truncate highlight-nicknames)))
117 117 '(erc-nick "johnw")
118 118 '(erc-port 6667)
119 119 '(erc-priority-people-regexp "\\`[^#].+")
@@ -153,12 +153,13 @@
153 153 '(gc-cons-threshold 3500000)
154 154 '(gdb-find-source-frame t)
155 155 '(gdb-same-frame nil)
  156 + '(global-auto-complete-mode t)
156 157 '(global-font-lock-mode t nil (font-lock))
157 158 '(haskell-check-command "hlintall")
158 159 '(haskell-config-use-unicode-symbols t)
159 160 '(haskell-doc-use-inf-haskell t)
160 161 '(haskell-hoogle-command nil)
161   - '(haskell-mode-hook (quote (turn-on-haskell-indentation turn-on-font-lock turn-on-eldoc-mode turn-on-haskell-doc-mode turn-on-haskell-decl-scan ghc-init my-haskell-mode-hook)))
  162 + '(haskell-mode-hook (quote (turn-on-haskell-indentation turn-on-font-lock turn-on-haskell-decl-scan ghc-init my-haskell-mode-hook)))
162 163 '(haskell-program-name "ghci")
163 164 '(haskell-saved-check-command "~/.cabal/bin/hlint" t)
164 165 '(hippie-expand-try-functions-list (quote (yas/hippie-try-expand try-complete-file-name-partially try-complete-file-name try-expand-all-abbrevs try-expand-list try-expand-line try-expand-dabbrev try-expand-dabbrev-all-buffers try-expand-dabbrev-from-kill try-complete-lisp-symbol-partially try-complete-lisp-symbol)))
@@ -268,7 +269,7 @@
268 269 '(slime-kill-without-query-p t)
269 270 '(slime-repl-history-file "~/.emacs.d/data/slime-history.eld")
270 271 '(slime-startup-animation nil)
271   - '(smart-compile-alist (quote (((lambda (buf) (let ((case-fold-search t)) (and (string-match "/ansi/" (buffer-file-name buf)) (string-match "/opencl" (shell-command-to-string "git symbolic-ref HEAD"))))) . "cd ~/Contracts/TI/src/c60_iaansi ; ~/Contracts/TI/bin/build.sh c60") ((lambda (buf) (let ((case-fold-search t)) (and (string-match "/\\(src/ansi\\|src/.*?ansi\\)/" (buffer-file-name buf)) (string-match "/merge_4_2" (shell-command-to-string "git symbolic-ref HEAD"))))) . "cd ~/Contracts/TI/src/msp_iaansi ; ~/Contracts/TI/bin/build.sh msp") ((lambda (buf) (string-match "/\\(\\(src\\|Projects\\)/ledger\\)/" (buffer-file-name buf))) . "cd ~/src/ledger ; ~/src/ledger/tools/build.sh debug") ((lambda (buf) (string-match "/emacs/" (buffer-file-name buf))) . "emacs-build release macport opt make") (emacs-lisp-mode emacs-lisp-byte-compile-and-load) ((lambda (buf) (string-match "/\\(cree\\|EDG/Projects/edg\\)/" (buffer-file-name buf))) . "cd ~/Products/cree/edg && (ninja -j$(ncpu) && ctest -j$(ncpu)) & (cd ~/src/cree; mktags src ext/llvm) & wait"))))
  272 + '(smart-compile-alist (quote (((lambda (buf) (let ((case-fold-search t)) (and (string-match "/ansi/" (buffer-file-name buf)) (string-match "/opencl" (shell-command-to-string "git symbolic-ref HEAD"))))) . "cd ~/Contracts/TI/src/c60_iaansi ; ~/Contracts/TI/bin/build.sh c60") ((lambda (buf) (let ((case-fold-search t)) (and (string-match "/\\(src/ansi\\|src/.*?ansi\\)/" (buffer-file-name buf)) (string-match "/merge_4_2" (shell-command-to-string "git symbolic-ref HEAD"))))) . "cd ~/Contracts/TI/src/msp_iaansi ; ~/Contracts/TI/bin/build.sh msp") ((lambda (buf) (string-match "/\\(\\(src\\|Projects\\)/ledger\\)/" (buffer-file-name buf))) . "cd ~/src/ledger ; ~/src/ledger/tools/build.sh debug") ((lambda (buf) (string-match "/emacs/" (buffer-file-name buf))) . "emacs-build release macport opt make") (emacs-lisp-mode emacs-lisp-byte-compile-and-load) ((lambda (buf) (string-match "/\\(cree\\|EDG/Projects/edg\\)/" (buffer-file-name buf))) . "cd ~/Products/cree/edg && (ninja && ctest -j$(ncpu)) & (cd ~/src/cree; mktags src ext/llvm) & wait"))))
272 273 '(sql-sqlite-program "sqlite3")
273 274 '(sr-attributes-display-mask (quote (nil nil t nil nil nil)))
274 275 '(sr-autoload-extensions nil)
@@ -347,13 +348,14 @@
347 348 '(diff-added2 ((t (:foreground "SeaGreen"))))
348 349 '(diff-changed ((t (:foreground "MediumBlue"))))
349 350 '(diff-context ((t (:foreground "Black"))))
350   - '(diff-file-header ((t (:background "grey90" :foreground "Red"))))
  351 + '(diff-file-header ((t (:background "plum" :foreground "Black"))))
351 352 '(diff-header ((t (:background "grey85" :foreground "red"))))
352 353 '(diff-hunk-header ((t (:background "grey90" :foreground "black"))))
353 354 '(diff-index ((t (:foreground "Green"))))
354 355 '(diff-nonexistent ((t (:foreground "DarkBlue"))))
355 356 '(diff-removed ((t (:foreground "firebrick"))))
356 357 '(diff-removed2 ((t (:foreground "Orange"))))
  358 + '(erc-timestamp-face ((t (:foreground "olive drab"))))
357 359 '(font-lock-comment-face ((((class color)) (:foreground "firebrick"))))
358 360 '(helm-M-x-key ((t (:foreground "dark red" :underline t))))
359 361 '(helm-candidate-number ((t (:background "#faffb5" :foreground "black"))))
460 site-lisp/gtags.el
... ... @@ -1,8 +1,9 @@
1 1 ;;; gtags.el --- gtags facility for Emacs
2 2
  3 +;(setq debug-on-error t)
3 4 ;;
4 5 ;; Copyright (c) 1997, 1998, 1999, 2000, 2006, 2007, 2008, 2009, 2010
5   -;; 2011
  6 +;; 2011, 2012
6 7 ;; Tama Communications Corporation
7 8 ;;
8 9 ;; This file is part of GNU GLOBAL.
@@ -23,9 +24,8 @@
23 24
24 25 ;; GLOBAL home page is at: http://www.gnu.org/software/global/
25 26 ;; Author: Tama Communications Corporation
26   -;; Version: 3.0
  27 +;; Version: 3.6
27 28 ;; Keywords: tools
28   -;; Required version: GLOBAL 5.9.7 or later
29 29
30 30 ;; Gtags-mode is implemented as a minor mode so that it can work with any
31 31 ;; other major modes. Gtags-select mode is implemented as a major mode.
@@ -47,12 +47,12 @@
47 47 ;; There are two hooks, gtags-mode-hook and gtags-select-mode-hook.
48 48 ;; The usage of the hook is shown as follows.
49 49 ;;
50   -;; [Setting to reproduce old 'Gtags mode']
  50 +;; [Setting to use vi style scroll key]
51 51 ;;
52 52 ;; (add-hook 'gtags-mode-hook
53 53 ;; '(lambda ()
54   -;; (setq gtags-pop-delete t)
55   -;; (setq gtags-path-style 'absolute)
  54 +;; (define-key gtags-mode-map "\C-f" 'scroll-up)
  55 +;; (define-key gtags-mode-map "\C-b" 'scroll-down)
56 56 ;; ))
57 57 ;;
58 58 ;; [Setting to make 'Gtags select mode' easy to see]
@@ -62,6 +62,11 @@
62 62 ;; (setq hl-line-face 'underline)
63 63 ;; (hl-line-mode 1)
64 64 ;; ))
  65 +;;
  66 +;; (Policy of key mapping)
  67 +;; If 'gtags-suggested-key-mapping' is not set, any key mapping is not done.
  68 +;; If 'gtags-disable-pushy-mouse-mapping' is set, any mouse mapping is not done.
  69 +;;
65 70
66 71 ;;; Code
67 72
@@ -84,6 +89,13 @@
84 89 (const :tag "Absolute" absolute))
85 90 :group 'gtags)
86 91
  92 +(defcustom gtags-ignore-case 'follow-case-fold-search
  93 + "*Controls whether or not ignore case in each search."
  94 + :type '(choice (const :tag "Follows case-fold-search variable" follow-case-fold-search)
  95 + (const :tag "Ignore case" t)
  96 + (const :tag "Distinguish case" nil))
  97 + :group 'gtags)
  98 +
87 99 (defcustom gtags-read-only nil
88 100 "Gtags read only mode"
89 101 :type 'boolean
@@ -99,7 +111,6 @@
99 111 :group 'gtags
100 112 :type 'boolean)
101 113
102   -; This has not been used any longer.
103 114 (defcustom gtags-disable-pushy-mouse-mapping nil
104 115 "*If non-nil, mouse key mapping is disabled."
105 116 :group 'gtags
@@ -110,6 +121,26 @@
110 121 :group 'gtags
111 122 :type 'boolean)
112 123
  124 +(defcustom gtags-use-old-key-map nil
  125 + "*If non-nil, old key mapping is enabled."
  126 + :group 'gtags
  127 + :type 'boolean)
  128 +
  129 +(defcustom gtags-grep-all-text-files nil
  130 + "*If non-nil, gtags-find-with-grep command searchs all text files."
  131 + :group 'gtags
  132 + :type 'boolean)
  133 +
  134 +(defcustom gtags-prefix-key "\C-c"
  135 + "*If non-nil, it is used for the prefix key of gtags-xxx command."
  136 + :group 'gtags
  137 + :type 'string)
  138 +
  139 +(defcustom gtags-auto-update nil
  140 + "*If non-nil, tag files are updated whenever a file is saved."
  141 + :type 'boolean
  142 + :group 'gtags)
  143 +
113 144 ;; Variables
114 145 (defvar gtags-current-buffer nil
115 146 "Current buffer.")
@@ -125,80 +156,206 @@
125 156 "Regexp matching tag definition name.")
126 157 (defvar gtags-mode-map (make-sparse-keymap)
127 158 "Keymap used in gtags mode.")
  159 +(defvar gtags-select-mode-map (make-sparse-keymap)
  160 + "Keymap used in gtags select mode.")
128 161 (defvar gtags-running-xemacs (string-match "XEmacs\\|Lucid" emacs-version)
129 162 "Whether we are running XEmacs/Lucid Emacs")
130 163 (defvar gtags-rootdir nil
131 164 "Root directory of source tree.")
132   -;
133   -; New key assignment to avoid conflicting with ordinary assignments.
134   -;
135   -(define-key gtags-mode-map "\e*" 'gtags-pop-stack)
136   -(define-key gtags-mode-map "\e." 'gtags-find-tag)
137   -(define-key gtags-mode-map "\C-x4." 'gtags-find-tag-other-window)
138   -;
139   -; You can make key mappings using 'gtags-mode-hook in your $HOME/.emacs:
140   -; The following two brings the same result.
141   -;
142   -; (add-hook 'gtags-mode-hook
143   -; '(lambda ()
144   -; (setq gtags-suggested-key-mapping t)
145   -; ))
146   -; (add-hook 'gtags-mode-hook
147   -; '(lambda ()
148   -; (define-key gtags-mode-map "\eh" 'gtags-display-browser)
149   -; (define-key gtags-mode-map "\C-]" 'gtags-find-tag-from-here)
150   -; (define-key gtags-mode-map "\C-t" 'gtags-pop-stack)
151   -; (define-key gtags-mode-map "\eP" 'gtags-find-file)
152   -; (define-key gtags-mode-map "\ef" 'gtags-parse-file)
153   -; (define-key gtags-mode-map "\eg" 'gtags-find-with-grep)
154   -; (define-key gtags-mode-map "\eI" 'gtags-find-with-idutils)
155   -; (define-key gtags-mode-map "\es" 'gtags-find-symbol)
156   -; (define-key gtags-mode-map "\er" 'gtags-find-rtag)
157   -; (define-key gtags-mode-map "\et" 'gtags-find-tag)
158   -; (define-key gtags-mode-map "\ev" 'gtags-visit-rootdir)
159   -; ))
  165 +(defvar gtags-global-command nil
  166 + "Command name of global.")
  167 +
  168 +;; Set global's command name
  169 +(setq gtags-global-command (getenv "GTAGSGLOBAL"))
  170 +(if (or (not gtags-global-command) (equal gtags-global-command ""))
  171 + (setq gtags-global-command "global"))
  172 +
  173 +;; Key mapping of gtags-mode.
  174 +(if gtags-suggested-key-mapping
  175 + (progn
  176 + ; Current key mapping.
  177 + (define-key gtags-mode-map (concat gtags-prefix-key "h") 'gtags-display-browser)
  178 + (define-key gtags-mode-map "\C-]" 'gtags-find-tag-from-here)
  179 + (define-key gtags-mode-map "\C-t" 'gtags-pop-stack)
  180 + (define-key gtags-mode-map (concat gtags-prefix-key "P") 'gtags-find-file)
  181 + (define-key gtags-mode-map (concat gtags-prefix-key "f") 'gtags-parse-file)
  182 + (define-key gtags-mode-map (concat gtags-prefix-key "g") 'gtags-find-with-grep)
  183 + (define-key gtags-mode-map (concat gtags-prefix-key "I") 'gtags-find-with-idutils)
  184 + (define-key gtags-mode-map (concat gtags-prefix-key "s") 'gtags-find-symbol)
  185 + (define-key gtags-mode-map (concat gtags-prefix-key "r") 'gtags-find-rtag)
  186 + (define-key gtags-mode-map (concat gtags-prefix-key "t") 'gtags-find-tag)
  187 + (define-key gtags-mode-map (concat gtags-prefix-key "d") 'gtags-find-tag)
  188 + (define-key gtags-mode-map (concat gtags-prefix-key "v") 'gtags-visit-rootdir)
  189 + ; common
  190 + (define-key gtags-mode-map "\e*" 'gtags-pop-stack)
  191 + (define-key gtags-mode-map "\e." 'gtags-find-tag)
  192 + (define-key gtags-mode-map "\C-x4." 'gtags-find-tag-other-window)
  193 + (if gtags-disable-pushy-mouse-mapping nil
  194 + (define-key gtags-mode-map [mouse-3] 'gtags-pop-stack)
  195 + (define-key gtags-mode-map [mouse-2] 'gtags-find-tag-by-event)))
  196 +)
  197 +;; Key mapping of old gtags-mode (obsoleted)
  198 +(if (and gtags-suggested-key-mapping gtags-use-old-key-map)
  199 + (progn
  200 + ; Old key mapping
  201 + (define-key gtags-mode-map "\eh" 'gtags-display-browser)
  202 + (define-key gtags-mode-map "\C-]" 'gtags-find-tag-from-here)
  203 + (define-key gtags-mode-map "\C-t" 'gtags-pop-stack)
  204 + (define-key gtags-mode-map "\eP" 'gtags-find-file)
  205 + (define-key gtags-mode-map "\ef" 'gtags-parse-file)
  206 + (define-key gtags-mode-map "\eg" 'gtags-find-with-grep)
  207 + (define-key gtags-mode-map "\eI" 'gtags-find-with-idutils)
  208 + (define-key gtags-mode-map "\es" 'gtags-find-symbol)
  209 + (define-key gtags-mode-map "\er" 'gtags-find-rtag)
  210 + (define-key gtags-mode-map "\et" 'gtags-find-tag)
  211 + (define-key gtags-mode-map "\ev" 'gtags-visit-rootdir)
  212 + ; common
  213 + (define-key gtags-mode-map "\e*" 'gtags-pop-stack)
  214 + (define-key gtags-mode-map "\e." 'gtags-find-tag)
  215 + (define-key gtags-mode-map "\C-x4." 'gtags-find-tag-other-window)
  216 + (if gtags-disable-pushy-mouse-mapping nil
  217 + (define-key gtags-mode-map [mouse-3] 'gtags-pop-stack)
  218 + (define-key gtags-mode-map [mouse-2] 'gtags-find-tag-by-event)))
  219 +)
160 220
161   -(defvar gtags-select-mode-map (make-sparse-keymap)
162   - "Keymap used in gtags select mode.")
163   -(define-key gtags-select-mode-map "\e*" 'gtags-pop-stack)
164   -(define-key gtags-select-mode-map "\^?" 'scroll-down)
165   -(define-key gtags-select-mode-map " " 'scroll-up)
166   -(define-key gtags-select-mode-map "\C-b" 'scroll-down)
167   -(define-key gtags-select-mode-map "\C-f" 'scroll-up)
168   -(define-key gtags-select-mode-map "k" 'previous-line)
169   -(define-key gtags-select-mode-map "j" 'next-line)
170   -(define-key gtags-select-mode-map "p" 'previous-line)
171   -(define-key gtags-select-mode-map "n" 'next-line)
172   -(define-key gtags-select-mode-map "q" 'gtags-pop-stack)
173   -(define-key gtags-select-mode-map "u" 'gtags-pop-stack)
  221 +;; Key mapping of gtags-select-mode.
  222 +; The map of key "\C-t" and "\C-m" is always carried out..
174 223 (define-key gtags-select-mode-map "\C-t" 'gtags-pop-stack)
175 224 (define-key gtags-select-mode-map "\C-m" 'gtags-select-tag)
176   -(define-key gtags-select-mode-map "\C-o" 'gtags-select-tag-other-window)
177   -(define-key gtags-select-mode-map "\e." 'gtags-select-tag)
  225 +(if gtags-suggested-key-mapping
  226 + (progn
  227 + (define-key gtags-select-mode-map "\e*" 'gtags-pop-stack)
  228 + (define-key gtags-select-mode-map "\^?" 'scroll-down)
  229 + (define-key gtags-select-mode-map " " 'scroll-up)
  230 + (define-key gtags-select-mode-map "\C-b" 'scroll-down)
  231 + (define-key gtags-select-mode-map "\C-f" 'scroll-up)
  232 + (define-key gtags-select-mode-map "k" 'previous-line)
  233 + (define-key gtags-select-mode-map "j" 'next-line)
  234 + (define-key gtags-select-mode-map "p" 'previous-line)
  235 + (define-key gtags-select-mode-map "n" 'next-line)
  236 + (define-key gtags-select-mode-map "q" 'gtags-pop-stack)
  237 + (define-key gtags-select-mode-map "u" 'gtags-pop-stack)
  238 + (define-key gtags-select-mode-map "\C-o" 'gtags-select-tag-other-window)
  239 + (define-key gtags-select-mode-map "\e." 'gtags-select-tag)
  240 + (if gtags-disable-pushy-mouse-mapping nil
  241 + (define-key gtags-select-mode-map [mouse-3] 'gtags-pop-stack)
  242 + (define-key gtags-select-mode-map [mouse-2] 'gtags-select-tag-by-event)))
  243 +)
  244 +
  245 +;;
  246 +;; TRAMP support
  247 +;;
  248 +;
  249 +; TRAMP style default-directory.
  250 +; /<method>:[<user id>@]<host name>:<directory>
  251 +; Ex: /ssh:remoteuser@remotehost:/usr/src/sys/
  252 +;
  253 +(defconst gtags-tramp-path-regexp "^/\\([^:]+\\):\\([^:]+\\):\\(.*\\)"
  254 + "Regexp matching tramp path name.")
  255 +(defconst gtags-tramp-user-host-regexp "^\\([^@]+\\)@\\(.*\\)"
  256 + "Regexp matching tramp user@host name.")
  257 +(defvar gtags-tramp-active nil
  258 + "TRAMP activity.")
  259 +(defvar gtags-tramp-saved-global-command nil
  260 + "Save area of the command name of global.")
  261 +
  262 +; The substitute of buffer-file-name
  263 +(defun gtags-buffer-file-name ()
  264 + (if buffer-file-name
  265 + (if (string-match gtags-tramp-path-regexp buffer-file-name)
  266 + (match-string 3 buffer-file-name)
  267 + buffer-file-name)
  268 + nil))
  269 +(defun gtags-push-tramp-environment ()
  270 + (let ((tramp-path default-directory))
  271 + (if (string-match gtags-tramp-path-regexp tramp-path)
  272 + (let ((shell (match-string 1 tramp-path))
  273 + (user-and-host (match-string 2 tramp-path))
  274 + (cwd (match-string 3 tramp-path)))
  275 + ;
  276 + ; Server side GLOBAL cannot treat other than rsh and ssh.
  277 + ;
  278 + (cond
  279 + ((equal shell "rsh"))
  280 + ((equal shell "ssh"))
  281 + ((equal shell "rcp")
  282 + (setq shell "rsh"))
  283 + ((equal shell "scp")
  284 + (setq shell "ssh"))
  285 + (t
  286 + (setq shell "ssh")))
  287 + (let (host user)
  288 + (if (string-match gtags-tramp-user-host-regexp user-and-host)
  289 + (progn
  290 + (setq user (match-string 1 user-and-host))
  291 + (setq host (match-string 2 user-and-host)))
  292 + (progn
  293 + (setq user nil)
  294 + (setq host user-and-host)))
  295 + ;
  296 + ; Move to tramp mode only when all the items are assembled.
  297 + ;
  298 + (if (and shell host cwd)
  299 + (progn
  300 + (setq gtags-tramp-active t)
  301 + (setq gtags-tramp-saved-global-command gtags-global-command)
  302 + ; Use 'global-client even if environment variable GTAGSGLOBAL is set.
  303 + ;(setq gtags-global-command (getenv "GTAGSGLOBAL"))
  304 + ;(if (or (not gtags-global-command) (equal gtags-global-command ""))
  305 + (setq gtags-global-command "global-client")
  306 + ;)
  307 + (push (concat "GTAGSREMOTESHELL=" shell) process-environment)
  308 + (push (concat "GTAGSREMOTEHOST=" host) process-environment)
  309 + (push (concat "GTAGSREMOTEUSER=" user) process-environment)
  310 + (push (concat "GTAGSREMOTECWD=" cwd) process-environment))))))))
  311 +
  312 +(defun gtags-pop-tramp-environment ()
  313 + (if gtags-tramp-active
  314 + (progn
  315 + (setq gtags-tramp-active nil)
  316 + (setq gtags-global-command gtags-tramp-saved-global-command)
  317 + (pop process-environment)
  318 + (pop process-environment)
  319 + (pop process-environment)
  320 + (pop process-environment))))
  321 +
  322 +;; End of TRAMP support
178 323
179 324 ;;
  325 +;; Invoked on saving a file.
  326 +;;
  327 +(defun gtags-auto-update ()
  328 + (if (and gtags-mode gtags-auto-update buffer-file-name)
  329 + (progn
  330 + (gtags-push-tramp-environment)
  331 + (call-process gtags-global-command nil nil nil "-u" (concat "--single-update=" (gtags-buffer-file-name)))
  332 + (gtags-pop-tramp-environment))))
  333 +;;
180 334 ;; utility
181 335 ;;
  336 +;; Ignore case or not.
  337 +(defun gtags-ignore-casep ()
  338 + (if (equal gtags-ignore-case 'follow-case-fold-search)
  339 + case-fold-search
  340 + gtags-ignore-case))
  341 +
182 342 (defun gtags-match-string (n)
183 343 (buffer-substring (match-beginning n) (match-end n)))
184 344
185 345 ;; Return a default tag to search for, based on the text at point.
186 346 (defun gtags-current-token ()
187   - (save-excursion
188   - (cond
189   - ((or (looking-at "[0-9A-Za-z_]")
190   - (looking-back "[0-9A-Za-z_]"))
191   - (forward-char -1)
192   - (while (and (not (bolp)) (looking-at "[0-9A-Za-z_]"))
193   - (forward-char -1))
194   - (if (not (looking-at "[0-9A-Za-z_]")) (forward-char 1)))
195   - (t
196   - (while (looking-at "[ \t]")
197   - (forward-char 1))))
198   - (if (and (bolp) (looking-at gtags-definition-regexp))
199   - (goto-char (match-end 0)))
200   - (if (looking-at gtags-symbol-regexp)
201   - (gtags-match-string 0) nil)))
  347 + (cond
  348 + ((looking-at "[0-9A-Za-z_]")
  349 + (while (and (not (bolp)) (looking-at "[0-9A-Za-z_]"))
  350 + (forward-char -1))
  351 + (if (not (looking-at "[0-9A-Za-z_]")) (forward-char 1)))
  352 + (t
  353 + (while (looking-at "[ \t]")
  354 + (forward-char 1))))
  355 + (if (and (bolp) (looking-at gtags-definition-regexp))
  356 + (goto-char (match-end 0)))
  357 + (if (looking-at gtags-symbol-regexp)
  358 + (gtags-match-string 0) nil))
202 359
203 360 ;; push current context to stack
204 361 (defun gtags-push-context ()
@@ -232,6 +389,8 @@
232 389 ;; completsion function for completing-read.
233 390 (defun gtags-completing-gtags (string predicate code)
234 391 (gtags-completing 'gtags string predicate code))
  392 +(defun gtags-completing-grtags (string predicate code)
  393 + (gtags-completing 'grtags string predicate code))
235 394 (defun gtags-completing-gsyms (string predicate code)
236 395 (gtags-completing 'gsyms string predicate code))
237 396 (defun gtags-completing-files (string predicate code)
@@ -244,14 +403,19 @@
244 403 ; The purpose of using the -n option for the -P command is to exclude
245 404 ; dependence on the execution directory.
246 405 (let ((option (cond ((eq flag 'files) "-cPo")
  406 + ((eq flag 'grtags) "-cr")
247 407 ((eq flag 'gsyms) "-cs")
248 408 ((eq flag 'idutils) "-cI")
249 409 (t "-c")))
250 410 (complete-list (make-vector 63 0))
251 411 (prev-buffer (current-buffer)))
  412 + (if (gtags-ignore-casep)
  413 + (setq option (concat option "i")))
252 414 ; build completion list
253 415 (set-buffer (generate-new-buffer "*Completions*"))
254   - (call-process "global" nil t nil option string)
  416 + (gtags-push-tramp-environment)
  417 + (call-process gtags-global-command nil t nil option string)
  418 + (gtags-pop-tramp-environment)
255 419 (goto-char (point-min))
256 420 ;
257 421 ; The specification of the completion for files is different from that for symbols.
@@ -279,7 +443,7 @@
279 443 (save-excursion
280 444 (setq buffer (generate-new-buffer (generate-new-buffer-name "*rootdir*")))
281 445 (set-buffer buffer)
282   - (setq n (call-process "global" nil t nil "-pr"))
  446 + (setq n (call-process gtags-global-command nil t nil "-pr"))
283 447 (if (= n 0)
284 448 (setq path (file-name-as-directory (buffer-substring (point-min)(1- (point-max))))))
285 449 (kill-buffer buffer))
@@ -303,11 +467,11 @@
303 467 "Tell tags commands the root directory of source tree."
304 468 (interactive)
305 469 (let (path input n)
306   - (if gtags-rootdir
307   - (setq path gtags-rootdir)
308   - (setq path (gtags-get-rootpath))
309   - (if (equal path nil)
310   - (setq path default-directory)))
  470 + (setq path gtags-rootdir)
  471 + (if (not path)
  472 + (setq path (gtags-get-rootpath)))
  473 + (if (not path)
  474 + (setq insert-default-directory (if (string-match gtags-tramp-path-regexp default-directory) nil t)))
311 475 (setq input (read-file-name "Visit root directory: " path path t))
312 476 (if (equal "" input) nil
313 477 (if (not (file-directory-p input))
@@ -343,7 +507,7 @@
343 507 (if tagname
344 508 (setq prompt (concat "Find tag (reference): (default " tagname ") "))
345 509 (setq prompt "Find tag (reference): "))
346   - (setq input (completing-read prompt 'gtags-completing-gtags
  510 + (setq input (completing-read prompt 'gtags-completing-grtags
347 511 nil nil nil gtags-history-list))
348 512 (if (not (equal "" input))
349 513 (setq tagname input))
@@ -380,7 +544,7 @@
380 544 (setq input (read-from-minibuffer prompt nil nil nil gtags-history-list))
381 545 (if (not (equal "" input)) (setq tagname input))
382 546 (gtags-push-context)
383   - (gtags-goto-tag tagname "g")))
  547 + (gtags-goto-tag tagname (if gtags-grep-all-text-files "go" "g"))))
384 548
385 549 (defun gtags-find-with-idutils ()
386 550 "Input pattern, search with idutils(1) and move to the locations."
@@ -412,7 +576,7 @@
412 576 (interactive)
413 577 (let (tagname prompt input)
414 578 (setq prompt "Parse file: ")
415   - (setq input (read-file-name prompt buffer-file-name buffer-file-name t))
  579 + (setq input (read-file-name prompt (gtags-buffer-file-name) (gtags-buffer-file-name) t))
416 580 (if (or (equal "" input) (not (file-regular-p input)))
417 581 (message "Please specify an existing source file.")
418 582 (setq tagname input)
@@ -425,7 +589,7 @@
425 589 (let (tagname flag)
426 590 (setq tagname (gtags-current-token))
427 591 (if (not tagname)
428   - (call-interactively 'gtags-find-tag)
  592 + nil
429 593 (gtags-push-context)
430 594 (gtags-goto-tag tagname "C"))))
431 595
@@ -434,7 +598,11 @@
434 598 (defun gtags-display-browser ()
435 599 "Display current screen on hypertext browser."
436 600 (interactive)
437   - (call-process "gozilla" nil nil nil (concat "+" (number-to-string (gtags-current-lineno))) buffer-file-name))
  601 + (if (= (gtags-current-lineno) 0)
  602 + (message "This is a null file.")
  603 + (if (not buffer-file-name)
  604 + (message "This buffer doesn't have the file name.")
  605 + (call-process "gozilla" nil nil nil (concat "+" (number-to-string (gtags-current-lineno))) (gtags-buffer-file-name)))))
438 606
439 607 ; Private event-point
440 608 ; (If there is no event-point then we use this version.
@@ -516,8 +684,10 @@
516 684 (setq flag-char (string-to-char flag))
517 685 ; Use always ctags-x format.
518 686 (setq option "-x")
  687 + (if (gtags-ignore-casep)
  688 + (setq option (concat option "i")))
519 689 (if (char-equal flag-char ?C)
520   - (setq context (concat "--from-here=" (number-to-string (gtags-current-lineno)) ":" buffer-file-name))
  690 + (setq context (concat "--from-here=" (number-to-string (gtags-current-lineno)) ":" (gtags-buffer-file-name)))
521 691 (setq option (concat option flag)))
522 692 (cond
523 693 ((char-equal flag-char ?C)
@@ -525,8 +695,7 @@
525 695 ((char-equal flag-char ?P)
526 696 (setq prefix "(P)"))
527 697 ((char-equal flag-char ?f)
528   - (setq prefix "(F)")
529   - (setq option (concat option "q")))
  698 + (setq prefix "(F)"))
530 699 ((char-equal flag-char ?g)
531 700 (setq prefix "(GREP)"))
532 701 ((char-equal flag-char ?I)
@@ -564,53 +733,58 @@
564 733 (setq now-buffer-list (cdr now-buffer-list))))))
565 734 (setq buffer (generate-new-buffer (generate-new-buffer-name (concat "*GTAGS SELECT* " prefix tagname))))
566 735 (set-buffer buffer)
567   - ;
568   - ; Path style is defined in gtags-path-style:
569   - ; root: relative from the root of the project (Default)
570   - ; relative: relative from the current directory
571   - ; absolute: absolute (relative from the system root directory)
572   - ;
573   - (cond
574   - ((equal gtags-path-style 'absolute)
575   - (setq option (concat option "a")))
576   - ((equal gtags-path-style 'root)
577   - (let (rootdir)
578   - (if gtags-rootdir
579   - (setq rootdir gtags-rootdir)
580   - (setq rootdir (gtags-get-rootpath)))
581   - (if rootdir (cd rootdir)))))
582 736 (message "Searching %s ..." tagname)
583   - (if (not (= 0 (if (equal flag "C")
584   - (call-process "global" nil t nil option "--encode-path=\" \t\"" context tagname)
585   - (call-process "global" nil t nil option "--encode-path=\" \t\"" tagname))))
586   - (progn (message (buffer-substring (point-min)(1- (point-max))))
587   - (gtags-pop-context))
588   - (goto-char (point-min))
589   - (setq lines (count-lines (point-min) (point-max)))
  737 + (let (status)
  738 + (gtags-push-tramp-environment)
  739 + ;
  740 + ; Path style is defined in gtags-path-style:
  741 + ; root: relative from the root of the project (Default)
  742 + ; relative: relative from the current directory
  743 + ; absolute: absolute (relative from the system root directory)
  744 + ; In TRAMP mode, 'root' is automatically converted to 'relative'.
  745 + ;
590 746 (cond
591   - ((= 0 lines)
592   - (cond
593   - ((char-equal flag-char ?P)
594   - (message "%s: path not found" tagname))
595   - ((char-equal flag-char ?g)
596   - (message "%s: pattern not found" tagname))
597   - ((char-equal flag-char ?I)
598   - (message "%s: token not found" tagname))
599   - ((char-equal flag-char ?s)
600   - (message "%s: symbol not found" tagname))
601   - (t
602   - (message "%s: tag not found" tagname)))
603   - (gtags-pop-context)
604   - (kill-buffer buffer)
605   - (set-buffer save))
606   - ((= 1 lines)
607   - (message "Searching %s ... Done" tagname)
608   - (gtags-select-it t other-win))
609   - (t
610   - (if (null other-win)
611   - (switch-to-buffer buffer)
612   - (switch-to-buffer-other-window buffer))
613   - (gtags-select-mode))))))
  747 + ((equal gtags-path-style 'absolute)
  748 + (setq option (concat option "a")))
  749 + ((and (not gtags-tramp-active) (equal gtags-path-style 'root))
  750 + (let (rootdir)
  751 + (if gtags-rootdir
  752 + (setq rootdir gtags-rootdir)
  753 + (setq rootdir (gtags-get-rootpath)))
  754 + (if rootdir (cd rootdir)))))
  755 + (setq status (if (equal flag "C")
  756 + (call-process gtags-global-command nil t nil option "--encode-path=\" \t\"" context tagname)
  757 + (call-process gtags-global-command nil t nil option "--encode-path=\" \t\"" tagname)))
  758 + (gtags-pop-tramp-environment)
  759 + (if (not (= 0 status))
  760 + (progn (message (buffer-substring (point-min)(1- (point-max))))
  761 + (gtags-pop-context))
  762 + (goto-char (point-min))
  763 + (setq lines (count-lines (point-min) (point-max)))
  764 + (cond
  765 + ((= 0 lines)
  766 + (cond
  767 + ((char-equal flag-char ?P)
  768 + (message "%s: path not found" tagname))
  769 + ((char-equal flag-char ?g)
  770 + (message "%s: pattern not found" tagname))
  771 + ((char-equal flag-char ?I)
  772 + (message "%s: token not found" tagname))
  773 + ((char-equal flag-char ?s)
  774 + (message "%s: symbol not found" tagname))
  775 + (t
  776 + (message "%s: tag not found" tagname)))
  777 + (gtags-pop-context)
  778 + (kill-buffer buffer)
  779 + (set-buffer save))
  780 + ((= 1 lines)
  781 + (message "Searching %s ... Done" tagname)
  782 + (gtags-select-it t other-win))
  783 + (t
  784 + (if (null other-win)
  785 + (switch-to-buffer buffer)
  786 + (switch-to-buffer-other-window buffer))
  787 + (gtags-select-mode)))))))
614 788
615 789 ;; select a tag line from lines
616 790 (defun gtags-select-it (delete &optional other-win)
@@ -691,30 +865,10 @@ with no args, if that value is non-nil."
691 865 (setq gtags-mode
692 866 (if (null forces) (not gtags-mode)
693 867 (> (prefix-numeric-value forces) 0)))
  868 + (if gtags-mode
  869 + (add-hook 'after-save-hook 'gtags-auto-update)
  870 + (remove-hook 'after-save-hook 'gtags-auto-update))
694 871 (run-hooks 'gtags-mode-hook)
695   - ; Suggested key mapping
696   - (if gtags-suggested-key-mapping
697   - (progn
698   - ; Key mapping.
699   - (define-key gtags-mode-map "\eh" 'gtags-display-browser)
700   - (define-key gtags-mode-map "\C-]" 'gtags-find-tag-from-here)
701   - (define-key gtags-mode-map "\C-t" 'gtags-pop-stack)
702   - (define-key gtags-mode-map "\eP" 'gtags-find-file)
703   - (define-key gtags-mode-map "\ef" 'gtags-parse-file)
704   - (define-key gtags-mode-map "\eg" 'gtags-find-with-grep)
705   - (define-key gtags-mode-map "\eI" 'gtags-find-with-idutils)
706   - (define-key gtags-mode-map "\es" 'gtags-find-symbol)
707   - (define-key gtags-mode-map "\er" 'gtags-find-rtag)
708   - (define-key gtags-mode-map "\et" 'gtags-find-tag)
709   - (define-key gtags-mode-map "\ev" 'gtags-visit-rootdir)
710   - ; Mouse key mapping
711   - (if (not gtags-running-xemacs) nil
712   - (define-key gtags-mode-map 'button3 'gtags-pop-stack)
713   - (define-key gtags-mode-map 'button2 'gtags-find-tag-by-event))
714   - (if gtags-running-xemacs nil
715   - (define-key gtags-mode-map [mouse-3] 'gtags-pop-stack)
716   - (define-key gtags-mode-map [mouse-2] 'gtags-find-tag-by-event)))
717   - )
718 872 )
719 873
720 874 ;; make gtags select-mode
@@ -741,16 +895,6 @@ Turning on Gtags-Select mode calls the value of the variable
741 895 (goto-char (point-min))
742 896 (message "[GTAGS SELECT MODE] %d lines" (count-lines (point-min) (point-max)))
743 897 (run-hooks 'gtags-select-mode-hook)
744   - ; Mouse key mapping
745   - (if gtags-suggested-key-mapping
746   - (progn
747   - (if (not gtags-running-xemacs) nil
748   - (define-key gtags-select-mode-map 'button3 'gtags-pop-stack)
749   - (define-key gtags-select-mode-map 'button2 'gtags-select-tag-by-event))
750   - (if gtags-running-xemacs nil
751   - (define-key gtags-select-mode-map [mouse-3] 'gtags-pop-stack)
752   - (define-key gtags-select-mode-map [mouse-2] 'gtags-select-tag-by-event)))
753   - )
754 898 )
755 899
756 900 (provide 'gtags)
2  site-lisp/hsenv.el
935 site-lisp/pos-tip.el
... ... @@ -0,0 +1,935 @@
  1 +;;; pos-tip.el -- Show tooltip at point -*- coding: utf-8 -*-
  2 +
  3 +;; Copyright (C) 2010 S. Irie
  4 +
  5 +;; Author: S. Irie
  6 +;; Maintainer: S. Irie
  7 +;; Keywords: Tooltip
  8 +
  9 +(defconst pos-tip-version "0.4.5")
  10 +
  11 +;; This program is free software; you can redistribute it and/or
  12 +;; modify it under the terms of the GNU General Public License as
  13 +;; published by the Free Software Foundation; either version 2, or
  14 +;; (at your option) any later version.
  15 +
  16 +;; It is distributed in the hope that it will be useful, but WITHOUT
  17 +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  18 +;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
  19 +;; License for more details.
  20 +
  21 +;; You should have received a copy of the GNU General Public
  22 +;; License along with this program; if not, write to the Free
  23 +;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
  24 +;; MA 02110-1301 USA
  25 +
  26 +;;; Commentary:
  27 +
  28 +;; The standard library tooltip.el provides the function for displaying
  29 +;; a tooltip at mouse position which allows users to easily show it.
  30 +;; However, locating tooltip at arbitrary buffer position in window
  31 +;; is not easy. This program provides such function to be used by other
  32 +;; frontend programs.
  33 +
  34 +;; This program is tested on GNU Emacs 22, 23 under X window system and
  35 +;; Emacs 23 for MS-Windows.
  36 +
  37 +;;
  38 +;; Installation:
  39 +;;
  40 +;; First, save this file as pos-tip.el and byte-compile in
  41 +;; a directory that is listed in load-path.
  42 +;;
  43 +;; Put the following in your .emacs file:
  44 +;;
  45 +;; (require 'pos-tip)
  46 +;;
  47 +;; To use the full features of this program on MS-Windows,
  48 +;; put the additional setting in .emacs file:
  49 +;;
  50 +;; (pos-tip-w32-max-width-height) ; Maximize frame temporarily
  51 +;;
  52 +;; or
  53 +;;
  54 +;; (pos-tip-w32-max-width-height t) ; Keep frame maximized
  55 +
  56 +;;
  57 +;; Examples:
  58 +;;
  59 +;; We can display a tooltip at the current position by the following:
  60 +;;
  61 +;; (pos-tip-show "foo bar")
  62 +;;
  63 +;; If you'd like to specify the tooltip color, use an expression as:
  64 +;;
  65 +;; (pos-tip-show "foo bar" '("white" . "red"))
  66 +;;
  67 +;; Here, "white" and "red" are the foreground color and background
  68 +;; color, respectively.
  69 +
  70 +
  71 +;;; History:
  72 +;; 2010-09-27 S. Irie
  73 +;; * Simplified implementation of `pos-tip-window-system'
  74 +;; * Version 0.4.5
  75 +;;
  76 +;; 2010-08-20 S. Irie
  77 +;; * Changed to use `window-line-height' to calculate tooltip position
  78 +;; * Changed `pos-tip-string-width-height' to ignore last empty line
  79 +;; * Version 0.4.4
  80 +;;
  81 +;; 2010-07-25 S. Irie
  82 +;; * Bug fix
  83 +;; * Version 0.4.3
  84 +;;
  85 +;; 2010-06-09 S. Irie
  86 +;; * Bug fix
  87 +;; * Version 0.4.2
  88 +;;
  89 +;; 2010-06-04 S. Irie
  90 +;; * Added support for text-scale-mode
  91 +;; * Version 0.4.1
  92 +;;
  93 +;; 2010-05-04 S. Irie
  94 +;; * Added functions:
  95 +;; `pos-tip-x-display-width', `pos-tip-x-display-height'
  96 +;; `pos-tip-normalize-natnum', `pos-tip-frame-relative-position'
  97 +;; * Fixed the supports for multi-displays and multi-frames
  98 +;; * Version 0.4.0
  99 +;;
  100 +;; 2010-04-29 S. Irie
  101 +;; * Modified to avoid byte-compile warning
  102 +;; * Bug fix
  103 +;; * Version 0.3.6
  104 +;;
  105 +;; 2010-04-29 S. Irie
  106 +;; * Renamed argument MAX-HEIGHT of `pos-tip-fill-string' to MAX-ROWS
  107 +;; * Modified old FSF address
  108 +;; * Version 0.3.5
  109 +;;
  110 +;; 2010-04-29 S. Irie
  111 +;; * Modified `pos-tip-show' to truncate string exceeding display size
  112 +;; * Added function `pos-tip-truncate-string'
  113 +;; * Added optional argument MAX-ROWS to `pos-tip-split-string'
  114 +;; * Added optional argument MAX-HEIGHT to `pos-tip-fill-string'
  115 +;; * Version 0.3.4
  116 +;;
  117 +;; 2010-04-16 S. Irie
  118 +;; * Changed `pos-tip-show' not to fill paragraph unless exceeding WIDTH
  119 +;; * Version 0.3.3
  120 +;;
  121 +;; 2010-04-08 S. Irie
  122 +;; * Bug fix
  123 +;; * Version 0.3.2
  124 +;;
  125 +;; 2010-03-31 S. Irie
  126 +;; * Bug fix
  127 +;; * Version 0.3.1
  128 +;;
  129 +;; 2010-03-30 S. Irie
  130 +;; * Added support for MS-Windows
  131 +;; * Added option `pos-tip-use-relative-coordinates'
  132 +;; * Bug fixes
  133 +;; * Version 0.3.0
  134 +;;
  135 +;; 2010-03-23 S. Irie
  136 +;; * Changed argument WORD-WRAP to JUSTIFY
  137 +;; * Added optional argument SQUEEZE
  138 +;; * Added function `pos-tip-fill-string'
  139 +;; * Added option `pos-tip-tab-width' used to expand tab characters
  140 +;; * Bug fixes
  141 +;; * Version 0.2.0
  142 +;;
  143 +;; 2010-03-22 S. Irie
  144 +;; * Added optional argument WORD-WRAP to `pos-tip-split-string'
  145 +;; * Changed `pos-tip-show' to perform word wrap or kinsoku shori
  146 +;; * Version 0.1.8
  147 +;;
  148 +;; 2010-03-20 S. Irie
  149 +;; * Added optional argument DY
  150 +;; * Bug fix
  151 +;; * Modified docstrings
  152 +;; * Version 0.1.7
  153 +;;
  154 +;; 2010-03-18 S. Irie
  155 +;; * Added/modifed docstrings
  156 +;; * Changed working buffer name to " *xwininfo*"
  157 +;; * Version 0.1.6
  158 +;;
  159 +;; 2010-03-17 S. Irie
  160 +;; * Fixed typos in docstrings
  161 +;; * Version 0.1.5
  162 +;;
  163 +;; 2010-03-16 S. Irie
  164 +;; * Added support for multi-display environment
  165 +;; * Bug fix
  166 +;; * Version 0.1.4
  167 +;;
  168 +;; 2010-03-16 S. Irie
  169 +;; * Bug fix
  170 +;; * Changed calculation for `x-max-tooltip-size'
  171 +;; * Modified docstring
  172 +;; * Version 0.1.3
  173 +;;
  174 +;; 2010-03-11 S. Irie
  175 +;; * Modified commentary
  176 +;; * Version 0.1.2
  177 +;;
  178 +;; 2010-03-11 S. Irie
  179 +;; * Re-implemented `pos-tip-string-width-height'
  180 +;; * Added indicator variable `pos-tip-upperside-p'
  181 +;; * Version 0.1.1
  182 +;;
  183 +;; 2010-03-09 S. Irie
  184 +;; * Re-implemented `pos-tip-show' (*incompatibly changed*)
  185 +;; - Use frame default font
  186 +;; - Automatically calculate tooltip pixel size
  187 +;; - Added optional arguments: TIP-COLOR, MAX-WIDTH
  188 +;; * Added utility functions:
  189 +;; `pos-tip-split-string', `pos-tip-string-width-height'
  190 +;; * Bug fixes
  191 +;; * Version 0.1.0
  192 +;;
  193 +;; 2010-03-08 S. Irie
  194 +;; * Added optional argument DX
  195 +;; * Version 0.0.4
  196 +;;
  197 +;; 2010-03-08 S. Irie
  198 +;; * Bug fix
  199 +;; * Version 0.0.3
  200 +;;
  201 +;; 2010-03-08 S. Irie
  202 +;; * Modified to move out mouse pointer
  203 +;; * Version 0.0.2
  204 +;;
  205 +;; 2010-03-07 S. Irie
  206 +;; * First release
  207 +;; * Version 0.0.1
  208 +
  209 +;; ToDo:
  210 +
  211 +;;; Code:
  212 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  213 +;; Settings
  214 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  215 +
  216 +(defvar pos-tip-border-width 1
  217 + "Outer border width of pos-tip's tooltip.")
  218 +
  219 +(defvar pos-tip-internal-border-width 2
  220 + "Text margin of pos-tip's tooltip.")
  221 +
  222 +(defvar pos-tip-foreground-color "black"
  223 + "Default foreground color of pos-tip's tooltip.")
  224 +
  225 +(defvar pos-tip-background-color "lightyellow"
  226 + "Default background color of pos-tip's tooltip.")
  227 +
  228 +(defvar pos-tip-tab-width nil
  229 + "Tab width used for `pos-tip-split-string' and `pos-tip-fill-string'
  230 +to expand tab characters. nil means use default value of `tab-width'.")
  231 +
  232 +(defvar pos-tip-use-relative-coordinates nil
  233 + "Non-nil means tooltip location is calculated as a coordinates
  234 +relative to the top left corner of frame. In this case the tooltip
  235 +will always be displayed within the frame.
  236 +
  237 +Note that this variable is automatically set to non-nil if absolute
  238 +coordinates can't be obtained by `pos-tip-compute-pixel-position'.")
  239 +
  240 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  241 +;; Functions
  242 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  243 +
  244 +(defun pos-tip-window-system (&optional frame)
  245 + "The name of the window system that FRAME is displaying through.
  246 +The value is a symbol---for instance, 'x' for X windows.
  247 +The value is nil if Emacs is using a text-only terminal.
  248 +
  249 +FRAME defaults to the currently selected frame."
  250 + (let ((type (framep (or frame (selected-frame)))))
  251 + (if type
  252 + (and (not (eq type t))
  253 + type)
  254 + (signal 'wrong-type-argument (list 'framep frame)))))
  255 +
  256 +(defun pos-tip-normalize-natnum (object &optional n)
  257 + "Return a Nth power of 2 if OBJECT is a positive integer.
  258 +Otherwise return 0. Omitting N means return 1 for a positive integer."
  259 + (ash (if (and (natnump object) (> object 0)) 1 0)
  260 + (or n 0)))
  261 +
  262 +(defvar pos-tip-saved-frame-coordinates '(0 . 0)
  263 + "The latest result of `pos-tip-frame-top-left-coordinates'.")
  264 +
  265 +(defvar pos-tip-frame-offset nil
  266 + "The latest result of `pos-tip-calibrate-frame-offset'. This value
  267 +is used for non-X graphical environment.")
  268 +
  269 +(defvar pos-tip-frame-offset-array [nil nil nil nil]
  270 + "Array of the results of `pos-tip-calibrate-frame-offset'. They are
  271 +recorded only when `pos-tip-frame-top-left-coordinates' is called for a
  272