Make Note AppleScript

set newnote to (do shell script "pbpaste") as string
if (length of newnote is 0) then return "Zero length note"

-- GET THE CURRENT DATE TO GENERATE DEFUALT NAME --
set cdate to do shell script "date +%Y-%m-%d | tr -d '\\n'"

-- DISPLAY DIALOG TO GET THE NOTE NAME --
set reply to display dialog "You are about to create new note with text:
\"" & newnote & "\"

Enter note name:" default answer "Note " & cdate

-- GOT NAME --
if (length of reply > 0) then
 
 set notename to text returned of reply as string
 set cnt to 1 -- INITIALIZE COUNTER FOR PATH GENERATING
 set fname to notename
 
 -- GET FULL NAME FOR DIRECTORY -- 
 set dir to (do shell script "echo -n $HOME") & "/Documents/-NOTES-/"
 
 -- GENERATE NEW NAME --
 repeat
  set notepath to dir & fname as string
  
  -- CHECK IF PATH EXISTS --
  set tst to do shell script "test -f \"" & notepath & "\"; echo $?"
  -- return (do shell script scr)
  -- display dialog tst
  
  
  if tst is not "0" then
   exit repeat -- PATH NAME IS OK, SO EXIT LOOP
  end if
  
  -- ELSE ADD COUNTER TO NAME 
  set fname to notename & " " & (cnt as string)
  set cnt to cnt + 1
  
 end repeat
 
 -- display dialog notepath
 
 if (length of notepath > 0) then
  -- PASTE CLIPBOARD TEXT INTO THE FILE --
  do shell script "pbpaste > \"" & notepath & "\""
 end if
 
end if

Current Date AppleScript

do shell script "date +%Y-%m-%d | tr -d '\\n'  | pbcopy"

2D Dock in Leopard

 defaults write com.apple.dock no-glass -boolean YES; killall Dock

OpenMCL part in emacs-init.lisp

(setf u:*ccl-home*  (concat u:*home* "Library/CCL/"))
(setf u:*ccl-init*  (concat u:*openmcl-home* "ccl-init.lisp"))
(setf u:*ccl-exec*  (concat u:*openmcl-home* "ccl/dppccl"))
(setenv "CCL_DEFAULT_DIRECTORY" (concat u:*ccl-home* "ccl"))

(defmacro def-slime-lisp (lisp)
  `(defun ,lisp ()
     (interactive)
     (let ((slime-default-lisp '`,lisp)) (slime))))

(def-slime-lisp sbcl)
(def-slime-lisp ccl)

    (slime)))

KMP Languages Mapper

(defvar *kmp-info* nil)

(defun read-kmp-info (path)
  (let ((info '()))
    (with-open-file (s path :direction :INPUT)
      (do*
       ((line  #1=(read-line s nil)            #1#)  
        (wrds  #2=(cl-ppcre:split "\\t" line)  #2#) 
        (key   #3=(nth 0 wrds)                 #3#))

       ((not (and key line)) (reverse info)) ;; RETURN POINT
    
        (push
          (cons (nth 0 wrds)
                (list 
                 :LOUT-ID        (nth 1 wrds)
                 :LOUT-NAME      (nth 2 wrds)
                 :LOUT-TBL       (nth 3 wrds)
                 :LOUT-TBL-FLGS  (nth 4 wrds)
                 :LOUT-ATBL      (nth 5 wrds)
                 :LOUT-ATBL-FLGS (nth 6 wrds)
                 :LOUT-NUMPAD    (nth 7 wrds)
                 :LOUT-ACCENTS   (nth 8 wrds)

                 :LOUT-INTL     (let ((val (nth 9 wrds)))  (and val (/= 0 (length val))))
                 :LOUT-LATIN    (let ((val (nth 10 wrds)))  (and val (/= 0 (length val))))))
          info))
      )))

;;;(pop *kmp-info*)
(progn 
  (setf *kmp-info* (read-kmp-info #p"src:kmp_util;KeyMapperLanguages.txt"))


  (with-open-file (os #p"src:kmp_util;KeyMapperLanguages.lisp" 
                      :direction :OUTPUT
                      :if-exists :SUPERSEDE
                      :if-does-not-exist :CREATE)
    (pprint *kmp-info* os)))

How to switch Safari's tooltips off

defaults write com.apple.Safari WebKitShowsURLsInToolTips 0

Force AppleMail to request mail recieve notifications

defaults write com.apple.mail UserHeaders '{"Disposition-Notification-To" = "Name@mail"; }'

sbcl-init.lisp

(setf (logical-pathname-translations "home") 
        `(("**;*.*.*" ,(concatenate 'string (posix-getenv "HOME") "/**/*.*")))

      (logical-pathname-translations "sbcl") 
        `(("**;*.*.*" ,(logical-pathname "home:Library;sbcl;**;*.*")))

      (logical-pathname-translations "src") 
        `(("**;*.*.*" ,(logical-pathname "home:Src;**;*.*")))

      (logical-pathname-translations "systems") 
        `(("**;*.*.*" ,(logical-pathname "sbcl:systems;**;*.*"))))


(require 'asdf)
(setf asdf:*central-registry* '(#p"systems:"))


(asdf:operate 'asdf:load-op 'asdf-install)
(setf asdf-install:*locations* 
        `((,(truename "systems:src") 
           ,(truename "systems:") 
           "SBCL specific installation")))

openmcl-init.lisp

(setf (logical-pathname-translations "src") 
        `(("**;*.*.*" ,(logical-pathname "home:Src;**;*.*")))

      (logical-pathname-translations "systems") 
        `(("**;*.*.*" ,(logical-pathname "home:Library;CCL;systems;**;*.*"))))

(load "ccl:tools;asdf.lisp")
(setf asdf:*central-registry* 
        '( *default-pathname-defaults* #p"systems:"))


(asdf:operate 'asdf:load-op 'asdf-install)
(setf asdf-install:*locations* 
        `((,(truename "systems:src") 
           ,(truename "systems:") 
           "Personal installation")))

Map on lines in Emacs

;;;--------------------------------------------------------------------
(defun u:map-lines (beg end func)

  "Call given FUNC in the form (LAMBDA (LBEG LEND LSTR LCOUNT)...)
for every line in the region. By default just print them."

  (interactive "r\nXMap Function ((LAMBDA (LSTR LBEG LEND LCOUNT) ...)): ")
   
  (let ((count 1)
        (inhibit-field-text-motion t))
    
    (when (stringp func)
      (setq func (car (read (eval (concat "(" func ")"))))))

    (unless func 
      (setq func #'(lambda (s b e c) (princ (format "%4d:%s" c s)))))
  
    (save-excursion
      (save-match-data
        (goto-char beg)

        (let (lbeg 
              lend 
              lstr
              (delta (- (point-max) end)))

          (while (< (point) (- (point-max) delta))
          
            (setq lbeg (line-beginning-position 1))
            (setq lend (line-beginning-position 2))
            (setq lstr (buffer-substring-no-properties lbeg lend))
            
            (funcall func lstr lbeg lend count)

            (goto-char lbeg)            ; line can be changed
            (forward-line 1)
  
            (incf count)))))))


;;--------------------------------------------------------------------
(defun u:remove-duplicates (beg end)
  (interactive "r")

  (let (prev-line)
    (u:map-lines beg end 
                 #'(lambda (line b e)
                     
                     (when (and prev-line
                                (string= prev-line line))
                                
                       (delete-region b e))
                       
                     (setq prev-line line)))))


;;--------------------------------------------------------------------
(defun u:num-lines (beg end start-num)
  (interactive "r\np")

  (when (not start-num) (setq start-num 0))
  (u:map-lines beg 
               end
               #'(lambda (s b e n) 
                   (delete-region b e)
                   (insert (format "%d: %s" (+ n start-num -1) s)) )))

Loop on lines in emacs (version 1)

(defmacro do-lines (args &rest body)
  (let ((line (gensym "line-"))
        (beg  (gensym "beg-"))
        (end  (gensym "end-")))
                
    `(let (,@args)
       (save-excursion
         (save-match-data
           (goto-char (point-min))
           (while (< (point) (point-max))
             (setq ,beg (point))
             (forward-line 1)
             (setq ,end (point))
             (setq ,line (buffer-substring-no-properties ,beg ,end))
             
             (setq ,(car args) ,line)
             (when ',(cdr args) (setq ,(cadr args) ,beg))
             (when ',(cddr args) (setq ,(caddr args) ,end))

             (progn ,@body)))))))

(let (lines)
  (do-lines (l b e) 
            (push (cons l e) lines))
  (reverse lines))

How to open file in some applicationl with AppleScript

The one way is:

 set the_application to path to application "TextEdit"
 tell application "Finder"
  open the_file using the_application
 end tell

but the best seems to be:

set f to choose file of type "TEXT"
tell application "Finder"
 set a to application file id "com.apple.TextEdit"
 open f using a
end tell

EMACS HOOKS FOR SWITCHING HEADER TO PROPER MODE

;; C-HOOK FOR SWITCHING HEADER TO PROPER MODE
(defun u:objc-h-match ()
  (and (string-match "\\.[hH]$" (buffer-file-name))
       (string-match "^\\(@\\|#import\\)" (buffer-string))))

(defun u:c++-h-match ()
  (and (string-match "\\.[hH]$" (buffer-file-name))
       (string-match "^\s*\\(class\s*.*\\(\s*:\s*public\\|protected\\|private\\)?\\)\\|\\(public\\|protected\\|private\\):\\|\\\\|\\"
                     (buffer-string))))
                  
(push '(u:objc-h-match . objc-mode) magic-mode-alist)
(push '(u:c++-h-match . c++-mode)   magic-mode-alist)

How To Get a List of Keyborad Layouts using F-Script

Inject F-Script into System Preferences with F-Script Anywhere. Switch to International ->Input Menu. From FSA menu create a new workspace and then from that workspace open a browser for the list of layouts (that is an object of the NoSelectionTableView class) and name that object and its data source (IntlKeyboardDataSource). In the script below I use the 'tview' and dsrc' names correspondingly.

> str := NSString new.
> 0 to: ((tview numberOfRows) - 1) do:
  [ :i | |name|
    ((dsrc isInputMethodForRow: i) | (dsrc isKeyboardRow: i))
        ifTrue: 
        [ name := dsrc resNameForRow: i.
          name ~~ nil ifTrue: [ str := str ++ name ++ '\n' ]]]
>str writeToFile: '/Users/sasha/tmp/Layouts' atomically: false.

Folder Action to create TODAY folder

The script below, if used as Folder Action Script, will authomatically create a folder with the current date as a name and link to it named _Today in every folder for which the corrspondent action is activated. To use it put it in the ~/Library/Scripts/Folder Action Scripts/ folder

on opening folder this_folder
 set tf_path to POSIX path of this_folder
 set dt to tf_path & "/" & (do shell script "date +%Y-%m-%d")
 set TODAY to tf_path & "/_Today"
 do shell script "DT=\"" & dt & "\" ; TODAY=\"" & TODAY & "\"; if [ ! -d $DT ] ; then  mkdir $DT ; pwd > ~/aaa; else pwd > ~/aaa ;  fi; if [  -h $TODAY ] ; then rm $TODAY ; fi; ln -s $DT $TODAY;"
end opening folder

Back To Etags

In my previous post I wrote about using exuberant-ctags for emacs and Objective-C. But for some reason exuberant-ctags failed to create tags for funcions in /usr/include/string.h on my Mac. So, I switched back to etags. Here the correspondent shell script for generating tags for system headers on Mac OS X:

#!/bin/sh
s="\t "
S="[$s]*"
w="_a-zA-Z0-9"
CN="[A-Z][$w]*"
NM="[$w][$w]*"

ETAGS="/Applications/Emacs.app/Contents/MacOS/bin/etags"

cat /dev/null > tmp.tags
find /usr/include -name "*.h" -exec \
$ETAGS -a --declarations -o tmp.tags \
"{}" ";"
mv tmp.tags include.tags

cat /dev/null > tmp.tags
find /System/Library/Frameworks -name "*.h" -exec \
$ETAGS -a --declarations -o tmp.tags \
-r "/$S[-+]$S(\($S$NM\)\{1,3\}$S\**$S)?$S\($NM\)$S[:;]/\2/" \
"{}" ";"
sed "/^@class/d" tmp.tags > Frameworks.tags
rm tmp.tags


Using Exuberant Ctags with Emacs And Objective-C

Below is a small script that generates Emacs tags files for the header files in /System/Library/Frameworks and /usr/include on Mac:

#!/bin/sh
s="\t "
S="[$s]*"
w="_a-zA-Z0-9"
CN="[A-Z][$w]*"
NM="[$w][$w]*"


cat /dev/null > tmp.tags
find /usr/include -name "*.h" -exec \
ctags -e -a -o tmp.tags "{}" ";"

awk -v LINE="" ' { if (LINE != $0) {LINE = $0; print $0;} }' tmp.tags > include.tags

cat /dev/null > tmp.tags
find /System/Library/Frameworks -name "*.h" -exec \
ctags -e -a -o tmp.tags \
--regex-C++="/^@(interface|protocol)$S($CN($S\($CN\))*)/\2/c/" \
--regex-C++="/^$S(\-|\+)$S\($S$NM($S$NM)*$S\**$S\)*$S($NM)$S[:;]/\3/f/" \
"{}" ";"

awk -v LINE="" ' { if (LINE != $0) {LINE = $0; print $0;} }'
tmp.tags > Frameworks.tags
rm tmp.tags