emacs/external/ljupdate/lj-pcomplete.el

   1 ;;; lj-pcomplete.el --- programmable completion for ljupdate composition buffers
   2
   3 ;; Copyright (C) 2002, 2003, 2004, 2005 Edward O'Connor <ted@oconnor.cx>
   4
   5 ;; Author: Edward O'Connor <ted@oconnor.cx>
   6 ;; Keywords: convenience
   7
   8 ;; This file is part of ljupdate, a LiveJournal client for Emacs.
   9
  10 ;; ljupdate is free software; you can redistribute it and/or
  11 ;; modify it under the terms of the GNU General Public License as
  12 ;; published by the Free Software Foundation; either version 2, or
  13 ;; {at your option} any later version.
  14
  15 ;; ljupdate is distributed in the hope that it will be useful, but
  16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  18 ;; General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING, or type `C-h C-c'. If
  22 ;; not, write to the Free Software Foundation at this address:
  23
  24 ;;   Free Software Foundation
  25 ;;   51 Franklin Street, Fifth Floor
  26 ;;   Boston, MA 02110-1301
  27 ;;   USA
  28
  29 ;;; Commentary:
  30 ;;
  31
  32 ;;; History:
  33 ;;
  34
  35 ;;; Code:
  36
  37 (require 'pcomplete)
  38
  39 (defun lj-pcomplete-setup ()
  40   "Configure this buffer for programmable completion."
  41   (set (make-local-variable 'pcomplete-termination-string) "")
  42   (set (make-local-variable 'pcomplete-ignore-case) t)
  43   (set (make-local-variable 'pcomplete-use-paring) nil)
  44   (set (make-local-variable 'pcomplete-parse-arguments-function)
  45        'lj-pcomplete-parse-header-arguments)
  46   (set (make-local-variable 'pcomplete-command-name-function)
  47        'lj-this-header))
  48
  49 ;; header completion
  50
  51 (defun pcomplete/lj-compose-header-mode/Subject ()
  52   "Attempt to complete the Subject header."
  53   (pcomplete-here nil))
  54
  55 (defun pcomplete/lj-compose-header-mode/Mood ()
  56   "Attempt to complete the Mood header."
  57   (pcomplete-here (sort (mapcar 'car (lj-server-get (lj-this-server) :moods))
  58                         'string-lessp)
  59                   nil nil t))
  60
  61 (defun pcomplete/lj-compose-header-mode/Server ()
  62   "Attempt to complete the Server header."
  63   (pcomplete-here (sort (lj-servers) 'string-lessp)
  64                   nil nil t))
  65
  66 (defun pcomplete/lj-compose-header-mode/User ()
  67   "Attempt to complete the User header."
  68   (pcomplete-here (sort (lj-users (lj-this-server)) 'string-lessp)
  69                   nil nil t))
  70
  71 (defun pcomplete/lj-compose-header-mode/Community ()
  72   "Attempt to complete the Community header."
  73   (pcomplete-here (sort (copy-list (lj-user-get (lj-this-server)
  74                                                 (lj-this-user)
  75                                                 :access))
  76                         'string-lessp)
  77                   nil nil t))
  78
  79 (defun pcomplete/lj-compose-header-mode/Picture ()
  80   "Attempt to complete the Picture header."
  81   (pcomplete-here (sort (copy-list (lj-user-get (lj-this-server)
  82                                                 (lj-this-user)
  83                                                 :pics))
  84                         'string-lessp)
  85                   nil nil t))
  86
  87 (defun pcomplete/lj-compose-header-mode/Access ()
  88   "Attempt to complete the Access header."
  89   (pcomplete-here (sort
  90                    (append
  91                     (list "public" "private" "friends")
  92                     (mapcar 'car
  93                             (lj-user-get (lj-this-server)
  94                                          (lj-this-user)
  95                                          :friends-groups)))
  96                    'string-lessp)
  97                   nil nil t))
  98
  99 ;; pcomplete support code
 100
 101 (defun lj-pcomplete-parse-header-arguments ()
 102   "Return a list of parsed whitespace-separated arguments.
 103 These are the words from the beginning of the line up to where point is
 104 right now."
 105   (let* ((start (save-excursion (beginning-of-line) (point)))
 106          (end (point))
 107          args beginnings)
 108     (save-excursion
 109       (if (< (skip-chars-backward " \t\n" start) 0)
 110           (setq args '("")
 111                 beginnings (list end)))
 112       (setq end (point))
 113       (while (< (skip-chars-backward "^ \t\n" start) 0)
 114         (setq beginnings (cons (point) beginnings)
 115               args (cons (buffer-substring-no-properties
 116                           (point) end)
 117                          args))
 118         (skip-chars-backward " \t\n" start)
 119         (setq end (point))))
 120     (cons args beginnings)))
 121
 122 (provide 'lj-pcomplete)
 123 ;;; lj-pcomplete.el ends here